The Registry
And so to begin. First, we need to convert the filename into just a file extension. That is, remove everything before the “.”:
TempFileName = Right(FileName, Len(FileName) - InStrRev(FileName, ".") + 1)
Now we take a look at the registry and see if it has any record of this file type (it is, of course, possible that it doesn’t)
lngError = RegOpenKey(HKEY_CLASSES_ROOT, TempFileName, lngRegKeyHandle)
If lngError Then GoTo No_Icon 'we do not even have a valid extension so lets NOT try to find an
icon!
lngStringLength = 260
'Make space for the incoming string
strProgramName = Space$(260)
'Get the key value:
lngError = RegQueryValueEx(lngRegKeyHandle, vbNullString, 0, 0, strProgramName, lngStringLength)
If lngError Then
'if
there's an error then BIG TROUBLE so lets use the normal "windows" icon
'the world may be about to end (or its just an error) but we'll clean up anyway
lngError = RegCloseKey(lngRegKeyHandle)
GoTo No_Icon
End If
'if this generates an error then we can't do anthing about it anyway
lngError = RegCloseKey(lngRegKeyHandle)
'Cut the name down to size
strProgramName = Left(strProgramName, lngStringLength - 1)
You will notice that even when I am not going to use it I still make “lngError” receive any errors. I have left this in because it’s useful for debugging.
You will notice that if any errors occur in this code I use the line “GoTo No_Icon”. This is because even if we can’t get a default icon for this file type, we will still want to display something, ie: the windows icon:
Ok, now we have the key name of our second registry key (stored in “strProgramName”) what we need to do now is to get the location for the default icon. The value that we want is held inside the sub-key “DefaultIcon”. So in a very similarly to the last piece of code, we need to get this value
'Use the value of the
last key in the name of the next one (strProgramName
)
lngError = RegOpenKey(HKEY_CLASSES_ROOT, strProgramName & "\DefaultIcon", lngRegKeyHandle)
'there is no icon for this extension so lets NOT try to load what doesn't exist!
If lngError Then GoTo No_Icon
'The rest is just the
same as before
lngStringLength = 260
strDefaultIcon = Space$(260)
lngError = RegQueryValueEx(lngRegKeyHandle, vbNullString, 0, 0, strDefaultIcon, lngStringLength)
If lngError Then
lngError = RegCloseKey(lngRegKeyHandle)
GoTo No_Icon
End If
lngError = RegCloseKey(lngRegKeyHandle)
strDefaultIcon = Trim$(Left(strDefaultIcon, lngStringLength - 1))