Consulting

Results 1 to 14 of 14

Thread: Help Needed with 64 Bit Declarations

  1. #1
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,400
    Location

    Help Needed with 64 Bit Declarations

    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: Declarations Need Help.xlsmDeclarations Need Help.xlsm

    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
    Declarations Need Help.xlsm
    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-...tml#post183353
    Greg

    Visit my website: http://gregmaxey.com

  2. #2
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,796
    Location
    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

    Links

    Of 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
    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
    I've used the MS links to update APIs to work with 32 or 64 bit Office
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  3. #3
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,400
    Location
    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.
    Greg

    Visit my website: http://gregmaxey.com

  4. #4
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,796
    Location
    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
    Attached Files Attached Files
    Last edited by Paul_Hossler; 10-04-2024 at 01:58 PM.
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  5. #5
    just add PtrSafe to each Function/Sub declaration.
    Attached Files Attached Files

  6. #6
    VBAX Master Aflatoon's Avatar
    Joined
    Sep 2009
    Location
    UK
    Posts
    1,783
    Location
    Quote Originally Posted by arnelgp View Post
    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.
    Be as you wish to seem

  7. #7
    Quote Originally Posted by Aflatoon View Post
    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.

  8. #8
    VBAX Master Aflatoon's Avatar
    Joined
    Sep 2009
    Location
    UK
    Posts
    1,783
    Location
    No. What you said is categorically wrong, and passing incorrect arguments to APIs is dangerous.
    Be as you wish to seem

  9. #9
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,400
    Location
    Thanks Paul. With this, I think I can probably sort it out.
    Greg

    Visit my website: http://gregmaxey.com

  10. #10
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,796
    Location
    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/of...gptr-data-type

    LongPtr is not a true data type because it transforms to a Long in 32-bit environments, or a LongLong 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
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  11. #11
    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).

  12. #12
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,796
    Location
    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
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  13. #13
    VBAX Contributor
    Joined
    Jul 2020
    Location
    Sun Prairie
    Posts
    126
    Location
    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?

  14. #14
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,400
    Location
    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.
    Greg

    Visit my website: http://gregmaxey.com

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •