?? setup1.bas
字號:
Attribute VB_Name = "basSetup1"
Option Explicit
Option Compare Text
'
' Global Constants
'
Public Enum OverwriteReturnVal
owYes
owNo
owNoToAll
End Enum
'Return values for setup toolkit functions
Global Const gintRET_CONT% = 1
Global Const gintRET_CANCEL% = 2
Global Const gintRET_EXIT% = 3
Global Const gintRET_ABORT% = 4
Global Const gintRET_FATAL% = 5
Global Const gintRET_FINISHEDSUCCESS% = 6 'Used only as parameter to ExitSetup at end of successful install
'Error levels for GetAppRemovalCmdLine()
Global Const APPREMERR_NONE = 0 'no error
Global Const APPREMERR_FATAL = 1 'fatal error
Global Const APPREMERR_NONFATAL = 2 'non-fatal error, user chose to abort
Global Const APPREMERR_USERCANCEL = 3 'user chose to cancel (no error)
'Flag for Path Dialog specifying Source or Dest directory needed
Global Const gstrDIR_SRC$ = "S"
Global Const gstrDIR_DEST$ = "D"
'Beginning of lines in [Files], [Bootstrap], and [Licenses] sections of SETUP.LST
Global Const gstrINI_FILE$ = "File"
Global Const gstrINI_REMOTE$ = "Remote"
Global Const gstrINI_LICENSE$ = "License"
'
' Command line constants
'
Global Const gstrSILENTSWITCH = "s"
Global Const gstrSMSSWITCH = "q"
'
' Icon Information
'
Global Const gsGROUP As String = "Group"
Global Const gsICON As String = "Icon"
Global Const gsTITLE As String = "Title"
Global Const gsICONGROUP As String = "IconGroups"
Global Const gstrINI_BOOTFILES$ = "Bootstrap Files"
'Font info
Global Const gsEXT_FONTTTF As String = "TTF"
Global Const gsEXT_FONTFON As String = "FON"
Declare Function AddFontResource Lib "gdi32" Alias "AddFontResourceA" (ByVal lpFilename As String) As Long
'Registry files (execute them based on .reg extension)
Global Const gsREGEDIT As String = "regedit /s "
Global Const gsEXT_REG As String = "reg"
'
'Type Definitions
'
Type FILEINFO ' Setup information file line format
intDiskNum As Integer ' disk number
fSplit As Integer ' split flag
strSrcName As String ' name of source file
strDestName As String ' name of destination file
strDestDir As String ' destination directory
strRegister As String ' registration info
fShared As Boolean ' whether the file is shared or private
fSystem As Boolean ' whether the file is a system file (i.e. should be installed but never removed)
varDate As Date ' file date
lFileSize As Long ' file size
sVerInfo As VERINFO ' file version number
strReserved As String ' Reserved. Leave empty, or error.
strProgramIconTitle As String ' Caption for icon in program group
strProgramIconCmdLine As String ' Command Line for icon in program group
End Type
Type DISKINFO ' Disk drive information
lAvail As Long ' Bytes available on drive
lReq As Long ' Bytes required for setup
lMinAlloc As Long ' minimum allocation unit
End Type
Type DESTINFO ' save dest dir for certain files
strAppDir As String
strAUTMGR32 As String
strRACMGR32 As String
End Type
Type REGINFO ' save registration info for files
strFilename As String
strRegister As String
'The following are used only for remote server registration
strNetworkAddress As String
strNetworkProtocol As String
intAuthentication As Integer
fDCOM As Boolean ' True if DCOM, otherwise False
End Type
'
'Global Variables
'
Global gstrSETMSG As String
Global gfRetVal As Integer 'return value for form based functions
Global gstrAppName As String 'name of app being installed
Global gintCabs As Long
Global gstrTitle As String '"setup" name of app being installed
Public gstrDefGroup As String 'Default name for group -- from setup.lst
Global gstrDestDir As String 'dest dir for application files
Global gstrAppExe As String 'name of app .EXE being installed
Public gstrAppToUninstall As String ' Name of app exe/ocx/dll to be uninstalled. Should be the same as gstrAppExe in most cases.
Global gstrSrcPath As String 'path of source files
Global gstrSetupInfoFile As String 'pathname of SETUP.LST file
Global gstrWinDir As String 'windows directory
Global gstrFontDir As String 'windows\font directory
Global gstrWinSysDir As String 'windows\system directory
Global gsDiskSpace() As DISKINFO 'disk space for target drives
Global gstrDrivesUsed As String 'dest drives used by setup
Global glTotalCopied As Long 'total bytes copied so far
Global gintCurrentDisk As Integer 'current disk number being installed
Global gsDest As DESTINFO 'dest dirs for certain files
Global gstrAppRemovalLog As String 'name of the app removal logfile
Global gstrAppRemovalEXE As String 'name of the app removal executable
Global gfAppRemovalFilesMoved As Boolean 'whether or not the app removal files have been moved to the application directory
Global gfForceUseDefDest As Boolean 'If set to true, then the user will not be prompted for the destination directory
Global fMainGroupWasCreated As Boolean 'Whether or not a main folder/group has been created
Public gfRegDAO As Boolean ' If this gets set to true in the code, then
' we need to add some registration info for DAO
' to the registry.
Global gsCABNAME As String
Global gsTEMPDIR As String
Global Const gsINI_CABNAME As String = "Cab"
Global Const gsINI_TEMPDIR As String = "TmpDir"
'
'Form/Module Constants
'
'SetFileTime junk
Public Type FileTime
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Public Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Public Const GENERIC_WRITE = &H40000000
Public Const GENERIC_READ = &H80000000
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const INVALID_HANDLE_VALUE = -1
Public Const FILE_SHARE_READ = &H1
Public Const FILE_SHARE_WRITE = &H2
Public Const CREATE_NEW = 1
Public Const CREATE_ALWAYS = 2
Public Const OPEN_EXISTING = 3
Public Const OPEN_ALWAYS = 4
Public Declare Function LocalFileTimeToFileTime Lib "Kernel32" (lpFileTime As FileTime, lpLocalFileTime As FileTime) As Long
Public Declare Function CreateFile Lib "Kernel32" Alias "CreateFileA" (ByVal lpFilename As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Public Declare Function SetFileTime Lib "Kernel32" (ByVal hFile As Long, lpCreationTime As FileTime, lpLastAccessTime As FileTime, lpLastWriteTime As FileTime) As Long
Public Declare Function CloseHandle Lib "Kernel32" (ByVal hObject As Long) As Long
Public Declare Function SystemTimeToFileTime Lib "Kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As FileTime) As Long
Public Declare Function VariantChangeTypeEx Lib "oleaut32.dll" (ByVal pvArgDest As Long, ByVal pvArgSrc As Long, ByVal LCID As Long, ByVal wFlags As Integer, ByVal VarType As Integer) As Long
Public Declare Function VariantTimeToSystemTime Lib "oleaut32.dll" (ByVal vtime As Date, lpSystemTime As SYSTEMTIME) As Long
'Possible ProgMan actions
Const mintDDE_ITEMADD% = 1 'AddProgManItem flag
Const mintDDE_GRPADD% = 2 'AddProgManGroup flag
'Special file names
Const mstrFILE_APPREMOVALLOGBASE$ = "ST6UNST" 'Base name of the app removal logfile
Const mstrFILE_APPREMOVALLOGEXT$ = ".LOG" 'Default extension for the app removal logfile
Const mstrFILE_AUTMGR32 = "AUTMGR32.EXE"
Const mstrFILE_RACMGR32 = "RACMGR32.EXE"
Const mstrFILE_RICHED32$ = "RICHED32.DLL"
'Name of temporary file used for concatenation of split files
Const mstrCONCATFILE$ = "VB5STTMP.CCT"
'setup information file registration macros
Const mstrDLLSELFREGISTER$ = "$(DLLSELFREGISTER)"
Const mstrEXESELFREGISTER$ = "$(EXESELFREGISTER)"
Const mstrTLBREGISTER$ = "$(TLBREGISTER)"
Const mstrREMOTEREGISTER$ = "$(REMOTE)"
Const mstrVBLREGISTER$ = "$(VBLREGISTER)" ' Bug 5-8039
'
'Form/Module Variables
'
Private msRegInfo() As REGINFO 'files to be registered
Private mlTotalToCopy As Long 'total bytes to copy
Private mintConcatFile As Integer 'handle of dest file for concatenation
Private mlSpaceForConcat As Long 'extra space required for concatenation
Private mstrConcatDrive As String 'drive to use for concatenation
Private mstrVerTmpName As String 'temp file name for VerInstallFile API
' Hkey cache (used for logging purposes)
Private Type HKEY_CACHE
hKey As Long
strHkey As String
End Type
Private hkeyCache() As HKEY_CACHE
' Registry manipulation API's (32-bit)
Global Const HKEY_CLASSES_ROOT = &H80000000
Global Const HKEY_CURRENT_USER = &H80000001
Global Const HKEY_LOCAL_MACHINE = &H80000002
Global Const HKEY_USERS = &H80000003
Const ERROR_SUCCESS = 0&
Const ERROR_NO_MORE_ITEMS = 259&
Const REG_SZ = 1
Const REG_BINARY = 3
Const REG_DWORD = 4
Declare Function OSRegCloseKey Lib "advapi32" Alias "RegCloseKey" (ByVal hKey As Long) As Long
Declare Function OSRegCreateKey Lib "advapi32" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpszSubKey As String, phkResult As Long) As Long
Declare Function OSRegDeleteKey Lib "advapi32" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpszSubKey As String) As Long
Declare Function OSRegEnumKey Lib "advapi32" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal iSubKey As Long, ByVal lpszName As String, ByVal cchName As Long) As Long
Declare Function OSRegOpenKey Lib "advapi32" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpszSubKey As String, phkResult As Long) As Long
Declare Function OSRegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpszValueName As String, ByVal dwReserved As Long, lpdwType As Long, lpbData As Any, cbData As Long) As Long
Declare Function OSRegSetValueEx Lib "advapi32" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Declare Function OSRegSetValueNumEx Lib "advapi32" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Declare Sub lstrcpyn Lib "Kernel32" (ByVal strDest As String, ByVal strSrc As Any, ByVal lBytes As Long)
Declare Function GetCurrentProcessId Lib "Kernel32" () As Long
Declare Function ExtractFileFromCab Lib "vb6stkit.dll" (ByVal Cab As String, ByVal File As String, ByVal Dest As String, ByVal iCab As Long, ByVal sSrc As String) As Long
'Reboot info
Public Const ANYSIZE_ARRAY = 1
Type LARGE_INTEGER
lowpart As Long
highpart As Long
End Type
Type LUID_AND_ATTRIBUTES
pLuid As LARGE_INTEGER
Attributes As Long
End Type
Type TOKEN_PRIVILEGES
PrivilegeCount As Long
Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type
Public Const TOKEN_ADJUST_PRIVILEGES = 32
Public Const TOKEN_QUERY = 8
Public Const SE_PRIVILEGE_ENABLED As Long = 2
Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LARGE_INTEGER) As Long
Declare Function GetCurrentProcess Lib "Kernel32" () As Long
Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
'Exit the program and return an error code
Private Declare Sub ExitProcess Lib "Kernel32" (ByVal uExitCode As Long)
'-----------------------------------------------------------
' SUB: AddPerAppPath
'
' Adds an application's full pathname and per-app path to the
' system registry (this is currently only meaningful to
' Windows 95).
'
' IN: [strAppExe] - app EXE name, not including path
' [strAppDir] - full path of EXE, not including filename
' [strAppPath] - per-app path for this application
' (semicolon-separated list of directory path names)
' If this is the empty string (""), no per-app path
' is registered, but the full pathname of the
' exe IS still registered.
'
' OUT:
' Example registry entries:
' HKEY_LOCAL_MACHINE\[strPathsBaseKeyName]\MyApp.Exe
' [Default]=C:\Program Files\MyApp\MyApp.Exe
' [Path]=C:\Program Files\MyApp;C:\Program Files\MyApp\System
'
'-----------------------------------------------------------
'
Sub AddPerAppPath(ByVal strAppExe As String, ByVal strAppDir As String, ByVal strPerAppPath As String)
If Not TreatAsWin95() Then
Exit Sub
End If
Dim strPathsBaseKeyName As String
Const strAppPaths$ = "App Paths"
Const strAppPathKeyName = "Path"
Dim fOk As Boolean
Dim hKey As Long
AddDirSep strAppDir
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -