[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.
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.
Reply With Quote
