?? setup1.bas
字號:
'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
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -