mirror of
https://github.com/cc65/cc65.git
synced 2024-11-11 01:05:25 +00:00
1178 lines
37 KiB
Plaintext
1178 lines
37 KiB
Plaintext
Option Explicit ' Variables must be declared explicitly
|
|
|
|
|
|
|
|
'******************************************************************************
|
|
' Installer defaults.
|
|
'******************************************************************************
|
|
const AppName = "cc65"
|
|
const Version = "2.11.9"
|
|
const Installer = "cc65 Installer"
|
|
const SpaceNeeded = 20 ' Free space needed on drive in MiB.
|
|
const Shortcut = true ' Create shortcut on desktop
|
|
|
|
|
|
|
|
'******************************************************************************
|
|
' Global constants
|
|
'******************************************************************************
|
|
const SysEnv = "HKLM\System\CurrentControlSet\Control\Session Manager\Environment"
|
|
const SysPath = "HKLM\System\CurrentControlSet\Control\Session Manager\Environment\Path"
|
|
|
|
|
|
|
|
'******************************************************************************
|
|
' Global variables
|
|
'******************************************************************************
|
|
dim Tab, NewLine, Quote ' String constants
|
|
dim Shell, FSO ' Global objects
|
|
dim ProgArgs ' Program arguments
|
|
dim Dbg ' Output debugging stuff
|
|
dim Language ' Program language
|
|
dim SystemDrive ' The system drive
|
|
dim SystemRoot ' The windows directory
|
|
dim UserName ' Name if the current user
|
|
dim UserProfile ' User profile directory
|
|
dim ProgramFiles ' Program files directory
|
|
dim AppData ' Application data directory
|
|
dim InstallSource ' Installation source directory
|
|
dim InstallTarget ' Installation target directory
|
|
dim UninstallCtrlFileName ' Name of the control file for the uninstaller
|
|
dim UninstallCtrlFile ' Control file for the uninstaller
|
|
dim Uninstaller ' Path to the uninstaller file
|
|
dim UninstallerCmdLine ' Command line for the uninstaller
|
|
dim Programs ' "Programs" menu folder
|
|
dim Desktop ' "Desktop" menu folder
|
|
dim RegUninstall ' Registry key for uninstall entries
|
|
dim BinDir ' Directory for binaries
|
|
dim LibDir ' Library directory
|
|
dim IncDir ' Include directory
|
|
dim DocIndexFile ' Name of documentation index file
|
|
dim AnnouncementFile ' Name of the announcement file
|
|
|
|
|
|
|
|
'******************************************************************************
|
|
' Display an error message window with an OK button
|
|
'******************************************************************************
|
|
sub ErrorMsg (Msg)
|
|
call MsgBox (Msg, vbOkOnly + vbExclamation, Installer)
|
|
end sub
|
|
|
|
|
|
|
|
'******************************************************************************
|
|
' Display an error message window and abort the installer
|
|
'******************************************************************************
|
|
sub Abort (Msg)
|
|
call ErrorMsg (Msg)
|
|
WScript.Quit (1)
|
|
end sub
|
|
|
|
|
|
|
|
'******************************************************************************
|
|
' Display a message with an OK button
|
|
'******************************************************************************
|
|
sub Message (Msg)
|
|
call MsgBox (Msg, vbOkOnly + vbInformation, Installer)
|
|
end sub
|
|
|
|
|
|
|
|
'******************************************************************************
|
|
' Convert a number to a string
|
|
'******************************************************************************
|
|
function ToString (Num)
|
|
ToString = FormatNumber (Num, vbFalse, vbTrue, vbFalse, vbFalse)
|
|
end function
|
|
|
|
|
|
|
|
'******************************************************************************
|
|
' Return a message in the current language
|
|
'******************************************************************************
|
|
function GetMsg (Key)
|
|
dim Msg
|
|
|
|
' Handle other languages here
|
|
|
|
' Default is english
|
|
if IsEmpty (Msg) then
|
|
' No assignment, use english
|
|
select case Key
|
|
case "MSG_ABORTINFO"
|
|
Msg = "Installation was aborted."
|
|
case "MSG_ADMIN"
|
|
Msg = "You must be Administrator to install %1."
|
|
Msg = Msg & " Are you sure you want to continue?"
|
|
case "MSG_COPYERR"
|
|
Msg = "Cannot copy %1 to %2: " & NewLine & "%3"
|
|
case "MSG_CREATEDIR"
|
|
Msg = "%1 does not exist." & NewLine & "Create it?"
|
|
case "MSG_CREATEERR"
|
|
Msg = "Cannot create %1:" & NewLine & "%2"
|
|
case "MSG_DELETEERR"
|
|
Msg = "Cannot delete %1:" & NewLine & "%2"
|
|
case "MSG_DRIVESPACE"
|
|
Msg = "Not enough space left on drive %1" & NewLine
|
|
Msg = Msg & "At least %2 MB are needed."
|
|
case "MSG_INSTALLPATH"
|
|
Msg = "The package will be installed in %1"
|
|
case "MSG_DOCENTRY"
|
|
Msg = "%1 Documentation"
|
|
case "MSG_REGREADERR"
|
|
Msg = "Installation failed: Cannot read the registry!"
|
|
case "MSG_REGWRITEERR"
|
|
Msg = "Installation failed: Cannot write to the registry!"
|
|
case "MSG_REMOVEENTRY"
|
|
Msg = "Remove %1"
|
|
case "MSG_REMOVEDIR"
|
|
Msg = "A folder with the name %1 does already exist."
|
|
Msg = Msg & " Is it ok to remove the folder?"
|
|
case "MSG_REMOVEOLD"
|
|
Msg = "Found an old version. Remove it?"
|
|
case "MSG_SUCCESS"
|
|
Msg = "Installation was successful!"
|
|
case "MSG_UNINSTALLERR"
|
|
Msg = "There was a problem uninstalling the old version. Please"
|
|
Msg = Msg & " uninstall the old program manually and restart"
|
|
Msg = Msg & " the installation."
|
|
case "MSG_ANNOUNCEMENT"
|
|
Msg = "cc65 Announcement"
|
|
case "MSG_INCOMPLETE"
|
|
Msg = "The package seems to be incomplete and cannot be"
|
|
Msg = Msg & " installed."
|
|
case else
|
|
Msg = Key
|
|
end select
|
|
end if
|
|
GetMsg = Msg
|
|
end function
|
|
|
|
|
|
|
|
'******************************************************************************
|
|
' Format a string replacing %n specifiers in the format string F
|
|
'******************************************************************************
|
|
function Fmt (F, Values)
|
|
dim I, Count, Key, Val, Start, Pos
|
|
Count = UBound (Values) ' How many values?
|
|
for I = Count to 0 step -1
|
|
Key = "%" & ToString (I)
|
|
select case VarType (Values (I))
|
|
case vbEmpty
|
|
Val = ""
|
|
case vbInteger
|
|
Val = ToString (Values (I))
|
|
case vbLong
|
|
Val = ToString (Values (I))
|
|
case vbNull
|
|
Val = ""
|
|
case vbSingle
|
|
Val = ToString (Values (I))
|
|
case vbDouble
|
|
Val = ToString (Values (I))
|
|
case vbString
|
|
Val = Values (I)
|
|
case else
|
|
Abort ("Internal error: Invalid conversion in Format()")
|
|
end select
|
|
F = Replace (F, Key, Val)
|
|
next
|
|
Fmt = F
|
|
end function
|
|
|
|
|
|
|
|
'******************************************************************************
|
|
' Format a message replacing %n specifiers in the format string F
|
|
'******************************************************************************
|
|
function FmtMsg (Msg, Values)
|
|
FmtMsg = Fmt (GetMsg (Msg), Values)
|
|
end function
|
|
|
|
|
|
|
|
'******************************************************************************
|
|
' Return an environment string. Fix up Microsoft's "innovative" ideas.
|
|
'******************************************************************************
|
|
function GetEnv (Key)
|
|
dim Value
|
|
Value = Shell.ExpandEnvironmentStrings (Key)
|
|
if Value = Key then
|
|
GetEnv = vbNullString
|
|
else
|
|
GetEnv = Value
|
|
end if
|
|
end function
|
|
|
|
|
|
|
|
'******************************************************************************
|
|
' Build a path from two components
|
|
'******************************************************************************
|
|
function BuildPath (Path, Name)
|
|
BuildPath = FSO.BuildPath (Path, Name)
|
|
end function
|
|
|
|
|
|
|
|
'******************************************************************************
|
|
' Return true if the file with the given name exists
|
|
'******************************************************************************
|
|
function FileExists (Name)
|
|
On Error Resume Next
|
|
FileExists = FSO.FileExists (Name)
|
|
end function
|
|
|
|
|
|
|
|
'******************************************************************************
|
|
' Return true if the folder with the given name exists
|
|
'******************************************************************************
|
|
function FolderExists (Name)
|
|
On Error Resume Next
|
|
FolderExists = FSO.FolderExists (Name)
|
|
end function
|
|
|
|
|
|
|
|
'******************************************************************************
|
|
' Copy a file and return an error message (empty string if no error)
|
|
'******************************************************************************
|
|
function CopyFile (Source, Target)
|
|
if Right (Target, 1) <> "\" and FolderExists (Target) then
|
|
Target = Target & "\"
|
|
end if
|
|
On Error Resume Next
|
|
call FSO.CopyFile (Source, Target)
|
|
on error goto 0
|
|
CopyFile = Err.Description
|
|
end function
|
|
|
|
|
|
|
|
'******************************************************************************
|
|
' Create a folder and all parent folders and return an error string
|
|
'******************************************************************************
|
|
function CreateFolder (Path)
|
|
|
|
' If the parent folder does not exist, try to create it
|
|
dim ParentFolder
|
|
ParentFolder = FSO.GetParentFolderName (Path)
|
|
if ParentFolder <> "" and not FolderExists (ParentFolder) then
|
|
CreateFolder (ParentFolder)
|
|
end if
|
|
|
|
' Now try to create the actual folder
|
|
On Error Resume Next
|
|
FSO.CreateFolder (Path)
|
|
CreateFolder = Err.Description
|
|
|
|
end function
|
|
|
|
|
|
|
|
'******************************************************************************
|
|
' Delete a file and return an error string
|
|
'******************************************************************************
|
|
function DeleteFile (Name)
|
|
On Error Resume Next
|
|
call FSO.DeleteFile (Name, true)
|
|
DeleteFile = Err.Description
|
|
end function
|
|
|
|
|
|
|
|
'******************************************************************************
|
|
' Delete a folder and return an error string
|
|
'******************************************************************************
|
|
function DeleteFolder (Path)
|
|
On Error Resume Next
|
|
call FSO.DeleteFolder (Path, true)
|
|
DeleteFolder = Err.Description
|
|
end function
|
|
|
|
|
|
|
|
'******************************************************************************
|
|
' Return the type of a registry entry
|
|
'******************************************************************************
|
|
function RegType (Value)
|
|
|
|
dim Result
|
|
|
|
' Determine the type of the registry value. If the string contains percent
|
|
' signs, use REG_EXPAND_SZ, otherwise use REG_SZ. This isn't always safe,
|
|
' but there is no way to determine the type, and VBS itself is too stupid
|
|
' to choose the correct type itself. Add the usual curse over Microsoft
|
|
' here...
|
|
Result = InStr (1, Value, "%")
|
|
if Result = 0 then
|
|
RegType = "REG_SZ"
|
|
else
|
|
RegType = "REG_EXPAND_SZ"
|
|
end if
|
|
end function
|
|
|
|
|
|
|
|
'******************************************************************************
|
|
' Read a string from the registry. Return an empty string if nothing was found.
|
|
'******************************************************************************
|
|
function RegReadStr (Key)
|
|
On Error Resume Next
|
|
RegReadStr = Shell.RegRead (Key)
|
|
if Err.Number <> 0 then
|
|
RegReadStr = ""
|
|
end if
|
|
end function
|
|
|
|
|
|
|
|
'******************************************************************************
|
|
' Write a binary value to the registry, return an error description
|
|
'******************************************************************************
|
|
function RegWriteBin (Key, Value)
|
|
on error resume next
|
|
Shell.RegWrite Key, Value, "REG_BINARY"
|
|
RegWriteBin = Err.Description
|
|
on error goto 0
|
|
WriteUninstallCtrlFile ("R " & Key)
|
|
end function
|
|
|
|
|
|
|
|
'******************************************************************************
|
|
' Write a string value to the registry, return an error description
|
|
'******************************************************************************
|
|
function RegWriteStr (Key, Value)
|
|
on error resume next
|
|
Shell.RegWrite Key, Value, "REG_SZ"
|
|
RegWriteStr = Err.Description
|
|
on error goto 0
|
|
WriteUninstallCtrlFile ("R " & Key)
|
|
end function
|
|
|
|
|
|
|
|
'******************************************************************************
|
|
' Run a program, wait for its termination and return an error code.
|
|
'******************************************************************************
|
|
function Run (Cmd, WinState)
|
|
dim ErrCode
|
|
|
|
On Error Resume Next
|
|
ErrCode = Shell.Run (Cmd, WinState, true)
|
|
if Err.Number <> 0 then
|
|
ErrCode = Err.Number
|
|
end if
|
|
Run = ErrCode
|
|
end function
|
|
|
|
|
|
|
|
'******************************************************************************
|
|
' Display a progress bar using the internet exploder
|
|
'******************************************************************************
|
|
dim PBDoc ' Progress bar document object
|
|
dim PBVal ' Current progress bar setting
|
|
dim IEApp ' Internet exploder application object
|
|
set PBDoc = nothing
|
|
set IEApp = nothing
|
|
PBVal = -1
|
|
|
|
sub ProgressBar (Percent)
|
|
|
|
' Remember the last setting
|
|
PBVal = Percent
|
|
|
|
'Create the progress bar window
|
|
if PBDoc is nothing then
|
|
|
|
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 if
|
|
end sub
|
|
|
|
|
|
|
|
'******************************************************************************
|
|
' Initialize global variables
|
|
'******************************************************************************
|
|
sub InitializeGlobals ()
|
|
dim I
|
|
|
|
' String stuff used for formatting
|
|
Tab = Chr (9)
|
|
NewLine = Chr (13)
|
|
Quote = Chr (34)
|
|
|
|
' 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 = Quote & BuildPath (InstallTarget, "uninstall.vbs") & Quote
|
|
UninstallCtrlFileName = BuildPath (InstallTarget, "uninstall.lst")
|
|
UninstallerCmdLine = "-" & Language & " " & AppName & " " & Quote & UninstallCtrlFileName & Quote
|
|
|
|
' 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 = false
|
|
end 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 & NewLine
|
|
end function
|
|
|
|
sub ShowPathsAndLocations ()
|
|
dim Msg
|
|
Msg = Msg & OneLoc ("SystemDrive", SystemDrive)
|
|
Msg = Msg & OneLoc ("SystemRoot", SystemRoot)
|
|
Msg = Msg & OneLoc ("User Name", 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 if
|
|
end 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 if
|
|
end 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 if
|
|
|
|
end 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 if
|
|
end 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 if
|
|
|
|
end 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 if
|
|
|
|
end sub
|
|
|
|
|
|
|
|
'******************************************************************************
|
|
' Create the uninstall control file
|
|
'******************************************************************************
|
|
sub CreateUninstallCtrlFile ()
|
|
|
|
dim Filename
|
|
|
|
' Generate the filename
|
|
on Error resume next
|
|
set UninstallCtrlFile = FSO.CreateTextFile (UninstallCtrlFileName, true)
|
|
on error goto 0
|
|
if Err.Number <> 0 then
|
|
dim Args(2)
|
|
Args(1) = UninstallCtrlFileName
|
|
Args(2) = Err.Description
|
|
call ErrorMsg (FmtMsg ("MSG_CREATEERR", Args))
|
|
WScript.Quit (1)
|
|
end if
|
|
|
|
' Write the name of the target directory to the file
|
|
call WriteUninstallCtrlFile ("D " & InstallTarget)
|
|
|
|
' Write the name of the file itself to the file
|
|
call WriteUninstallCtrlFile ("F " & UninstallCtrlFileName)
|
|
|
|
end sub
|
|
|
|
|
|
|
|
'******************************************************************************
|
|
' Write to the uninstall control file
|
|
'******************************************************************************
|
|
sub WriteUninstallCtrlFile (Line)
|
|
|
|
on error resume next
|
|
UninstallCtrlFile.WriteLine (Line)
|
|
if Err.Number <> 0 then
|
|
dim Args(2)
|
|
Args(1) = UninstallCtrlFileName
|
|
Args(2) = Err.Description
|
|
call ErrorMsg (FmtMsg ("MSG_WRITEERR", Args))
|
|
WScript.Quit (1)
|
|
end if
|
|
|
|
end sub
|
|
|
|
|
|
|
|
'******************************************************************************
|
|
' Close the uninstall control file
|
|
'******************************************************************************
|
|
sub CloseUninstallCtrlFile ()
|
|
|
|
on error resume next
|
|
UninstallCtrlFile.Close
|
|
if Err.Number <> 0 then
|
|
dim Args(2)
|
|
Args(1) = UninstallCtrlFileName
|
|
Args(2) = Err.Description
|
|
call ErrorMsg (FmtMsg ("MSG_WRITEERR", Args))
|
|
WScript.Quit (1)
|
|
end if
|
|
|
|
end sub
|
|
|
|
|
|
|
|
'******************************************************************************
|
|
' Copy the application files
|
|
'******************************************************************************
|
|
sub RecursiveCopy (Dir, SourcePath, TargetPath)
|
|
|
|
dim File, TargetFile, SubDir, SourceName, TargetName, Result, Args(3)
|
|
|
|
' Copy all files in this folder
|
|
for each File in Dir.Files
|
|
|
|
' Generate source and target file names
|
|
SourceName = BuildPath (SourcePath, File.Name)
|
|
TargetName = BuildPath (TargetPath, File.Name)
|
|
|
|
' Copy the file. The error check doesn't seem to work.
|
|
on error resume next
|
|
File.Copy (TargetName)
|
|
on error goto 0
|
|
if Err.Number <> 0 then
|
|
Args(1) = SourceName
|
|
Args(2) = TargetName
|
|
Args(3) = Err.Description
|
|
call ErrorMsg (FmtMsg ("MSG_COPYERR", Args))
|
|
call AbortInfo ()
|
|
end if
|
|
|
|
' Remove the r/o attribute from the target file if set
|
|
set TargetFile = FSO.GetFile (TargetName)
|
|
if TargetFile.Attributes mod 2 = 1 then
|
|
TargetFile.Attributes = TargetFile.Attributes - 1
|
|
end if
|
|
|
|
' Remember this file in the uninstall control file
|
|
call WriteUninstallCtrlFile ("F " & TargetName)
|
|
next
|
|
|
|
' Handle all subdirectories
|
|
for each SubDir in Dir.SubFolders
|
|
|
|
' Update the progress bar with each copied directory
|
|
if PBVal <= 80 then
|
|
call ProgressBar (PBVal + 5)
|
|
end if
|
|
|
|
' Generate the new directory names
|
|
SourceName = BuildPath (SourcePath, SubDir.Name)
|
|
TargetName = BuildPath (TargetPath, SubDir.Name)
|
|
|
|
' Generate the new target dir. Notify the user about errors, but
|
|
' otherwise ignore them.
|
|
Result = CreateFolder (TargetName)
|
|
if Result <> "" then
|
|
' Display an error but try to continue
|
|
Args(1) = TargetName
|
|
Args(2) = Result
|
|
call ErrorMsg (FmtMsg ("MSG_CREATEERR", Args))
|
|
end if
|
|
|
|
' Recursively process files in the subdirectory
|
|
call RecursiveCopy (SubDir, SourceName, TargetName)
|
|
|
|
' Remember the subdirectory in the uninstall control file
|
|
WriteUninstallCtrlFile ("D " & TargetName)
|
|
|
|
next
|
|
end sub
|
|
|
|
sub CopyFiles ()
|
|
|
|
' Update the progress bar
|
|
call ProgressBar (10)
|
|
|
|
' Copy all files generating entries in the uninstall control file
|
|
call RecursiveCopy (FSO.GetFolder (InstallSource), InstallSource, InstallTarget)
|
|
|
|
' Update the progress bar
|
|
call ProgressBar (90)
|
|
end sub
|
|
|
|
|
|
|
|
'******************************************************************************
|
|
' Create the registry entries
|
|
'******************************************************************************
|
|
sub CreateRegEntries ()
|
|
|
|
dim Cmd
|
|
|
|
' Create the entry in Systemsteuerung -> Software. Check if the first write
|
|
' succeeds. If not, we don't have admin rights.
|
|
if RegWriteBin (RegUninstall, 1) <> "" then
|
|
call Abort (GetMsg ("MSG_REGWRITEERR"))
|
|
end if
|
|
call RegWriteStr (RegUninstall & "DisplayName", AppName & " " & Version)
|
|
call RegWriteStr (RegUninstall & "UninstallString", "wscript /nologo " & Uninstaller & " " & UninstallerCmdLine)
|
|
|
|
end sub
|
|
|
|
|
|
|
|
'******************************************************************************
|
|
' Function that creates an URL
|
|
'******************************************************************************
|
|
sub CreateUrl (Name, Url, Description)
|
|
' Ignore errors
|
|
On Error Resume Next
|
|
|
|
dim Link
|
|
set Link = Shell.CreateShortcut (Name)
|
|
Link.TargetPath = Url
|
|
Link.Description = Description
|
|
Link.Save
|
|
|
|
' Allow errors again
|
|
on error goto 0
|
|
|
|
' Write the file name to the uninstall control file
|
|
WriteUninstallCtrlFile ("F " & Name)
|
|
end sub
|
|
|
|
|
|
|
|
'******************************************************************************
|
|
' Function that creates a shortcut
|
|
'******************************************************************************
|
|
sub CreateShortcut (Name, Exe, Args, Description)
|
|
' Ignore errors
|
|
On Error Resume Next
|
|
|
|
dim Link
|
|
set Link = Shell.CreateShortcut (Name)
|
|
Link.TargetPath = Exe
|
|
Link.Arguments = Args
|
|
Link.WindowStyle = 1
|
|
Link.Description = Description
|
|
Link.WorkingDirectory = AppData
|
|
Link.Save
|
|
|
|
' Allow errors again
|
|
on error goto 0
|
|
|
|
' Write the file name to the uninstall control file
|
|
WriteUninstallCtrlFile ("F " & Name)
|
|
end sub
|
|
|
|
|
|
|
|
'******************************************************************************
|
|
' Function that creates the menu entries
|
|
'******************************************************************************
|
|
sub CreateMenuEntries ()
|
|
dim Folder, Result, Name, Desc, Target, Args(2)
|
|
|
|
' Create the start menu folder.
|
|
Folder = BuildPath (Programs, AppName)
|
|
Result = CreateFolder (Folder)
|
|
if Result <> "" then
|
|
' Display an error but try to continue
|
|
Args(1) = Folder
|
|
Args(2) = Result
|
|
call ErrorMsg (FmtMsg ("MSG_CREATEERR", Args))
|
|
end if
|
|
|
|
' Create an uninstall shortcut in the menu folder
|
|
Args(1) = AppName
|
|
Desc = FmtMsg ("MSG_REMOVEENTRY", Args)
|
|
Name = BuildPath (Folder, Desc & ".lnk")
|
|
call CreateShortcut (Name, Uninstaller, UninstallerCmdLine, Desc)
|
|
|
|
' Create a documentation shortcut in the menu folder
|
|
Target = BuildPath (InstallTarget, DocIndexFile)
|
|
if FileExists (Target) then
|
|
Args(1) = AppName
|
|
Desc = FmtMsg ("MSG_DOCENTRY", Args)
|
|
Name = BuildPath (Folder, Desc & ".url")
|
|
call CreateUrl (Name, "file://" & Target, Desc)
|
|
end if
|
|
|
|
' Create the shortcut to the announcement in the menu folder
|
|
Target = BuildPath (InstallTarget, AnnouncementFile)
|
|
if FileExists (Target) then
|
|
Desc = GetMsg ("MSG_ANNOUNCEMENT")
|
|
Name = BuildPath (Folder, Desc & ".url")
|
|
call CreateUrl (Name, "file://" & Target, Desc)
|
|
end if
|
|
|
|
' Update the uninstall control file
|
|
call WriteUninstallCtrlFile ("D " & Folder)
|
|
end sub
|
|
|
|
|
|
|
|
'******************************************************************************
|
|
' Add a directory to the system path
|
|
'******************************************************************************
|
|
sub AddToSysPath (Dir)
|
|
|
|
dim Path
|
|
|
|
' Handle errors. Assume failure
|
|
on error resume next
|
|
|
|
' Retrieve the PATH setting
|
|
Path = Shell.RegRead (SysPath)
|
|
if Err.Number <> 0 then
|
|
' Could not read
|
|
call Abort (GetMsg ("MSG_REGREADERR"))
|
|
end if
|
|
|
|
' Add the new directory to the path
|
|
if (Len (Path) > 0) and (Right (Path, 1) <> ";") then
|
|
Path = Path + ";"
|
|
end if
|
|
Path = Path + Dir
|
|
|
|
' Write the new path
|
|
call Shell.RegWrite (SysPath, Path, "REG_EXPAND_SZ")
|
|
if Err.Number <> 0 then
|
|
' Could not set
|
|
call Abort (GetMsg ("MSG_REGWRITEERR"))
|
|
end if
|
|
end sub
|
|
|
|
|
|
|
|
'******************************************************************************
|
|
' Add environment variables
|
|
'******************************************************************************
|
|
sub AddEnvironment ()
|
|
|
|
' Add CC65_LIB
|
|
if RegWriteStr (SysEnv & "\CC65_LIB", LibDir) <> "" then
|
|
call Abort (GetMsg ("MSG_REGWRITEERR"))
|
|
end if
|
|
|
|
' Add CC65_INC
|
|
if RegWriteStr (SysEnv & "\CC65_INC", IncDir) <> "" then
|
|
call Abort (GetMsg ("MSG_REGWRITEERR"))
|
|
end if
|
|
|
|
' Add the bin directory to the path if it's not already there
|
|
if not DirInPath (BinDir) then
|
|
call AddToSysPath (BinDir)
|
|
end if
|
|
|
|
' Run the wm_envchange program to notify other running programs
|
|
' of the changed environment. Ignore errors.
|
|
call Run (BuildPath (BinDir, "wm_envchange.exe"), 0)
|
|
|
|
end sub
|
|
|
|
|
|
|
|
'******************************************************************************
|
|
' Function that tells the user that the install was successful
|
|
'******************************************************************************
|
|
sub Success ()
|
|
call MsgBox (GetMsg ("MSG_SUCCESS"), vbOkOnly + vbInformation, Installer)
|
|
end sub
|
|
|
|
|
|
|
|
'******************************************************************************
|
|
' Main program
|
|
'******************************************************************************
|
|
sub Main ()
|
|
|
|
' Initialize global variables. This includes the paths used
|
|
call InitializeGlobals ()
|
|
if Dbg then
|
|
call ShowPathsAndLocations ()
|
|
end if
|
|
|
|
' Check that there's something to install
|
|
call CheckFilesToInstall ()
|
|
|
|
' Check that we're running this script as admin
|
|
call CheckAdminRights ()
|
|
|
|
' Check if there is an old installation and offer to remove it
|
|
call CheckOldInstall ()
|
|
|
|
' Check if the source directory does really exist
|
|
call CheckInstallTarget ()
|
|
|
|
' Display the progress bar
|
|
call ProgressBar (0)
|
|
|
|
' Create the uninstall file
|
|
call CreateUninstallCtrlFile ()
|
|
call ProgressBar (2)
|
|
|
|
' Create registry entries
|
|
CreateRegEntries ()
|
|
call Progressbar (5)
|
|
|
|
' Copy the application files (will do automatic progress bar updates)
|
|
call CopyFiles ()
|
|
|
|
' Create the menu entries
|
|
call CreateMenuEntries ()
|
|
call ProgressBar (90)
|
|
|
|
' Add entries to the enviroment
|
|
call AddEnvironment ()
|
|
call ProgressBar (95)
|
|
|
|
' Close the uninstall control file
|
|
call CloseUninstallCtrlFile ()
|
|
|
|
' We're done
|
|
call ProgressBar (100)
|
|
call ProgressBar (-1)
|
|
call Success ()
|
|
|
|
' Return a success code
|
|
WScript.Quit (0)
|
|
end sub
|
|
|
|
|
|
|
|
'******************************************************************************
|
|
' The script body just calls Main...
|
|
'******************************************************************************
|
|
Main ()
|
|
|
|
|
|
|
|
|
|
|