dcsimg
Results 1 to 4 of 4

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
    2,341

    [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
    2,341

    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().




    The screen shot shows the Album Art in my ucShellBrowse control; that's not in the current public release, but if you can't wait, it's super simple to add. In the AddThumbView2 function, right near the top there's a block for PERCEIVED_TYPE_VIDEO, right below that If block you can add another for MP3
    Code:
            If LCase$(Right$(sFullPath, 4)) = ".mp3" Then
                'Album cover art in mp3 is supported.
                hThumbVid = AddThumbviewVideoISI(pidlFQ, cxAdd, cyAdd)
            End If
    Obviously you can also see the art in Explorer or anything else that loads mp3 art.

  3. #3
    Addicted Member
    Join Date
    Dec 2008
    Location
    Argentina
    Posts
    202

    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: 55
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
    2,341

    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.

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
  •  



Featured


Click Here to Expand Forum to Full Width