Visual Basic Programmer'…arterly (Limited Edition)/Visual_Basic_Programmers_Journal_VB-CD_Quarterly_Limited_Edition_1995.iso/code/ch21code/version.cls

Text File | 1995-08-17 | 6.9 KB | 207 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Version"
Attribute VB_Creatable = True
Attribute VB_Exposed = True
' Version class -- VERSION.CLS
'
'   Properties
'       None
'
'   Methods
'       InstallFile
'
Option Explicit

#If Win16 Then
Private Declare Function GetWindowsDirectory Lib "Kernel" _
    (ByVal lpBuffer As String, _
    ByVal nSize As Integer) _
    As Integer
Private Declare Function GetSystemDirectory Lib "Kernel" (ByVal lpBuffer As String, _
    ByVal nSize As Integer) As Integer
Private Declare Function VerInstallFile Lib "VER.DLL" _
    (ByVal Flags As Integer, _
    ByVal SrcName As String, _
    ByVal DestName As String, _
    ByVal SrcDir As String, _
    ByVal DestDir As String, _
    ByVal CurrDir As String, _
    ByVal TmpName As String, _
    iTempLen As Integer) As Long
Private Declare Function VerFindFile Lib "VER.DLL" _
    (ByVal iFlags As Integer, _
    ByVal strFileName As String, _
    ByVal strWinDirectory As String, _
    ByVal strAppDir As String, _
    ByVal strCurDir As String, _
    iCurDirLen As Integer, _
    ByVal strDestDir As String, _
    iDestDirLen As Integer) _
    As Integer
#Else
Private Declare Function GetWindowsDirectory Lib "kernel32" _
    Alias "GetWindowsDirectoryA" _
    (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function GetSystemDirectory Lib "kernel32" _
    Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, _
    ByVal nSize As Long) As Long
Private Declare Function VerFindFile Lib "version.dll" _
    Alias "VerFindFileA" (ByVal uFlags As Long, _
    ByVal szFileName As String, ByVal szWinDir As String, _
    ByVal szAppDir As String, ByVal szCurDir As String, _
    lpuCurDirLen As Long, ByVal szDestDir As String, _
    lpuDestDirLen As Long) As Long
Private Declare Function VerInstallFile Lib "version.dll" Alias _
    "VerInstallFileA" (ByVal uFlags As Long, _
    ByVal szSrcFileName As String, _
    ByVal szDestFileName As String, _
    ByVal szSrcDir As String, _
    ByVal szDestDir As String, _
    ByVal szCurDir As String, _
    ByVal szTmpFile As String, _
    lpuTmpFileLen As Long) As Long
#End If

' VerFind flag (only one).
Const VFFF_ISSHAREDFILE = 1
' VerFindFile error return codes.
Const VFF_CURNEDEST = 1
Const VFF_FILEINUSE = 2
Const VFF_BUFFTOOSMALL = 4

' VerInstallFile flags.
Const VIFF_FORCEINSTALL% = &H1
Const VIF_TEMPFILE& = &H1
' VerInstallFile error return codes.
Const VIF_SRCOLD& = &H4
Const VIF_DIFFLANG& = &H8
Const VIF_DIFFCODEPG& = &H10
Const VIF_DIFFTYPE& = &H20
Const VIF_WRITEPROT& = &H40
Const VIF_FILEINUSE& = &H80
Const VIF_OUTOFSPACE& = &H100
Const VIF_ACCESSVIOLATION& = &H200
Const VIF_SHARINGVIOLATION = &H400
Const VIF_CANNOTCREATE = &H800
Const VIF_CANNOTDELETE = &H1000
Const VIF_CANNOTRENAME = &H2000
Const VIF_OUTOFMEMORY = &H8000
Const VIF_CANNOTREADSRC = &H10000
Const VIF_CANNOTREADDST = &H20000
Const VIF_BUFFTOOSMALL = &H40000

Public Sub InstallFile(strSrcFile, strSrcDir, strDestFile, strDestDir)
    Dim strWinDir As String, strCurDir As String, _
        strAppDir As String, strTmpFile As String
    #If Win16 Then
    Dim iWorked As Integer, iLen As Integer
    Dim lWorked As Long
    #Else
    Dim iWorked As Long, iLen As Long
    Dim lWorked As Long
    #End If
    strSrcDir = "b:\"
    strWinDir = GetWinDir
    strAppDir = "c:\olestore"
    strCurDir = CurDir$
    strDestDir = Space(144)
    iLen = Len(strDestDir)
    iWorked = VerFindFile(VFFF_ISSHAREDFILE, strDestFile, strWinDir, _
        strAppDir, strCurDir, Len(strCurDir), _
        strDestDir, iLen)
    Select Case iWorked
        ' File not found, so OK to install.
        Case VFF_CURNEDEST
            ' Install file (0& indicates no pre-existing file)
            lWorked = VerInstallFile(0, _
                strSrcFile, _
                strDestFile, _
                strSrcDir, _
                strDestDir, _
                0&, _
                strTmpFile, _
                iLen)
        ' File is locked and can't be overwritten.
        Case VFF_FILEINUSE
            GoTo errInstallFile
        ' Destination directory string not big enough.
        Case VFF_BUFFTOOSMALL
            GoTo errInstallFile
        ' File was found, so compare versions.
        Case Else
            If iLen Then
                strTmpFile = Space(144)
                iLen = Len(strTmpFile)
                lWorked = VerInstallFile(0, _
                    strSrcFile, _
                    strDestFile, _
                    strSrcDir, _
                    strDestDir, _
                    strDestDir, _
                    strTmpFile, _
                    iLen)
                If lWorked And VIF_SRCOLD Then
                'Source file was older, not copied
                ElseIf lWorked And (VIF_DIFFLANG Or VIF_DIFFCODEPG Or VIF_DIFFTYPE) Then
                ' Retry and force installation.
                ' May want to prompt here in your code...
                    lWorked = VerInstallFile(VIFF_FORCEINSTALL, _
                        strSrcFile, _
                        strDestFile, _
                        strSrcDir, _
                        strDestDir, _
                        strDestDir, _
                        strTmpFile, _
                        iLen)
                Else
                    GoTo errInstallFile
                End If
            End If
    End Select
    Exit Sub
errInstallFile:
    ' Error handler for installation errors.
    ' These lines left in template form for the save of brevity here.
    ' VerFindFile errors.
    If iWorked = VFF_FILEINUSE Then
        ' Notify user to close application.
    Else
        ' Internal problem (buffer too small).
    Debug.Print "buffer; too; small"
    End If
    ' VerInstallFile errors.
    If lWorked And VIF_WRITEPROT Then
    ElseIf lWorked And VIF_FILEINUSE Then
    ElseIf lWorked And VIF_OUTOFSPACE Then
    ElseIf lWorked And VIF_ACCESSVIOLATION Then
    ElseIf lWorked And VIF_SHARINGVIOLATION Then
    ElseIf lWorked And VIF_OUTOFMEMORY Then
    Else
        ' For these cases, report the error and do not install the file
        If lWorked And VIF_CANNOTCREATE Then
        ElseIf lWorked And VIF_CANNOTDELETE Then
        ElseIf lWorked And VIF_CANNOTRENAME Then
        ElseIf lWorked And VIF_CANNOTREADSRC Then
        ElseIf lWorked And VIF_CANNOTREADDST Then
        ElseIf lWorked And VIF_BUFFTOOSMALL Then
        End If
    End If
End Sub

' Returns the Windows directory.
Private Function GetWinDir() As String
    Dim strWinDirectory As String
    Dim iWorked As Integer
    ' Allocate space for the returned path string.
    strWinDirectory = Space(144)
    ' Get the Windows directory.
    iWorked = GetWindowsDirectory(strWinDirectory, _
    Len(strWinDirectory))
    ' Trim off the excess space.
    GetWinDir = Left(strWinDirectory, iWorked)
End Function