Results 1 to 18 of 18

Thread: [VB6] Write MP3 Album Art and other tags using the Windows Property System

  1. #1

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,651

    [VB6] Write MP3 Album Art and other tags using the Windows Property System


    None of the VB ID3 classes seem to support adding a thumbnail for the album art in an MP3 (the APIC tag), and I've tried to add such support without much success*. But earlier today, we were talking about writing Unicode to ID3 tags, which my shell browser control does through the Windows Property System, and I got thinking about album covers. When I saw Microsoft listed PKEY_ThumbnailStream on a page called 'Metadata Properties For Media Files' I got curious if that meant MP3 to.
    It did, and my browser could then display them as thumbnails thanks to a technique based on dilettante's project to read that property. And that of course led to wondering... my shell browser reads it through an object's IPropertyStore, writes other properties through that... could I write album art? It's a little tricky but the answer is yes.

    So here's a demo of that technique. It also has an option to write the Album Title to demonstrate writing the more simple tags through Windows as well. Note that the VB textbox doesn't support Unicode, but if you did pass a Unicode string to the function, it works.

    Requirements
    -Windows Vista or newer
    -oleexp.tlb 4.6 or higher


    The Code
    Here's what the core routine looks like (declares/support funcs not included, see download)
    Code:
    Private Function WriteCover(sJPG As String, sMP3 As String, Optional sTitle As String = "") As Long
    Dim hFile As Long, nFile As Long, lp As Long
    Dim hBitmap As Long
    Dim hImage As Long
    Dim hGG As Long, lpGlobal As Long
    hFile = CreateFileW(StrPtr(sJPG), FILE_READ_DATA, FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, 0, 0)
    If hFile Then
        'read bitmap file into memory
        nFile = GetFileSize(hFile, lp)
        hGG = GlobalAlloc(GPTR, nFile)
        lpGlobal = GlobalLock(hGG)
        If lpGlobal Then
            Dim oStrm As oleexp.IUnknown
            Call ReadFile(hFile, ByVal lpGlobal, nFile, nFile, ByVal 0&)
            Call GlobalUnlock(hGG)
            Call CreateStreamOnHGlobal(hGG, 1, oStrm)
        
            Dim vbr As Variant, vpr As Variant
        
            Set vbr = oStrm
            VariantToPropVariant vbr, vpr
            
            'At this point since VARIANT doesn't support VT_STREAM, its type is VT_UNKNOWN
            'So the PROPVARIANT is also VT_UNKNOWN. But that will give us a type mismatch.
            'PropVariantChangeType seems to only support numbers, so we manually change the type
            'to VT_STREAM, which is valid because our IUnknown object is an IStream.
            'In the PROPVARIANT structure, the first two bytes are the VARENUM value indicating type
            Dim vt As Integer
            vt = VT_STREAM
            CopyMemory ByVal VarPtr(vpr), ByVal VarPtr(vt), 2&
    
            Dim si2 As IShellItem2
            Dim pps As IPropertyStore
            oleexp.SHCreateItemFromParsingName StrPtr(sMP3), Nothing, IID_IShellItem2, si2
            
            si2.GetPropertyStore GPS_OPENSLOWITEM Or GPS_READWRITE, IID_IPropertyStore, pps
            If (pps Is Nothing) = False Then
                Dim hr As Long
                hr = pps.SetValue(PKEY_ThumbnailStream, vpr)
                If hr <> S_OK Then
                    WriteCover = hr
                    Exit Function
                End If
                hr = 0
                'Title is easy by comparison. You can write any other string ID3 tags
                'that have a PKEY in Windows as well (see mPKEY.bas or propkey.h)
                If sTitle <> "" Then
                    hr = pps.SetValue(PKEY_Music_AlbumTitle, CVar(sTitle))
                    If hr <> S_OK Then
                        WriteCover = hr
                        Exit Function
                    End If
                    hr = 0
                End If
                hr = pps.Commit()
                WriteCover = hr
            End If
            GlobalFree hGG
            CloseHandle hFile
        End If
    End If
    End Function


    * - I tried writing the APIC tag in clsID3v2 but I just couldn't get it to write without a couple bytes elsewhere in the tag getting corrupted and breaking the tag.
    Attached Files Attached Files
    Last edited by fafalone; Nov 1st, 2019 at 07:10 AM.

  2. #2

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,651

    Re: [VB6] Write MP3 Album Art and other tags using the Windows Property System

    Other Notes

    To read the cover image, you do something like this:
    Code:
    Dim si2 As IShellItem2
    Dim vProp As Variant, vrProp As Variant
    
    
    oleexp.SHCreateItemFromParsingName StrPtr(sMP3), Nothing, IID_IShellItem2, si2
    If (si2 Is Nothing) = False Then
        si2.GetProperty PKEY_ThumbnailStream, vProp
        PropVariantToVariant vProp, vrProp
        If VarType(vrProp) = vbDataObject Then
            HBITMAP = hBitmapFromStream(vrProp)
        Else
            Debug.Print "No thumbstream found, VT=" & VarType(vrProp), 2
        End If
    Else
        Debug.Print "Failed to create IShellItem2", 2
    End If
    
    'with
    Private Function hBitmapFromStream(ByVal ImageSteam As oleexp.IStream) As Long
        Dim GdipBitmap As Long
        Dim hBitmap As Long 'GDI Bitmap handle.
    
        If gdipInitToken Then
            If GdipCreateBitmapFromStream(ImageSteam, GdipBitmap) = 0 Then 'GDIP_OK Then
                If GdipCreateHBITMAPFromBitmap(GdipBitmap, hBitmap, 0) = 0 Then 'GDIP_OK Then
                    hBitmapFromStream = hBitmap
                Else
                    Debug.Print "hBitmapFromStream failed at hbmpfrombmp|"
                End If
            Else
                Debug.Print "hBitmapFromStream failed at bmpFromStream"
            End If
        Else
            Debug.Print "GDIP not initialized"
        End If
    
    End Function
    That's the general idea to get an HBITMAP you can then display wherever.

    You can use the same GetProperty call to read the string ID3 tags; just use a Variant then CStr().
    Last edited by fafalone; Nov 29th, 2019 at 06:31 PM.

  3. #3
    Hyperactive Member
    Join Date
    Dec 2008
    Location
    Argentina
    Posts
    439

    Re: [VB6] Write MP3 Album Art and other tags using the Windows Property System

    Thanks for sharing, I researched a little more and found other keys to recover other data so I decided to put together a class module, it works fine, but in some cases "I think" that when the items are empty they may not be written correctly.

    I share here the class module accompanied by an example.

    Name:  captura.jpg
Views: 1876
Size:  36.5 KB

    Mp3 Tag Editor.zip
    leandroascierto.com Visual Basic 6 projects

  4. #4

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,651

    Re: [VB6] Write MP3 Album Art and other tags using the Windows Property System

    You might need to check the types in those cases... like Track Number takes a 4-byte unsigned integer, not a string, so there may be a problem related to something like that. So you'd want at least CVar on a Long instead of a string, but to be sure I change it to unsigned since the PROPVARIANT data type need not be supported in VB to be passed to the property store; you can use PropVariantChangeType and convert the Variant to VT_UI4.

    Very nice work.


    Edit- Just a small side note, prefixing API calls like oleexp.SHCreateItemFromParsingName is just to avoid conflicts, like in case in some other module you had Public Declare Function SHCreateItemFromParsingName and the declare differed (in this case, ByVal pbc As Long or As Any is sometimes used instead of pbc As IBindCtx). In that case a plain call would go to the module as modules are higher priority than TLBs. It's not mandatory, so you need only prefix API calls with oleexp. if you're expecting conflicts.
    Last edited by fafalone; Nov 6th, 2019 at 12:54 AM.

  5. #5
    Junior Member
    Join Date
    Oct 2018
    Posts
    28

    Re: [VB6] Write MP3 Album Art and other tags using the Windows Property System

    I have used the 'Modern Shell Interface' with the class 'ClsID3' and 'oleexp.tlb' to extract the Itags from
    the Mp3 files, but unfortunately it is extremely slow when I want to extract more than 10,000 files
    the Itag information and then save it in a database of data.

    To have an idea to obtain the Itag of about 7,500 files it took approximately 18min. I would like to know if something can be done faster.

    Since for each Itag extraction (Title, Album, etc ..) the 'LoadFile' Function is called, reopening the files for each Itag that we want to extract.
    Thanks.

    Code:
    'FCnt = Total MP3 files found 
    For i = 1 To FCnt
       With cID3
          RutaSong = Trim(F(i))
               If .LoadFile(RutaSong) = True Then   'Call class
                    List1.AddItem .title
              End if
      End With 
    Next

  6. #6

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,651

    Re: [VB6] Write MP3 Album Art and other tags using the Windows Property System

    I looked at the class and it's reading each value with a IShellItem2.GetProperty call, so for each file it's opening and closing the property store over a dozen times.

    Instead, create an IPropertyStore object in loadfile, use IShellItem2.GetPropertyStore (or even better, GetPropertyStoreForKeys, which opens a limited store for only the PKEYs specified), and read the properties from that. Or, if you only need the title, just read that (you can keep using .GetProperty if it's just a single prop)-- the class is reading image data, that's going to slow it down quite a bit if your mp3s have art in them. But every unneeded tag slows it down.

  7. #7
    Junior Member
    Join Date
    Oct 2018
    Posts
    28

    Re: [VB6] Write MP3 Album Art and other tags using the Windows Property System

    Hello,

    uffffff is very complicate, I've been this morning and there's no way.
    I have modified the 'LoadFile' function with the following code, which I don't know how to load the 'PKeys' in the call to 'PSGetPropertyDescription' on ????????

    Code:
    Public Function LoadFile(ByVal sPath As String) As Boolean
       On Error GoTo ErrItags
    
        Dim pps As IPropertyStore
        Dim psi As IShellItem2
        Dim i As Long
        Dim pProp As IPropertyDescription
        Dim lpProp As Long
        Dim sProp As String
        Dim PkeyPro As Integer
    
        Call SHCreateItemFromParsingName(StrPtr(sPath), ByVal 0&, IID_IShellItem2, si2)
        psi.GetPropertyStore GPS_DEFAULT Or GPS_BESTEFFORT Or GPS_OPENSLOWITEM, IID_IPropertyStore, pps
         With FrmMain
               PkeyPro = PKEY_Music_AlbumTitle : GoSub GetItagName: .List1.AddItem sProp  'Album
               PkeyPro = PKEY_Title : GoSub GetItagName: .List1.AddItem sProp  'Titulo
          .List1.AddItem "--------------------"
        End With
    
    LoadFile = True
    Exit Function
    
    GetItagName:
           PSGetPropertyDescription ????????? , IID_IPropertyDescription, pProp
           PSFormatPropertyValue ObjPtr(pps), ObjPtr(pProp), PDFF_DEFAULT, lpProp
          sProp = BStrFromLPWStr(lpProp)
       Return
    
    
    ErrItags:
       LoadFile = False
    End Function
    My Pkeys:

    Code:
    Private Const PKEY_ThumbnailStream = "{F29F85E0-4FF9-1068-AB91-08002B27B3D9},27"
    Private Const PKEY_Music_Artist = "{56A3372E-CE9C-11D2-9F0E-006097C686F6}, 2"
    Private Const PKEY_Title = "{F29F85E0-4FF9-1068-AB91-08002B27B3D9},2"
    Private Const PKEY_Music_AlbumTitle = "{56A3372E-CE9C-11D2-9F0E-006097C686F6}, 4"
    Private Const PKEY_Media_Year = "{56A3372E-CE9C-11D2-9F0E-006097C686F6},5"
    Private Const PKEY_Audio_VariableBitRate = "{e6822fee-8c17-4d62-823c-8e9cfcbd1d5c}, 100" 'If empty VBR=True
    Private Const PKEY_Media_EncodedBy = "{64440492-4C8B-11D1-8B70-080036B11A03},36"
    Private Const PKEY_Audio_ChannelCount = "{64440490-4C8B-11D1-8B70-080036B11A03},7"
    Private Const PKEY_Music_Genre = "{56A3372E-CE9C-11D2-9F0E-006097C686F6},11"
    Private Const PKEY_Media_Duration = "{64440490-4C8B-11D1-8B70-080036B11A03},3"
    Private Const PKEY_Music_TrackNumber = "{56A3372E-CE9C-11D2-9F0E-006097C686F6},7"
    Private Const PKEY_Audio_EncodingBitrate = "{64440490-4C8B-11D1-8B70-080036B11A03},4"
    Private Const PKEY_Audio_SampleSize = "{64440490-4C8B-11D1-8B70-080036B11A03}, 6"
    Private Const PKEY_Audio_SampleRate = "{64440490-4C8B-11D1-8B70-080036B11A03},5"
    Private Const PKEY_Comment = "{F29F85E0-4FF9-1068-AB91-08002B27B3D9},6"
    
    
    
    Private Function Load_PKey() As Boolean
     
     Dim P As Integer
      For P = 1 To 15
          ReDim Preserve PropKeyP(P)
            PropKeyP(P).Cover_ThumbnailStream = PKEY_ThumbnailStream
            PropKeyP(P).Music_Artist = PKEY_Music_Artist
            PropKeyP(P).Music_Title = PKEY_Title
            PropKeyP(P).Music_AlbumTitle = PKEY_Music_AlbumTitle
            PropKeyP(P).Media_Year = PKEY_Media_Year
            PropKeyP(P).Audio_VariableBitRate = PKEY_Audio_VariableBitRate
            PropKeyP(P).Media_EncodedBy = PKEY_Media_EncodedBy
            PropKeyP(P).Audio_ChannelCount = PKEY_Audio_ChannelCount
            PropKeyP(P).Music_Genre = PKEY_Music_Genre
            PropKeyP(P).Media_Duration = PKEY_Media_Duration
            PropKeyP(P).Music_TrackNumber = PKEY_Music_TrackNumber
            PropKeyP(P).Audio_EncodingBitrate = PKEY_Audio_EncodingBitrate
            PropKeyP(P).Audio_SampleSize = PKEY_Audio_SampleSize
            PropKeyP(P).Audio_SampleRate = PKEY_Audio_SampleRate
            PropKeyP(P).Music_Comment = PKEY_Comment
     Next
       Load_PKey = True
    End Function
    Thank you.
    Last edited by Lompin; Apr 22nd, 2021 at 12:42 PM.

  8. #8

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,651

    Re: [VB6] Write MP3 Album Art and other tags using the Windows Property System

    You have to pass a PROPERTYKEY type to PSGetPropertyDescription, not a string.

    Code:
    Private Sub DEFINE_PROPERTYKEY(Name As PROPERTYKEY, L As Long, w1 As Integer, w2 As Integer, B0 As Byte, b1 As Byte, b2 As Byte, B3 As Byte, b4 As Byte, b5 As Byte, b6 As Byte, b7 As Byte, pid As Long)
      With Name.fmtid
        .Data1 = L: .Data2 = w1: .Data3 = w2: .Data4(0) = B0: .Data4(1) = b1: .Data4(2) = b2: .Data4(3) = B3: .Data4(4) = b4: .Data4(5) = b5: .Data4(6) = b6: .Data4(7) = b7
      End With
      Name.pid = pid
    End Sub
    
    Private Function tPKEY_Music_AlbumTitle() As PROPERTYKEY
    Static pkk As PROPERTYKEY
     If (pkk.fmtid.Data1 = 0&) Then Call DEFINE_PROPERTYKEY(pkk, &H56A3372E, &HCE9C, &H11D2, &H9F, &HE, &H0, &H60, &H97, &HC6, &H86, &HF6, 4)
    tPKEY_Music_AlbumTitle = pkk
    End Function
    then
    Code:
    Private Declare Function PSGetPropertyDescription Lib "propsys.dll" (PropKey As oleexp.PROPERTYKEY, riid As oleexp.UUID, ppv As Any) As Long
    
    PSGetPropertyDescription tPKEY_Music_AlbumTitle, IID_IPropertyDescription, pProp
    I put a t in front of it so it doesn't conflict with your existing code there.


    -

    Can you clarify exactly what you're trying to and what keys you need? Can probably write up the quickest way to do it.

  9. #9

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,651

    Re: [VB6] Write MP3 Album Art and other tags using the Windows Property System

    Here's a barebones routine to read PKEY_Title and PKEY_Music_AlbumTitle like you're doing.

    This will be about as fast as gets before you have to start going for extremes (you can look at my ucShellBrowse project... it will open a folder of thousands of mp3s with titles/albums displayed in a second; but loads album/title on demand instead of all at once.

    Name:  mp3read.jpg
Views: 1258
Size:  26.8 KB

    Code:
    Private Sub Command1_Click()
    
    Dim siPath As IShellItem
    Dim siChild As IShellItem, si2 As IShellItem2
    Dim sTitle As String
    Dim sAlbum As String
    Dim sFile As String
    Dim sOut As String
    Dim pEnum As IEnumShellItems
    Dim pc As Long
    Dim vpv As Variant, vbv As Variant
    Dim pps As IPropertyStore
    Dim tPK() As PROPERTYKEY
    ReDim tPK(2)
    oleexp.SHCreateItemFromParsingName StrPtr(Text1.Text), Nothing, IID_IShellItem, siPath
    If (siPath Is Nothing) Then
        Debug.Print "Invalid path."
        Exit Sub
    End If
    
    tPK(0) = PKEY_FileName
    tPK(1) = PKEY_Title
    tPK(2) = PKEY_Music_AlbumTitle
    
    siPath.BindToHandler 0&, BHID_EnumItems, IID_IEnumShellItems, pEnum
    Do While pEnum.Next(1&, siChild, pc) = S_OK
        If (siChild Is Nothing) = False Then
            Set si2 = siChild
            si2.GetPropertyStoreForKeys tPK(0), UBound(tPK) + 1&, GPS_OPENSLOWITEM Or GPS_BESTEFFORT, IID_IPropertyStore, pps
            If (pps Is Nothing) = False Then
                pps.GetValue PKEY_Title, vpv
                PropVariantToVariant vpv, vbv
                sTitle = CStr(vbv)
                pps.GetValue PKEY_Music_AlbumTitle, vpv
                PropVariantToVariant vpv, vbv
                sAlbum = CStr(vbv)
                pps.GetValue PKEY_FileName, vpv
                PropVariantToVariant vpv, vbv
                sFile = CStr(vbv)
                sOut = sFile & " Title=" & sTitle & ",Album=" & sAlbum
                List1.AddItem sOut
            End If
        End If
        Set si2 = Nothing
        Set siChild = Nothing
    Loop
    
    End Sub
    As you can see, it uses the GetPropertyStoreForKeys method to get a limited-purpose PropertyStore with only the items we're interested, instead a store were you can access any property.

    If you want to add another tag to read, add the PROPERTYKEY to tPK. The keys have to actual PROPERTYKEY structures though, not strings. See Module1.bas in the project. If you never want to have to worry about defining Property Keys, oleexp.tlb comes with a module called mPKEY.bas with all general purpose keys-- you can add the module, and only what you use will be compiled into your project, not the whole thing.

    Using the PROPERTYKEY type:
    Code:
    Public Sub DEFINE_PROPERTYKEY(Name As PROPERTYKEY, L As Long, w1 As Integer, w2 As Integer, B0 As Byte, b1 As Byte, b2 As Byte, B3 As Byte, b4 As Byte, b5 As Byte, b6 As Byte, b7 As Byte, pid As Long)
      With Name.fmtid
        .Data1 = L: .Data2 = w1: .Data3 = w2
        .Data4(0) = B0: .Data4(1) = b1: .Data4(2) = b2: .Data4(3) = B3: .Data4(4) = b4: .Data4(5) = b5: .Data4(6) = b6: .Data4(7) = b7
      End With
      Name.pid = pid
    End Sub
    
    Public Function PKEY_Music_AlbumTitle() As PROPERTYKEY
    Static pkk As PROPERTYKEY
     If (pkk.fmtid.Data1 = 0&) Then Call DEFINE_PROPERTYKEY(pkk, &H56A3372E, &HCE9C, &H11D2, &H9F, &HE, &H0, &H60, &H97, &HC6, &H86, &HF6, 4)
    PKEY_Music_AlbumTitle = pkk
    End Function
    and they go on like that in module, with something similar for IID_ values.

    Saves you from having to convert string to GUID then GUID+PID to PROPERTYKEY.

    Regarding PKEY_ThumbnailStream... that's the cover image, JPG or PNG... you really don't want to pre-load 7,500 of these... you can't display that many at once unless you've got like a giant video wall, and might have memory issues. Load them on demand.
    Attached Files Attached Files
    Last edited by fafalone; Apr 23rd, 2021 at 01:51 AM.

  10. #10
    Junior Member
    Join Date
    Oct 2018
    Posts
    28

    Re: [VB6] Write MP3 Album Art and other tags using the Windows Property System

    Thank you,
    I've been modifying my program so you can see what you think and if it can be improved.
    Now it is much faster, to read the Itags that interest me it takes about 2 minutes instead of 18 minutes that it used to take to read 7.841 music files, we have improved a lot.

    I have been testing your program and it disappears or there is something that makes the system close it.
    Now I will see it in more depth, there is something that I do not understand much, I will tell you.


    Attachment 181163

    Greetings.

  11. #11
    Junior Member
    Join Date
    Oct 2018
    Posts
    28

    Re: [VB6] Write MP3 Album Art and other tags using the Windows Property System

    Hello,

    I have been examining the code and it fails on this line:
    Code:
            si2.GetPropertyStoreForKeys tPK(0), UBound(tPK) + 1&, GPS_OPENSLOWITEM Or GPS_BESTEFFORT, IID_IPropertyStore, pps
    Modify the code above a bit because it only read the files in the main folder and not the subfolders and the code looked like this.

    Code:
    Dim Itags As ClsItags
    si2 As IShellItem2
    Dim sTitle As String
    Dim sAlbum As String
    Dim sYear As String
    Dim sOut As String
    Dim pEnum As IEnumShellItems
    Dim pc As Long
    Dim vpv As Variant, vbv As Variant
    Dim pps As IPropertyStore
    Dim tPK() As PROPERTYKEY
    Dim F() As String
    Dim FCnt As Long
    Dim i As Long
    Dim IDir As String
    
    ReDim tPK(2)
    
    tPK(0) = tPKEY_Music_Title
    tPK(1) = tPKEY_Music_AlbumTitle
    tPK(2) = tPKEY_Media_Year
    
    
    IDir = "F:\JoyingCar"
    
    EnumFiles IDir, F, FCnt, "*.mp3*;* ", True
    
    For i = 1 To FCnt
       DoEvents
     
          oleexp.SHCreateItemFromParsingName StrPtr(Trim(F(i))), Nothing, IID_IShellItem2, si2
         ' Call SHCreateItemFromParsingName(StrPtr(fPath), ByVal 0&, IID_IShellItem2, si2)
    
     
           ProgressBar1.Value = i
            Label2.Caption = "Total Files: " & Format(FCnt, "##,##") & "/" & Format(i, "##,##")
    
            si2.GetPropertyStoreForKeys tPK(0), UBound(tPK) + 1&, GPS_OPENSLOWITEM Or GPS_BESTEFFORT, IID_IPropertyStore, pps
              If (pps Is Nothing) = False Then
                pps.GetValue tPKEY_Music_Title, vpv
                PropVariantToVariant vpv, vbv
                sTitle = CStr(vbv)
                pps.GetValue tPKEY_Music_AlbumTitle, vpv
                PropVariantToVariant vpv, vbv
                sAlbum = CStr(vbv)
                pps.GetValue tPKEY_Media_Year, vpv
                PropVariantToVariant vpv, vbv
                syear = CStr(vbv)
                sOut = "Album=" & sAlbum & "|Title=" & sTitle & " " & sYear
                List1.AddItem sOut
            End If
             Set si2 = Nothing
    Next
    I don't know how I can upload the file with the program?

  12. #12
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: [VB6] Write MP3 Album Art and other tags using the Windows Property System

    Quote Originally Posted by lompin View Post
    thank you,
    i've been modifying my program so you can see what you think and if it can be improved.
    Now it is much faster, to read the itags that interest me it takes about 2 minutes instead of 18 minutes that it used to take to read 7.841 music files, we have improved a lot.

    I have been testing your program and it disappears or there is something that makes the system close it.
    Now i will see it in more depth, there is something that i do not understand much, i will tell you.


    Attachment 181163

    greetings.
    download link err?

  13. #13

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,651

    Re: [VB6] Write MP3 Album Art and other tags using the Windows Property System

    The code is failing how? On all files, certain files?

    Trying adding the GPS_DEFAULT flag.
    Last edited by fafalone; Apr 25th, 2021 at 05:36 PM.

  14. #14
    Junior Member
    Join Date
    Oct 2018
    Posts
    28

    Re: [VB6] Write MP3 Album Art and other tags using the Windows Property System

    Hello,

    By setting 'Set pps = Nothing' the program does not exit or overflow, it seems to be going well.

    Code:
    Dim Itags As ClsItags
    si2 As IShellItem2
    Dim sTitle As String
    Dim sAlbum As String
    Dim sYear As String
    Dim sOut As String
    Dim pc As Long
    Dim vpv As Variant, vbv As Variant
    Dim pps As IPropertyStore
    Dim tPK() As PROPERTYKEY
    Dim F() As String
    Dim FCnt As Long
    Dim i As Long
    Dim IDir As String
    
    ReDim tPK(2)
    
    tPK(0) = tPKEY_Music_Title
    tPK(1) = tPKEY_Music_AlbumTitle
    tPK(2) = tPKEY_Media_Year
    
    
    IDir = "F:\JoyingCar"
    
    EnumFiles IDir, F, FCnt, "*.mp3*;* ", True
    
    For i = 1 To FCnt
       DoEvents
     
          oleexp.SHCreateItemFromParsingName StrPtr(Trim(F(i))), Nothing, IID_IShellItem2, si2
         ' Call SHCreateItemFromParsingName(StrPtr(fPath), ByVal 0&, IID_IShellItem2, si2)
    
     
           ProgressBar1.Value = i
            Label2.Caption = "Total Files: " & Format(FCnt, "##,##") & "/" & Format(i, "##,##")
    
            si2.GetPropertyStoreForKeys tPK(0), UBound(tPK) + 1&, GPS_OPENSLOWITEM Or GPS_BESTEFFORT, IID_IPropertyStore, pps
              If (pps Is Nothing) = False Then
                pps.GetValue tPKEY_Music_Title, vpv
                PropVariantToVariant vpv, vbv
                sTitle = CStr(vbv)
                pps.GetValue tPKEY_Music_AlbumTitle, vpv
                PropVariantToVariant vpv, vbv
                sAlbum = CStr(vbv)
                pps.GetValue tPKEY_Media_Year, vpv
                PropVariantToVariant vpv, vbv
                syear = CStr(vbv)
                sOut = "Album=" & sAlbum & "|Title=" & sTitle & " " & sYear
                List1.AddItem sOut
            End If
    
             Set pps= Nothing       '<<<<<<<
              Set si2 = Nothing
    Next

  15. #15
    Junior Member
    Join Date
    Oct 2018
    Posts
    28

    Re: [VB6] Write MP3 Album Art and other tags using the Windows Property System

    Hello,

    I would like to know the difference in putting 'GPS_DEFAULT Or GPS_FASTPROPERTIESONLY' and GPS_DEFAULT Or GPS_BESTEFFORT to the 'GetPropertyStoreForKeys' call.

    The first one only reads the extensions files, Artist Name, Title and Album all empty, that if it goes super fast but without results.
    The second reads all the keys I have nothing to say.

    Too bad it does not read as fast as the first one would be luxurious.

    Thanks

  16. #16

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,651

    Re: [VB6] Write MP3 Album Art and other tags using the Windows Property System

    the 'Fast properties only' does exactly as it suggests-- only read the properties it can retrieve fast. If it has to load a property handler, that's going to be slow, and for things like mp3 properties, office documents, etc, those use a property handler. best effort tells it to return a property store even if all requested properties aren't available. Here's a page describing all the flags:

    https://docs.microsoft.com/en-us/win...ertystoreflags

  17. #17
    Junior Member
    Join Date
    Oct 2018
    Posts
    28

    Re: [VB6] Write MP3 Album Art and other tags using the Windows Property System

    Hello,

    By entering this 'PKEY_Music_Artist' and 'PKEY_Music_Genre' in your code 'FastReadMP3'
    It gives me the Error '13 - The types do not match 'and I don't understand, let's see if you can verify it. Thanks.

    I have added this:


    Module Bas:
    Code:
    Public Function PKEY_Music_Artist() As PROPERTYKEY
    Static pkk As PROPERTYKEY
     If (pkk.fmtid.Data1 = 0&) Then Call DEFINE_PROPERTYKEY(pkk, &H56A3372E, &HCE9C, &H11D2, &H9F, &HE, &H0, &H60, &H97, &HC6, &H86, &HF6, 2)
    PKEY_Music_Artist = pkk
    End Function
    
    Public Function PKEY_Music_Genre() As PROPERTYKEY
    Static pkk As PROPERTYKEY
     If (pkk.fmtid.Data1 = 0&) Then Call DEFINE_PROPERTYKEY(pkk, &H56A3372E, &HCE9C, &H11D2, &H9F, &HE, &H0, &H60, &H97, &HC6, &H86, &HF6, 11)
     PKEY_Music_Genre = pkk
    End Function
    In 'Go Button'
    Code:
    Dim siPath As IShellItem
    Dim siChild As IShellItem, si2 As IShellItem2
    Dim sAlbum As String
    Dim sArtist As String
    Dim SGenre as String
    Dim sOut As String
    Dim pEnum As IEnumShellItems
    Dim pc As Long
    Dim vpv As Variant, vbv As Variant
    Dim pps As IPropertyStore
    Dim tPK() As PROPERTYKEY
    
    ReDim tPK(3)
    
    oleexp.SHCreateItemFromParsingName StrPtr(Text1.Text), Nothing, IID_IShellItem, siPath
    If (siPath Is Nothing) Then
        Debug.Print "Invalid path."
        Exit Sub
    End If
    
    tPK(0) = PKEY_Title
    tPK(1) = PKEY_Music_Artist
    tPK(2) = PKEY_Music_AlbumTitle
    tPK(3) = PKEY_Music_Genre
    
    siPath.BindToHandler 0&, BHID_EnumItems, IID_IEnumShellItems, pEnum
    Do While pEnum.Next(1&, siChild, pc) = S_OK
       DoEvents
        If (siChild Is Nothing) = False Then
            Set si2 = siChild
            si2.GetPropertyStoreForKeys tPK(0), UBound(tPK) + 1&, GPS_DEFAULT Or GPS_BESTEFFORT, IID_IPropertyStore, pps
            If (pps Is Nothing) = False Then
                
                pps.GetValue PKEY_Title, vpv
                PropVariantToVariant vpv, vbv
                sTitle = CStr(vbv)
                
                pps.GetValue PKEY_Music_Artist, vpv
                PropVariantToVariant vpv, vbv
                sArtist = CStr(vbv)                                  '<<<<<<<<<<< Here Error '13'
                
                pps.GetValue PKEY_Music_Genre, vpv
                PropVariantToVariant vpv, vbv
                sGenre = CStr(vbv)                                 '<<<<<<<<<<< Here Error '13'
    
                pps.GetValue PKEY_Music_AlbumTitle, vpv
                PropVariantToVariant vpv, vbv
                sAlbum = CStr(vbv)
                
                sOut = "Title=" & sTitle & ",Artist=" & sArtist & ",Album=" & sAlbum & ",Genre=" & sGenre
                List1.AddItem sOut
            End If
        End If
        Set si2 = Nothing
        Set siChild = Nothing
        Set pps = Nothing
        
    Loop
    Beep
    Erase tPK
    Thx.
    Last edited by Lompin; Apr 29th, 2021 at 04:29 AM.

  18. #18

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,651

    Re: [VB6] Write MP3 Album Art and other tags using the Windows Property System

    If you Google the keys and look at Microsoft's entry for them, you find that both PKEY_Music_Artist ('Contributing Artists') and PKEY_Music_Genre ('Genres') are listed as 'Multivalue string' for their type: This means they're string arrays, so you have to read each element:

    Code:
    Dim i As Long
    Dim sArtist As String
    Dim sGenre As String
    '...
    
                sArtist = ""
                pps.GetValue PKEY_Music_Artist, vpv
                PropVariantToVariant vpv, vbv
                Dim i As Long
                For i = 0 To UBound(vbv)
                    sArtist = sArtist & CStr(vbv(i)) & "; "
                Next i
    
                sGenre = ""
                pps.GetValue PKEY_Music_Genre, vpv
                PropVariantToVariant vpv, vbv
                For i = 0 To UBound(vbv)
                    sGenre = sGenre & CStr(vbv(i)) & "; "
                Next i
    I've written a more robust method that automatically handles whatever type a key is and returns a string, if you're willing to incur a minor performance penalty:

    Code:
    Private Declare Function PSGetPropertyDescription Lib "propsys.dll" (PropKey As oleexp.PROPERTYKEY, riid As oleexp.UUID, ppv As Any) As Long
    Private Declare Function PSFormatPropertyValue Lib "propsys.dll" (ByVal pps As Long, ByVal ppd As Long, ByVal pdff As PROPDESC_FORMAT_FLAGS, ppszDisplay As Long) As Long
    Private Declare Function SysReAllocString Lib "oleaut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long) As Long
    
    Private Function GetPropertyKeyDisplayString(pps As oleexp.IPropertyStore, pkProp As oleexp.PROPERTYKEY, Optional bFixChars As Boolean = True) As String
    'Gets the string value of the given the PROPERTYKEY: See mPKEY.bas/propkey.h
    'This would be the value displayed in Explorer if you added the column in details view
    
    On Error GoTo e0
    
    Dim lpsz As Long
    Dim ppd As oleexp.IPropertyDescription
    If ((pps Is Nothing) = False) Then
        PSGetPropertyDescription pkProp, IID_IPropertyDescription, ppd
        If (ppd Is Nothing) Then
            Dim vrr As Variant, vbr As Variant
            pps.GetValue pkProp, vrr
            PropVariantToVariant vrr, vbr
            If (VarType(vbr) And vbArray) = vbArray Then
                Dim i As Long
                For i = LBound(vbr) To UBound(vbr)
                    GetPropertyKeyDisplayString = GetPropertyKeyDisplayString & CStr(vbr(i)) & "; "
                Next i
                If Len(GetPropertyKeyDisplayString) > 2 Then
                    GetPropertyKeyDisplayString = Left$(GetPropertyKeyDisplayString, Len(GetPropertyKeyDisplayString) - 2)
                End If
            Else
                GetPropertyKeyDisplayString = CStr(vbr)
            End If
        Else
            Dim hr As Long
            hr = PSFormatPropertyValue(ObjPtr(pps), ObjPtr(ppd), PDFF_DEFAULT, lpsz)
            SysReAllocString VarPtr(GetPropertyKeyDisplayString), lpsz
            CoTaskMemFree lpsz
        End If
        If bFixChars Then
            GetPropertyKeyDisplayString = Replace$(GetPropertyKeyDisplayString, ChrW$(&H200E), "")
            GetPropertyKeyDisplayString = Replace$(GetPropertyKeyDisplayString, ChrW$(&H200F), "")
            GetPropertyKeyDisplayString = Replace$(GetPropertyKeyDisplayString, ChrW$(&H202A), "")
            GetPropertyKeyDisplayString = Replace$(GetPropertyKeyDisplayString, ChrW$(&H202C), "")
        End If
        Set ppd = Nothing
    Else
        Debug.Print "GetPropertyKeyDisplayString.Error->PropertyStore is not set."
    End If
    
    Exit Function
    
    e0:
        Debug.Print "GetPropertyKeyDisplayString->Error: " & Err.Description & ", 0x" & Hex$(Err.Number)
    End Function
    
    Private Function IID_IPropertyDescription() As oleexp.UUID
    '(IID_IPropertyDescription, 0x6f79d558, 0x3e96, 0x4549, 0xa1,0xd1, 0x7d,0x75,0xd2,0x28,0x88,0x14
    Static iid As oleexp.UUID
     If (iid.Data1 = 0) Then Call DEFINE_UUID(iid, &H6F79D558, CInt(&H3E96), CInt(&H4549), &HA1, &HD1, &H7D, &H75, &HD2, &H28, &H88, &H14)
      IID_IPropertyDescription = iid
    End Function
    Last edited by fafalone; Apr 29th, 2021 at 07:46 PM.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width