?? setup1.bas
字號:
' Create the new key, whose name is based on the app's name
If Not RegCreateKey(HKEY_LOCAL_MACHINE, RegPathWinCurrentVersion(), strAppPaths & gstrSEP_DIR & strAppExe, hKey) Then
GoTo Err
End If
fOk = True
' Default value indicates full EXE pathname
fOk = fOk And RegSetStringValue(hKey, "", strAppDir & strAppExe)
' [Path] value indicates the per-app path
If strPerAppPath <> "" Then
fOk = fOk And RegSetStringValue(hKey, strAppPathKeyName, strPerAppPath)
End If
If Not fOk Then
GoTo Err
End If
RegCloseKey hKey
Exit Sub
Err:
MsgError ResolveResString(resERR_REG), vbExclamation Or vbOKOnly, gstrTitle
'
' If we are running an SMS install, we can't continue.
'
If gfSMS Then
ExitSetup frmSetup1, gintRET_FATAL
End If
End Sub
'-----------------------------------------------------------
' FUNCTION: AddQuotesToFN
'
' Given a pathname (directory and/or filename), returns
' that pathname surrounded by double quotes if the
' path contains spaces or commas. This is required for
' setting up an icon correctly, since otherwise such paths
' would be interpreted as a pathname plus arguments.
'-----------------------------------------------------------
'
Function AddQuotesToFN(ByVal strFilename) As String
If InStr(strFilename, " ") Or InStr(strFilename, ",") Then
AddQuotesToFN = """" & strFilename & """"
Else
AddQuotesToFN = strFilename
End If
End Function
'-----------------------------------------------------------
' SUB: CalcDiskSpace
'
' Calculates disk space required for installing the files
' listed in the specified section of the setup information
' file (SETUP.LST)
'-----------------------------------------------------------
'
Sub CalcDiskSpace(ByVal strsection As String)
Static fSplitFile As Integer
Static lDestFileSpace As Long
Dim intIdx As Integer
Dim intDrvIdx As Integer
Dim sFile As FILEINFO
Dim strDrive As String
Dim lThisFileSpace As Long
intIdx = 1
On Error GoTo CalcDSError
'
'For each file in the specified section, read info from the setup info file
'
Do While ReadSetupFileLine(strsection, intIdx, sFile) = True
'
'if the file isn't split or if this is the first section of a split file
'
If sFile.strDestDir <> vbNullString Then
fSplitFile = sFile.fSplit
'
'Get the dest drive used for this file. If this is the first file using
'the drive for a destination, add the drive to the drives used 'table',
'allocate an array element for the holding the drive info, and get
'available disk space and minimum allocation unit
'
strDrive = Left$(sFile.strDestDir, 1)
intDrvIdx = InStr(gstrDrivesUsed, strDrive)
If intDrvIdx = 0 Then
gstrDrivesUsed = gstrDrivesUsed & strDrive
intDrvIdx = Len(gstrDrivesUsed)
ReDim Preserve gsDiskSpace(intDrvIdx)
gsDiskSpace(intDrvIdx).lAvail = GetDiskSpaceFree(strDrive)
gsDiskSpace(intDrvIdx).lMinAlloc = GetDrivesAllocUnit(strDrive)
End If
'
'Calculate size of the dest final (file size + minimum allocation for drive)
'
lThisFileSpace = CalcFinalSize(sFile.lFileSize, strDrive)
mlTotalToCopy = mlTotalToCopy + lThisFileSpace
'
'If the file already exists, then if we copy it at all, we'll be
'replacing it. So, we get the size of the existing dest file so
'that we can subtract it from the amount needed later.
'
If FileExists(sFile.strDestDir & sFile.strDestName) Then
lDestFileSpace = FileLen(sFile.strDestDir & sFile.strDestName)
Else
lDestFileSpace = 0
End If
End If
'
'If file not split, or if the last section of a split file
'
If sFile.fSplit = False Then
'
'If this is the last section of a split file, then if it's the *largest*
'split file, set the extra space needed for concatenation to this size
'
If fSplitFile = True And lThisFileSpace > mlSpaceForConcat Then
mlSpaceForConcat = lThisFileSpace
End If
'
'Subtract size of existing dest file, if applicable and then accumulate
'space required
'
lThisFileSpace = lThisFileSpace - lDestFileSpace
If lThisFileSpace < 0 Then
lThisFileSpace = 0
End If
gsDiskSpace(intDrvIdx).lReq = gsDiskSpace(intDrvIdx).lReq + lThisFileSpace
End If
intIdx = intIdx + 1
Loop
Exit Sub
CalcDSError:
MsgError Error$ & vbLf & vbLf & ResolveResString(resCALCSPACE), vbCritical, gstrSETMSG
ExitSetup frmMessage, gintRET_FATAL
End Sub
'-----------------------------------------------------------
' SUB: CalcFinalSize
'
' Computes the space required for a file of the size
' specified on the given dest path. This includes the
' file size plus a padding to ensure that the final size
' is a multiple of the minimum allocation unit for the
' dest drive
'-----------------------------------------------------------
'
Function CalcFinalSize(lBaseFileSize As Long, strDestPath As String) As Long
Dim lMinAlloc As Long
Dim intPadSize As Long
lMinAlloc = gsDiskSpace(InStr(gstrDrivesUsed, Left$(strDestPath, 1))).lMinAlloc
intPadSize = lMinAlloc - (lBaseFileSize Mod lMinAlloc)
If intPadSize = lMinAlloc Then
intPadSize = 0
End If
CalcFinalSize = lBaseFileSize + intPadSize
End Function
'-----------------------------------------------------------
' SUB: CenterForm
'
' Centers the passed form just above center on the screen
'-----------------------------------------------------------
'
Sub CenterForm(frm As Form)
SetMousePtr vbHourglass
frm.Top = (Screen.Height * 0.85) \ 2 - frm.Height \ 2
frm.Left = Screen.Width \ 2 - frm.Width \ 2
SetMousePtr gintMOUSE_DEFAULT
End Sub
'-----------------------------------------------------------
' SUB: UpdateDateTime
'
' Updates the date/time for bootstrap files
'-----------------------------------------------------------
'
Sub UpdateDateTime()
Dim intIdx As Integer
Dim sFile As FILEINFO
Dim lTime As FileTime
Dim hFile As Long
'
'For each file in the specified section, read info from the setup info file
'
intIdx = 1
Do While ReadSetupFileLine(gstrINI_BOOTFILES, intIdx, sFile) = True
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
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
End If
intIdx = intIdx + 1
Loop
End Sub
'-----------------------------------------------------------
' FUNCTION: CheckDiskSpace
'
' Reads from the space required array generated by calling
' the 'CalcDiskSpace' function and determines whether there
' is sufficient free space on all of the drives used for
' installation
'
' Returns: True if there is enough space, False otherwise
'-----------------------------------------------------------
'
Function CheckDiskSpace() As Integer
Static fDontAskOnSpaceErr As Integer
Dim intIdx As Integer
Dim intTmpDrvIdx As Integer
Dim lDiskSpaceLeft As Long
Dim lMostSpaceLeft As Long
'
'Default to True (enough space on all drives)
'
CheckDiskSpace = True
'
'For each drive that is the destination for one or more files, compare
'the space available to the space required.
'
For intIdx = 1 To Len(gstrDrivesUsed)
lDiskSpaceLeft = gsDiskSpace(intIdx).lAvail - gsDiskSpace(intIdx).lReq
If lDiskSpaceLeft < 0 Then
GoSub CheckDSAskSpace
Else
'
'If no "TMP" drive was found, or if the "TMP" drive wasn't ready,
'save the index of the drive and the amount of space on the drive
'which will have the most free space. If no "TMP" drive was
'found in InitDiskInfo(), then this drive will be used as a
'temporary drive for concatenating split files
'
If mstrConcatDrive = vbNullString Then
If lDiskSpaceLeft > lMostSpaceLeft Then
lMostSpaceLeft = lDiskSpaceLeft
intTmpDrvIdx = intIdx
End If
Else
'
'"TMP" drive was specified, so we'll use that
'
If Left$(mstrConcatDrive, 1) = Mid$(gstrDrivesUsed, intIdx, 1) Then
intTmpDrvIdx = intIdx
End If
End If
End If
Next
'
'If at least one drive was specified as a destination (if there was at least
'one CalcDiskSpace call in Form_Load of SETUP1.FRM), then subtract the extra
'space needed for concatenation from either:
' The "TMP" drive if available - OR -
' The drive with the most space remaining
'
If intTmpDrvIdx > 0 Then
gsDiskSpace(intTmpDrvIdx).lReq = gsDiskSpace(intTmpDrvIdx).lReq + mlSpaceForConcat
If gsDiskSpace(intTmpDrvIdx).lAvail < gsDiskSpace(intTmpDrvIdx).lReq Then
GoSub CheckDSAskSpace
End If
'
'If a "TMP" drive was found, we use it regardless, otherwise we use the drive
'with the most free space
'
If mstrConcatDrive = vbNullString Then
mstrConcatDrive = Mid$(gstrDrivesUsed, intTmpDrvIdx, 1) & gstrCOLON & gstrSEP_DIR
AddDirSep mstrConcatDrive
End If
End If
Exit Function
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -