GUID of MDE files

Topic

From: Shamil Salakhetdinov <shamil@marta.darts.spb.ru>
To: ACCESS-L <ACCESS-L@PEACH.EASE.LSOFT.COM>
Subject: GUID in MDE files
Date: 29 September 1998 3:52

I'm now quite sure that every complied Access 97 MDB - MDE file gets GUID. Here is the code which I use to get GUID of MDE files compiled under WinNT 4.0 / Access 97:

Private Const BYTE_SIZE = 32568 
Private Const BYTE_SIZE_Plus15 = BYTE_SIZE + 15
Private Const GUID_OFFSET = 32 ' - no 7f as beginning - 33 ' starts from 0
Private Const GUID_LEN = 16
Private Const SHOULDNTBE_FF_OFFSET = 74 ' 75 ' starts from 0
Private Const GUID_BLOCK_LEN = 96

Public Function smsMdeGUIDGet(ByVal vstrMdePath As String, _
                              Optional ByRef vlngOffset As Variant) As String
' Returns:
'
' <>"" - mde's GUID string
' vlngOffset - GUID offset in mde file starting from 0
'
    
    Dim lngOffset As Long
    Dim strGUIDBlock As String
    Dim strTmp As String
    Dim strHex As String
    Dim i As Integer
    
    lngOffset = smsGUIDBlockGet(vstrMdePath, strGUIDBlock)
    If lngOffset <> 0 Then
        strGUIDBlock = Mid(strGUIDBlock, GUID_OFFSET + 1, GUID_LEN)
        strTmp = "{"
        For i = 1 To 16
          Select Case i
          Case 1:
           strHex = smsHex(Asc(Mid(strGUIDBlock, 4, 1)))
           strTmp = strTmp & strHex
          Case 2:
           strHex = smsHex(Asc(Mid(strGUIDBlock, 3, 1)))
           strTmp = strTmp & strHex
          Case 3:
           strHex = smsHex(Asc(Mid(strGUIDBlock, 2, 1)))
           strTmp = strTmp & strHex
          Case 4:
           strHex = smsHex(Asc(Mid(strGUIDBlock, 1, 1)))
           strTmp = strTmp & strHex & "-"
          Case 5, 7:
           strHex = smsHex(Asc(Mid(strGUIDBlock, i + 1, 1)))
           strTmp = strTmp & strHex
          Case 6, 8:
            strHex = smsHex(Asc(Mid(strGUIDBlock, i - 1, 1)))
           strTmp = strTmp & strHex & "-"
          Case 9:
           strHex = smsHex(Asc(Mid(strGUIDBlock, i, 1)))
           strTmp = strTmp & strHex
          Case 10:
           strHex = smsHex(Asc(Mid(strGUIDBlock, i, 1)))
           strTmp = strTmp & strHex & "-"
          Case 9 To 16:
           strHex = smsHex(Asc(Mid(strGUIDBlock, i, 1)))
           strTmp = strTmp & strHex
          Case Else
          End Select
        Next i
       strTmp = strTmp & "}"
       smsMdeGUIDGet = Trim(strTmp)
    Else
        smsMdeGUIDGet = ""
    End If
    
    If Not IsMissing(vlngOffset) Then
       vlngOffset = lngOffset + GUID_OFFSET
    End If
End Function


Public Function smsGUIDBlockGet(ByVal vstrMdePath As String, _
                                ByRef vstrGUIDBlock As String) 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
    
    smsGUIDBlockGet = 0
    vstrGUIDBlock = ""
    
    strSignature = smsSignatureSet()
    intFn = FreeFile
    
    Open vstrMdePath For Binary Access Read Shared As #intFn Len = BYTE_SIZE
    lngOffset = 0
    lngBlocksRead = 1
    
    While Not EOF(intFn)
      Get intFn, , strbuf
       lngPos = InStr(1, strbuf, strSignature)
       If lngPos <> 0 Then
         If Asc(Mid(strbuf, lngPos + SHOULDNTBE_FF_OFFSET, 1)) <> &HFF Then
           vstrGUIDBlock = Mid(strbuf, lngPos, GUID_BLOCK_LEN)
           smsGUIDBlockGet = lngOffset + lngPos - 1
           GoTo smsGUIDBlockGet_Exit
         End If
       End If
       lngOffset = lngOffset + BYTE_SIZE
       lngBlocksRead = lngBlocksRead + 1
    Wend
smsGUIDBlockGet_Exit:
    Close #intFn
End Function


Public 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

Public 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

I planned to use this code to solve the problem of compiled MDEs' project/binary imcompatibility but it didn't help - I found more elegant and easy solution but this is another story...

If you'll test this code under non-US versions of MS Access please send me a note - does this function work for your case...