[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.
Last edited by fafalone; Nov 1st, 2019 at 07:10 AM.
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.
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.
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.
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
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.
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
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.
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.
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.
Last edited by fafalone; Apr 23rd, 2021 at 01:51 AM.
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.
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?
Re: [VB6] Write MP3 Album Art and other tags using the Windows Property System
Originally Posted by lompin
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.
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
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.
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:
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.
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.