-
1 Attachment(s)
[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.
twinBASIC 64bit compatible version at https://github.com/fafalone/MiscDemos
-
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().
-
2 Attachment(s)
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.
Attachment 172021
Attachment 172023
-
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.
-
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
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.
-
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.
-
2 Attachment(s)
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.
Attachment 181144
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.
-
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.
-
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
Quote:
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.
Attachment 181163
greetings.
download link err?
-
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.
-
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.
Thanks
-
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
-
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.
-
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
-
Re: [VB6] Write MP3 Album Art and other tags using the Windows Property System
Hello, I wanted to know how to insert just the image into an mp3.
With 2 Fileboxes
Private Sub Form_Load()
FileMP3.Path = App.Path & "\Moti Special\Dancing For Victory 1990"
FileCover.Path = App.Path & "\Moti Special\Dancing For Victory 1990"
End Sub
Sorry my English not the best but Thank you in advanced
-
Re: [VB6] Write MP3 Album Art and other tags using the Windows Property System
-
Re: [VB6] Write MP3 Album Art and other tags using the Windows Property System
Just a barebones 'write the image' is what the code in my original post to start this thread does.
WriteCover FileCover.Path & "\" & FileCover.FileName, FileMP3.Path & "\" & FileMP3.FileName
-
Re: [VB6] Write MP3 Album Art and other tags using the Windows Property System
You could also shorten the whole thing a bit. It's from a test project and as always without TLB. :D
Code:
Public Function WriteMp3Image(ByVal Mp3File As String, _
ByVal ImageFile As String) As Boolean
Dim Ret As Boolean
Dim pIPropertyStore As Long
If SHGetPropertyStoreFromParsingName(StrPtr(Mp3File), 0&, GPS_READWRITE, _
Str2Guid(IID_IPropertyStore), _
pIPropertyStore) = S_OK Then
Dim pIStream As Long
If SHCreateStreamOnFile(StrPtr(ImageFile), STGM_READ, pIStream) = S_OK Then
Dim tPROPERTYKEY As PROPERTYKEY
With tPROPERTYKEY
.fmtid = Str2Guid(PKEY_ThumbnailStream_Guid)
.pid = PKEY_ThumbnailStream_Pid
End With
Dim tPROPVARIANT As PROPVARIANT
With tPROPVARIANT
.vt = VT_STREAM
.vData0 = pIStream
End With
If InvokeIfc(pIPropertyStore, IPropertyStore_SetValue, _
VarPtr(tPROPERTYKEY), VarPtr(tPROPVARIANT)) = S_OK Then
If InvokeIfc(pIPropertyStore, IPropertyStore_Commit) = S_OK Then
Ret = True
End If
End If
Call ReleaseIfc(pIStream)
End If
Call ReleaseIfc(pIPropertyStore)
End If
WriteMp3Image = Ret
End Function
-
Re: [VB6] Write MP3 Album Art and other tags using the Windows Property System
That's an interesting definition of "shorten", hiding code in other functions ;)
To shorten your shorten method,
Code:
Public Function WriteMp3Image(ByVal Mp3File As String, _
ByVal ImageFile As String) As Boolean
On Error GoTo out
Dim Ret As Boolean
Dim pIPropertyStore As IPropertyStore
SHGetPropertyStoreFromParsingName StrPtr(Mp3File), 0&, GPS_READWRITE, _
IID_IPropertyStore, _
pIPropertyStore
If (pIPropertyStore Is Nothing) = False Then
Dim pIStream As IStream
SHCreateStreamOnFile StrPtr(ImageFile), STGM_READ, pIStream
If (pIStream Is Nothing) = False Then
pIPropertyStore.SetValue PKEY_ThumbnailStream, pIStream
ret = True
End If
End If
out:
WriteMp3Image = Ret
End Function
No need for the crazy InvokeIfc stuff, manually freeing, PROPVARIANT UDTs, String2Guid, and bespoke vtable enums and GUIDs. Just the standard oleexp and its standard addon modules (or copying fewer lines from them than the total in non-boilerplate code from the original) :wave:
-
Re: [VB6] Write MP3 Album Art and other tags using the Windows Property System
Quote:
Originally Posted by
fafalone
That's an interesting definition of "shorten", hiding code in other functions ;)
...
Just the standard oleexp and its standard addon modules...
same difference... ;)
Olaf
-
Re: [VB6] Write MP3 Album Art and other tags using the Windows Property System
Yes we're splitting hairs and playing with definitions, welcome to the party :)
But I think there is a slight difference between "copy and paste this specific code" and "check the box/click add for reference". Surely an RC6-based solution wouldn't expect us to count the (unknowable) full method lengths inside the vbRichClient DLL.
-
Re: [VB6] Write MP3 Album Art and other tags using the Windows Property System
It's not about splitting hairs or whether to use a TLB or not. What I mean is, look at your code from #1 and now. It's a lot shorter. :D
-
Re: [VB6] Write MP3 Album Art and other tags using the Windows Property System
Hello LeandroA
I have a question. I want to hide a label when no image is displayed and display the label when an image is displayed. But how...
Thank you in andvance ?
-
Re: [VB6] Write MP3 Album Art and other tags using the Windows Property System
-
Re: [VB6] Write MP3 Album Art and other tags using the Windows Property System
The open command already does a simple test to see if there's an image or not; it should be pretty obvious how to put a LabelWhatever.Visible = True/False around this...
Code:
If VarType(.ThumbnailStream) <> vbEmpty Then
PaintPictureFromArrData .ThumbnailData, Picture1.hdc, Picture1.ScaleWidth, Picture1.ScaleHeight
End If
.Visible = False at the start of the Sub and = True only inside that block.
-
Re: [VB6] Write MP3 Album Art and other tags using the Windows Property System
Quote:
Originally Posted by
fafalone
The open command already does a simple test to see if there's an image or not; it should be pretty obvious how to put a LabelWhatever.Visible = True/False around this...
Code:
If VarType(.ThumbnailStream) <> vbEmpty Then
PaintPictureFromArrData .ThumbnailData, Picture1.hdc, Picture1.ScaleWidth, Picture1.ScaleHeight
End If
.Visible = False at the start of the Sub and = True only inside that block.
Thank you
but I still have a problem. I want the tags to be entered into several mp3s with a timer or for next loop
Private Sub InfoSave()
sFileMP3 = FileMP3.Path & "" & FileMP3.FileName
With cID3
.Title = TxtTitle.Text
.Artist = Split(LblInfo(0).Caption, "//")
.AlbumTitle = LblInfo(1).Caption
.Year = IIf(Val(LblInfo(2).Caption) > 0, Val(LblInfo(2).Caption), Empty)
If .WriteFile Then
Beep
Else
MsgBox "Error"
End If
End With
TxtInfo.Visible = False: TxtInfo.Text = "": LblSave.Visible = False
End Sub
Private Sub TSave_Timer()
tis = tis + 1
FileMP3.ListIndex = tis - 1
Call InfoSave
If tis = FileMP3.ListCount Then TSave.Enabled = False: tis = 0
End Sub
this only works in the first mp3 then no longer
Could you help me please
Thank you in advance for your response ?
-
Re: [VB6] Write MP3 Album Art and other tags using the Windows Property System
You can remove the timer and wrap it in a loop like
Code:
Dim i As Long
For i = 0 To FileMP3.ListCount - 1
sFileMP3 = FileMP3.Path & "\" & FileMP3.List(i)
...
Next
-
Re: [VB6] Write MP3 Album Art and other tags using the Windows Property System
Code:
Private Sub LblSave_Click()
Dim lis As Long
For lis = 0 To FileMP3.ListCount - 1
sFileMP3 = FileMP3.Path & "\" & FileMP3.List(lis)
With cID3
'.Title = TxtTitle.Text
.Artist = Split(LblInfo(0).Caption, "//")
.AlbumTitle = LblInfo(1).Caption
.Year = IIf(Val(LblInfo(2).Caption) > 0, Val(LblInfo(2).Caption), Empty)
If .WriteFile Then
Beep
Else
MsgBox "Error"
End If
End With
TxtInfo.Visible = False: TxtInfo.Text = "": LblSave.Visible = False
Next
End Sub
Even so, only the first mp3 is written. What else am I doing wrong? ??
-
Re: [VB6] Write MP3 Album Art and other tags using the Windows Property System
You're not loading the new file into cID3.
Code:
Private Sub LblSave_Click()
Dim lis As Long
If (cID3 Is Nothing) = False Then Set cID3 = Nothing 'close any open file
For lis = 0 To FileMP3.ListCount - 1
sFileMP3 = FileMP3.Path & "\" & FileMP3.List(lis)
Set cID3 = New clsID3
With cID3
If .LoadFile(sFileMP3) Then
'.Title = TxtTitle.Text
.Artist = Split(LblInfo(0).Caption, "//")
.AlbumTitle = LblInfo(1).Caption
.Year = IIf(Val(LblInfo(2).Caption) > 0, Val(LblInfo(2).Caption), Empty)
If .WriteFile Then
Beep
Else
MsgBox "Error"
End If
End If
End With
Set cID3 = Nothing
TxtInfo.Visible = False: TxtInfo.Text = "": LblSave.Visible = False
Next
End Sub
-
Re: [VB6] Write MP3 Album Art and other tags using the Windows Property System
Quote:
Originally Posted by
fafalone
You're not loading the new file into cID3.
Code:
Private Sub LblSave_Click()
Dim lis As Long
If (cID3 Is Nothing) = False Then Set cID3 = Nothing 'close any open file
For lis = 0 To FileMP3.ListCount - 1
sFileMP3 = FileMP3.Path & "\" & FileMP3.List(lis)
Set cID3 = New clsID3
With cID3
If .LoadFile(sFileMP3) Then
'.Title = TxtTitle.Text
.Artist = Split(LblInfo(0).Caption, "//")
.AlbumTitle = LblInfo(1).Caption
.Year = IIf(Val(LblInfo(2).Caption) > 0, Val(LblInfo(2).Caption), Empty)
If .WriteFile Then
Beep
Else
MsgBox "Error"
End If
End If
End With
Set cID3 = Nothing
TxtInfo.Visible = False: TxtInfo.Text = "": LblSave.Visible = False
Next
End Sub
thank you very much it works
-
Re: [VB6] Write MP3 Album Art and other tags using the Windows Property System
Hey can anyone tell me their experience of using this demo on Windows 10?
This worked fine on 7 but today I tried it on 10 for the first time, and it just blanked out the entire id3 tag. Mp3Tag indicated it was still present, just all the fields were now blank, even those my program doesn't touch.
Then I found the same thing happens if I try to edit a tag in Explorer... so it's not my code, it's the handler itself.
If I edit a second time, it correctly sets the new fields, but the original ones remain blank.
Looking to at least see if this is a 'my computer' problem or a common Windows 10/11 problem... so if anyone could give it a quick try.. would be appreciated.
Note: I did try compiling a 64bit version too, no difference. You can check it out here but note I started to add some other features and didn't finish them, just updated the VB6 code... https://github.com/fafalone/MP3Cover
-
Re: [VB6] Write MP3 Album Art and other tags using the Windows Property System
I didn't know Explorer could edit MP3 properties but it does work fine in both Windows 10 and 11. Your code also works fine, the JPG is added successfully and also the album title is changed correctly. Explorer also shows these changes so I don't know what's wrong with yours.
This compacted version also works correctly (using your recent fix of "SHCreateMemStream"):
Code:
Private Function WriteCover(sJPG As String, sMP3 As String, Optional sTitle As String) As Long
Dim vpr As Variant, oStrm As IStream, baData() As Byte, si2 As IShellItem2, pps As IPropertyStore
With CreateObject("ADODB.Stream")
.Type = 1: .Open: .LoadFromFile sJPG: baData = .Read
Set oStrm = SHCreateMemStream(baData(0), .Size)
End With
CopyMemory vpr, VT_STREAM, 2: CopyMemory ByVal VarPtr(vpr) + 8, ObjPtr(oStrm), 4
SHCreateItemFromParsingName StrPtr(sMP3), Nothing, IID_IShellItem2, si2
si2.GetPropertyStore GPS_OPENSLOWITEM Or GPS_READWRITE, IID_IPropertyStore, pps
If Not pps Is Nothing Then
If pps.SetValue(PKEY_ThumbnailStream, vpr) = S_OK Then
If Len(sTitle) Then pps.SetValue PKEY_Music_AlbumTitle, CVar(sTitle)
pps.Commit
End If
End If
WriteCover = Err.LastHresult
End Function
-
Re: [VB6] Write MP3 Album Art and other tags using the Windows Property System
I see, thanks for testing it. Not the first time my Explorer has acted odd... Currently it's locked into elevated.
Ps- Couldn't you just Set vpr = oStrm then overwrite the type rather than manually copy the pointer (with a 64bit unfriendly hard coded pointer size no less?)
But there's an even more compact option I believe; SHCreateStreamOnFile.
-
Re: [VB6] Write MP3 Album Art and other tags using the Windows Property System
You could make CopyMemory 64bit-friendly by changing the "Length" parameter to "LenB(LongPtr)" but yeah, "Set" works the same provided you change the variant type to "VT_STREAM" afterwards.
Most compact version yet:
Code:
Private Function WriteCover(sJPG As String, sMP3 As String, Optional sTitle As String) As Long
Dim vpr As Variant, si2 As IShellItem2, pps As IPropertyStore
Set vpr = SHCreateStreamOnFile(sJPG, STGM_READ)
If Not IsEmpty(vpr) Then
CopyMemory vpr, VT_STREAM, 2
If SHCreateItemFromParsingName(StrPtr(sMP3), Nothing, IID_IShellItem2, si2) = S_OK Then
si2.GetPropertyStore GPS_OPENSLOWITEM Or GPS_READWRITE, IID_IPropertyStore, pps
If Not pps Is Nothing Then
If pps.SetValue(PKEY_ThumbnailStream, vpr) = S_OK Then If Len(sTitle) Then pps.SetValue PKEY_Music_AlbumTitle, CVar(sTitle)
pps.Commit
End If
End If
End If
WriteCover = Err.LastHResult
End Function
