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 / ch21code / version.cls < prev    next >
Text File  |  1995-08-17  |  7KB  |  207 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "Version"
  6. Attribute VB_Creatable = True
  7. Attribute VB_Exposed = True
  8. ' Version class -- VERSION.CLS
  9. '
  10. '   Properties
  11. '       None
  12. '
  13. '   Methods
  14. '       InstallFile
  15. '
  16. Option Explicit
  17.  
  18. #If Win16 Then
  19. Private Declare Function GetWindowsDirectory Lib "Kernel" _
  20.     (ByVal lpBuffer As String, _
  21.     ByVal nSize As Integer) _
  22.     As Integer
  23. Private Declare Function GetSystemDirectory Lib "Kernel" (ByVal lpBuffer As String, _
  24.     ByVal nSize As Integer) As Integer
  25. Private Declare Function VerInstallFile Lib "VER.DLL" _
  26.     (ByVal Flags As Integer, _
  27.     ByVal SrcName As String, _
  28.     ByVal DestName As String, _
  29.     ByVal SrcDir As String, _
  30.     ByVal DestDir As String, _
  31.     ByVal CurrDir As String, _
  32.     ByVal TmpName As String, _
  33.     iTempLen As Integer) As Long
  34. Private Declare Function VerFindFile Lib "VER.DLL" _
  35.     (ByVal iFlags As Integer, _
  36.     ByVal strFileName As String, _
  37.     ByVal strWinDirectory As String, _
  38.     ByVal strAppDir As String, _
  39.     ByVal strCurDir As String, _
  40.     iCurDirLen As Integer, _
  41.     ByVal strDestDir As String, _
  42.     iDestDirLen As Integer) _
  43.     As Integer
  44. #Else
  45. Private Declare Function GetWindowsDirectory Lib "kernel32" _
  46.     Alias "GetWindowsDirectoryA" _
  47.     (ByVal lpBuffer As String, ByVal nSize As Long) As Long
  48. Private Declare Function GetSystemDirectory Lib "kernel32" _
  49.     Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, _
  50.     ByVal nSize As Long) As Long
  51. Private Declare Function VerFindFile Lib "version.dll" _
  52.     Alias "VerFindFileA" (ByVal uFlags As Long, _
  53.     ByVal szFileName As String, ByVal szWinDir As String, _
  54.     ByVal szAppDir As String, ByVal szCurDir As String, _
  55.     lpuCurDirLen As Long, ByVal szDestDir As String, _
  56.     lpuDestDirLen As Long) As Long
  57. Private Declare Function VerInstallFile Lib "version.dll" Alias _
  58.     "VerInstallFileA" (ByVal uFlags As Long, _
  59.     ByVal szSrcFileName As String, _
  60.     ByVal szDestFileName As String, _
  61.     ByVal szSrcDir As String, _
  62.     ByVal szDestDir As String, _
  63.     ByVal szCurDir As String, _
  64.     ByVal szTmpFile As String, _
  65.     lpuTmpFileLen As Long) As Long
  66. #End If
  67.  
  68. ' VerFind flag (only one).
  69. Const VFFF_ISSHAREDFILE = 1
  70. ' VerFindFile error return codes.
  71. Const VFF_CURNEDEST = 1
  72. Const VFF_FILEINUSE = 2
  73. Const VFF_BUFFTOOSMALL = 4
  74.  
  75. ' VerInstallFile flags.
  76. Const VIFF_FORCEINSTALL% = &H1
  77. Const VIF_TEMPFILE& = &H1
  78. ' VerInstallFile error return codes.
  79. Const VIF_SRCOLD& = &H4
  80. Const VIF_DIFFLANG& = &H8
  81. Const VIF_DIFFCODEPG& = &H10
  82. Const VIF_DIFFTYPE& = &H20
  83. Const VIF_WRITEPROT& = &H40
  84. Const VIF_FILEINUSE& = &H80
  85. Const VIF_OUTOFSPACE& = &H100
  86. Const VIF_ACCESSVIOLATION& = &H200
  87. Const VIF_SHARINGVIOLATION = &H400
  88. Const VIF_CANNOTCREATE = &H800
  89. Const VIF_CANNOTDELETE = &H1000
  90. Const VIF_CANNOTRENAME = &H2000
  91. Const VIF_OUTOFMEMORY = &H8000
  92. Const VIF_CANNOTREADSRC = &H10000
  93. Const VIF_CANNOTREADDST = &H20000
  94. Const VIF_BUFFTOOSMALL = &H40000
  95.  
  96. Public Sub InstallFile(strSrcFile, strSrcDir, strDestFile, strDestDir)
  97.     Dim strWinDir As String, strCurDir As String, _
  98.         strAppDir As String, strTmpFile As String
  99.     #If Win16 Then
  100.     Dim iWorked As Integer, iLen As Integer
  101.     Dim lWorked As Long
  102.     #Else
  103.     Dim iWorked As Long, iLen As Long
  104.     Dim lWorked As Long
  105.     #End If
  106.     strSrcDir = "b:\"
  107.     strWinDir = GetWinDir
  108.     strAppDir = "c:\olestore"
  109.     strCurDir = CurDir$
  110.     strDestDir = Space(144)
  111.     iLen = Len(strDestDir)
  112.     iWorked = VerFindFile(VFFF_ISSHAREDFILE, strDestFile, strWinDir, _
  113.         strAppDir, strCurDir, Len(strCurDir), _
  114.         strDestDir, iLen)
  115.     Select Case iWorked
  116.         ' File not found, so OK to install.
  117.         Case VFF_CURNEDEST
  118.             ' Install file (0& indicates no pre-existing file)
  119.             lWorked = VerInstallFile(0, _
  120.                 strSrcFile, _
  121.                 strDestFile, _
  122.                 strSrcDir, _
  123.                 strDestDir, _
  124.                 0&, _
  125.                 strTmpFile, _
  126.                 iLen)
  127.         ' File is locked and can't be overwritten.
  128.         Case VFF_FILEINUSE
  129.             GoTo errInstallFile
  130.         ' Destination directory string not big enough.
  131.         Case VFF_BUFFTOOSMALL
  132.             GoTo errInstallFile
  133.         ' File was found, so compare versions.
  134.         Case Else
  135.             If iLen Then
  136.                 strTmpFile = Space(144)
  137.                 iLen = Len(strTmpFile)
  138.                 lWorked = VerInstallFile(0, _
  139.                     strSrcFile, _
  140.                     strDestFile, _
  141.                     strSrcDir, _
  142.                     strDestDir, _
  143.                     strDestDir, _
  144.                     strTmpFile, _
  145.                     iLen)
  146.                 If lWorked And VIF_SRCOLD Then
  147.                 'Source file was older, not copied
  148.                 ElseIf lWorked And (VIF_DIFFLANG Or VIF_DIFFCODEPG Or VIF_DIFFTYPE) Then
  149.                 ' Retry and force installation.
  150.                 ' May want to prompt here in your code...
  151.                     lWorked = VerInstallFile(VIFF_FORCEINSTALL, _
  152.                         strSrcFile, _
  153.                         strDestFile, _
  154.                         strSrcDir, _
  155.                         strDestDir, _
  156.                         strDestDir, _
  157.                         strTmpFile, _
  158.                         iLen)
  159.                 Else
  160.                     GoTo errInstallFile
  161.                 End If
  162.             End If
  163.     End Select
  164.     Exit Sub
  165. errInstallFile:
  166.     ' Error handler for installation errors.
  167.     ' These lines left in template form for the save of brevity here.
  168.     ' VerFindFile errors.
  169.     If iWorked = VFF_FILEINUSE Then
  170.         ' Notify user to close application.
  171.     Else
  172.         ' Internal problem (buffer too small).
  173.     Debug.Print "buffer; too; small"
  174.     End If
  175.     ' VerInstallFile errors.
  176.     If lWorked And VIF_WRITEPROT Then
  177.     ElseIf lWorked And VIF_FILEINUSE Then
  178.     ElseIf lWorked And VIF_OUTOFSPACE Then
  179.     ElseIf lWorked And VIF_ACCESSVIOLATION Then
  180.     ElseIf lWorked And VIF_SHARINGVIOLATION Then
  181.     ElseIf lWorked And VIF_OUTOFMEMORY Then
  182.     Else
  183.         ' For these cases, report the error and do not install the file
  184.         If lWorked And VIF_CANNOTCREATE Then
  185.         ElseIf lWorked And VIF_CANNOTDELETE Then
  186.         ElseIf lWorked And VIF_CANNOTRENAME Then
  187.         ElseIf lWorked And VIF_CANNOTREADSRC Then
  188.         ElseIf lWorked And VIF_CANNOTREADDST Then
  189.         ElseIf lWorked And VIF_BUFFTOOSMALL Then
  190.         End If
  191.     End If
  192. End Sub
  193.  
  194. ' Returns the Windows directory.
  195. Private Function GetWinDir() As String
  196.     Dim strWinDirectory As String
  197.     Dim iWorked As Integer
  198.     ' Allocate space for the returned path string.
  199.     strWinDirectory = Space(144)
  200.     ' Get the Windows directory.
  201.     iWorked = GetWindowsDirectory(strWinDirectory, _
  202.     Len(strWinDirectory))
  203.     ' Trim off the excess space.
  204.     GetWinDir = Left(strWinDirectory, iWorked)
  205. End Function
  206.  
  207.