📄 install.vbs
字号:
if ((Cint (Percent) < 0) or (Cint (Percent) > 100)) then ' Close request, but object already destroyed exit sub end if ' Create an object that control the internet exploder set IEApp = CreateObject ("InternetExplorer.Application") ' Set the exploder to fullscreen and retrieve its size dim ScreenHeight, ScreenWidth IEApp.Visible = false IEApp.FullScreen = true ScreenWidth = IEApp.Width ScreenHeight = IEApp.Height IEApp.FullScreen = false ' Now prepare the actual window IEApp.Offline = true IEApp.AddressBar = false IEApp.Height = 100 IEApp.Width = 250 IEApp.MenuBar = false IEApp.StatusBar = false IEApp.Silent = true IEApp.ToolBar = false IEApp.Resizable = false IEApp.Left = (ScreenWidth - IEApp.Width) / 2 IEApp.Top = (ScreenHeight - IEApp.Height) / 2 call IEApp.Navigate ("about:blank") do while IEApp.Busy call WScript.Sleep (100) loop ' Connect to the displayed document do until not PBDoc is nothing call WScript.Sleep (100) set PBDoc = IEApp.Document loop ' Generate a new document showing a progress bar PBDoc.Open call PBDoc.Write ("<html><head><title>" & Installer & " progress</title></head>") call PBDoc.Write ("<body bgcolor=#C0C0C0><center>") call PBDoc.Write ("<table width=100% border=1 frame=box><tr><td>") call PBDoc.Write ("<table id=progress width=0 border=0 cellpadding=0 cellspacing=0 bgcolor=#FFFFFF>") call PBDoc.Write ("<tr><td> </td></tr></table>") call PBDoc.Write ("</td></tr></table>") call PBDoc.Write ("</center></body></html>") PBDoc.Close ' Display the exploder window IEApp.Visible = true else if ((Cint (Percent) < 0) or (Cint (Percent) > 100)) then ' Request for shutdown IEApp.Visible = false set PBDoc = nothing IEApp.Quit set IEApp = nothing else ' Update the progress bar if Cint (Percent) = 0 then PBDoc.all.progress.width = "1%" PBDoc.all.progress.bgcolor = "#C0C0C0" else PBDoc.all.progress.width = Cstr (Cint (Percent)) & "%" PBDoc.all.progress.bgcolor = "#0000C0" end if end if end ifend sub'******************************************************************************' Initialize global variables'******************************************************************************sub InitializeGlobals () dim I ' String stuff used for formatting Tab = Chr (9) NewLine = Chr (13) ' Global objects set Shell = WScript.CreateObject ("WScript.Shell") set FSO = CreateObject ("Scripting.FileSystemObject") ' Arguments set ProgArgs = WScript.Arguments ' Handle program arguments Dbg = false Language = "de" for I = 0 to ProgArgs.Count-1 select case ProgArgs(I) case "-de" Language = "de" case "-debug" Dbg = true case "-en" Language = "en" end select next ' Paths and locations SystemDrive = GetEnv ("%SystemDrive%") if SystemDrive = vbNullString then SystemDrive = "c:" end if SystemRoot = GetEnv ("%SystemRoot%") if SystemRoot = vbNullString then SystemRoot = BuildPath (SystemDrive, "winnt") end if UserName = GetEnv ("%USERNAME%") if UserName = vbNullString then UserName = "Administrator" end if UserProfile = GetEnv ("%USERPROFILE%") if UserProfile = vbNullString then UserProfile = BuildPath (SystemDrive, "Dokumente und Einstellungen\" & UserName) end if ProgramFiles = GetEnv ("%ProgramFiles%") if ProgramFiles = vbNullString then ProgramFiles = BuildPath (SystemDrive, "Programme") end if AppData = GetEnv ("%AppData%") if AppData = vbNullString then AppData = UserProfile end if InstallSource = FSO.GetParentFolderName (WScript.ScriptFullName) InstallTarget = BuildPath (ProgramFiles, AppName) Programs = Shell.SpecialFolders ("AllUsersPrograms") Desktop = Shell.SpecialFolders ("AllUsersDesktop") ' Uninstaller set UninstallCtrlFile = nothing Uninstaller = BuildPath (InstallTarget, "uninstall.vbs") UninstallCtrlFileName = BuildPath (InstallTarget, "uninstall.lst") UninstallerCmdLine = "-" & Language & " " & AppName & " " & UninstallCtrlFileName ' Registry paths RegUninstall = "HKLM\Software\Microsoft\Windows\CurrentVersion\Uninstall\" & AppName & "\" ' Directories BinDir = BuildPath (InstallTarget, "bin") LibDir = BuildPath (InstallTarget, "lib") IncDir = BuildPath (InstallTarget, "include") ' Files AnnouncementFile = "announce.txt" DocIndexFile = "doc\index.html"end sub'******************************************************************************' Ask a yes/no question and return the result. "Yes" is default.'******************************************************************************function AskYesNo (Question) AskYesNo = MsgBox (Question, vbYesNo + vbQuestion + vbDefaultButton1, Installer)end function'******************************************************************************' Ask a yes/no question and return the result. "No" is default.'******************************************************************************function AskNoYes (Question) AskNoYes = MsgBox (Question, vbYesNo + vbQuestion + vbDefaultButton2, Installer)end function'******************************************************************************' Tell the user that the installation was aborted and terminate the script'******************************************************************************sub InfoAbort () call MsgBox (GetMsg ("MSG_ABORTINFO"), vbOkOnly + vbInformation, Installer) WScript.Quit (0)end sub'******************************************************************************' Input routine with the window caption preset'******************************************************************************function Input (Prompt, Default) Input = InputBox (Prompt, Installer, Default)end function'******************************************************************************' Check if a directory is a given the path'******************************************************************************function DirInPath (ByVal Dir) dim Path, Entries, I ' Get the path in lower case Path = LCase (GetEnv ("%Path%")) ' Convert the directory to lower case Dir = LCase (Dir) ' Split the path into separate entries Entries = Split (Path, ";") ' Check all entries for I = LBound (Entries) to UBound (Entries) if Entries(I) = Dir then DirInPath = true exit function end if next DirInPath = falseend function'******************************************************************************' Function that displays the paths and locations found'******************************************************************************function OneLoc (Key, Value) dim Result Result = Trim (Key) if Len (Result) <= 8 then Result = Result & Tab end if OneLoc = Result & Tab & "=" & Tab & Value & NewLineend functionsub ShowPathsAndLocations () dim Msg Msg = Msg & OneLoc ("SystemDrive", SystemDrive) Msg = Msg & OneLoc ("SystemRoot", SystemRoot) Msg = Msg & OneLoc ("UserName", UserName) Msg = Msg & OneLoc ("UserProfile", UserProfile) Msg = Msg & OneLoc ("ProgramFiles", ProgramFiles) Msg = Msg & OneLoc ("AppData", AppData) Msg = Msg & OneLoc ("InstallSource", InstallSource) Msg = Msg & OneLoc ("InstallTarget", InstallTarget) Msg = Msg & OneLoc ("Programs", Programs) Msg = Msg & OneLoc ("Desktop", Desktop) Msg = Msg & OneLoc ("Free space", ToString (GetDriveSpace (InstallTarget))) call MsgBox (Msg, vbOkOnly, "Paths and Locations")end sub'******************************************************************************' Return the amount of free space for a path (in Megabytes)'******************************************************************************function GetDriveSpace (Path) dim Drive On Error Resume Next set Drive = FSO.GetDrive (FSO.GetDriveName (Path)) if Err.Number <> 0 then GetDriveSpace = 0 else GetDriveSpace = Drive.FreeSpace / (1024 * 1024) end ifend function'******************************************************************************' Check that there's something to install'******************************************************************************sub CheckFilesToInstall () ' If the uninstaller is unavailable for some reason or the other, we ' have a problem, because the installer will create an uninstaller entry ' in the registry, but it will not work, which means that the package ' cannot be deinstalled or overwritten. So we have to check that at least ' the uninstaller is available in the same directory as the installer. if not FileExists (BuildPath (InstallSource, "uninstall.vbs")) then Abort (GetMsg ("MSG_INCOMPLETE")) end ifend sub'******************************************************************************' Check that were running this script as admin'******************************************************************************sub CheckAdminRights () ' FIXME: This check is not perfect if UserName <> "Administrator" then dim Args(1) Args(1) = AppName if AskNoYes (FmtMsg ("MSG_ADMIN", Args)) <> vbYes then WScript.Quit (1) end if end ifend sub'******************************************************************************' Remove an old installation.'******************************************************************************sub RemoveOldInstall (UninstallCmd) dim ErrCode ' Execute the uninstall ErrCode = Run (UninstallCmd, 0) ' Tell the user that the uninstall is done if ErrCode <> 0 then call Abort (GetMsg ("MSG_UNINSTALLERR")) end ifend sub'******************************************************************************' Check if there is an old installation. Offer to remove it.'******************************************************************************sub CheckOldInstall () dim UninstallCmd ' Read the uninstall command from the registry UninstallCmd = RegReadStr (RegUninstall & "UninstallString") ' Check if there is already an executable if UninstallCmd <> "" then ' Ask to remove an old install if AskYesNo (GetMsg ("MSG_REMOVEOLD")) = vbYes then ' Remove the old installation call RemoveOldInstall (UninstallCmd) end if end ifend sub'******************************************************************************' Check that the install target exists. Offer to create it.'******************************************************************************sub CheckInstallTarget () dim Msg, Result, Args(2) ' Tell the user about the install target and ask if it's ok Args(1) = InstallTarget Msg = FmtMsg ("MSG_INSTALLPATH", Args) if MsgBox (Msg, vbOkCancel, Installer) <> vbOk then call InfoAbort () end if ' Check if there's enough space left on the target drive if GetDriveSpace (InstallTarget) < SpaceNeeded then Args(1) = FSO.GetDriveName (InstallTarget) Args(2) = SpaceNeeded call Abort (FmtMsg ("MSG_DRIVESPACE", Args)) end if ' Check if the install path exist, create it if necessary if not FolderExists (InstallTarget) then Result = CreateFolder (InstallTarget) if Result <> "" then Args(1) = InstallTarget Args(2) = Result call Abort (FmtMsg ("MSG_CREATEERR", Args)) end if end ifend sub'******************************************************************************' Create the uninstall control file'******************************************************************************sub CreateUninstallCtrlFile () dim Filename⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -