home bbs files messages ]

Forums before death by AOL, social media and spammers... "We can't have nice things"

   comp.lang.visual.basic      MS Visual Basic discussions, NOT dot-net      10,840 messages   

[   << oldest   |   < older   |   list   |   newer >   |   newest >>   ]

   Message 9,515 of 10,840   
   Raoul Watson to RWC   
   Re: Programatically determining if Acces   
   19 May 05 04:14:54   
   
   XPost: comp.databases.ms-access   
   From: WatsonR@IntelligenCIA.com   
      
   "RWC"  wrote in message   
   news:Ybpie.1389236$8l.321516@pd7tw1no...   
   > Hi Folks,   
   >   
   > I'm looking for a way to determine if the client machine has access   
   > installed and if so, what version.  The reason I need this is to determine   
   > (programatically) if the Access Runtime is required to be installed and if   
   > not, which version of the program database needs to be installed with the   
   > current version of Access.  (hope that makes sense).   
   >   
   > If anyonoe could point me in the right direction, I'd really appreciate   
   it.   
   >   
   > Thanks in advance!   
   > Rick   
   >   
      
   My logic is that since normally mdb is associated with access, we can find   
   the application associated with mdb then find the file version. I have not   
   tested this code but give it a shot:   
      
   ' Calling code in form   
      
   exePath = GetAccessPath   
   exeversion = GetVersion(Trim(exePath))   
      
      
   '===module level   
   Option Explicit   
   Public gAccessExists As Boolean   
   Public gAccessPath As String   
      
   Public Declare Function FindExecutable Lib "shell32" _   
      Alias "FindExecutableA" _   
     (ByVal lpFile As String, _   
      ByVal lpDirectory As String, _   
      ByVal sResult As String) As Long   
      
   Public Declare Function GetTempPath Lib "kernel32" _   
      Alias "GetTempPathA" _   
     (ByVal nSize As Long, _   
      ByVal lpBuffer As String) As Long   
      
   Public Const MAX_PATH As Long = 260   
   Public Const ERROR_FILE_NO_ASSOCIATION As Long = 31   
   Public Const ERROR_FILE_NOT_FOUND As Long = 2   
   Public Const ERROR_PATH_NOT_FOUND As Long = 3   
   Public Const ERROR_FILE_SUCCESS As Long = 32  > is good   
   Public Const ERROR_BAD_FORMAT As Long = 11   
      
   Private Const ERROR_SUCCESS As Long = 0   
      
   Private Type FIXEDFILEINFO   
       dwSignature As Long   
       dwStrucVersionl As Integer   
       dwStrucVersionh As Integer   
       dwFileVersionMSl As Integer   
       dwFileVersionMSh As Integer   
       dwFileVersionLSl As Integer   
       dwFileVersionLSh As Integer   
       dwProductVersionMSl As Integer   
       dwProductVersionMSh As Integer   
       dwProductVersionLSl As Integer   
       dwProductVersionLSh As Integer   
       dwFileFlagsMask As Long   
       dwFileFlags As Long   
       dwFileOS As Long   
       dwFileType As Long   
       dwFileSubtype As Long   
       dwFileDateMS As Long   
       dwFileDateLS As Long   
   End Type   
      
   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 Declare Function GetFileVersionInfoSize Lib "Version.dll" Alias   
   "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As   
   Long) 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 Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As   
   Any, ByVal Source As Long, ByVal length As Long)   
      
   ' Find what is associated with mdb   
      
   Public Function GetmdbAssociation(dwFlagReturned As Long) As String   
      Dim sTempFolder   
      Dim hfile   
      Dim sResult As String   
      
     'get the user's temp folder   
      sTempFolder = GetTempDir()   
      
     'create a dummy mdb file in the temp dir   
      hfile = FreeFile   
         Open sTempFolder & "dummy.mdb" For Output As #hfile   
      Close   
      
     'get the file path & name associated with the file   
      sResult = Space$(MAX_PATH)   
      dwFlagReturned = FindExecutable("dummy.mdb", sTempFolder, sResult)   
      
     'clean up   
      Kill sTempFolder & "dummy.mdb"   
      
     'return result   
      GetmdbAssociation = TrimNull(sResult)   
      
   End Function   
      
      
   Public Function TrimNull(item As String)   
     Dim pos As Integer   
       pos = InStr(item, Chr$(0))   
       If pos Then   
          TrimNull = Left$(item, pos - 1)   
       Else   
          TrimNull = item   
       End If   
    End Function   
      
      
   Public Function GetTempDir() As String   
       Dim nSize As Long   
       Dim tmp As String   
       tmp = Space$(MAX_PATH)   
       nSize = Len(tmp)   
       Call GetTempPath(nSize, tmp)   
       GetTempDir = TrimNull(tmp)   
   End Function   
      
   Public Function GetAccessPath() As String   
   Dim b$   
   Dim success As Long   
     'success is passed and filled in the routine   
      b$ = GetmdbAssociation(success)   
      
     'possible return values from the call   
     'returned in success   
      Select Case success   
      
        'the call succeeded   
         Case Is >= ERROR_FILE_SUCCESS  '>32 good   
             gAccessExists = True   
      
        'other possible return values   
         'Case ERROR_FILE_NO_ASSOCIATION   
         'Case ERROR_FILE_NOT_FOUND   
         'Case ERROR_PATH_NOT_FOUND   
         'Case ERROR_BAD_FORMAT   
         gAccessPath = b$   
         Case Else   
             gAccessExists = False   
      End Select   
      GetAccessPath = b$   
   End Function   
      
   Public Function GetVersion(sPath) As String   
   Dim rc As Long   
   Dim lDummy As Long   
   Dim sBuffer() As Byte   
   Dim lBufferLen As Long   
   Dim lVerPointer As Long   
   Dim udtVerBuffer As FIXEDFILEINFO   
   Dim lVerbufferLen As Long   
      
      On Error GoTo GetFileVersion_Error   
      
      '*** Get size ****   
      lBufferLen = GetFileVersionInfoSize(sPath, lDummy)   
      If lBufferLen < 1 Then   
         GetVersion = ""   
         Exit Function   
      End If   
      
      '**** Store info into struct ****   
      ReDim sBuffer(lBufferLen)   
      rc = GetFileVersionInfo(sPath, 0&, lBufferLen, sBuffer(0))   
      rc = VerQueryValue(sBuffer(0), "\", lVerPointer, lVerbufferLen)   
      MoveMemory udtVerBuffer, lVerPointer, Len(udtVerBuffer)   
   ' a very very long line below   
      GetVersion = Format$(udtVerBuffer.dwFileVersionMSh) & "." &   
   Format$(udtVerBuffer.dwFileVersionMSl) & "." &   
   Format$(udtVerBuffer.dwFileVersionLSh) & "." &   
   Format$(udtVerBuffer.dwFileVersionLSl)   
      
      On Error GoTo 0   
      Exit Function   
      
   GetFileVersion_Error:   
       GetVersion = ""   
   End Function   
      
   --- SoupGate-Win32 v1.05   
    * Origin: you cannot sedate... all the things you hate (1:229/2)   

[   << oldest   |   < older   |   list   |   newer >   |   newest >>   ]


(c) 1994,  bbs@darkrealms.ca