--- /dev/null
+Option Explicit ' Variables must be declared explicitly
+
+
+
+'******************************************************************************
+' Installer defaults.
+'******************************************************************************
+const AppName = "cc65"
+const Version = "2.10.1"
+const Installer = "cc65 Installer"
+const SpaceNeeded = 20 ' Free space needed on drive in MB
+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 ' 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 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 Microsofts "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)
+
+ ' 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 = 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 ("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 if
+end function
+
+
+
+'******************************************************************************
+' 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, Exe, 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
+ Args(1) = AppName
+ Desc = FmtMsg ("MSG_DOCENTRY", Args)
+ Name = BuildPath (Folder, Desc & ".url")
+ Exe = "file://" & BuildPath (InstallTarget, DocIndexFile)
+ call CreateUrl (Name, Exe, Desc)
+
+ ' Create the shortcut to the announcement in the menu folder
+ Desc = GetMsg ("MSG_ANNOUNCEMENT")
+ Name = BuildPath (Folder, Desc & ".url")
+ Exe = "file://" & BuildPath (InstallTarget, AnnouncementFile)
+ call CreateUrl (Name, Exe, Desc)
+
+ ' 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
+ call AddToSysPath (BinDir)
+
+ ' Run the wm_settingchange program to notify other running programs
+ ' of the changed environment. Ignore errors.
+ call Run (BuildPath (BinDir, "wm_settingchange.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 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 ()
+
+
+
+
+
--- /dev/null
+Option Explicit ' Variables must be declared explicitly
+
+
+
+'******************************************************************************
+' Global constants and variables
+'******************************************************************************
+dim Tab, NewLine ' String constants
+dim Shell, FSO ' Global objects
+dim ProgArgs ' Program arguments
+dim Dbg ' Output debugging stuff
+dim Language ' Program language
+dim AppName ' Application name
+dim Title ' Application title
+dim UninstallCtrlFileName ' Name of the uninstall control file
+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 Failed ' Global flag for removal failed
+dim RegList ' List of registry entries to remove
+dim FileList ' List of files to remove
+dim DirList ' List of directories to remove
+
+
+
+'******************************************************************************
+' Display an error message window with an OK button
+'******************************************************************************
+sub ErrorMsg (Msg)
+ call MsgBox (Msg, vbOkOnly + vbExclamation, Title)
+end sub
+
+
+
+'******************************************************************************
+' Display an error message window and abort the installer
+'******************************************************************************
+sub Abort (Msg)
+ call ErrorMsg (Msg)
+ WScript.Quit (1)
+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_ABORT"
+ Msg = "Do you want to abort the installation?"
+ case "MSG_ADMIN"
+ Msg = "You must be Administrator to remove %1."
+ Msg = Msg & " Are you sure you want to continue?"
+ case "MSG_CTRLFILEERR"
+ Msg = "The file %1 is invalid." & NewLine
+ Msg = Msg & "Line %2: %3"
+ case "MSG_DIRDEL"
+ Msg = "Some folders could not be removed:"
+ Msg = Msg & NewLine & "%1"
+ case "MSG_DUPLICATE"
+ Msg = "Duplicate value"
+ case "MSG_FAILURE"
+ Msg = "Could not remove %1." & NewLine
+ Msg = "%2 needs to be run by an Administrator!"
+ case "MSG_FILEDEL"
+ Msg = "Some files could not be deleted:"
+ Msg = Msg & NewLine & "%1"
+ case "MSG_OPENERR"
+ Msg = "Error opening %1"
+ case "MSG_REGDEL"
+ Msg = "Some registry entries could not be deleted:"
+ Msg = Msg & NewLine & "%1"
+ case "MSG_REMOVE"
+ Msg = "Remove %1?"
+ case "MSG_SUCCESS"
+ Msg = "%1 has been successfully removed."
+ case "MSG_USAGE"
+ Msg = "Usage:" & NewLine & "uninstall appname ctrl-file"
+ 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 "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
+
+
+
+'******************************************************************************
+' 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
+
+
+
+'******************************************************************************
+' Delete a file and return an error string
+'******************************************************************************
+function DeleteFile (Path)
+ on error resume next
+ call FSO.DeleteFile (Path, true)
+ DeleteFile = Err.Description
+end function
+
+
+
+'******************************************************************************
+' Delete a registry entry
+'******************************************************************************
+function RegDelete (Key)
+ on error resume next
+ call Shell.RegDelete (Key)
+ RegDelete = Err.Description
+end function
+
+
+
+'******************************************************************************
+' Sort an array of strings
+'******************************************************************************
+sub QS (byref A, Lo, Hi)
+
+ dim I, J, T
+
+ ' Quicksort
+ do while Hi > Lo
+ I = Lo + 1
+ J = Hi
+ do while I <= J
+ do while I <= J
+ if StrComp (A(Lo), A(I), vbTextCompare) < 0 then
+ exit do
+ end if
+ I = I + 1
+ loop
+ do while I <= J
+ if StrComp (A(Lo), A(J), vbTextCompare) >= 0 then
+ exit do
+ end if
+ J = J - 1
+ loop
+ if I <= J then
+ ' Swap A(I) and A(J)
+ T = A(I)
+ A(I) = A(J)
+ A(J) = T
+ I = I + 1
+ J = J - 1
+ end if
+ loop
+ if J <> Lo then
+ ' Swap A(J) and A(Lo)
+ T = A(J)
+ A(J) = A(Lo)
+ A(Lo) = T
+ end if
+ if (2 * J) > (Hi + Lo) then
+ call QS (A, J + 1, Hi)
+ Hi = J - 1
+ else
+ call QS (A, Lo, J - 1)
+ Lo = J + 1
+ end if
+ loop
+end sub
+
+sub Quicksort (byref A)
+ if UBound (A) > 1 then
+ call QS (A, LBound (A), UBound (A))
+ end if
+end 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
+ AppName = ""
+ Title = "Uninstaller"
+ UninstallCtrlFileName = ""
+ 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"
+ case else
+ if AppName = "" then
+ AppName = ProgArgs(I)
+ elseif UninstallCtrlFileName = "" then
+ UninstallCtrlFileName = ProgArgs(I)
+ else
+ call ErrorMsg (GetMsg ("MSG_USAGE"))
+ WScript.Quit (1)
+ end if
+ end select
+ next
+
+ ' We need the application name and uninstall control file
+ if AppName = "" or UninstallCtrlFileName = "" then
+ call Abort (GetMsg ("MSG_USAGE"))
+ end if
+
+ ' Set the title early, because it's used in error messages
+ Title = AppName & " Uninstaller"
+
+ ' 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
+
+ ' Assume we could remove the software
+ Failed = false
+
+end sub
+
+
+
+'******************************************************************************
+' Ask a yes/no question and return the result. "Yes" is default.
+'******************************************************************************
+function AskYesNo (Question)
+ AskYesNo = MsgBox (Question, vbYesNo + vbQuestion + vbDefaultButton1, Title)
+end function
+
+
+
+'******************************************************************************
+' Ask a yes/no question and return the result. "No" is default.
+'******************************************************************************
+function AskNoYes (Question)
+ AskNoYes = MsgBox (Question, vbYesNo + vbQuestion + vbDefaultButton2, Title)
+end function
+
+
+
+'******************************************************************************
+' Ask if the user wants to abort install, and terminate if the answer is yes
+'******************************************************************************
+sub QueryAbort ()
+ if AskNoYes (GetMsg ("MSG_ABORT")) = vbYes then
+ WScript.Quit (1)
+ end if
+end sub
+
+
+
+'******************************************************************************
+' 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 ("UserName", UserName)
+ Msg = Msg & OneLoc ("UserProfile", UserProfile)
+ Msg = Msg & OneLoc ("ProgramFiles", ProgramFiles)
+
+ MsgBox Msg, vbOkOnly, "Paths and Locations"
+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
+
+
+
+'******************************************************************************
+' Read the uninstall control file and create the data collections
+'******************************************************************************
+sub InvalidCtrlFile (Line, Val)
+ dim Args(3)
+ Args(1) = UninstallCtrlFileName
+ Args(2) = Line
+ Args(3) = Val
+ call Abort (FmtMsg ("MSG_CTRLFILEERR", Args))
+end sub
+
+sub ReadUninstallCtrlFile ()
+
+ const ForReading = 1
+ dim File, Line, Tag, Args(3)
+ dim MyRegList, MyFileList, myDirList
+
+ ' Create some dictionaries. These are not really used as dictionaries, but
+ ' have the nice property of expanding dynamically, and we need that.
+ set MyRegList = CreateObject ("Scripting.Dictionary")
+ set MyFileList = CreateObject ("Scripting.Dictionary")
+ set MyDirList = CreateObject ("Scripting.Dictionary")
+
+ ' Open the file. Checking Err doesn't work here, don't know why.
+ set File = nothing
+ on error resume next
+ set File = FSO.OpenTextFile (UninstallCtrlFileName, ForReading)
+ on error goto 0
+ if File is nothing then
+ Args(1) = UninstallCtrlFileName
+ call Abort (FmtMsg ("MSG_OPENERR", Args))
+ end if
+
+ ' Read all lines and insert them in their list
+ do while File.AtEndOfStream <> true
+
+ ' Read the next line
+ on error resume next
+ Line = File.ReadLine
+ on error goto 0
+
+ ' Get the type from the line and remove it, so the line contains just
+ ' the argument name
+ Tag = Left (Line, 1)
+ Line = Mid (Line, 3)
+
+ ' Determine the type of the entry
+ select case Tag
+
+ case "D"
+ ' A directory. Convert to lowercase to unify names.
+ Line = LCase (Line)
+ if MyDirList.Exists (Line) then
+ call InvalidCtrlFile (File.Line - 1, GetMsg ("MSG_DUPLICATE"))
+ else
+ call MyDirList.Add (Line, "")
+ end if
+
+ case "F"
+ ' A file. Convert to lowercase to unify names
+ Line = LCase (Line)
+ if MyFileList.Exists (Line) then
+ call InvalidCtrlFile (File.Line - 1, GetMsg ("MSG_DUPLICATE"))
+ else
+ call MyFileList.Add (Line, "")
+ end if
+
+ case "R"
+ ' A registry entry
+ if MyRegList.Exists (Line) then
+ call InvalidCtrlFile (File.Line - 1, GetMsg ("MSG_DUPLICATE"))
+ else
+ call MyRegList.Add (Line, "")
+ end if
+
+ case else
+ call InvalidCtrlFile (File.Line - 1, Tag & " " & Line)
+
+ end select
+
+ loop
+
+ ' Close the file
+ on error resume next
+ call File.Close ()
+ on error goto 0
+
+ ' Make the global arrays big enough for the data
+ RegList = Array (MyRegList.Count)
+ FileList = Array (MyFileList.Count)
+ DirList = Array (MyDirList.Count)
+
+ ' Copy the data into the global arrays
+ RegList = MyRegList.Keys
+ FileList = MyFileList.Keys
+ DirList = MyDirList.Keys
+
+ ' Sort all the lists. This makes sure nodes are in the array before the
+ ' leaves that depend on it. Or in other words: Top level directories and
+ ' registry entries come first. So if we delete the items starting at the
+ ' other side of the array, we will never delete a subdirectory before its
+ ' parent directory.
+ call QuickSort (RegList)
+ call QuickSort (FileList)
+ call QuickSort (DirList)
+
+end sub
+
+
+
+'******************************************************************************
+' Delete the registry entries
+'******************************************************************************
+sub DeleteRegistryEntries ()
+
+ dim I, Result, NoDel, Args(1)
+
+ NoDel = ""
+ for I = UBound (RegList) to LBound (RegList) step -1
+ Result = RegDelete (RegList (I))
+ if Result <> "" then
+ ' Remember the entries we could not delete
+ NoDel = NoDel & RegList (I) & NewLine
+ end if
+ next
+
+ if NoDel <> "" then
+ Args(1) = NoDel
+ call ErrorMsg (FmtMsg ("MSG_REGDEL", Args))
+ end if
+end sub
+
+
+
+'******************************************************************************
+' Delete the files
+'******************************************************************************
+sub DeleteFiles ()
+
+ dim I, Result, NoDel, Args(1)
+
+ NoDel = ""
+ for I = UBound (FileList) to LBound (FileList) step -1
+ Result = DeleteFile (FileList (I))
+ if Result <> "" then
+ ' Remember the files we could not delete
+ NoDel = NoDel & FileList (I) & NewLine
+ end if
+ next
+
+ if NoDel <> "" then
+ Args(1) = NoDel
+ call ErrorMsg (FmtMsg ("MSG_FILEDEL", Args))
+ end if
+end sub
+
+
+
+'******************************************************************************
+' Delete the directories
+'******************************************************************************
+sub DeleteDirectories ()
+
+ dim I, Result, NoDel, Args(1)
+
+ NoDel = ""
+ for I = UBound (DirList) to LBound (DirList) step -1
+ Result = DeleteFolder (DirList (I))
+ if Result <> "" then
+ ' Remember the directories we could not delete
+ NoDel = NoDel & DirList (I) & NewLine
+ end if
+ next
+
+ if NoDel <> "" then
+ Args(1) = NoDel
+ call ErrorMsg (FmtMsg ("MSG_DIRDEL", Args))
+ end if
+end sub
+
+
+
+'******************************************************************************
+' Function that tells the user that the install was successful
+'******************************************************************************
+sub Success ()
+ dim Args(1), App
+
+ ' Popup message
+ Args(1) = AppName
+ call MsgBox (FmtMsg ("MSG_SUCCESS", Args), vbOkOnly + vbInformation, Title)
+
+end sub
+
+
+
+'******************************************************************************
+' Function that tells the user that the uninstall failed
+'******************************************************************************
+sub Failure ()
+ dim Args(2)
+
+ ' Popup message
+ Args(1) = AppName
+ Args(2) = Title
+ ErrorMsg (FmtMsg ("MSG_FAILURE", Args))
+ WScript.Quit (1)
+
+end sub
+
+
+
+'******************************************************************************
+' Main program
+'******************************************************************************
+sub Main ()
+
+ dim Args(1)
+
+ ' Initialize global variables. This includes the paths used
+ InitializeGlobals ()
+ if Dbg then
+ ShowPathsAndLocations ()
+ end if
+
+ ' Check that we're running this script as admin
+ CheckAdminRights ()
+
+ ' Let the user make up his mind
+ Args(1) = AppName
+ if AskYesNo (FmtMsg ("MSG_REMOVE", Args)) <> vbYes then
+ WScript.Quit (1)
+ end if
+
+ ' Read the uninstall control file
+ call ReadUninstallCtrlFile ()
+
+ ' Delete the registry entries
+ call DeleteRegistryEntries ()
+
+ ' Delete all files
+ call DeleteFiles ()
+
+ ' Delete the directories
+ call DeleteDirectories ()
+
+ ' We're done
+ if Failed then
+ Failure ()
+ else
+ Success ()
+ end if
+end sub
+
+
+
+'******************************************************************************
+' The script body just calls Main...
+'******************************************************************************
+Main ()
+
+
+
+
projects / cc65 / commitdiff