[AccessD] [Fwd: Re: Incompatibility?]

MartyConnelly martyconnelly at shaw.ca
Mon Apr 3 15:35:51 CDT 2006


You might get this with ArcInfo as it uses Access as one of its data 
engines,
so you might get a bum DAO reference on an install, don't know about AutoCAD
AutoCAD might also might forece an install of an old common control.

This might help

Stick this code in an mde and run on the odd machine.
It will printout the possible reference differences (version number, 
path and name).
Or rewrite this inorder to dump to a text file like
'kill file as necessary
Open c:\temp\outputref.txt For Output As #1
     Print #1, ReferencePropertiesList
     Close #1
Run it from autoexec macro, code should be fully disambiguated to avoid 
any initial reference check
before running. ie VBA.MsgBox, Access.Reference and VBA.Len, VarPtr 
might not be available in lower versions of Access
might be a replacement on www.mvps.org/access


Place in 3 seperate modules.

'http://allenbrowne.com/ser-38.html
'http://www.accessmvp.com/djsteele/AccessReferenceErrors.html'

'I got tired of trying to decipher the full path name to a DLL in Tools:
'Reference Window. In Access 97 it cuts off the path filename at about 30
'chars. To get the a list of the all the filenames and paths for your
'external references, run the routine below it places all the references
'into a string suitable for dropping into a text box. As an afterthought I
'added some code to give the actual version number from the dll or ocx file
'etc. This might be useful in an MDE to track if the user has correct
'version number of DAO ADO etc. installed. Place in About popup window.
' It only seems to work some of the time if a reference is missing, seems
'to depend on installation order. So it might not help in all missing 
references.

Function ReferencePropertiesList() As String
'list all references in a MDB and place in a string
   Dim ref As Access.Reference
   Dim strList As String
    strList = "Reference Properties:" & vbCrLf & vbCrLf
   For Each ref In Access.References
      ' Check for ActiveX type files
      'Check for Broken Properties
      If ref.IsBroken = False Then
        strList = strList & "  Name: " & ref.Name & vbCrLf
        strList = strList & " FullPath: " & ref.FullPath & vbCrLf
        strList = strList & " Version: " & ref.Major & "." & ref.Minor & _
                   vbCrLf

          'skip these two calls if detail not needed
         strList = strList & " Description: " & _
                  GetFileDescription(ref.FullPath) & vbCrLf
          strList = strList & " Version No: " & _
                  FileVersionNo(ref.FullPath) & _
                 vbCrLf & vbCrLf
         Else
        strList = strList & " GUIDs of broken references:" & vbCrLf
        strList = strList & " " & ref.Guid & vbCrLf & vbCrLf
       End If
 
   'VBA.MsgBox GetFileDescription(ref.FullPath) & " - " & 
FileVersionNo(ref.FullPath)
   Next ref
   Debug.Print strList
   ReferencePropertiesList = strList
End Function
------------------ module 2



 'usage: file description

'Private Sub Command1_Click()
'    MsgBox GetFileDescription("c:\windows\system\shell32.dll")
'End Sub

'Declarations:
Private Declare Function GetLocaleInfoA Lib "kernel32.dll" (ByVal lLCID As _
Long, ByVal lLCTYPE As Long, ByVal strLCData As String, ByVal lDataLen As _
Long) As Long

Private Declare Sub lstrcpyn Lib "kernel32.dll" (ByVal strDest As String, _
ByVal strSrc As Any, ByVal lBytes As Long)

Private Declare Function GetFileVersionInfoSize Lib "Version.dll" _
Alias "GetFileVersionInfoSizeA" (ByVal sFile As String, lpLen As Long) 
As Long

Private Declare Function GetFileVersionInfo Lib "Version.dll" _
Alias "GetFileVersionInfoA" (ByVal sFile As String, ByVal lpIgnored As _
Long, ByVal lpSize As Long, ByVal lpBuf As Long) As Long

Private Declare Function VerQueryValue Lib "Version.dll" _
Alias "VerQueryValueA" (ByVal lpBuf As Long, ByVal szReceive As String, _
lpBufPtr As Long, lLen As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" _
 (pDest As Any, pSource As Any, ByVal ByteLen As Long)

Private Declare Function GetUserDefaultLCID Lib "kernel32.dll" () As Long

 'Functions:

Public Function StringFromBuffer(buffer As String) As String
    Dim nPos As Long

    nPos = VBA.InStr(buffer, vbNullChar)
    If nPos > 0 Then
        StringFromBuffer = VBA.Left$(buffer, nPos - 1)
    Else
        StringFromBuffer = buffer
    End If
End Function

Public Function GetFileDescription(ByVal sFile As String) As String
    Dim lVerSize As Long
    Dim lTemp As Long
    Dim lRet As Long
    Dim bInfo() As Byte
    Dim lpBuffer As Long
    Dim sDesc As String
    Dim sKEY As String

    lVerSize = GetFileVersionInfoSize(sFile, lTemp)
    ReDim bInfo(lVerSize)
    If lVerSize > 0 Then
    lRet = GetFileVersionInfo(sFile, lTemp, lVerSize, VBA.VarPtr(bInfo(0)))
        If lRet <> 0 Then
            sKEY = GetNLSKey(bInfo)
            lRet = VerQueryValue(VBA.VarPtr(bInfo(0)), sKEY & 
"\FileDescription", lpBuffer, lVerSize)
            If lRet <> 0 Then
                sDesc = VBA.Space$(lVerSize)
                lstrcpyn sDesc, lpBuffer, lVerSize
                GetFileDescription = StringFromBuffer(sDesc)
            End If
        End If
    End If
End Function

Public Function GetNLSKey(byteVerData() As Byte) As String
    Static strLANGCP As String
    Dim lpBufPtr As Long
    Dim strNLSKey As String
    Dim fGotNLSKey As Integer
    Dim intOffset As Integer
    Dim lVerSize As Long
    Dim lTmp As Long
    Dim lBufLen As Long
    Dim lLCID As Long
    Dim strTmp As String

    On Error GoTo GNLSKCleanup
    If VerQueryValue(VBA.VarPtr(byteVerData(0)), 
"\VarFileInfo\Translation", lpBufPtr, lVerSize) <> 0 Then
        If VBA.Len(strLANGCP) = 0 Then
            lLCID = GetUserDefaultLCID()
            If lLCID > 0 Then
                strTmp = VBA.Space$(8)
                GetLocaleInfoA lLCID, 11, strTmp, 8
                strLANGCP = StringFromBuffer(strTmp)
                Do While VBA.Len(strLANGCP) < 4
                    strLANGCP = "0" & strLANGCP
                Loop
                GetLocaleInfoA lLCID, 9, strTmp, 8
                strLANGCP = StringFromBuffer(strTmp) & strLANGCP
                Do While VBA.Len(strLANGCP) < 8
                    strLANGCP = "0" & strLANGCP
                Loop
            End If
        End If
        If VerQueryValue(VBA.VarPtr(byteVerData(0)), strLANGCP, lTmp, 
lBufLen) <> 0 Then
            strNLSKey = strLANGCP
        Else
            For intOffset = 0 To lVerSize - 1 Step 4
                CopyMemory lTmp, ByVal lpBufPtr + intOffset, 4
                strTmp = VBA.Hex$(lTmp)
                Do While VBA.Len(strTmp) < 8
                    strTmp = "0" & strTmp
                Loop
                strNLSKey = "\StringFileInfo\" & Right$(strTmp, 4) & 
Left$(strTmp, 4)
                If VerQueryValue(VBA.VarPtr(byteVerData(0)), strNLSKey, 
lTmp, lBufLen) <> 0 Then
                    fGotNLSKey = True
                    Exit For
                End If
            Next
            If Not fGotNLSKey Then
                strNLSKey = "\StringFileInfo\040904E4"
                If VerQueryValue(VBA.VarPtr(byteVerData(0)), strNLSKey, 
lTmp, lBufLen) <> 0 Then
                    fGotNLSKey = True
                End If
            End If
        End If
    End If
GNLSKCleanup:
    If fGotNLSKey Then
        GetNLSKey = strNLSKey
    End If
End Function

------------------------ module 3


'Eg. Get Version Details of C:\Windows\System\Comctl32.ocx
'Sub Example()
'    Debug.Print FileVersionNo("C:\Windows\System\comctl32.ocx")
'End Sub
'http://www.vbusers.com/code/codeget.asp?ThreadID=58&PostID=1&NumReplies=1
'--------------GET VERSION INFO API-----------------------
Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function VerQueryValue Lib "Version.dll" _
Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, _
lplpBuffer As Any, puLen As Long) As Long
Private Declare Function GetFileVersionInfoSize Lib "Version.dll" _
Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, 
lpdwHandle _
As Long) As Long
Private Declare Function GetFileVersionInfo Lib "Version.dll" _
Alias "GetFileVersionInfoA" (ByVal lptstrFilename As String, ByVal 
dwhandle _
As Long, ByVal dwlen As Long, lpData As Any) As Long

Private Type VS_FIXEDFILEINFO
   Signature As Long
   StrucVersionl As Integer     '  e.g. = &h0000 = 0
   StrucVersionh As Integer     '  e.g. = &h0042 = .42
   FileVersionMSl As Integer    '  e.g. = &h0003 = 3
   FileVersionMSh As Integer    '  e.g. = &h0075 = .75
   FileVersionLSl As Integer    '  e.g. = &h0000 = 0
   FileVersionLSh As Integer    '  e.g. = &h0031 = .31
   ProductVersionMSl As Integer '  e.g. = &h0003 = 3
   ProductVersionMSh As Integer '  e.g. = &h0010 = .1
   ProductVersionLSl As Integer '  e.g. = &h0000 = 0
   ProductVersionLSh As Integer '  e.g. = &h0031 = .31
   FileFlagsMask As Long        '  = &h3F for version "0.42"
   FileFlags As Long            '  e.g. VFF_DEBUG Or VFF_PRERELEASE
   FileOS As Long               '  e.g. VOS_DOS_WINDOWS16
   FileType As Long             '  e.g. VFT_DRIVER
   FileSubtype As Long          '  e.g. VFT2_DRV_KEYBOARD
   FileDateMS As Long           '  e.g. 0
   FileDateLS As Long           '  e.g. 0
End Type

'Purpose     :  To obtain the file version info of a DLL, OCX, EXE etc.
'Inputs      :  sFileName               The path and name of the file to 
return the version info
'Outputs     :  Returns the file version number of the specified file
'Author      :  Andrew Baker
'Date        :  09/10/2000 23:39
'Notes       :
'Revisions   :

Function FileVersionNo(sFileName As String) As String
   Dim lFileHwnd As Long, lRet As Long, lBufferLen As Long, lplpBuffer 
As Long, lpuLen As Long
   Dim abytBuffer() As Byte
   Dim tVerInfo As VS_FIXEDFILEINFO
   Dim sBlock As String
   Dim sStrucVer As String
   Dim lentVerInfo As Long
    'Get the size File version info structure
    lBufferLen = GetFileVersionInfoSize(sFileName, lFileHwnd)
    If lBufferLen = 0 Then
       Exit Function
    End If

    'Create byte array buffer, then copy memory into structure
    ReDim abytBuffer(lBufferLen)
    Call GetFileVersionInfo(sFileName, 0&, lBufferLen, abytBuffer(0))
    Call VerQueryValue(abytBuffer(0), "\", lplpBuffer, lpuLen)
    'lentVerInfo = VBA.Len(tVerInfo) 'doesn't compile Len(tVerInfo) does 
so force
    'with magic number
    lentVerInfo = 52
   
    Call CopyMem(tVerInfo, ByVal lplpBuffer, lentVerInfo)

    'Determine structure version number (For info only)
    sStrucVer = VBA.Format$(tVerInfo.StrucVersionh) & "." & 
VBA.Format$(tVerInfo.StrucVersionl)

    'Concatenate file version number details into a result string
    FileVersionNo = VBA.Format$(tVerInfo.FileVersionMSh) & "." & 
VBA.Format$(tVerInfo.FileVersionMSl, "00") & "."
    If tVerInfo.FileVersionLSh > 0 Then
        FileVersionNo = FileVersionNo & 
VBA.Format$(tVerInfo.FileVersionLSh, "0000") & "." & 
VBA.Format$(tVerInfo.FileVersionLSl, "00")
    Else
        FileVersionNo = FileVersionNo & 
VBA.Format$(tVerInfo.FileVersionLSl, "0000")
    End If
End Function








Rocky Smolin - Beach Access Software wrote:

>Dear List:
>
>Does anyone have any idea why my mde might be failing on one machine on 
>a network but not the others?
>
>MTIA
>
>Rocky
>
>
>-------- Original Message --------
>Subject: 	Re: Incompatibility?
>Date: 	Mon, 03 Apr 2006 14:06:28 +0530
>From: 	R Ramamurthy <rram22 at dataone.in>
>To: 	Rocky Smolin - Beach Access Software <bchacc at san.rr.com>
>References: 	<037001c655ff$4f2cdf00$6401a8c0 at ramamurty> 
><442F5442.6010202 at san.rr.com>
>
>
>
>
> >>I never heard of an incompatibility with AutoCAD but I suppose it's 
>possible.  Do any other access mdbs have this problem on this machine?
>## The Access program itself opens in that computer but only PPM does 
>not. There are no other *.mdb files to try out. And all other computers 
>in the LAN do not have this problem.
> 
>## The failure message that appears (under the PPM blue strip in the 
>warning window) reads as:
> 
>"The expression On Open you entered as the event property setting 
>produced the following erors: Licence information for the component not 
>found. You do not have an appropriate licence to use the functionality 
>in the design environment.
>* The expression may not result in the name of a macro, the name of a 
>user-defined function, or [ Event procedure ]
>* There may have been an error evaluating the function, event, or macro"
> 
>## Rocky, please note the words  
>'On Open', both with capital O's
>'design environment'
>Do these provide a clue?
> 
>Does the PPM program generate such a warning?
> 
>Ram
>
>  
>

-- 
Marty Connelly
Victoria, B.C.
Canada






More information about the AccessD mailing list