?? setup1.bas
字號(hào):
CheckDSAskSpace:
'
'if the user hasn't been prompted before in the event of not enough free space,
'then display table of drive space and allow them to (basically) abort, retry,
'or ignore.
'
If fDontAskOnSpaceErr = False Then
If gfNoUserInput Then
If gfSilent = True Then
LogSilentMsg ResolveResString(resLBLNOSPACE)
End If
If gfSMS = True Then
LogSMSMsg ResolveResString(resLBLNOSPACE)
End If
ExitSetup frmSetup1, gintRET_FATAL
Else
frmDskSpace.Show vbModal
End If
If gfRetVal <> gintRET_CONT Then
CheckDiskSpace = False
Exit Function
Else
fDontAskOnSpaceErr = True
End If
End If
Return
End Function
'-----------------------------------------------------------
' FUNCTION: CheckDrive
'
' Check to see if the specified drive is ready to be read
' from. In the case of a drive that holds removable media,
' this would mean that formatted media was in the drive and
' that the drive door was closed.
'
' IN: [strDrive] - drive to check
' [strCaption] - caption if the drive isn't ready
'
' Returns: True if the drive is ready, False otherwise
'-----------------------------------------------------------
'
Function CheckDrive(ByVal strDrive As String, ByVal strCaption As String) As Integer
Dim strDir As String
Dim strMsg As String
Dim fIsUNC As Boolean
On Error Resume Next
SetMousePtr vbHourglass
Do
Err = 0
fIsUNC = False
'
'Attempt to read the current directory of the specified drive. If
'an error occurs, we assume that the drive is not ready
'
If IsUNCName(strDrive) Then
fIsUNC = True
strDir = Dir$(GetUNCShareName(strDrive))
Else
strDir = Dir$(Left$(strDrive, 2))
End If
If Err > 0 Then
If fIsUNC Then
strMsg = Error$ & vbLf & vbLf & ResolveResString(resCANTREADUNC, "|1", strDrive) & vbLf & vbLf & ResolveResString(resCHECKUNC)
Else
strMsg = Error$ & vbLf & vbLf & ResolveResString(resDRVREAD) & strDrive & vbLf & vbLf & ResolveResString(resDRVCHK)
End If
If MsgError(strMsg, vbExclamation Or vbRetryCancel, strCaption) = vbCancel Then
CheckDrive = False
Err = 0
End If
Else
CheckDrive = True
End If
If Err And gfNoUserInput = True Then
ExitSetup frmSetup1, gintRET_FATAL
End If
Loop While Err
SetMousePtr gintMOUSE_DEFAULT
End Function
'-----------------------------------------------------------
' FUNCTION: CheckOverwritePrivateFile
'
' Checks if a private file that we are about to install
' already exists in the destination directory. If it
' does, it asks if they want to overwrite the file
'
' IN: [strFN] - Full path of the private file that is
' about to be installed.
'
'-----------------------------------------------------------
'
Public Function CheckOverwritePrivateFile(ByVal strFN As String) As Boolean
Static fNoToAll As Boolean
If fNoToAll Then 'They've already said no to all, don't ask again
CheckOverwritePrivateFile = False
Exit Function
End If
If FileExists(strFN) Then
Do
Select Case MsgFunc(ResolveResString(resOVERWRITEPRIVATE) & vbLf & vbLf & ResolveResString(resCANCELSETUP), vbYesNo Or vbDefaultButton1 Or vbExclamation, gstrTitle)
Case vbYes
'The user chose to cancel. (This is best.)
gfDontLogSMS = True ' Don't log this message if SMS because we already logged the previous one and we can only use 255 characters.
MsgError ResolveResString(resCHOOSENEWDEST), vbOKOnly, gstrTitle
ExitSetup frmCopy, gintRET_FATAL
Case Else
'One more level of warning to let them know that we highly
' recommend cancelling setup at this point
Select Case MsgFunc(ResolveResString(resOVERWRITEPRIVATE2) & vbLf & vbLf & ResolveResString(resVERIFYCONTINUE), vbYesNo Or vbDefaultButton2 Or vbExclamation, gstrTitle)
Case vbNo
'User chose "no, don't continue"
'Repeat the first-level warning
Case Else
'They decided to continue anyway
Exit Do
'End Case
End Select
'End Case
End Select
Loop
Else
CheckOverwritePrivateFile = True
End If
End Function
'-----------------------------------------------------------
' FUNCTION: CopyFile
'
' Uses the Windows VerInstallFile API to copy a file from
' the specified source location/name to the destination
' location/name. Split files should be combined via the
' '...Concat...' file routines before calling this
' function.
' If the file is successfully updated and the file is a
' shared file (fShared = True), then the
' files reference count is updated (32-bits only)
'
' IN: [strSrcDir] - directory where source file is located
' [strDestDir] - destination directory for file
' [strSrcName] - name of source file
' [strDestName] - name of destination file
'
' PRECONDITION: NewAction() must have already been called
' for this file copy (of type either
' gstrKEY_SHAREDFILE or gstrKEY_PRIVATE --
' see CopySection for an example of how
' this works). See NewAction() and related
' functions in LOGGING.BAS for comments on
' using the logging function.
' Either CommitAction() or AbortAction() will
' allows be called by this procedure, and
' should not be done by the caller.
'
' Returns: True if copy was successful, False otherwise
'
' POSTCONDITION: The current action will be either committed or
' aborted.
'-----------------------------------------------------------
'
Function CopyFile(ByVal strSrcDir As String, ByVal strDestDir As String, ByVal strSrcName As String, ByVal strDestName As String, ByVal fShared As Boolean, ByVal fSystem As Boolean, Optional ByVal fOverWrite As Boolean = False) As Boolean
Const intUNKNOWN% = 0
Const intCOPIED% = 1
Const intNOCOPY% = 2
Const intFILEUPTODATE% = 3
'
'VerInstallFile() Flags
'
Const VIFF_FORCEINSTALL% = &H1
Const VIF_TEMPFILE& = &H1
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
Static fIgnoreWarn As Integer 'user warned about ignoring error?
Dim strMsg As String
Dim lRC As Long
Dim lpTmpNameLen As Long
Dim intFlags As Integer
Dim intRESULT As Integer
Dim fFileAlreadyExisted
On Error Resume Next
CopyFile = False
'
'Ensure that the source file is available for copying
'
If DetectFile(strSrcDir & strSrcName) = vbIgnore Then
AbortAction
Exit Function
End If
'
' Make sure that the Destination path (including path, filename, commandline args, etc.
' is not longer than the max allowed.
'
If Not fCheckFNLength(strDestDir & strDestName) Then
AbortAction
strMsg = ResolveResString(resCANTCOPYPATHTOOLONG) & vbLf & vbLf & ResolveResString(resCHOOSENEWDEST) & vbLf & vbLf & strDestDir & strDestName
Call MsgError(strMsg, vbOKOnly, gstrSETMSG)
ExitSetup frmCopy, gintRET_FATAL
Exit Function
End If
'
'Make the destination directory, prompt the user to retry if there is an error
'
If Not MakePath(strDestDir) Then
AbortAction ' Abort file copy
Exit Function
End If
'
'Make sure we have the LFN (long filename) of the destination directory
'
strDestDir = GetLongPathName(strDestDir)
'
'Setup for VerInstallFile call
'
lpTmpNameLen = gintMAX_SIZE
mstrVerTmpName = String$(lpTmpNameLen, 0)
intFlags = 0
If fOverWrite Then intFlags = VIFF_FORCEINSTALL
fFileAlreadyExisted = FileExists(strDestDir & strDestName)
intRESULT = intUNKNOWN
Do While intRESULT = intUNKNOWN
'VerInstallFile under Windows 95 does not handle
' long filenames, so we must give it the short versions
' (32-bit only).
Dim strShortSrcName As String
Dim strShortDestName As String
Dim strShortSrcDir As String
Dim strShortDestDir As String
strShortSrcName = strSrcName
strShortSrcDir = strSrcDir
strShortDestName = strDestName
strShortDestDir = strDestDir
If Not FileExists(strDestDir & strDestName) Then
'If the destination file does not already
' exist, we create a dummy with the correct
' (long) filename so that we can get its
' short filename for VerInstallFile.
Open strDestDir & strDestName For Output Access Write As #1
Close #1
End If
On Error GoTo UnexpectedErr
If Not IsWindowsNT() Then
Dim strTemp As String
'This conversion is not necessary under Windows NT
strShortSrcDir = GetShortPathName(strSrcDir)
If GetFileName(strSrcName) = strSrcName Then
strShortSrcName = GetFileName(GetShortPathName(strSrcDir & strSrcName))
Else
strTemp = GetShortPathName(strSrcDir & strSrcName)
strShortSrcName = Mid$(strTemp, Len(strShortSrcDir) + 1)
End If
strShortDestDir = GetShortPathName(strDestDir)
strShortDestName = GetFileName(GetShortPathName(strDestDir & strDestName))
End If
On Error Resume Next
lRC = VerInstallFile(intFlags, strShortSrcName, strShortDestName, strShortSrcDir, strShortDestDir, 0&, mstrVerTmpName, lpTmpNameLen)
If Err <> 0 Then
'
'If the version or file expansion DLLs couldn't be found, then abort setup
'
ExitSetup frmCopy, gintRET_FATAL
End If
If lRC = 0 Then
'
'File was successfully installed, increment reference count if needed
'
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -