Song files information

Option Explicit

'Drag music file's Explorer icon onto this program's icon and drop it.

Private Const ssfDESKTOP = 0 'Root of the Shell filesystem namespace.

Private Const EM_SETTABSTOPS = &HCB&

Private Declare Function InvalidateRect Lib "user32" ( _
    ByVal hWnd As Long, _
    ByVal lpRect As Long, _
    ByVal bErase As Long) As Long

Private Declare Function SendMessage Lib "user32" Alias "SendMessageW" ( _
    ByVal hWnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long

Private ShellFolderItem As Object

Public Sub TBSetTabstops( _
    ByVal TextBox As VB.TextBox, _
    ParamArray Tabs() As Variant)
    'Set tab stops at list of char positions.  Pass 1 value
    'to set tabs at each n positions (i.e. all further stops are at
    'the offset of the last value passed).
    Dim lngTabCount As Long
    Dim dtuTabsVals() As Long
    Dim I As Integer
    
    lngTabCount = UBound(Tabs)
    If lngTabCount > -1 Then
        ReDim dtuTabsVals(lngTabCount)
        For I = 0 To lngTabCount
            dtuTabsVals(I) = 4 * Tabs(I)
        Next
        lngTabCount = lngTabCount + 1 'UBound() to Count.
        SendMessage TextBox.hWnd, EM_SETTABSTOPS, lngTabCount, _
                    VarPtr(dtuTabsVals(0))
        InvalidateRect TextBox.hWnd, 0&, False
    End If
End Sub

Private Sub Pr(ByVal Name As String, ByVal Value As String)
    With Text1
        .SelStart = &H7FFF
        .SelText = Name
        .SelText = vbTab
        .SelText = Value
        .SelText = vbNewLine
    End With
End Sub

Private Sub PrExtProp(ByVal PropName As String)
    'Retrieve, decode, and "print" common Shell Extended Property types
    'prefixed by their abbreviated names.
    Const VT_UI4 = 19
    Const VT_UI8 = 21
    Dim ExtProp As Variant
    Dim Value As String

    ExtProp = ShellFolderItem.ExtendedProperty(PropName)
    If IsEmpty(ExtProp) Then
        Value = "n/a"
    Else
        If VarType(ExtProp) And vbArray Then
            'We'll assume VT_STRING array:
            Value = Join$(ExtProp, ", ")
        Else
            Select Case VarType(ExtProp)
                Case vbString
                    Value = ExtProp
                Case VT_UI4
                    'This is not a VB VarType, but CStr() can convert them
                    'to a String.
                    Value = CStr(ExtProp)
                Case VT_UI8
                    'This is not a VB VarType.  Things like Duration come
                    'back as these with values in 100ns units.
                    ExtProp = Int(CCur(CStr(ExtProp)) / 10000000@) 'To seconds.
                    Value = Format$(TimeSerial(0, 0, ExtProp), "Hh:Nn:Ss")
                Case Else
                    'Punt.
                    Value = "?"
                    On Error Resume Next
                    Value = CStr(ExtProp)
                    On Error GoTo 0
            End Select
        End If
    End If
    Pr Mid$(PropName, InStrRev(PropName, ".") + 1), Value
End Sub

Private Sub Form_Load()
    Dim FullPath As String
    
    FullPath = Command$()
    If Left$(FullPath, 1) = """" Then FullPath = Mid$(FullPath, 2, Len(FullPath) - 2)
    
    With CreateObject("Shell.Application")
        Set ShellFolderItem = .NameSpace(ssfDESKTOP).ParseName(FullPath)
    End With
    
    TBSetTabstops Text1, 12
    Pr "File", ShellFolderItem.Name
    'From Windows SDK header file propkey.h:
    PrExtProp "System.Music.AlbumTitle"
    PrExtProp "System.Music.AlbumArtist"
    PrExtProp "System.Title"
    PrExtProp "System.Music.Artist"
    PrExtProp "System.Media.Year"
    PrExtProp "System.Media.Duration"
    PrExtProp "System.Music.TrackNumber"
    PrExtProp "System.Music.Genre"
End Sub

Private Sub Form_Resize()
    If WindowState <> vbMinimized Then
        Text1.Move 0, 0, ScaleWidth, ScaleHeight
    End If
End Sub

File        sealab.mp3
AlbumTitle  Sealab 2021
AlbumArtist Calamine
Title       Sealab 2021 Theme
Artist      Calamine
Year        2001
Duration    00:00:27
TrackNumber n/a
Genre       Soundtrack