setup1.bas

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

            
            '
            'If the file info just read from SETUP.LST is the application .EXE
            '(i.e.; it's the value of the AppExe Key in the [Setup] section,
            'then save it's full pathname for later use
            '
            If strDestName = gstrAppExe Then
                '
                'Used for creating a program manager icon in Form_Load of SETUP1.FRM
                'and for registering the per-app path
                '
                gsDest.strAppDir = strDestDir
            End If

            'Special case for RICHED32.DLL
            '-- we only install this file under Windows 95, not under Windows NT (3.51 or 4.0)
            If strDestName = mstrFILE_RICHED32 Then
                If Not IsWindows95() Then
                    'We're not running under Win95 - do not install this file.
                    intRC = vbIgnore
                    LogNote ResolveResString(resCOMMON_RICHED32NOTCOPIED, "|1", strDestName)
                    AbortAction
                End If
            End If
            '
            ' Special case for AXDIST.EXE
            ' If this is Win95 or NT4 and AXDIST.EXE is in the setup list, we need
            ' to execute it when setup1 is complete.  AXDIST.EXE is a self-extracting
            ' exe that installs special files needed for internet functionality.
            '
            If UCase(strDestName) = gstrFILE_AXDIST Then
                '
                ' Don't do anything here if this is not Win95 or NT4.
                '
                If Not TreatAsWin95() Then
                    'We're not running under Win95 or NT4- do not install this file.
                    intRC = vbIgnore
                    LogNote ResolveResString(resCOMMON_AXDISTNOTCOPIED, "|1", strDestName)
                    AbortAction
                    gfAXDist = False
                End If
            End If
            '
            ' Special case for WINt351.EXE
            ' If this is NT3.51 and WINt351.EXE is in the setup list, we need
            ' to execute it when setup1 is complete.  WINt351.EXE is a self-extracting
            ' exe that installs special files needed for internet functionality.
            '
            If UCase(strDestName) = gstrFILE_WINT351 Then
                '
                ' Don't do anything here if this is not NT3.51.
                '
                If TreatAsWin95() Then
                    'We're not running under NT3.51- do not install this file.
                    intRC = vbIgnore
                    LogNote ResolveResString(resCOMMON_WINT351NOTCOPIED, "|1", strDestName)
                    AbortAction
                    gfWINt351 = False
                End If
            End If
            
            strRegister = sFile.strRegister

            lThisFileSize = CalcFinalSize(sFile.lFileSize, sFile.strDestDir)

            '
            'The stuff below trys to save some time by pre-checking whether a file
            'should be installed before a split file is concatenated or before
            'VerInstallFile does its think which involves a full file read (for
            'a compress file) at the minimum.  Basically, if both files have
            'version numbers, they are compared.  If one file has a version number
            'and the other doesn't, the one with the version number is deemed
            '"Newer".  If neither file has a version number, we compare date.
            '
            'Always attempt to get the source file version number.  If the setup
            'info file did not contain a version number (sSrcVerInfo.nMSHi =
            'gintNOVERINFO), we attempt to read the version number from the source
            'file.  Reading the version number from a split file will always fail.
            'That's why it's a good idea to include the version number for a file
            '(especially split ones) in the setup info file (SETUP.LST)
            '
            fSrcVer = True
            sSrcVerInfo = sFile.sVerInfo
            If sSrcVerInfo.FileVerPart1 = gintNOVERINFO Then
                fSrcVer = GetFileVerStruct(strSrcDir & strSrcName, sSrcVerInfo)
            End If

            '
            'If there is an existing destination file with version information, then
            'compare its version number to the source file version number.
            '
            fOverWrite = True
            If intRC <> vbIgnore Then
                fRemoteReg = (sFile.strRegister = mstrREMOTEREGISTER)
                If GetFileVerStruct(strDestDir & strDestName, sDestVerInfo, fRemoteReg) = True Then
                    If fSrcVer = True Then
                        If IsNewerVer(sSrcVerInfo, sDestVerInfo) = False Then
                            '
                            'Existing file is newer than the one we want to install;
                            'prompt user for what to do
                            '
                            
                            If Not fOverwriteAll Then
                                Set frm = New frmOverwrite
                                frm.FileName = strDestDir & strDestName
                                With sDestVerInfo
                                    frm.Version = CStr(.FileVerPart1) & "." & CStr(.FileVerPart2) & "." & _
                                        CStr(.FileVerPart3) & "." & CStr(.FileVerPart4)
                                End With
                                frm.Description = GetFileDescription(strDestDir & strDestName)
                                frm.Show vbModal, frmSetup1
                                If frm.ReturnVal = owNo Then 'overwrite the file
                                    fOverWrite = True
                                ElseIf frm.ReturnVal = owYes Then 'Keep this file
                                    fOverWrite = False
                                ElseIf frm.ReturnVal = owNoToAll Then 'Overwrite all files
                                    fOverWrite = True
                                    fOverwriteAll = True
                                End If
                            End If
                            If Not fOverWrite Then
                                intRC = vbIgnore
                                fFileWasUpToDate = True
                                DecideIncrementRefCount strDestDir & strDestName, sFile.fShared, sFile.fSystem, True
                                If (Extension(sFile.strDestName) = gsEXT_FONTFON) Or (Extension(sFile.strDestName) = gsEXT_FONTTTF) Then
                                    'do nothing
                                Else
                                    AddActionNote ResolveResString(resLOG_FILEUPTODATE)
                                    CommitAction
                                End If
                            End If
                        End If
                    End If
                Else
                    '
                    'If the destination file has no version info, then we'll copy the
                    'source file if it *does* have a version.  If neither file has a
                    'version number, then we compare date.
                    '
                    If sFile.varDate <= FileDateTime(strDestDir & strDestName) Then
                        If Err = 0 Then
                            '
                            'Although neither the source nor the existing file contain version
                            'information, the existing file has a newer date so we'll use it.
                            '
                            If Not fOverwriteAll Then
                                Set frm = New frmOverwrite
                                frm.FileName = strDestDir & strDestName
                                frm.Version = vbNullString
                                frm.Description = GetFileDescription(strDestDir & strDestName)
                                frm.Show vbModal, frmSetup1
                                If frm.ReturnVal = owNo Then 'overwrite the file
                                    fOverWrite = True
                                ElseIf frm.ReturnVal = owYes Then 'Keep this file
                                    fOverWrite = False
                                ElseIf frm.ReturnVal = owNoToAll Then 'Overwrite all files
                                    fOverWrite = True
                                    fOverwriteAll = True
                                End If
                            End If
                            If Not fOverWrite Then
                                intRC = vbIgnore
                                fFileWasUpToDate = True
                                DecideIncrementRefCount strDestDir & strDestName, sFile.fShared, sFile.fSystem, True
                                If (Extension(sFile.strDestName) = gsEXT_FONTFON) Or (Extension(sFile.strDestName) = gsEXT_FONTTTF) Then
                                    'do nothing
                                Else
                                    AddActionNote ResolveResString(resLOG_FILEUPTODATE)
                                    CommitAction
                                End If
                            End If
                        Else
                            Err = 0
                        End If
                    End If
                End If
            End If
            
        End If
        If fOverwriteAll Then fOverWrite = True
        '
        'If the file wasn't split, or if this is the last extent of a split file
        '
        If fSplit = False Then

            '
            'After all of this, if we're still ready to copy, then give it a whirl!
            '
            If intRC <> vbIgnore Then
                ' CopyFile will increment the reference count for us, and will either
                ' commit or abort the current Action.
                'Turn off READONLY flag in case we copy.
                SetAttr strDestDir & strDestName, vbNormal
                If Extension(sFile.strRegister) <> gsEXT_REG Then
                    intRC = IIf(CopyFile(strSrcDir, strDestDir, strDestName, strDestName, sFile.fShared, sFile.fSystem, fOverWrite), 0, vbIgnore)
                End If
            End If

            '
            'Save the paths of certain files for later use, if they were
            'successfully installed or were already on the system
            '
            If (Extension(strDestDir & strDestName) = gsEXT_FONTTTF) Or (Extension(strDestDir & strDestName) = gsEXT_FONTFON) Then
                If AddFontResource(strDestDir & strDestName) <> 0 Then
                    'Success
                Else
                    'Failure
                End If
            End If
            If (intRC = 0 Or fFileWasUpToDate) Then
                Select Case strDestName
                    Case mstrFILE_AUTMGR32
                        '
                        'Used for creating an icon if installed
                        '
                        gsDest.strAUTMGR32 = strDestDir & mstrFILE_AUTMGR32
                    Case mstrFILE_RACMGR32
                        '
                        'Used for creating an icon if installed
                        '
                        gsDest.strRACMGR32 = strDestDir & mstrFILE_RACMGR32
                    'End Case
                End Select
            
                '
                'If we successfully copied the file, and if registration information was
                'specified in the setup info file, save the registration info into an
                'array so that we can register all files requiring it in one fell swoop
                'after all the files have been copied.
                '
                If strRegister <> vbNullString Then
                    Err = 0
                    ReDim Preserve msRegInfo(UBound(msRegInfo) + 1)
    
                    If Err > 0 Then
                        ReDim msRegInfo(0)
                    End If
    
                    msRegInfo(UBound(msRegInfo)).strFilename = strDestDir & strDestName
    
                    Select Case strRegister
                        Case mstrDLLSELFREGISTER, mstrEXESELFREGISTER, mstrTLBREGISTER, mstrVBLREGISTER
                            'Nothing in particular to do
                        Case mstrREMOTEREGISTER
                            'We need to look for and parse the corresponding "RemoteX=..." line
                            If Not ReadSetupRemoteLine(strsection, intIdx, msRegInfo(UBound(msRegInfo))) = True Then
                                MsgError ResolveResString(resREMOTELINENOTFOUND, "|1", strDestName, "|2", gstrINI_REMOTE & Format$(intIdx)), vbExclamation Or vbOKOnly, gstrTitle
                                ExitSetup frmSetup1, gintRET_FATAL
                            End If
                        Case Else
                            '
                            'If the registration info specified the name of a file with
                            'registration info (which we assume if a registration macro
                            'was not specified), then we also assume that, if no path
                            'information is available, this reginfo file is in the same
                            'directory as the file it registers
                            '
                            strRegister = ResolveDestDirs(strRegister)
                            If InStr(strRegister, gstrSEP_DIR) = 0 Then
                                strRegister = strSrcDir & strRegister
                            End If
                        'End Case
                    End Select
    
                    If Extension(strRegister) = gsEXT_REG Then
                        SyncShell gsREGEDIT & strQuoteString(strRegister), INFINITE
                    End If
                    msRegInfo(UBound(msRegInfo)).strRegister = strRegister
                End If
            
            End If
        End If

        strLastFile = sFile.strDestName

CSContinue:
        '
        'If the file wasn't split, or if this was the last extent of a split file, then
        'update the copy status bar.  We need to do the update regardless of whether a
        'file was actually copied or not.
        '
        If sFile.fSplit = False Then
            glTotalCopied = glTotalCopied + lThisFileSize
            UpdateStatus frmCopy.picStatus, glTotalCopied / mlTotalToCopy
        End If

        Dim sCurDate As String, sFileDate As String
        
        sFileDate = Format(FileDateTime(sFile.strDestDir & sFile.strDestName), "m/d/yyyy h:m")
        sCurDate = Format(Now, "m/d/yyyy h:m")
        
        If sFileDate = sCurDate Then
            Dim lTime As FileTime
            Dim hFile As Long
            
            lTime = GetFileTime(sFile.varDate)
            hFile = CreateFile(sFile.strDestDir & sFile.strDestName, GENERIC_WRITE Or GENERIC_READ, 0, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
            Call SetFileTime(hFile, lTime, lTime, lTime)
            DoEvents
            CloseHandle hFile
        Else
            '
            'Give a chance for the 'Cancel' button command to be processed if it was pressed
            '
            DoEvents