?? common.bas
字號:
Else
intButtonNum = 1
End If
'
' Now determine the type of message box we are dealing
' with and return the default button.
'
If (intFlags And vbRetryCancel) = vbRetryCancel Then
intDefButton = IIf(intButtonNum = 1, vbRetry, vbCancel)
ElseIf (intFlags And vbYesNoCancel) = vbYesNoCancel Then
Select Case intButtonNum
Case 1
intDefButton = vbYes
Case 2
intDefButton = vbNo
Case 3
intDefButton = vbCancel
'End Case
End Select
ElseIf (intFlags And vbOKCancel) = vbOKCancel Then
intDefButton = IIf(intButtonNum = 1, vbOK, vbCancel)
ElseIf (intFlags And vbAbortRetryIgnore) = vbAbortRetryIgnore Then
Select Case intButtonNum
Case 1
intDefButton = vbAbort
Case 2
intDefButton = vbRetry
Case 3
intDefButton = vbIgnore
'End Case
End Select
ElseIf (intFlags And vbYesNo) = vbYesNo Then
intDefButton = IIf(intButtonNum = 1, vbYes, vbNo)
Else
intDefButton = vbOK
End If
GetDefMsgBoxButton = intDefButton
End Function
'-----------------------------------------------------------
' FUNCTION: GetDiskSpaceFree
' Get the amount of free disk space for the specified drive
'
' IN: [strDrive] - drive to check space for
'
' Returns: Amount of free disk space, or -1 if an error occurs
'-----------------------------------------------------------
'
Function GetDiskSpaceFree(ByVal strDrive As String) As Long
Dim strCurDrive As String
Dim lDiskFree As Long
On Error Resume Next
'
'Save the current drive
'
strCurDrive = Left$(CurDir$, 2)
'
'Fixup drive so it includes only a drive letter and a colon
'
If InStr(strDrive, gstrSEP_DRIVE) = 0 Or Len(strDrive) > 2 Then
strDrive = Left$(strDrive, 1) & gstrSEP_DRIVE
End If
'
'Change to the drive we want to check space for. The DiskSpaceFree() API
'works on the current drive only.
'
ChDrive strDrive
'
'If we couldn't change to the request drive, it's an error, otherwise return
'the amount of disk space free
'
If Err <> 0 Or (strDrive <> Left$(CurDir$, 2)) Then
lDiskFree = -1
Else
Dim lRet As Long
Dim lBytes As Long, lSect As Long, lClust As Long, lTot As Long
lRet = GetDiskFreeSpace(vbNullString, lSect, lBytes, lClust, lTot)
On Error Resume Next
lDiskFree = (lBytes * lSect) * lClust
If Err Then lDiskFree = 2147483647
End If
If lDiskFree = -1 Then
MsgError Error$ & vbLf & vbLf & ResolveResString(resDISKSPCERR) & strDrive, vbExclamation, gstrTitle
End If
GetDiskSpaceFree = lDiskFree
'
'Cleanup by setting the current drive back to the original
'
ChDrive strCurDrive
Err = 0
End Function
'-----------------------------------------------------------
' FUNCTION: GetUNCShareName
'
' Given a UNC names, returns the leftmost portion of the
' directory representing the machine name and share name.
' E.g., given "\\SCHWEIZ\PUBLIC\APPS\LISTING.TXT", returns
' the string "\\SCHWEIZ\PUBLIC"
'
' Returns a string representing the machine and share name
' if the path is a valid pathname, else returns NULL
'-----------------------------------------------------------
'
Function GetUNCShareName(ByVal strFN As String) As Variant
GetUNCShareName = Null
If IsUNCName(strFN) Then
Dim iFirstSeparator As Integer
iFirstSeparator = InStr(3, strFN, gstrSEP_DIR)
If iFirstSeparator > 0 Then
Dim iSecondSeparator As Integer
iSecondSeparator = InStr(iFirstSeparator + 1, strFN, gstrSEP_DIR)
If iSecondSeparator > 0 Then
GetUNCShareName = Left$(strFN, iSecondSeparator - 1)
Else
GetUNCShareName = strFN
End If
End If
End If
End Function
'-----------------------------------------------------------
' FUNCTION: GetWindowsSysDir
'
' Calls the windows API to get the windows\SYSTEM directory
' and ensures that a trailing dir separator is present
'
' Returns: The windows\SYSTEM directory
'-----------------------------------------------------------
'
Function GetWindowsSysDir() As String
Dim strBuf As String
strBuf = Space$(gintMAX_SIZE)
'
'Get the system directory and then trim the buffer to the exact length
'returned and add a dir sep (backslash) if the API didn't return one
'
If GetSystemDirectory(strBuf, gintMAX_SIZE) > 0 Then
strBuf = StripTerminator(strBuf)
AddDirSep strBuf
GetWindowsSysDir = strBuf
Else
GetWindowsSysDir = vbNullString
End If
End Function
'-----------------------------------------------------------
' SUB: TreatAsWin95
'
' Returns True iff either we're running under Windows 95
' or we are treating this version of NT as if it were
' Windows 95 for registry and application loggin and
' removal purposes.
'-----------------------------------------------------------
'
Function TreatAsWin95() As Boolean
If IsWindows95() Then
TreatAsWin95 = True
ElseIf NTWithShell() Then
TreatAsWin95 = True
Else
TreatAsWin95 = False
End If
End Function
'-----------------------------------------------------------
' FUNCTION: NTWithShell
'
' Returns true if the system is on a machine running
' NT4.0 or greater.
'-----------------------------------------------------------
'
Function NTWithShell() As Boolean
If Not IsWindowsNT() Then
NTWithShell = False
Exit Function
End If
Dim osvi As OSVERSIONINFO
Dim strCSDVersion As String
osvi.dwOSVersionInfoSize = Len(osvi)
If GetVersionEx(osvi) = 0 Then
Exit Function
End If
strCSDVersion = StripTerminator(osvi.szCSDVersion)
'Is this Windows NT 4.0 or higher?
Const NT4MajorVersion = 4
Const NT4MinorVersion = 0
If (osvi.dwMajorVersion >= NT4MajorVersion) Then
NTWithShell = True
Else
NTWithShell = False
End If
End Function
'-----------------------------------------------------------
' FUNCTION: IsDepFile
'
' Returns true if the file passed to this routine is a
' dependency (*.dep) file. We make this determination
' by verifying that the extension is .dep and that it
' contains version information.
'-----------------------------------------------------------
'
Function fIsDepFile(strFilename As String) As Boolean
Const strEXT_DEP = "DEP"
fIsDepFile = False
If UCase(Extension(strFilename)) = strEXT_DEP Then
If GetFileVersion(strFilename) <> vbNullString Then
fIsDepFile = True
End If
End If
End Function
'-----------------------------------------------------------
' FUNCTION: IsWin32
'
' Returns true if this program is running under Win32 (i.e.
' any 32-bit operating system)
'-----------------------------------------------------------
'
Function IsWin32() As Boolean
IsWin32 = (IsWindows95() Or IsWindowsNT())
End Function
'-----------------------------------------------------------
' FUNCTION: IsWindows95
'
' Returns true if this program is running under Windows 95
' or successor
'-----------------------------------------------------------
'
Function IsWindows95() As Boolean
Const dwMask95 = &H1&
IsWindows95 = (GetWinPlatform() And dwMask95)
End Function
'-----------------------------------------------------------
' FUNCTION: IsWindowsNT
'
' Returns true if this program is running under Windows NT
'-----------------------------------------------------------
'
Function IsWindowsNT() As Boolean
Const dwMaskNT = &H2&
IsWindowsNT = (GetWinPlatform() And dwMaskNT)
End Function
'-----------------------------------------------------------
' FUNCTION: IsWindowsNT4WithoutSP2
'
' Determines if the user is running under Windows NT 4.0
' but without Service Pack 2 (SP2). If running under any
' other platform, returns False.
'
' IN: [none]
'
' Returns: True if and only if running under Windows NT 4.0
' without at least Service Pack 2 installed.
'-----------------------------------------------------------
'
Function IsWindowsNT4WithoutSP2() As Boolean
IsWindowsNT4WithoutSP2 = False
If Not IsWindowsNT() Then
Exit Function
End If
Dim osvi As OSVERSIONINFO
Dim strCSDVersion As String
osvi.dwOSVersionInfoSize = Len(osvi)
If GetVersionEx(osvi) = 0 Then
Exit Function
End If
strCSDVersion = StripTerminator(osvi.szCSDVersion)
'Is this Windows NT 4.0?
Const NT4MajorVersion = 4
Const NT4MinorVersion = 0
If (osvi.dwMajorVersion <> NT4MajorVersion) Or (osvi.dwMinorVersion <> NT4MinorVersion) Then
'No. Return False.
Exit Function
End If
'If no service pack is installed, or if Service Pack 1 is
'installed, then return True.
Const strSP1 = "SERVICE PACK 1"
If strCSDVersion = "" Then
IsWindowsNT4WithoutSP2 = True 'No service pack installed
ElseIf strCSDVersion = strSP1 Then
IsWindowsNT4WithoutSP2 = True 'Only SP1 installed
End If
End Function
'-----------------------------------------------------------
' FUNCTION: IsUNCName
'
' Determines whether the pathname specified is a UNC name.
' UNC (Universal Naming Convention) names are typically
' used to specify machine resources, such as remote network
' shares, named pipes, etc. An example of a UNC name is
' "\\SERVER\SHARE\FILENAME.EXT".
'
' IN: [strPathName] - pathname to check
'
' Returns: True if pathname is a UNC name, False otherwise
'-----------------------------------------------------------
'
Function IsUNCName(ByVal strPathName As String) As Integer
Const strUNCNAME$ = "\\//\" 'so can check for \\, //, \/, /\
IsUNCName = ((InStr(strUNCNAME, Left$(strPathName, 2)) > 0) And _
(Len(strPathName) > 1))
End Function
'-----------------------------------------------------------
' FUNCTION: LogSilentMsg
'
' If this is a silent install, this routine writes
' a message to the gstrSilentLog file.
'
' IN: [strMsg] - The message
'
' Normally, this routine is called inlieu of displaying
' a MsgBox and strMsg is the same message that would
' have appeared in the MsgBox
'-----------------------------------------------------------
'
Sub LogSilentMsg(strMsg As String)
If Not gfSilent Then Exit Sub
Dim fn As Integer
On Error Resume Next
fn = FreeFile
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -