Patching GUID of MDE files

Legend

When your MS Access 97 application consists of several library MDE files you soon meet with the following problem:

- you have realeased v.1.00 to your client ;

- your client has found a bug in your release ;

- you check your sources and fix the bug - you only edit one line of code, don't change any functions'/subs' definitions etc.;

- you're lucky enough - the bug was located only in one of the library/component MDE files which you delivered to your client in v.1.00 ;

- your client cannot wait, he wants your fix immediately and you e-mail him just a fixed MDE;

- several hours later your client calls you and says that when he starts the app he gets an error message: "The expression you entered has a function name that Microsoft Access can't find"

What is the problem ?

Answer

As I've found, the problem is in that MS Access 97 stores GUID of library MDE file in an MDE file which has reference to this library MDE. When you recompile library/component MDE file you have to recompile all the MDE files which have references to these library/component MDEs. If you don't do that you get "The expression you entered has a function name that Microsoft Access can't find" error message or (in the case you changed function definitions, quantity or sequence of functions in modules, added a new module, i.e. you somehow changed interfaces of library mde files) you get GPF :(

But maybe it is possible to "fool" MS Access to solve the problem described in legend of this topic? Yes, it is possible and the code presented here does the trick but I don't recommend to use it in mission-critical real-life projects:

Option Compare Database
Option Explicit

Private Const BYTE_SIZE = 32568
Private Const PATCH_STR_OFFSET = 32 ' starts from 0
Private Const PATCH_STR_LEN = 16 '
Private Const SHOULDBEZERO_OFFSET = 27
Private Const SHOULDNTBE_FF_OFFSET = 75

Public Function TestOfTrick()
    Dim strBaseMDEPath As String
    Dim strMdeToPatchPath As String
    
    strBaseMDEPath = "c:\tst\lib_old.mde"
    strMdeToPatchPath = "c:\tst\lib.mde"
    MsgBox smsMDELibPatch(strBaseMDEPath, strMdeToPatchPath)
    
End Function

Public Function smsMDELibPatch(ByVal vstrBaseMdePath As String, _
                               ByVal vstrMdeToPatchPath As String, _
                               Optional ByVal vlngStartOffset As Long = 1) As Boolean

    Dim lngBaseSignatureOffset As Long
    Dim strBaseSignature As String
    
    Dim lngMdeToPatchSignatureOffset As Long
    Dim strMdeToPatchSignature As String
    
    smsMDELibPatch = False
    
    lngBaseSignatureOffset = smsSignatureFind(vstrBaseMdePath, strBaseSignature)
    If lngBaseSignatureOffset = 0 Then
        MsgBox "Base signature not found in " & vstrBaseMdePath
    Else
       lngMdeToPatchSignatureOffset = smsSignatureFind(vstrMdeToPatchPath, strMdeToPatchSignature, vlngStartOffset)
       If lngMdeToPatchSignatureOffset = 0 Then
          MsgBox "Target signature not found in " & vstrMdeToPatchPath
       Else
            Dim i As Integer
            For i = 1 To PATCH_STR_LEN
                PatchByte vstrMdeToPatchPath, _
                          PATCH_STR_OFFSET + lngMdeToPatchSignatureOffset + i, _
                          CByte(Asc(Mid(strBaseSignature, i, 1)))
            Next i
            smsMDELibPatch = True
       End If
    End If
End Function

Public Function smsSignatureDebugPrint(ByVal vstrMdePath As String, _
                                       Optional ByVal vlngStartPos As Long = 1) As Long
    Dim intFn As Integer
    Dim strbuf As String * BYTE_SIZE
    Dim strSignature As String

    Dim lngPos As Long
    Dim lngBlocksRead As Long
    Dim lngOffset As Long
    Dim iii As Integer
    Dim jjj As Integer
    
    smsSignatureDebugPrint = 0
    
    strSignature = smsSignatureSet()
    intFn = FreeFile
    Open vstrMdePath For Binary Access Read Shared As #intFn Len = BYTE_SIZE
    lngOffset = vlngStartPos - 1
    If lngOffset <> 0 Then
        Seek intFn, lngOffset + 1
    End If
    lngBlocksRead = 1
    While Not EOF(intFn)
      Get intFn, , strbuf
       lngPos = InStr(1, strbuf, strSignature)
       If lngPos <> 0 Then
         'If Asc(Mid(strbuf, lngPos + SHOULDBEZERO_OFFSET, 1)) = 0 Then
         'If Asc(Mid(strbuf, lngPos + SHOULDNTBE_FF_OFFSET, 1)) <> &HFF Then
         'If Asc(Mid(strbuf, lngPos + SHOULDNTBE_FF_OFFSET, 1)) = &HFF Then
           Debug.Print "Filepath = " & vstrMdePath
           Debug.Print "BlocksRead = " & lngBlocksRead
           Debug.Print "FileOffset = " & lngOffset + lngPos - 1 & "(10), " & smsHex(lngOffset + lngPos - 1) & "(16)"
           For iii = 0 To 79 + 16 + 16 + 16 + 16 + 16 + 16
             If iii Mod 16 = 0 Then
               Debug.Print smsHex(iii, 8) & ": ";
               For jjj = 0 To 15
                  Debug.Print smsHex(Asc(Mid(strbuf, lngPos + iii + jjj, 1))) & " ";
               Next jjj
               Debug.Print
             End If
           Next iii
         'End If
         'End If
         smsSignatureDebugPrint = lngOffset + lngPos - 1
         GoTo smsSignatureDebugPrint_exit
       End If
       
       lngOffset = lngOffset + BYTE_SIZE
       lngBlocksRead = lngBlocksRead + 1
    Wend
smsSignatureDebugPrint_exit:
    Close #intFn
End Function

Public Function smsSignatureFind(ByVal vstrMdePath As String, _
                                 ByRef vstrSignature As String, _
                                 Optional ByVal vlngStartOffset As Long = 1) As Long
    Dim intFn As Integer
    Dim strbuf As String * BYTE_SIZE
    Dim strSignature As String

    Dim lngPos As Long
    Dim lngBlocksRead As Long
    Dim lngOffset As Long
    
    smsSignatureFind = 0
    vstrSignature = ""
    
    strSignature = smsSignatureSet()
    intFn = FreeFile
    
    Open vstrMdePath For Binary Access Read Shared As #intFn Len = BYTE_SIZE
    lngOffset = vlngStartOffset - 1
    lngBlocksRead = 1
    If lngOffset <> 0 Then
        Seek #intFn, lngOffset + 1
    End If
    
    While Not EOF(intFn)
      Get intFn, , strbuf
       lngPos = InStr(1, strbuf, strSignature)
       If lngPos <> 0 Then
         'If Asc(Mid(strbuf, lngPos + SHOULDBEZERO_OFFSET, 1)) = 0 Then
         If Asc(Mid(strbuf, lngPos + SHOULDNTBE_FF_OFFSET, 1)) <> &HFF Then
           vstrSignature = Mid(strbuf, lngPos + PATCH_STR_OFFSET, PATCH_STR_LEN)
           smsSignatureFind = lngOffset + lngPos - 1
           GoTo smsSignatureFind_Exit
         End If
         'End If
       End If
       lngOffset = lngOffset + BYTE_SIZE
       lngBlocksRead = lngBlocksRead + 1
    Wend
smsSignatureFind_Exit:
    Close #intFn
End Function

Public Function PatchByte(ByVal vstrFilePath As String, _
                          ByVal vlngOffset As Long, _
                          ByVal vbytValue As Byte)
                          
    Dim intFn As Integer
    
    intFn = FreeFile
    Open vstrFilePath For Binary Access Write As #intFn
    Put #intFn, vlngOffset, vbytValue
    Close intFn
End Function

Private Function smsHex(ByVal vvar As Variant, Optional ByVal intOutputLen As Integer = 2)
    Dim strRet As String
    strRet = Hex(vvar)
    If Len(strRet) = 0 Then
        smsHex = "??"
    ElseIf Len(strRet) < intOutputLen Then
        smsHex = String(intOutputLen - Len(strRet), "0") & strRet
    Else
        smsHex = strRet
    End If
End Function

Private Function smsSignatureSet() As String
    Dim strSignature As String
    
    '00 - 7f
    ''''strSignature = strSignature & Chr(&H7F) - isn't present sometimes !!!
    
    '01 - 00 - four times
    strSignature = strSignature & Chr(&H0)
    strSignature = strSignature & Chr(&H0)
    strSignature = strSignature & Chr(&H0)
    strSignature = strSignature & Chr(&H0)
    '05 - 13, Acc2000 0E
    strSignature = strSignature & Chr(&H13)
    '06 - 00 - three times
    strSignature = strSignature & Chr(&H0)
    strSignature = strSignature & Chr(&H0)
    strSignature = strSignature & Chr(&H0)
    '09 - 09
    strSignature = strSignature & Chr(&H9)
    '10 - 00 - five times
    strSignature = strSignature & Chr(&H0)
    strSignature = strSignature & Chr(&H0)
    strSignature = strSignature & Chr(&H0)
    strSignature = strSignature & Chr(&H0)
    strSignature = strSignature & Chr(&H0)
    '15 - 01
    strSignature = strSignature & Chr(&H1)
    '16 - 00
    strSignature = strSignature & Chr(&H0)
    '17 - 08
    strSignature = strSignature & Chr(&H8)
    '18 - 00 - seven times
    strSignature = strSignature & Chr(&H0)
    strSignature = strSignature & Chr(&H0)
    strSignature = strSignature & Chr(&H0)
    strSignature = strSignature & Chr(&H0)
    strSignature = strSignature & Chr(&H0)
    strSignature = strSignature & Chr(&H0)
    strSignature = strSignature & Chr(&H0)
    
    '25 - B9 02
    '27 - (00)(6 times)
    '
    '33 - 5 bytes to patch
    '
    '38 - Another five bytes
    '
    '43 - And Another six bytes
    '
    ' Tail of signature ???
    '49 - 00 00
    '51 - 09 04
    '53 - 00 00
    '55 - 19 04
    '57 - 00 00
    '59 - E3 04
    '61 - 00 00 00 00 00 00
    '67 - <byte> 00 <byte1 = byte> ...
    smsSignatureSet = strSignature
End Function