INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

Song files information

Song files information

(OP)
[b]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?

RE: Song files information

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.

CODE

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:

CODE

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.

RE: Song files information

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.

RE: Song files information

>a bit tougher though.

Not that much tougher.


Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members!

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close