PDA

View Full Version : [SOLVED:] Help Needed with 64 Bit Declarations



gmaxey
10-02-2024, 08:04 AM
I was recently asked come up with a process for generating MD5 Hash values for a list of files. That wasn't too difficult but problems arose when the file size was larger than about 200M. I found some code here to work around that until the file size exceeded 2G.

After a pretty extensive Google search and some modifications to a couple of seemingly complete class modules found on Stack Overflow, I have come up with a process that appears to handle very large files (at least a large as the largest file I have had to process > 3G).

The problem is that classes were apparently written around 2005 and all of the declarations are 32 bit. I was hoping that some guy or gal here with a 64 bit installation of Excel would take interest and see if they can modify the conditional If statements so the code will function in both 64 and 32 bit applications. Here is the code in three sections

Here is the file: 3179831798

1. The calling procedure. Put it in any standard code module:


Private Sub TestHash()
Dim Hash As clsMD5Hash
Dim strFilePath As String
strFilePath = "D:\Test\A File.docm" 'Any valid file path
Set Hash = New clsMD5Hash
ActiveWorkbook.ActiveSheet.Range("A1").Value = Hash.HashFile(strFilePath)
lbl_Exit:
Exit Sub
End Sub
lbl_Exit:
Exit Sub
End Sub
31798

2. The Hash Class. Put it in a class module named clsMD5Hash:

Option Explicit
'Add all of this to a class named "clsMD5Hash" (Very large binary file)
Private Const ALG_TYPE_ANY As Long = 0
Private Const ALG_CLASS_HASH As Long = 32768
Private Const ALG_SID_MD5 As Long = 3
Private Const CALG_MD5 As Long = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD5
Private Const PROV_RSA_FULL As Long = 1
Private Const CRYPT_VERIFYCONTEXT As Long = &HF0000000
Private Const MS_DEFAULT_PROVIDER As String = "Microsoft Base Cryptographic Provider v1.0"
Private Const HP_HASHVAL As Long = 2
Private Const HP_HASHSIZE As Long = 4
#If VBA7 Then
Private Declare Function CryptAcquireContext Lib "advapi32" Alias "CryptAcquireContextA" ( _
ByRef phProv As Long, ByVal pszContainer As String, _
ByVal pszProvider As String, ByVal dwProvType As Long, _
ByVal dwFlags As Long) As Long
Private Declare Function CryptCreateHash Lib "advapi32" (ByVal hProv As Long, ByVal algid As Long, _
ByVal hKey As Long, ByVal dwFlags As Long, ByRef phHash As Long) As Long
Private Declare Function CryptDestroyHash Lib "advapi32" (ByVal hHash As Long) As Long
Private Declare Function CryptGetHashParam Lib "advapi32" (ByVal hHash As Long, ByVal dwParam As Long, _
ByRef pbData As Any, ByRef pdwDataLen As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptHashData Lib "advapi32" (ByVal hHash As Long, ByRef pbData As Any, _
ByVal dwDataLen As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptReleaseContext Lib "advapi32" (ByVal hProv As Long, ByVal dwFlags As Long) As Long
Private m_hHash As Long
Private m_hProvider As Long
#Else
Private Declare Function CryptAcquireContext Lib "advapi32" Alias "CryptAcquireContextA" ( _
ByRef phProv As Long, ByVal pszContainer As String, _
ByVal pszProvider As String, ByVal dwProvType As Long, _
ByVal dwFlags As Long) As Long
Private Declare Function CryptCreateHash Lib "advapi32" (ByVal hProv As Long, ByVal algid As Long, _
ByVal hKey As Long, ByVal dwFlags As Long, ByRef phHash As Long) As Long
Private Declare Function CryptDestroyHash Lib "advapi32" (ByVal hHash As Long) As Long
Private Declare Function CryptGetHashParam Lib "advapi32" (ByVal hHash As Long, ByVal dwParam As Long, _
ByRef pbData As Any, ByRef pdwDataLen As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptHashData Lib "advapi32" (ByVal hHash As Long, ByRef pbData As Any, _
ByVal dwDataLen As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptReleaseContext Lib "advapi32" (ByVal hProv As Long, ByVal dwFlags As Long) As Long
Private m_hHash As Long
Private m_hProvider As Long
#End If
Private Sub Class_Initialize()
If CryptAcquireContext(m_hProvider, vbNullString, MS_DEFAULT_PROVIDER, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT) = 0 Then
Err.Raise vbObjectError Or &HC352&, "MD5Hash.Class_Initialize", "Failed to obtain access to CryptoAPI, system error " & CStr(Err.LastDllError)
End If
End Sub
Private Sub HashBlock(ByRef Block() As Byte)
If CryptHashData(m_hHash, Block(LBound(Block)), UBound(Block) - LBound(Block) + 1, 0&) = 0 Then
Err.Raise vbObjectError Or &HC312&, "MD5Hash", _
"Failed to hash data block, system error " _
& CStr(Err.LastDllError)
End If
End Sub
Private Function HashValue() As String
Dim lngDataLen As Long, lngHashSize As Long
Dim bytHashValue() As Byte
Dim intByte As Integer
lngDataLen = 4
If CryptGetHashParam(m_hHash, HP_HASHSIZE, lngHashSize, lngDataLen, 0&) = 0 Then
Err.Raise vbObjectError Or &HC322&, "MD5Hash", _
"Failed to obtain hash value length, system error " & CStr(Err.LastDllError)
Else
lngDataLen = lngHashSize
ReDim bytHashValue(lngDataLen - 1)
If CryptGetHashParam(m_hHash, HP_HASHVAL, bytHashValue(0), lngDataLen, 0&) = 0 Then
Err.Raise vbObjectError Or &HC324&, "MD5Hash", _
"Failed to obtain hash value, system error " & CStr(Err.LastDllError)
Else
For intByte = 0 To lngDataLen - 1
HashValue = HashValue & Right$("0" & Hex$(bytHashValue(intByte)), 2)
Next
CryptDestroyHash m_hHash
End If
End If
End Function
Private Sub NewHash()
If CryptCreateHash(m_hProvider, CALG_MD5, 0&, 0&, m_hHash) = 0 Then
Err.Raise vbObjectError Or &HC332&, "MD5Hash", _
"Failed to create CryptoAPI Hash object, system error " & CStr(Err.LastDllError)
End If
End Sub
'----- Public Methods -----
Public Function HashFile(ByVal Filename As String) As String
Const CHUNK As Long = 16384
Dim VeryLargeFile As clsVLBF
Dim cyWholeChunks As Currency
Dim lngRemainder As Long
Dim cyChunk As Currency
Dim bytBlock() As Byte
On Error Resume Next
GetAttr Filename
If Err.Number = 0 Then
On Error GoTo 0
Set VeryLargeFile = New clsVLBF
VeryLargeFile.OpenFile Filename
cyWholeChunks = Int(VeryLargeFile.FileLen / CHUNK)
lngRemainder = VeryLargeFile.FileLen - (CHUNK * cyWholeChunks)
NewHash
ReDim bytBlock(CHUNK - 1)
For cyChunk = 1 To cyWholeChunks
VeryLargeFile.ReadBytes bytBlock
HashBlock bytBlock
Next
If lngRemainder > 0 Then
ReDim bytBlock(lngRemainder - 1)
VeryLargeFile.ReadBytes bytBlock
HashBlock bytBlock
End If
VeryLargeFile.CloseFile
HashFile = HashValue()
Else
Err.Raise vbObjectError Or &HC342&, "MD5Hash.HashFile", "File doesn't exist"
End If
End Function
Public Function HashBytes(ByRef Block() As Byte) As String
NewHash
HashBlock Block
HashBytes = HashValue()
End Function
Private Sub Class_Terminate()
On Error Resume Next
CryptDestroyHash m_hHash
CryptReleaseContext m_hProvider, 0&
End Sub

3. The VeryLargeBinaryFile Class. Put it in a class module named clsVLBF:


Option Explicit
'Add all of this to a class named "clsVLBF" (Very large binary file)
Public Enum Errors
UNKNOWN_ERROR = 45600
FILE_ALREADY_OPEN
OPEN_FAILURE
FILELEN_FAILURE
READ_FAILURE
FILE_ALREADY_CLOSED
End Enum
Private Const SOURCE = "clsVLBF"
Private Const GENERIC_WRITE As Long = &H40000000
Private Const GENERIC_READ As Long = &H80000000
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80&
Private Const CREATE_ALWAYS = 2
Private Const OPEN_ALWAYS = 4
Private Const INVALID_HANDLE_VALUE = -1
Private Const INVALID_SET_FILE_POINTER = -1
Private Const INVALID_FILE_SIZE = -1
Private Const FILE_BEGIN = 0, FILE_CURRENT = 1, FILE_END = 2
Private Type MungeCurr
Value As Currency
End Type
Private Type Munge2Long
LowVal As Long
HighVal As Long
End Type
#If VBA7 Then
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" ( _
ByVal dwFlags As Long, lpSource As Long, ByVal dwMessageId As Long, _
ByVal dwLanguageId As Long, ByVal lpBuffer As String, _
ByVal nSize As Long, Arguments As Any) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, _
ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, _
ByVal lpOverlapped As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, _
ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, _
ByVal lpOverlapped As Long) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, _
ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, _
lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Private Declare Function FlushFileBuffers Lib "kernel32" (ByVal hFile As Long) As Long
Private hFile As Long
Private C As MungeCurr
Private L As Munge2Long
#Else
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" ( _
ByVal dwFlags As Long, lpSource As Long, ByVal dwMessageId As Long, _
ByVal dwLanguageId As Long, ByVal lpBuffer As String, _
ByVal nSize As Long, Arguments As Any) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, _
ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, _
ByVal lpOverlapped As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, _
ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, _
ByVal lpOverlapped As Long) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, _
ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, _
lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Private Declare Function FlushFileBuffers Lib "kernel32" (ByVal hFile As Long) As Long
Private hFile As Long
Private C As MungeCurr
Private L As Munge2Long
#End If
Private sFName As String
Private fEOF As Boolean
Public Property Get FileHandle() As Long
RaiseErrorIfClosed
FileHandle = hFile
End Property
Public Property Get FileLen() As Currency
RaiseErrorIfClosed
L.LowVal = GetFileSize(hFile, L.HighVal)
If L.LowVal = INVALID_FILE_SIZE Then
If Err.LastDllError Then RaiseError FILELEN_FAILURE
End If
LSet C = L
FileLen = C.Value * 10000@
End Property
Public Property Get Filename() As String
RaiseErrorIfClosed
Filename = sFName
End Property
Public Property Get EOF() As Boolean
RaiseErrorIfClosed
EOF = fEOF
End Property
Public Property Get IsOpen() As Boolean
IsOpen = hFile <> INVALID_HANDLE_VALUE
End Property
Public Sub CloseFile()
RaiseErrorIfClosed
CloseHandle hFile
sFName = ""
fEOF = False
hFile = INVALID_HANDLE_VALUE
End Sub
Public Sub OpenFile(ByVal strFileName As String)
If hFile <> INVALID_HANDLE_VALUE Then RaiseError FILE_ALREADY_OPEN
hFile = CreateFile(strFileName, GENERIC_WRITE Or GENERIC_READ, 0, 0, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
If hFile = INVALID_HANDLE_VALUE Then RaiseError OPEN_FAILURE
sFName = strFileName
End Sub
Public Function ReadBytes(ByRef Buffer() As Byte) As Long
RaiseErrorIfClosed
If ReadFile(hFile, Buffer(LBound(Buffer)), UBound(Buffer) - LBound(Buffer) + 1, ReadBytes, 0) Then
If ReadBytes = 0 Then fEOF = True
Else
RaiseError READ_FAILURE
End If
End Function

Private Sub Class_Initialize()
hFile = INVALID_HANDLE_VALUE
End Sub
Private Sub Class_Terminate()
If hFile <> INVALID_HANDLE_VALUE Then CloseHandle hFile
End Sub
Private Sub RaiseError(ByVal ErrorCode As Errors)
Dim Win32Err As Long, Win32Text As String
Win32Err = Err.LastDllError
If Win32Err Then
Win32Text = vbNewLine & "Error " & Win32Err & vbNewLine & DecodeAPIErrors(Win32Err)
End If
If IsOpen Then CloseFile
Select Case ErrorCode
Case FILE_ALREADY_OPEN: Err.Raise FILE_ALREADY_OPEN, SOURCE, "File already open."
Case OPEN_FAILURE: Err.Raise OPEN_FAILURE, SOURCE, "Error opening file." & Win32Text
Case FILELEN_FAILURE: Err.Raise FILELEN_FAILURE, SOURCE, "GetFileSize Error." & Win32Text
Case READ_FAILURE: Err.Raise READ_FAILURE, SOURCE, "Read failure." & Win32Text
Case FILE_ALREADY_CLOSED: Err.Raise FILE_ALREADY_CLOSED, SOURCE, "File must be open for this operation."
Case Else
Err.Raise UNKNOWN_ERROR, SOURCE, "Unknown error." & Win32Text
End Select
End Sub
Private Sub RaiseErrorIfClosed()
If hFile = INVALID_HANDLE_VALUE Then RaiseError FILE_ALREADY_CLOSED
End Sub
Private Function DecodeAPIErrors(ByVal ErrorCode As Long) As String
Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000&
Dim strMsg As String, lngMsgLen As Long
strMsg = Space$(256)
lngMsgLen = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, 0&, ErrorCode, 0&, strMsg, 256&, 0&)
If lngMsgLen > 0 Then
DecodeAPIErrors = Left(strMsg, lngMsgLen)
Else
DecodeAPIErrors = "Unknown Error."
End If
End Function


Cross posted at: https://www.msofficeforums.com/word-vba/52880-help-64-bit-declarations.html#post183353

Paul_Hossler
10-02-2024, 11:52 AM
FWIW, (I don't have 64 bit Office)

JKP has a very nice writeup

https://jkp-ads.com/articles/apideclarations.asp

and has links to the MS resources


LinksOf course Microsoft documents how to do this. There is an introductory article on Microsoft MSDN:
Compatibility Between the 32-bit and 64-bit Versions of Office 2010 (http://msdn.microsoft.com/en-us/library/ee691831(office.14).aspx)
That article describes the how-to's to properly write the declarations. What is missing is which type declarations go with which API function or sub.
Microsoft has provided an updated version of the Win32API.txt with all proper declarations available for download here:
Office 2010 Help Files: Win32API_PtrSafe with (https://docs.microsoft.com/en-us/office/troubleshoot/office-suite-issues/win32api_ptrsafe-with-64-bit-support)

I've used the MS links to update APIs to work with 32 or 64 bit Office

gmaxey
10-02-2024, 12:11 PM
Paul, thanks for the reply. Unfortunately like you, I don't have access to Office 64 bit to test with. I could try updating them but unable to test. It seems that the last link you posted has expired and no longer available.

Paul_Hossler
10-02-2024, 05:40 PM
The zip is really just a txt

These are old copies but for anything I needed, the APIs were covered

Testing 64 bit is hard without 64 bit office but I could usually find someone to do it

arnelgp
10-02-2024, 08:17 PM
just add PtrSafe to each Function/Sub declaration.

Aflatoon
10-03-2024, 02:24 AM
just add PtrSafe to each Function/Sub declaration.

That is absolutely not sufficient, and getting APIs wrong is not a good idea. Any handles/pointers also need to be converted to LongPtr.

arnelgp
10-03-2024, 04:34 AM
That is absolutely not sufficient, and getting APIs wrong is not a good idea. Any handles/pointers also need to be converted to LongPtr.
download the db and test it yourself.

Aflatoon
10-03-2024, 07:13 AM
No. What you said is categorically wrong, and passing incorrect arguments to APIs is dangerous.

gmaxey
10-03-2024, 02:02 PM
Thanks Paul. With this, I think I can probably sort it out.

Paul_Hossler
10-05-2024, 01:28 PM
Greg -- Also

The various data structures required for some APIs are there so they need to be included (I know that you know this)

One later change I think was the including of LongPtr

https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/longptr-data-type


LongPtr (https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/longptr-data-type) is not a true data type because it transforms to a Long (https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/long-data-type) in 32-bit environments, or a LongLong (https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/longlong-data-type) in 64-bit environments. Using LongPtr enables writing portable code that can run in both 32-bit and 64-bit environments. Use LongPtr for pointers and handles.

You've probably seen this before, but there are some built in compiler constants that might be useful



' ver 01 10/9/2014
' initial (and probably only)


Option Explicit
Option Private Module






'Compiler Constants
'
'Visual Basic for Applications defines constants for exclusive use with the #If...Then...#Else directive.
' These constants are functionally equivalent to constants defined with the #If...Then...#Else directive except
' that they are global in scope; that is, they apply everywhere in a project.
'
'
' Note
'Because Win32 returns true in both 32-bit and 64-bit development platforms it is important that the order within the
' #If...Then...#Else directive returns the desired results in your code. For example, because Win32 returns True in
' 64-bit (Win32 is compatible in Win64 environments) checking for Win32 before Win64 results in the Win64 condition
' never running because Win32 returns True. The following order returns predictable results:
'
' #If Win64 Then
' Win64=true, Win32=true, Win16= false
' #ElseIf Win32 Then
' Win32=true, Win16=false
' #Else
' Win16=true
' #End If
'
'This applies to both Winx and VBAx constants.
'
'
'On 16-bit development platforms, the compiler constants are defined as follows:
'
'Constant Value Description
'Win16 True Indicates development environment is 16-bit compatible.
'Win32 False Indicates that the development environment is not 32-bit compatible.
'Win64 False Indicates that the development environment is not 64-bit compatible.
'
'On 32-bit development platforms, the compiler constants are defined as follows:
'
'Constant Value Description
'Vba6 True Indicates that the development environment is Visual Basic for Applications, version 6.0 compatible.
' False Indicates that the development environment is not Visual Basic for Applications, version 6.0 compatible.
'Vba7 True Indicates that the development environment is Visual Basic for Applications, version 7.0 compatible.
' False Indicates that the development environment is not Visual Basic for Applications, version 7.0 compatible.
'Win16 False Indicates that the development environment is not 16-bit compatible.
'Win32 True Indicates that the development environment is 32-bit compatible.
'Win64 False Indicates that the development environment is not 64-bit compatible.
'Mac True Indicates that the development environment is Macintosh.
' False Indicates that the development environment is not Macintosh.
'
'On 64-bit development platforms, the compiler constants are defined as follows:
'
'Constant Value Description
'Vba6 True Indicates that the development environment is Visual Basic for Applications, version 6.0 compatible.
' False Indicates that the development environment is not Visual Basic for Applications, version 6.0 compatible.
'Vba7 True Indicates that the development environment is Visual Basic for Applications, version 7.0 compatible.
' False Indicates that the development environment is not Visual Basic for Applications, version 7.0 compatible.
'Win16 False Indicates development environment is not 16-bit compatible.
'Win32 True Indicates that the development environment is 32-bit compatible.
'Win64 True Indicates that the development environment is 64-bit compatible.
'Mac True Indicates that the development environment is Macintosh.
' False Indicates that the development environment is not Macintosh.




Sub WhatVersion()


#If Win64 Then
#If VBA6 Then
msgBox "64 bit and VBA v6.0 compatible"
#ElseIf VBA7 Then
msgBox "64 bit and VBA v7.0 compatible"
#ElseIf Mac Then
msgBox "64 bit and Mac"
#End If

#ElseIf Win32 Then
#If VBA6 Then
msgBox "32 bit and VBA v6.0 compatible"
#ElseIf VBA7 Then
msgBox "32 bit and VBA v7.0 compatible"
#ElseIf Mac Then
msgBox "32 bit and Mac"
#End If

#Else
#If VBA6 Then
msgBox "16 bit and VBA v6.0 compatible"
#ElseIf VBA7 Then
msgBox "16 bit and VBA v7.0 compatible"
#ElseIf Mac Then
msgBox "16 bit and Mac"
#End If


#End If


End Sub

arnelgp
10-05-2024, 09:14 PM
you only need to test for VBA7 (Office 2010 and later), which the only version that supports LongPtr (for both x32 and x64).
there is no Win16 now (Office for Win95').

But if all your client is running Office 2010 and up, there is no need to test for anything (#IF..#Else..#End If).
just declare them (handles and pointers) as LongPtr (don't forget the add PtrSafe declaration in front of each function/sub).

Paul_Hossler
10-06-2024, 06:54 AM
Well, I was thinking that sometimes you can't be sure what version someone is running, so you might need to have different definitions

The fragment was old, so it might be OBE




'Declare a UDT to store a GUID for the IPicture OLE Interface
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type


#If VBA7 Then
'Declare a UDT to store the bitmap information
Private Type PICTDESC
Size As Long
Type As Long
hPic As LongPtr
hPal As LongPtr
End Type

'Declare a UDT to store the GDI+ Startup information
Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As LongPtr
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type

'Windows API calls into the GDI+ library
Private Declare PtrSafe Function GdiplusStartup Lib "GDIPlus" (token As LongPtr, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As LongPtr = 0) As Long
Private Declare PtrSafe Function GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal fileName As LongPtr, bitmap As LongPtr) As Long
Private Declare PtrSafe Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" (ByVal bitmap As LongPtr, hbmReturn As LongPtr, ByVal background As LongPtr) As Long
Private Declare PtrSafe Function GdipDisposeImage Lib "GDIPlus" (ByVal image As LongPtr) As Long
Private Declare PtrSafe Sub GdiplusShutdown Lib "GDIPlus" (ByVal token As LongPtr)
Private Declare PtrSafe Function OleCreatePictureIndirect Lib "oleaut32" (PicDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long


#Else
'Declare a UDT to store the bitmap information
Private Type PICTDESC
Size As Long
Type As Long
hPic As Long
hPal As Long
End Type

'Declare a UDT to store the GDI+ Startup information
Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type

'Windows API calls into the GDI+ library
Private Declare Function GdiplusStartup Lib "GDIPlus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Private Declare Function GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal fileName As Long, bitmap As Long) As Long
Private Declare Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" (ByVal bitmap As Long, hbmReturn As Long, ByVal background As Long) As Long
Private Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal image As Long) As Long
Private Declare Sub GdiplusShutdown Lib "GDIPlus" (ByVal token As Long)
Private Declare Function OleCreatePictureIndirect Lib "oleaut32" (PicDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
#End If

Chas Kenyon
10-08-2024, 02:04 PM
I have 64-bit and am willing to help but this is way over my head. What do I need to do? What am I looking for?

gmaxey
10-10-2024, 04:23 AM
Thanks everyone for you replies. I decided to install a 64 bit version on my laptop so I was able to change and test the code and it all works.