setup1.bas

Custom Visual Basic Packager and Installer for Visual Basic Developers. This is a group of standard

            'One more kludge for long filenames: VerInstallFile may have renamed
            'the file to its short version if it went through with the copy.
            'Therefore we simply rename it back to what it should be.
            Name strDestDir & strShortDestName As strDestDir & strDestName
            intRESULT = intCOPIED
        ElseIf lRC And VIF_SRCOLD Then
            '
            'Source file was older, so not copied, the existing version of the file
            'will be used.  Increment reference count if needed
            '
            intRESULT = intFILEUPTODATE
        ElseIf lRC And (VIF_DIFFLANG Or VIF_DIFFCODEPG Or VIF_DIFFTYPE) Then
            '
            'We retry and force installation for these cases.  You can modify the code
            'here to prompt the user about what to do.
            '
            intFlags = VIFF_FORCEINSTALL
        ElseIf lRC And VIF_WRITEPROT Then
            strMsg = ResolveResString(resWRITEPROT)
            GoSub CFMsg
        ElseIf lRC And VIF_FILEINUSE Then
            strMsg = ResolveResString(resINUSE)
            GoSub CFMsg
        ElseIf lRC And VIF_OUTOFSPACE Then
            strMsg = ResolveResString(resOUTOFSPACE) & Left$(strDestDir, 2)
            GoSub CFMsg
        ElseIf lRC And VIF_ACCESSVIOLATION Then
            strMsg = ResolveResString(resACCESSVIOLATION)
            GoSub CFMsg
        ElseIf lRC And VIF_SHARINGVIOLATION Then
            strMsg = ResolveResString(resSHARINGVIOLATION)
            GoSub CFMsg
        ElseIf lRC And VIF_OUTOFMEMORY Then
            strMsg = ResolveResString(resOUTOFMEMORY)
            GoSub CFMsg
        Else
            '
            ' For these cases, we generically report the error and do not install the file
            ' unless this is an SMS install; in which case we abort.
            '
            If lRC And VIF_CANNOTCREATE Then
                strMsg = ResolveResString(resCANNOTCREATE)
            ElseIf lRC And VIF_CANNOTDELETE Then
                strMsg = ResolveResString(resCANNOTDELETE)
            ElseIf lRC And VIF_CANNOTRENAME Then
                strMsg = ResolveResString(resCANNOTRENAME)
            ElseIf lRC And VIF_CANNOTREADSRC Then
                strMsg = ResolveResString(resCANNOTREADSRC)
            ElseIf lRC And VIF_CANNOTREADDST Then
                strMsg = ResolveResString(resCANNOTREADDST)
            ElseIf lRC And VIF_BUFFTOOSMALL Then
                strMsg = ResolveResString(resBUFFTOOSMALL)
            End If

            strMsg = strMsg & ResolveResString(resNOINSTALL)
            MsgError strMsg, vbOKOnly Or vbExclamation, gstrTitle
            If gfSMS Then
                ExitSetup frmSetup1, gintRET_FATAL
            End If
            intRESULT = intNOCOPY
        End If
    Loop

    '
    'If there was a temp file left over from VerInstallFile, remove it
    '
    If lRC And VIF_TEMPFILE Then
        Kill mstrVerTmpName
    End If

    'Abort or commit the current Action, and do reference counting
    Select Case intRESULT
        Case intNOCOPY
            AbortAction
        Case intCOPIED
            DecideIncrementRefCount strDestDir & strDestName, fShared, fSystem, fFileAlreadyExisted
            If (Extension(strDestName) = gsEXT_FONTFON) Or (Extension(strDestName) = gsEXT_FONTTTF) Then
                'do nothing
            Else
                AddActionNote ResolveResString(resLOG_FILECOPIED)
                CommitAction
            End If
            CopyFile = True
        Case intFILEUPTODATE
            DecideIncrementRefCount strDestDir & strDestName, fShared, fSystem, fFileAlreadyExisted
            If (Extension(strDestName) = gsEXT_FONTFON) Or (Extension(strDestName) = gsEXT_FONTTTF) Then
                'do nothing
            Else
                AddActionNote ResolveResString(resLOG_FILECOPIED)
                CommitAction
            End If
            CopyFile = True
        Case Else
            AbortAction ' Defensive - this shouldn't be reached
        'End Case
    End Select

    Exit Function

UnexpectedErr:
    MsgError Error$ & vbLf & vbLf & ResolveResString(resUNEXPECTED), vbOKOnly Or vbExclamation, gstrTitle
    ExitSetup frmCopy, gintRET_FATAL
    
CFMsg: '(Subroutine)
    Dim intMsgRet As Integer
    strMsg = strDestDir & strDestName & vbLf & vbLf & strMsg
    intMsgRet = MsgError(strMsg, vbAbortRetryIgnore Or vbExclamation Or vbDefaultButton2, gstrTitle)
    If gfNoUserInput Then intMsgRet = vbAbort
    Select Case intMsgRet
        Case vbAbort
            ExitSetup frmCopy, gintRET_ABORT
        Case vbIgnore
            If fIgnoreWarn = True Then
                intRESULT = intNOCOPY
            Else
                fIgnoreWarn = True
                strMsg = strMsg & vbLf & vbLf & ResolveResString(resWARNIGNORE)
                If MsgError(strMsg, vbYesNo Or vbQuestion Or vbDefaultButton2, gstrTitle) = vbYes Then
                    intRESULT = intNOCOPY
                Else
                    'Will retry
                End If
            End If
        'End Case
    End Select

    Return
End Function

'-----------------------------------------------------------
' SUB: CopySection
'
' Attempts to copy the files that need to be copied from
' the named section of the setup info file (SETUP.LST)
'
' IN: [strSection] - name of section to copy files from
'
'-----------------------------------------------------------
'
Sub CopySection(ByVal strsection As String)
    Dim intIdx As Integer
    Dim fSplit As Integer
    Dim fSrcVer As Integer
    Dim sFile As FILEINFO
    Dim strLastFile As String
    Dim intRC As Integer
    Dim lThisFileSize As Long
    Dim strSrcDir As String
    Dim strDestDir As String
    Dim strSrcName As String
    Dim strDestName As String
    Dim strRegister As String
    Dim sSrcVerInfo As VERINFO
    Dim sDestVerInfo As VERINFO
    Dim fFileWasUpToDate As Boolean
    Dim strMultDirBaseName As String
    Dim strMsg As String
    Dim strDetectPath As String
    Dim fRemoteReg As Boolean
    Dim fOverWrite As Boolean
    Dim frm As frmOverwrite
    Static fOverwriteAll As Boolean
    
    On Error Resume Next

    UpdateDateTime
    strMultDirBaseName = ResolveResString(resCOMMON_MULTDIRBASENAME)
    intIdx = 1

    If Not FileExists(gsTEMPDIR) Then
        MkDir gsTEMPDIR
    End If
    '
    'For each file in the specified section, read info from the setup info file
    '
    Do While ReadSetupFileLine(strsection, intIdx, sFile) = True
        fFileWasUpToDate = False
        
        '
        'If last result was IGNORE, and if this is an extent of a split file,
        'then no need to process this chunk of the file either
        '
        
        If sFile.strSrcName = gstrSEP_AMPERSAND & gstrFILE_MDAG Then
            'We don't need to extract mdac_typ twice
            GoTo CSContinue
        End If
        ExtractFileFromCab GetShortPathName(gsCABNAME), sFile.strSrcName, gsTEMPDIR & sFile.strDestName, gintCabs, gstrSrcPath
        If FileExists(gsTEMPDIR & sFile.strDestName) Then
            sFile.strSrcName = gsTEMPDIR & sFile.strDestName
            sFile.intDiskNum = gintCurrentDisk
        End If
        If intRC = vbIgnore And sFile.strDestName = strDestName Then
            GoTo CSContinue
        End If
        intRC = 0

        '
        ' If a new disk is called for, or if for some reason we can't find the
        ' source path (user removed the install floppy, for instance) then
        ' prompt for the next disk.  The PromptForNextDisk function won't
        ' actually prompt the user unless it determines that the source drive
        ' contains removeable media or is a network connection.  Also, we don't
        ' prompt if this is a silent install.  It will fail later on a silent
        ' install when it can't find the file.
        '
        If gfNoUserInput = False And (sFile.intDiskNum <> gintCurrentDisk Or DirExists(gstrSrcPath) = False) Then
            PromptForNextDisk sFile.intDiskNum, sFile.strSrcName
        End If

        strSrcName = sFile.strSrcName
        '
        ' The file could exist in either the main source directory or
        ' in a subdirectory named DISK1, DISK2, etc.  Set the appropriate
        ' path.  If it's in neither place, it is an error and will be
        ' handled later.
        '
        If FileExists(strSrcName) = True Then
            strSrcDir = gsTEMPDIR
        'ElseIf FileExists(gstrSrcPath & ".." & gstrSEP_DIR & strMultDirBaseName & Format(sFile.intDiskNum) & gstrSEP_DIR & strSrcName) = True Then
            'strSrcDir = ResolveDir(gstrSrcPath & ".." & gstrSEP_DIR & strMultDirBaseName & Format(sFile.intDiskNum) & gstrSEP_DIR, False, False)
            'gstrSrcPath = strSrcDir
        Else
            '
            ' Can't find the file.
            '
            If DirExists(gstrSrcPath & strMultDirBaseName & Format(sFile.intDiskNum)) = True Then
                strDetectPath = gstrSrcPath & strMultDirBaseName & Format(sFile.intDiskNum)
            Else
                strDetectPath = gstrSrcPath
            End If
            strMsg = ResolveResString(resCOMMON_CANTFINDSRCFILE, "|1", strDetectPath & gstrSEP_DIR & strSrcName)
            MsgError strMsg, vbExclamation Or vbOKOnly, gstrTitle
            ExitSetup frmCopy, gintRET_FATAL
        End If

        '
        'if the file isn't split, or if this is the first section of a split file
        '
        If sFile.strDestDir <> vbNullString Then
            fSplit = sFile.fSplit

            strDestDir = sFile.strDestDir
            strDestName = sFile.strDestName
            
            'We need to go ahead and create the destination directory, or else
            'GetLongPathName() may fail
            If Not MakePath(strDestDir) Then
                intRC = vbIgnore
            End If
            
            If intRC <> vbIgnore Then
                Err = 0
                strDestDir = GetLongPathName(strDestDir)

                frmCopy.lblDestFile.Caption = strDestDir & sFile.strDestName
                frmCopy.lblDestFile.Refresh

                If UCase(strDestName) = gstrFILE_AXDIST Then
                    '
                    ' AXDIST.EXE is installed temporarily.  We'll be
                    ' deleting it at the end of setup.  Set gfAXDist = True
                    ' so we know we need to delete it later.
                    '
                    NewAction gstrKEY_TEMPFILE, """" & strDestDir & strDestName & """"
                    gfAXDist = True
                    gstrAXDISTInstallPath = strDestDir & strDestName
                ElseIf UCase(strDestName) = gstrFILE_MDAG Then
                    '
                    ' mdac_typ.EXE is installed temporarily.  We'll be
                    ' deleting it at the end of setup.  Set mdag = True
                    ' so we know we need to delete it later.
                    '
                    NewAction gstrKEY_TEMPFILE, """" & strDestDir & strDestName & """"
                    gfMDag = True
                    gstrMDagInstallPath = strDestDir & strDestName
                ElseIf UCase(strDestName) = gstrFILE_WINT351 Then
                    '
                    ' WINt351.EXE is installed temporarily.  We'll be
                    ' deleting it at the end of setup.  Set WINt351 = True
                    ' so we know we need to delete it later.  (Note, this file
                    ' is only installed if the target is nt3.51.  This is dealt
                    ' with below in this same routine.  )
                    '
                    NewAction gstrKEY_TEMPFILE, """" & strDestDir & strDestName & """"
                    gfWINt351 = True
                    gstrWINt351InstallPath = strDestDir & strDestName
                ElseIf (Extension(sFile.strDestName) = gsEXT_FONTTTF) Then
                    'No new actions for fonts
                ElseIf (Extension(sFile.strDestName) = gsEXT_FONTFON) Then
                    'No new actions for fonts
                ElseIf sFile.fShared Then
                    NewAction gstrKEY_SHAREDFILE, """" & strDestDir & strDestName & """"
                ElseIf sFile.fSystem Then
                    NewAction gstrKEY_SYSTEMFILE, """" & strDestDir & strDestName & """"
                ElseIf (Extension(sFile.strDestName) = gsEXT_REG) Then
                    If Extension(sFile.strRegister) = gsEXT_REG Then
                        'No new actions for registration files.
                    Else
                        NewAction gstrKEY_PRIVATEFILE, """" & strDestDir & strDestName & """"
                    End If
                Else
                    NewAction gstrKEY_PRIVATEFILE, """" & strDestDir & strDestName & """"
                End If
            End If