home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Programmer'…arterly (Limited Edition) / Visual_Basic_Programmers_Journal_VB-CD_Quarterly_Limited_Edition_1995.iso / code / ch16code / filever.bas next >
Encoding:
BASIC Source File  |  1995-08-17  |  9.9 KB  |  257 lines
  1. Attribute VB_Name = "Module1"
  2. Option Explicit
  3.  
  4. #If Win16 Then
  5. Declare Function DiskSpaceFree Lib "SETUPKIT.DLL" () As Long
  6. Declare Sub DLLSelfRegister Lib "SETUPKIT.DLL" _
  7.     (ByVal lpDllName As String)
  8. Declare Function GetPrivateProfileString Lib _
  9.     "Kernel" (ByVal lpApplicationName As String, _
  10.     ByVal lpKeyName As Any, ByVal lpDefault As String, _
  11.     ByVal lpReturnedString As String, ByVal nSize As Integer, _
  12.     ByVal lpFileName As String) As Integer
  13. Declare Function WritePrivateProfileString Lib "Kernel" _
  14.     (ByVal lpApplicationName As Any, ByVal lpKeyName As Any, _
  15.     ByVal lpString As Any, ByVal lplFileName As String) _
  16.     As Integer
  17. Declare Function GetWindowsDirectory Lib "Kernel" _
  18.     (ByVal lpBuffer As String, ByVal nSize As Integer) As Integer
  19. Declare Function GetSystemDirectory Lib "Kernel" _
  20.     (ByVal lpBuffer As String, ByVal nSize As Integer) As Integer
  21. Declare Function GetDriveType16 Lib "Kernel" Alias _
  22.     "GetDriveType" (ByVal intDriveNum As Integer) As Integer
  23. Declare Function GetTempFileName16 Lib "Kernel" Alias _
  24.     "GetTempFileName" (ByVal cDriveLetter As Integer, _
  25.     ByVal lpPrefixString As String, ByVal wUnique As Integer, _
  26.     ByVal lpTempFileName As String) As Integer
  27. Declare Function GetFileVersionInfoSize Lib "VER.DLL" _
  28.     (ByVal strFileName As String, lVerHandle As Long) As Long
  29. Declare Function GetFileVersionInfo Lib "VER.DLL" _
  30.     (ByVal strFileName As String, ByVal lVerHandle As Long, _
  31.     ByVal lcbSize As Long, ByVal strDATA As String) As Integer
  32. Declare Function VerQueryValue Lib "VER.DLL" _
  33.     (ByVal strVerData As String, ByVal lpszSubBlock As String, _
  34.     lplpBuf As Long, lpcb As Long) As Integer
  35. Declare Function VerInstallFile Lib "VER.DLL" _
  36.     (ByVal Flags As Integer, _
  37.     ByVal SrcName As String, _
  38.     ByVal DestName As String, _
  39.     ByVal SrcDir As String, _
  40.     ByVal DestDir As String, _
  41.     ByVal CurrDir As Any, _
  42.     ByVal TmpName As String, _
  43.     iTempLen As Integer) As Long
  44. Declare Function VerFindFile Lib "VER.DLL" _
  45.     (ByVal iFlags As Integer, _
  46.     ByVal strFileName As String, _
  47.     ByVal strWinDirectory As String, _
  48.     ByVal strAppDir As String, _
  49.     ByVal strCurDir As String, _
  50.     iCurDirLen As Integer, _
  51.     ByVal strDestDir As String, _
  52.     iDestDirLen As Integer) _
  53.     As Integer
  54. #Else
  55. Declare Function DiskSpaceFree Lib "STKIT432.DLL" _
  56.     Alias "DISKSPACEFREE" () As Long
  57. Declare Function GetWinPlatform Lib "STKIT432.DLL" () As Long
  58. Declare Function FSyncShell Lib "STKIT432.DLL" _
  59.     Alias "SyncShell" (ByVal strCmdLine As String, _
  60.     ByVal intCmdShow As Long) As Long
  61. Declare Sub DLLSelfRegister Lib "STKIT432.DLL" _
  62.     (ByVal lpDllName As String)
  63. Declare Function GetPrivateProfileString Lib "Kernel32" _
  64.     Alias "GetPrivateProfileStringA" _
  65.     (ByVal lpApplicationName As String, ByVal lpKeyName As Any, _
  66.     ByVal lpDefault As String, ByVal lpReturnedString As String, _
  67.     ByVal lSize As Long, ByVal lpFileName As String) As Long
  68. Declare Function WritePrivateProfileString Lib "Kernel32" Alias _
  69.     "WritePrivateProfileStringA" (ByVal lpApplicationName As Any, _
  70.     ByVal lpKeyName As Any, ByVal lpString As Any, _
  71.     ByVal lplFileName As String) As Long
  72. Declare Function GetWindowsDirectory Lib "Kernel32" _
  73.     Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, _
  74.     ByVal nSize As Long) As Long
  75. Declare Function GetSystemDirectory Lib "Kernel32" Alias _
  76.     "GetSystemDirectoryA" (ByVal lpBuffer As String, _
  77.     ByVal nSize As Long) As Long
  78. Declare Function GetDriveType32 Lib "Kernel32" Alias _
  79.     "GetDriveTypeA" (ByVal strWhichDrive As String) As Long
  80. Declare Function GetTempFileName32 Lib "Kernel32" Alias _
  81.     "GetTempFileNameA" (ByVal strWhichDrive As String, _
  82.     ByVal lpPrefixString As String, ByVal wUnique As Integer, _
  83.     ByVal lpTempFileName As String) As Long
  84. Declare Function VerInstallFile Lib "version.dll" _
  85.     Alias "VerInstallFileA" (ByVal uFlags As Long, _
  86.     ByVal szSrcFileName As String, _
  87.     ByVal szDestFileName As String, _
  88.     ByVal szSrcDir As String, _
  89.     ByVal szDestDir As String, _
  90.     ByVal szCurDir As String, _
  91.     ByVal szTmpFile As String, _
  92.     lpuTmpFileLen As Long) As Long
  93. Declare Function GetFileVersionInfoSize Lib "version.dll" _
  94.     Alias "GetFileVersionInfoSizeA" (ByVal strFileName As String, _
  95.     lVerHandle As Long) As Long
  96. Declare Function GetFileVersionInfo Lib "version.dll" _
  97.     Alias "GetFileVersionInfoA" (ByVal strFileName As String, _
  98.     ByVal lVerHandle As Long, ByVal lcbSize As Long, _
  99.     lpvData As Byte) As Long
  100. Declare Function VerQueryValue Lib "version.dll" _
  101.     Alias "VerQueryValueA" (lpvVerData As Byte, _
  102.     ByVal lpszSubBlock As String, lplpBuf As Long, _
  103.     lpcb As Long) As Long
  104. Declare Function VerFindFile Lib "version.dll" _
  105.     Alias "VerFindFileA" (ByVal uFlags As Long, _
  106.     ByVal szFileName As String, _
  107.     ByVal szWinDir As String, _
  108.     ByVal szAppDir As String, _
  109.     ByVal szCurDir As String, _
  110.     lpuCurDirLen As Long, _
  111.     ByVal szDestDir As String, _
  112.     lpuDestDirLen As Long) As Long
  113.  
  114. #End If
  115.  
  116. ' VerFind flag (only one).
  117. Const VFFF_ISSHAREDFILE = 1
  118. ' VerFindFile error return codes.
  119. Const VFF_CURNEDEST = 1
  120. Const VFF_FILEINUSE = 2
  121. Const VFF_BUFFTOOSMALL = 4
  122.  
  123. ' VerInstallFile flags.
  124.     Const VIFF_FORCEINSTALL% = &H1
  125.     Const VIF_TEMPFILE& = &H1
  126. ' VerInstallFile error return codes.
  127.     Const VIF_SRCOLD& = &H4
  128.     Const VIF_DIFFLANG& = &H8
  129.     Const VIF_DIFFCODEPG& = &H10
  130.     Const VIF_DIFFTYPE& = &H20
  131.     Const VIF_WRITEPROT& = &H40
  132.     Const VIF_FILEINUSE& = &H80
  133.     Const VIF_OUTOFSPACE& = &H100
  134.     Const VIF_ACCESSVIOLATION& = &H200
  135.     Const VIF_SHARINGVIOLATION = &H400
  136.     Const VIF_CANNOTCREATE = &H800
  137.     Const VIF_CANNOTDELETE = &H1000
  138.     Const VIF_CANNOTRENAME = &H2000
  139.     Const VIF_OUTOFMEMORY = &H8000
  140.     Const VIF_CANNOTREADSRC = &H10000
  141.     Const VIF_CANNOTREADDST = &H20000
  142.     Const VIF_BUFFTOOSMALL = &H40000
  143.  
  144. Sub InstallFile(strSrcFile, strSrcDir, strDestFile, strDestDir)
  145.     Dim strWinDir As String, strCurDir As String, _
  146.         strAppDir As String, strTmpFile As String
  147.     #If Win16 Then
  148.     Dim iWorked As Integer, iLen As Integer
  149.     #Else
  150.     Dim iWorked As Long, iLen As Long
  151.     #End If
  152.     Dim lWorked As Long
  153.     strSrcDir = "b:\"
  154.     strWinDir = GetWinDir
  155.     strAppDir = "c:\olestore"
  156.     strCurDir = CurDir$
  157.     strDestDir = Space(255)
  158.     iLen = Len(strDestDir)
  159.     iWorked = VerFindFile(VFFF_ISSHAREDFILE, strDestFile, strWinDir, _
  160.         strAppDir, strCurDir, Len(strCurDir), _
  161.         strDestDir, iLen)
  162.     Select Case iWorked
  163.         ' File not found, so OK to install.
  164.         Case VFF_CURNEDEST
  165.             ' Install file (0& indicates no pre-existing file)
  166.             lWorked = VerInstallFile(0, _
  167.                 strSrcFile, _
  168.                 strDestFile, _
  169.                 strSrcDir, _
  170.                 strDestDir, _
  171.                 0&, _
  172.                 strTmpFile, _
  173.                 iLen)
  174.         ' File is locked and can't be overwritten.
  175.         Case VFF_FILEINUSE
  176.             GoTo errInstallFile
  177.         ' Destination directory string not big enough.
  178.         Case VFF_BUFFTOOSMALL
  179.             GoTo errInstallFile
  180.         ' File was found, so compare versions.
  181.         Case Else
  182.             If iLen Then
  183.                 strTmpFile = Space(255)
  184.                 iLen = Len(strTmpFile)
  185.                 lWorked = VerInstallFile(0, _
  186.                     strSrcFile, _
  187.                     strDestFile, _
  188.                     strSrcDir, _
  189.                     strDestDir, _
  190.                     strDestDir, _
  191.                     strTmpFile, _
  192.                     iLen)
  193.                 If lWorked And VIF_SRCOLD Then
  194.                 'Source file was older, not copied
  195.                 ElseIf lWorked And (VIF_DIFFLANG Or VIF_DIFFCODEPG Or VIF_DIFFTYPE) Then
  196.                 ' Retry and force installation.
  197.                 ' May want to prompt here in your code...
  198.                     lWorked = VerInstallFile(VIFF_FORCEINSTALL, _
  199.                         strSrcFile, _
  200.                         strDestFile, _
  201.                         strSrcDir, _
  202.                         strDestDir, _
  203.                         strDestDir, _
  204.                         strTmpFile, _
  205.                         iLen)
  206.                 Else
  207.                     GoTo errInstallFile
  208.                 End If
  209.             End If
  210.     End Select
  211.     Exit Sub
  212. errInstallFile:
  213.     ' Error handler for installation errors.
  214.     ' VerFindFile errors.
  215.     If iWorked = VIF_FILEINUSE Then
  216.         ' Notify user.
  217.     Else
  218.         ' Stop program.
  219.     End If
  220.     ' VerInstallFile errors.
  221.     If lWorked And VIF_WRITEPROT Then
  222.     ElseIf lWorked And VIF_FILEINUSE Then
  223.     ElseIf lWorked And VIF_OUTOFSPACE Then
  224.     ElseIf lWorked And VIF_ACCESSVIOLATION Then
  225.     ElseIf lWorked And VIF_SHARINGVIOLATION Then
  226.     ElseIf lWorked And VIF_OUTOFMEMORY Then
  227.     Else
  228.         ' For these cases, report the error and do not install the file
  229.         If lWorked And VIF_CANNOTCREATE Then
  230.         ElseIf lWorked And VIF_CANNOTDELETE Then
  231.         ElseIf lWorked And VIF_CANNOTRENAME Then
  232.         ElseIf lWorked And VIF_CANNOTREADSRC Then
  233.         ElseIf lWorked And VIF_CANNOTREADDST Then
  234.         ElseIf lWorked And VIF_BUFFTOOSMALL Then
  235.         End If
  236.     End If
  237. End Sub
  238. ' Returns the Windows directory.
  239. Function GetWinDir() As String
  240.     Dim strWinDirectory As String
  241.     Dim iWorked As Integer
  242.     ' Allocate space for the returned path string.
  243.     strWinDirectory = Space(144)
  244.     ' Get the Windows directory.
  245.     iWorked = GetWindowsDirectory(strWinDirectory, Len(strWinDirectory))
  246.     ' Trim off the excess space.
  247.     GetWinDir = Left(strWinDirectory, iWorked)
  248. End Function
  249. Sub main()
  250.     ' Demonstrate GetWinDir.
  251.     MsgBox "Windows directory: " & GetWinDir
  252.     ' Demonstrate InstallFile (need distribution disk).
  253.     ' InstallFile "olestore.ex_", "b:\", "olestore.exe", "c:\olestore"
  254. End Sub
  255.  
  256.  
  257.