Song files information

[icryalot]

I have created a program that will print a song list that will fit inside a slim line CD plastic holder. It works fine but I have to type each song name and artist name individually which is really time consuming.
I would like to place up to 25 song tiles at one time from a list of song files
on a list by a copy and paste routine and print them.
Any ideas as to how I can copy the song titles and artist names from a music file?

 

[dilettante]

As long as you can leave the unsupported, unsafe, Windows Xp and earlier behind you it is fairly simple. You can ask the Windows Shell (a.k.a. Explorer) to retrieve these for you.

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

Sample run:

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

On older OSs things get a bit tougher though.

 

[Andrzejek]

icryalot, when you say: "song files" or "music file", do you mean MP3?

Have fun.

---- Andy

A bus station is where a bus stops. A train station is where a train stops. On my desk, I have a work station.

 

[strongm]

>a bit tougher though.

Not that much tougher.