Does SHGetFileInfo work in Access 2003?

B

Bob Landers

Hi,

Does the SHGetFileInfo API call work in Access 2003?

I have copied and tested various bits of code invoking this, but the hIcon
and index parts of SHFILEINFO keep coming back as 0 which seems in turn to
cause an "invalid picture".


TIA
Bob
 
B

Bob Landers

Thanks for responding Douglas.

As I said in my earlier post, I've tried various bits of code offered by
others but every bit of code I've tried returns 0 for the members of the
shfileinfo structure.

The code below is a fairly typical example of the code snippets I've tried.
I'm invoking it by iterating through the files in my folder using fso and
passing the full path and filename to the FileExtractIcon function



Regards
Bob

' ****************************************

Private Const MAX_PATH = 260

Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type

Private Type PICTDESC
cbSize As Long
picType As Long
hImage As Long
Data1 As Long
Data2 As Long
End Type

Private Type SHFILEINFO
hIcon As Long
iIcon As Long
dwAttributes As Long
szDisplayName As String * MAX_PATH
szTypeName As String * 80
End Type


Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll"
(pPictDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As Long,
ppvObj As StdPicture) As Long

Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias
"SHGetFileInfoA" (ByVal pszPath As String, ByVal dwFileAttributes As Long,
psfi As SHFILEINFO, ByVal cbSizeFileInfo As Long, ByVal uFlags As Long) As
Long

'Purpose : Retrieves the default associated icon from a file
'Inputs : sFileName = the full path and name of the file to retrieve
the icon of.
'Outputs : Returns the icon


Function FileExtractIcon(sFileName As String) As StdPicture
Dim tPic As PICTDESC
Dim tIDispatch As GUID
Dim oPic As StdPicture
Dim hIcon As Long
Dim tFileInfo As SHFILEINFO
Const SHGFI_ICON = &H100, SHGFI_DISPLAYNAME = &H200
Const SHGFI_TYPENAME = &H400, SHGFI_SMALLICON = &H1
'FYI, file attribute bits
Const FILE_ATTRIBUTE_READONLY = &H1, FILE_ATTRIBUTE_HIDDEN = &H2
Const FILE_ATTRIBUTE_SYSTEM = &H4, FILE_ATTRIBUTE_DIRECTORY = &H10
Const FILE_ATTRIBUTE_ARCHIVE = &H20, FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_ATTRIBUTE_TEMPORARY = &H100


On Error Resume Next
'Extract File information
Call SHGetFileInfo(sFileName, 0, tFileInfo, Len(tFileInfo), SHGFI_ICON +
SHGFI_SMALLICON)

'Get the handle to the files icon
hIcon = tFileInfo.hIcon

' Checking Values:
'Dim strFileInfo_index As Long
'strFileInfo_index = tFileInfo.iIcon
'MsgBox ("rtnSHGetFileInfo: " & rtnSHGetFileInfo & vbCrLf & _
"strFileInfo_index: " & strFileInfo_index & vbCrLf & _
"hIcon: " & hIcon)

'Initialise type
With tPic
.cbSize = Len(tPic)
.picType = 3 'vbPicTypeIcon
.hImage = hIcon
End With

'Fill IDispatch Interface ID,{00020400-0000-0000-C000-000000046}
With tIDispatch
.Data1 = &H20400
.Data4(0) = &HC0
.Data4(7) = &H46
End With

'Get Icon
Call OleCreatePictureIndirect(tPic, tIDispatch, 0, oPic)

' Check Values:
' Dim lngReturnValue As Long
' lngReturnValue = OleCreatePictureIndirect(tPic, tIDispatch, 0, oPic)

'Return Icon
Set FileExtractIcon = oPic


End Function
 
B

Bob Landers

That's what I'm trying to use it for.

I've got some code working which relies on the ExtractIcons and
OleCreatePictureDirect API functions to extract and convert the default
icons into stdpicture format before storing them in an imagelist for use
with a listview control.

My code appears to be working fine except that the icons are degraded.
After googling the problem, it would appear that others have run into
similar problems and overcome them by using SHGetFileInfo instead of
ExtractIcons. If I can work out how to get SHGetFileInfo to actually return
a handle, I'm hoping I will be able to generate better quality icons for
viewing in my listview.


Regards
Bob
 
B

Bob Landers

For anyone else out there having the same problem, I managed to resolve the
picture quality issue by replacing the existing call to SHGetFileInfo with
the following code:

If blnFolder = True Then
rtnSHGetFileInfo = SHGetFileInfo(sFileName, FILE_ATTRIBUTE_DIRECTORY,
tFileInfo, Len(tFileInfo), SHGFI_USEFILEATTRIBUTES Or SHGFI_DISPLAYNAME Or
SHGFI_TYPENAME Or SHGFI_SMALLICON Or SHGFI_ICON)
Else
rtnSHGetFileInfo = SHGetFileInfo(sFileName, 0&, tFileInfo, Len(tFileInfo),
SHGFI_USEFILEATTRIBUTES Or SHGFI_DISPLAYNAME Or SHGFI_TYPENAME Or
SHGFI_SMALLICON Or SHGFI_ICON)
End If

This code creates icons that look as crisp and clean as those that appear in
windows explorer. Woohoo!!!

By the way, I amended the function name/definition as follows:

Function FileExtractIcon(sFileName As String, Optional blnFolder As Boolean
= False) As StdPicture

End Function

This way, I can pass "True" as the blnFolder parameter to flag that the
current item is a folder. The reference to "FILE_ATTRIBUTE_DIRECTORY" then
ensures that the folder icon is extracted and returned by the function as a
stdpicture.

Hopefully this helps some other poor soul out there.



Regards
Bob
 
Top