1 Option Explicit ' Variables must be declared explicitly
5 '******************************************************************************
7 '******************************************************************************
9 const Version = "2.10.5.20050325"
10 const Installer = "cc65 Installer"
11 const SpaceNeeded = 20 ' Free space needed on drive in MB
12 const Shortcut = true ' Create shortcut on desktop
16 '******************************************************************************
18 '******************************************************************************
19 const SysEnv = "HKLM\System\CurrentControlSet\Control\Session Manager\Environment"
20 const SysPath = "HKLM\System\CurrentControlSet\Control\Session Manager\Environment\Path"
24 '******************************************************************************
26 '******************************************************************************
27 dim Tab, NewLine ' String constants
28 dim Shell, FSO ' Global objects
29 dim ProgArgs ' Program arguments
30 dim Dbg ' Output debugging stuff
31 dim Language ' Program language
32 dim SystemDrive ' The system drive
33 dim SystemRoot ' The windows directory
34 dim UserName ' Name if the current user
35 dim UserProfile ' User profile directory
36 dim ProgramFiles ' Program files directory
37 dim AppData ' Application data directory
38 dim InstallSource ' Installation source directory
39 dim InstallTarget ' Installation target directory
40 dim UninstallCtrlFileName ' Name of the control file for the uninstaller
41 dim UninstallCtrlFile ' Control file for the uninstaller
42 dim Uninstaller ' Path to the uninstaller file
43 dim UninstallerCmdLine ' Command line for the uninstaller
44 dim Programs ' "Programs" menu folder
45 dim Desktop ' "Desktop" menu folder
46 dim RegUninstall ' Registry key for uninstall entries
47 dim BinDir ' Directory for binaries
48 dim LibDir ' Library directory
49 dim IncDir ' Include directory
50 dim DocIndexFile ' Name of documentation index file
51 dim AnnouncementFile ' Name of the announcement file
55 '******************************************************************************
56 ' Display an error message window with an OK button
57 '******************************************************************************
59 call MsgBox (Msg, vbOkOnly + vbExclamation, Installer)
64 '******************************************************************************
65 ' Display an error message window and abort the installer
66 '******************************************************************************
74 '******************************************************************************
75 ' Display a message with an OK button
76 '******************************************************************************
78 call MsgBox (Msg, vbOkOnly + vbInformation, Installer)
83 '******************************************************************************
84 ' Convert a number to a string
85 '******************************************************************************
86 function ToString (Num)
87 ToString = FormatNumber (Num, vbFalse, vbTrue, vbFalse, vbFalse)
92 '******************************************************************************
93 ' Return a message in the current language
94 '******************************************************************************
98 ' Handle other languages here
101 if IsEmpty (Msg) then
102 ' No assignment, use english
105 Msg = "Installation was aborted."
107 Msg = "You must be Administrator to install %1."
108 Msg = Msg & " Are you sure you want to continue?"
110 Msg = "Cannot copy %1 to %2: " & NewLine & "%3"
112 Msg = "%1 does not exist." & NewLine & "Create it?"
114 Msg = "Cannot create %1:" & NewLine & "%2"
116 Msg = "Cannot delete %1:" & NewLine & "%2"
117 case "MSG_DRIVESPACE"
118 Msg = "Not enough space left on drive %1" & NewLine
119 Msg = Msg & "At least %2 MB are needed."
120 case "MSG_INSTALLPATH"
121 Msg = "The package will be installed in %1"
123 Msg = "%1 Documentation"
124 case "MSG_REGREADERR"
125 Msg = "Installation failed: Cannot read the registry!"
126 case "MSG_REGWRITEERR"
127 Msg = "Installation failed: Cannot write to the registry!"
128 case "MSG_REMOVEENTRY"
131 Msg = "A folder with the name %1 does already exist."
132 Msg = Msg & " Is it ok to remove the folder?"
134 Msg = "Found an old version. Remove it?"
136 Msg = "Installation was successful!"
137 case "MSG_UNINSTALLERR"
138 Msg = "There was a problem uninstalling the old version. Please"
139 Msg = Msg & " uninstall the old program manually and restart"
140 Msg = Msg & " the installation."
141 case "MSG_ANNOUNCEMENT"
142 Msg = "cc65 Announcement"
152 '******************************************************************************
153 ' Format a string replacing %n specifiers in the format string F
154 '******************************************************************************
155 function Fmt (F, Values)
156 dim I, Count, Key, Val, Start, Pos
157 Count = UBound (Values) ' How many values?
158 for I = Count to 0 step -1
159 Key = "%" & ToString (I)
160 select case VarType (Values (I))
164 Val = ToString (Values (I))
166 Val = ToString (Values (I))
170 Val = ToString (Values (I))
172 Val = ToString (Values (I))
176 Abort ("Internal error: Invalid conversion in Format()")
178 F = Replace (F, Key, Val)
185 '******************************************************************************
186 ' Format a message replacing %n specifiers in the format string F
187 '******************************************************************************
188 function FmtMsg (Msg, Values)
189 FmtMsg = Fmt (GetMsg (Msg), Values)
194 '******************************************************************************
195 ' Return an environment string. Fix up Microsofts "innovative" ideas.
196 '******************************************************************************
197 function GetEnv (Key)
199 Value = Shell.ExpandEnvironmentStrings (Key)
201 GetEnv = vbNullString
209 '******************************************************************************
210 ' Build a path from two components
211 '******************************************************************************
212 function BuildPath (Path, Name)
213 BuildPath = FSO.BuildPath (Path, Name)
218 '******************************************************************************
219 ' Return true if the file with the given name exists
220 '******************************************************************************
221 function FileExists (Name)
223 FileExists = FSO.FileExists (Name)
228 '******************************************************************************
229 ' Return true if the folder with the given name exists
230 '******************************************************************************
231 function FolderExists (Name)
233 FolderExists = FSO.FolderExists (Name)
238 '******************************************************************************
239 ' Copy a file and return an error message (empty string if no error)
240 '******************************************************************************
241 function CopyFile (Source, Target)
242 if Right (Target, 1) <> "\" and FolderExists (Target) then
243 Target = Target & "\"
246 call FSO.CopyFile (Source, Target)
248 CopyFile = Err.Description
253 '******************************************************************************
254 ' Create a folder and all parent folders and return an error string
255 '******************************************************************************
256 function CreateFolder (Path)
258 ' If the parent folder does not exist, try to create it
260 ParentFolder = FSO.GetParentFolderName (Path)
261 if ParentFolder <> "" and not FolderExists (ParentFolder) then
262 CreateFolder (ParentFolder)
265 ' Now try to create the actual folder
267 FSO.CreateFolder (Path)
268 CreateFolder = Err.Description
274 '******************************************************************************
275 ' Delete a file and return an error string
276 '******************************************************************************
277 function DeleteFile (Name)
279 call FSO.DeleteFile (Name, true)
280 DeleteFile = Err.Description
285 '******************************************************************************
286 ' Delete a folder and return an error string
287 '******************************************************************************
288 function DeleteFolder (Path)
290 call FSO.DeleteFolder (Path, true)
291 DeleteFolder = Err.Description
296 '******************************************************************************
297 ' Return the type of a registry entry
298 '******************************************************************************
299 function RegType (Value)
303 ' Determine the type of the registry value. If the string contains percent
304 ' signs, use REG_EXPAND_SZ, otherwise use REG_SZ. This isn't always safe,
305 ' but there is no way to determine the type, and VBS itself is too stupid
306 ' to choose the correct type itself. Add the usual curse over Microsoft
308 Result = InStr (1, Value, "%")
312 RegType = "REG_EXPAND_SZ"
318 '******************************************************************************
319 ' Read a string from the registry. Return an empty string if nothing was found.
320 '******************************************************************************
321 function RegReadStr (Key)
323 RegReadStr = Shell.RegRead (Key)
324 if Err.Number <> 0 then
331 '******************************************************************************
332 ' Write a binary value to the registry, return an error description
333 '******************************************************************************
334 function RegWriteBin (Key, Value)
336 Shell.RegWrite Key, Value, "REG_BINARY"
337 RegWriteBin = Err.Description
339 WriteUninstallCtrlFile ("R " & Key)
344 '******************************************************************************
345 ' Write a string value to the registry, return an error description
346 '******************************************************************************
347 function RegWriteStr (Key, Value)
349 Shell.RegWrite Key, Value, "REG_SZ"
350 RegWriteStr = Err.Description
352 WriteUninstallCtrlFile ("R " & Key)
357 '******************************************************************************
358 ' Run a program, wait for its termination and return an error code.
359 '******************************************************************************
360 function Run (Cmd, WinState)
364 ErrCode = Shell.Run (Cmd, WinState, true)
365 if Err.Number <> 0 then
373 '******************************************************************************
374 ' Display a progress bar using the internet exploder
375 '******************************************************************************
376 dim PBDoc ' Progress bar document object
377 dim PBVal ' Current progress bar setting
378 dim IEApp ' Internet exploder application object
383 sub ProgressBar (Percent)
385 ' Remember the last setting
388 'Create the progress bar window
389 if PBDoc is nothing then
391 if ((Cint (Percent) < 0) or (Cint (Percent) > 100)) then
392 ' Close request, but object already destroyed
396 ' Create an object that control the internet exploder
397 set IEApp = CreateObject ("InternetExplorer.Application")
399 ' Set the exploder to fullscreen and retrieve its size
400 dim ScreenHeight, ScreenWidth
401 IEApp.Visible = false
402 IEApp.FullScreen = true
403 ScreenWidth = IEApp.Width
404 ScreenHeight = IEApp.Height
405 IEApp.FullScreen = false
407 ' Now prepare the actual window
409 IEApp.AddressBar = false
412 IEApp.MenuBar = false
413 IEApp.StatusBar = false
415 IEApp.ToolBar = false
416 IEApp.Resizable = false
417 IEApp.Left = (ScreenWidth - IEApp.Width) / 2
418 IEApp.Top = (ScreenHeight - IEApp.Height) / 2
419 call IEApp.Navigate ("about:blank")
421 call WScript.Sleep (100)
424 ' Connect to the displayed document
425 do until not PBDoc is nothing
426 call WScript.Sleep (100)
427 set PBDoc = IEApp.Document
430 ' Generate a new document showing a progress bar
432 call PBDoc.Write ("<html><head><title>" & Installer & " progress</title></head>")
433 call PBDoc.Write ("<body bgcolor=#C0C0C0><center>")
434 call PBDoc.Write ("<table width=100% border=1 frame=box><tr><td>")
435 call PBDoc.Write ("<table id=progress width=0 border=0 cellpadding=0 cellspacing=0 bgcolor=#FFFFFF>")
436 call PBDoc.Write ("<tr><td> </td></tr></table>")
437 call PBDoc.Write ("</td></tr></table>")
438 call PBDoc.Write ("</center></body></html>")
441 ' Display the exploder window
445 if ((Cint (Percent) < 0) or (Cint (Percent) > 100)) then
446 ' Request for shutdown
447 IEApp.Visible = false
452 ' Update the progress bar
453 if Cint (Percent) = 0 then
454 PBDoc.all.progress.width = "1%"
455 PBDoc.all.progress.bgcolor = "#C0C0C0"
457 PBDoc.all.progress.width = Cstr (Cint (Percent)) & "%"
458 PBDoc.all.progress.bgcolor = "#0000C0"
466 '******************************************************************************
467 ' Initialize global variables
468 '******************************************************************************
469 sub InitializeGlobals ()
472 ' String stuff used for formatting
477 set Shell = WScript.CreateObject ("WScript.Shell")
478 set FSO = CreateObject ("Scripting.FileSystemObject")
481 set ProgArgs = WScript.Arguments
483 ' Handle program arguments
486 for I = 0 to ProgArgs.Count-1
487 select case ProgArgs(I)
497 ' Paths and locations
498 SystemDrive = GetEnv ("%SystemDrive%")
499 if SystemDrive = vbNullString then
502 SystemRoot = GetEnv ("%SystemRoot%")
503 if SystemRoot = vbNullString then
504 SystemRoot = BuildPath (SystemDrive, "winnt")
506 UserName = GetEnv ("%USERNAME%")
507 if UserName = vbNullString then
508 UserName = "Administrator"
510 UserProfile = GetEnv ("%USERPROFILE%")
511 if UserProfile = vbNullString then
512 UserProfile = BuildPath (SystemDrive, "Dokumente und Einstellungen\" & UserName)
514 ProgramFiles = GetEnv ("%ProgramFiles%")
515 if ProgramFiles = vbNullString then
516 ProgramFiles = BuildPath (SystemDrive, "Programme")
518 AppData = GetEnv ("%AppData%")
519 if AppData = vbNullString then
520 AppData = UserProfile
522 InstallSource = FSO.GetParentFolderName (WScript.ScriptFullName)
523 InstallTarget = BuildPath (ProgramFiles, AppName)
525 Programs = Shell.SpecialFolders ("AllUsersPrograms")
526 Desktop = Shell.SpecialFolders ("AllUsersDesktop")
529 set UninstallCtrlFile = nothing
530 Uninstaller = BuildPath (InstallTarget, "uninstall.vbs")
531 UninstallCtrlFileName = BuildPath (InstallTarget, "uninstall.lst")
532 UninstallerCmdLine = "-" & Language & " " & AppName & " " & UninstallCtrlFileName
535 RegUninstall = "HKLM\Software\Microsoft\Windows\CurrentVersion\Uninstall\" & AppName & "\"
538 BinDir = BuildPath (InstallTarget, "bin")
539 LibDir = BuildPath (InstallTarget, "lib")
540 IncDir = BuildPath (InstallTarget, "include")
543 AnnouncementFile = "announce.txt"
544 DocIndexFile = "doc\index.html"
549 '******************************************************************************
550 ' Ask a yes/no question and return the result. "Yes" is default.
551 '******************************************************************************
552 function AskYesNo (Question)
553 AskYesNo = MsgBox (Question, vbYesNo + vbQuestion + vbDefaultButton1, Installer)
558 '******************************************************************************
559 ' Ask a yes/no question and return the result. "No" is default.
560 '******************************************************************************
561 function AskNoYes (Question)
562 AskNoYes = MsgBox (Question, vbYesNo + vbQuestion + vbDefaultButton2, Installer)
567 '******************************************************************************
568 ' Tell the user that the installation was aborted and terminate the script
569 '******************************************************************************
571 call MsgBox (GetMsg ("MSG_ABORTINFO"), vbOkOnly + vbInformation, Installer)
577 '******************************************************************************
578 ' Input routine with the window caption preset
579 '******************************************************************************
580 function Input (Prompt, Default)
581 Input = InputBox (Prompt, Installer, Default)
586 '******************************************************************************
587 ' Check if a directory is a given the path
588 '******************************************************************************
589 function DirInPath (ByVal Dir)
593 ' Get the path in lower case
594 Path = LCase (GetEnv ("%Path%"))
596 ' Convert the directory to lower case
599 ' Split the path into separate entries
600 Entries = Split (Path, ";")
603 for I = LBound (Entries) to UBound (Entries)
604 if Entries(I) = Dir then
616 '******************************************************************************
617 ' Function that displays the paths and locations found
618 '******************************************************************************
619 function OneLoc (Key, Value)
622 if Len (Result) <= 8 then
623 Result = Result & Tab
625 OneLoc = Result & Tab & "=" & Tab & Value & NewLine
628 sub ShowPathsAndLocations ()
630 Msg = Msg & OneLoc ("SystemDrive", SystemDrive)
631 Msg = Msg & OneLoc ("SystemRoot", SystemRoot)
632 Msg = Msg & OneLoc ("UserName", UserName)
633 Msg = Msg & OneLoc ("UserProfile", UserProfile)
634 Msg = Msg & OneLoc ("ProgramFiles", ProgramFiles)
635 Msg = Msg & OneLoc ("AppData", AppData)
636 Msg = Msg & OneLoc ("InstallSource", InstallSource)
637 Msg = Msg & OneLoc ("InstallTarget", InstallTarget)
638 Msg = Msg & OneLoc ("Programs", Programs)
639 Msg = Msg & OneLoc ("Desktop", Desktop)
640 Msg = Msg & OneLoc ("Free space", ToString (GetDriveSpace (InstallTarget)))
642 call MsgBox (Msg, vbOkOnly, "Paths and Locations")
647 '******************************************************************************
648 ' Return the amount of free space for a path (in Megabytes)
649 '******************************************************************************
650 function GetDriveSpace (Path)
653 set Drive = FSO.GetDrive (FSO.GetDriveName (Path))
654 if Err.Number <> 0 then
657 GetDriveSpace = Drive.FreeSpace / (1024 * 1024)
663 '******************************************************************************
664 ' Check that were running this script as admin
665 '******************************************************************************
666 sub CheckAdminRights ()
668 ' FIXME: This check is not perfect
669 if UserName <> "Administrator" then
673 if AskNoYes (FmtMsg ("MSG_ADMIN", Args)) <> vbYes then
682 '******************************************************************************
683 ' Remove an old installation.
684 '******************************************************************************
685 sub RemoveOldInstall (UninstallCmd)
689 ' Execute the uninstall
690 ErrCode = Run (UninstallCmd, 0)
692 ' Tell the user that the uninstall is done
694 call Abort (GetMsg ("MSG_UNINSTALLERR"))
700 '******************************************************************************
701 ' Check if there is an old installation. Offer to remove it.
702 '******************************************************************************
703 sub CheckOldInstall ()
707 ' Read the uninstall command from the registry
708 UninstallCmd = RegReadStr (RegUninstall & "UninstallString")
710 ' Check if there is already an executable
711 if UninstallCmd <> "" then
713 ' Ask to remove an old install
714 if AskYesNo (GetMsg ("MSG_REMOVEOLD")) = vbYes then
715 ' Remove the old installation
716 call RemoveOldInstall (UninstallCmd)
725 '******************************************************************************
726 ' Check that the install target exists. Offer to create it.
727 '******************************************************************************
728 sub CheckInstallTarget ()
730 dim Msg, Result, Args(2)
732 ' Tell the user about the install target and ask if it's ok
733 Args(1) = InstallTarget
734 Msg = FmtMsg ("MSG_INSTALLPATH", Args)
735 if MsgBox (Msg, vbOkCancel, Installer) <> vbOk then
739 ' Check if there's enough space left on the target drive
740 if GetDriveSpace (InstallTarget) < SpaceNeeded then
741 Args(1) = FSO.GetDriveName (InstallTarget)
742 Args(2) = SpaceNeeded
743 call Abort (FmtMsg ("MSG_DRIVESPACE", Args))
746 ' Check if the install path exist, create it if necessary
747 if not FolderExists (InstallTarget) then
748 Result = CreateFolder (InstallTarget)
750 Args(1) = InstallTarget
752 call Abort (FmtMsg ("MSG_CREATEERR", Args))
760 '******************************************************************************
761 ' Create the uninstall control file
762 '******************************************************************************
763 sub CreateUninstallCtrlFile ()
767 ' Generate the filename
769 set UninstallCtrlFile = FSO.CreateTextFile (UninstallCtrlFileName, true)
771 if Err.Number <> 0 then
773 Args(1) = UninstallCtrlFileName
774 Args(2) = Err.Description
775 call ErrorMsg (FmtMsg ("MSG_CREATEERR", Args))
779 ' Write the name of the target directory to the file
780 call WriteUninstallCtrlFile ("D " & InstallTarget)
782 ' Write the name of the file itself to the file
783 call WriteUninstallCtrlFile ("F " & UninstallCtrlFileName)
789 '******************************************************************************
790 ' Write to the uninstall control file
791 '******************************************************************************
792 sub WriteUninstallCtrlFile (Line)
795 UninstallCtrlFile.WriteLine (Line)
796 if Err.Number <> 0 then
798 Args(1) = UninstallCtrlFileName
799 Args(2) = Err.Description
800 call ErrorMsg (FmtMsg ("MSG_WRITEERR", Args))
808 '******************************************************************************
809 ' Close the uninstall control file
810 '******************************************************************************
811 sub CloseUninstallCtrlFile ()
814 UninstallCtrlFile.Close
815 if Err.Number <> 0 then
817 Args(1) = UninstallCtrlFileName
818 Args(2) = Err.Description
819 call ErrorMsg (FmtMsg ("MSG_WRITEERR", Args))
827 '******************************************************************************
828 ' Copy the application files
829 '******************************************************************************
830 sub RecursiveCopy (Dir, SourcePath, TargetPath)
832 dim File, TargetFile, SubDir, SourceName, TargetName, Result, Args(3)
834 ' Copy all files in this folder
835 for each File in Dir.Files
837 ' Generate source and target file names
838 SourceName = BuildPath (SourcePath, File.Name)
839 TargetName = BuildPath (TargetPath, File.Name)
841 ' Copy the file. The error check doesn't seem to work.
843 File.Copy (TargetName)
845 if Err.Number <> 0 then
848 Args(3) = Err.Description
849 call ErrorMsg (FmtMsg ("MSG_COPYERR", Args))
853 ' Remove the r/o attribute from the target file if set
854 set TargetFile = FSO.GetFile (TargetName)
855 if TargetFile.Attributes mod 2 = 1 then
856 TargetFile.Attributes = TargetFile.Attributes - 1
859 ' Remember this file in the uninstall control file
860 call WriteUninstallCtrlFile ("F " & TargetName)
863 ' Handle all subdirectories
864 for each SubDir in Dir.SubFolders
866 ' Update the progress bar with each copied directory
868 call ProgressBar (PBVal + 5)
871 ' Generate the new directory names
872 SourceName = BuildPath (SourcePath, SubDir.Name)
873 TargetName = BuildPath (TargetPath, SubDir.Name)
875 ' Generate the new target dir. Notify the user about errors, but
876 ' otherwise ignore them.
877 Result = CreateFolder (TargetName)
879 ' Display an error but try to continue
882 call ErrorMsg (FmtMsg ("MSG_CREATEERR", Args))
885 ' Recursively process files in the subdirectory
886 call RecursiveCopy (SubDir, SourceName, TargetName)
888 ' Remember the subdirectory in the uninstall control file
889 WriteUninstallCtrlFile ("D " & TargetName)
896 ' Update the progress bar
897 call ProgressBar (10)
899 ' Copy all files generating entries in the uninstall control file
900 call RecursiveCopy (FSO.GetFolder (InstallSource), InstallSource, InstallTarget)
902 ' Update the progress bar
903 call ProgressBar (90)
908 '******************************************************************************
909 ' Create the registry entries
910 '******************************************************************************
911 sub CreateRegEntries ()
915 ' Create the entry in Systemsteuerung -> Software. Check if the first write
916 ' succeeds. If not, we don't have admin rights.
917 if RegWriteBin (RegUninstall, 1) <> "" then
918 call Abort (GetMsg ("MSG_REGWRITEERR"))
920 call RegWriteStr (RegUninstall & "DisplayName", AppName & " " & Version)
921 call RegWriteStr (RegUninstall & "UninstallString", "wscript //nologo " & Uninstaller & " " & UninstallerCmdLine)
927 '******************************************************************************
928 ' Function that creates an URL
929 '******************************************************************************
930 sub CreateUrl (Name, Url, Description)
935 set Link = Shell.CreateShortcut (Name)
936 Link.TargetPath = Url
937 Link.Description = Description
943 ' Write the file name to the uninstall control file
944 WriteUninstallCtrlFile ("F " & Name)
949 '******************************************************************************
950 ' Function that creates a shortcut
951 '******************************************************************************
952 sub CreateShortcut (Name, Exe, Args, Description)
957 set Link = Shell.CreateShortcut (Name)
958 Link.TargetPath = Exe
959 Link.Arguments = Args
961 Link.Description = Description
962 Link.WorkingDirectory = AppData
968 ' Write the file name to the uninstall control file
969 WriteUninstallCtrlFile ("F " & Name)
974 '******************************************************************************
975 ' Function that creates the menu entries
976 '******************************************************************************
977 sub CreateMenuEntries ()
978 dim Folder, Result, Name, Desc, Exe, Args(2)
980 ' Create the start menu folder.
981 Folder = BuildPath (Programs, AppName)
982 Result = CreateFolder (Folder)
984 ' Display an error but try to continue
987 call ErrorMsg (FmtMsg ("MSG_CREATEERR", Args))
990 ' Create an uninstall shortcut in the menu folder
992 Desc = FmtMsg ("MSG_REMOVEENTRY", Args)
993 Name = BuildPath (Folder, Desc & ".lnk")
994 call CreateShortcut (Name, Uninstaller, UninstallerCmdLine, Desc)
996 ' Create a documentation shortcut in the menu folder
998 Desc = FmtMsg ("MSG_DOCENTRY", Args)
999 Name = BuildPath (Folder, Desc & ".url")
1000 Exe = "file://" & BuildPath (InstallTarget, DocIndexFile)
1001 call CreateUrl (Name, Exe, Desc)
1003 ' Create the shortcut to the announcement in the menu folder
1004 Desc = GetMsg ("MSG_ANNOUNCEMENT")
1005 Name = BuildPath (Folder, Desc & ".url")
1006 Exe = "file://" & BuildPath (InstallTarget, AnnouncementFile)
1007 call CreateUrl (Name, Exe, Desc)
1009 ' Update the uninstall control file
1010 call WriteUninstallCtrlFile ("D " & Folder)
1015 '******************************************************************************
1016 ' Add a directory to the system path
1017 '******************************************************************************
1018 sub AddToSysPath (Dir)
1022 ' Handle errors. Assume failure
1023 on error resume next
1025 ' Retrieve the PATH setting
1026 Path = Shell.RegRead (SysPath)
1027 if Err.Number <> 0 then
1029 call Abort (GetMsg ("MSG_REGREADERR"))
1032 ' Add the new directory to the path
1033 if (Len (Path) > 0) and (Right (Path, 1) <> ";") then
1038 ' Write the new path
1039 call Shell.RegWrite (SysPath, Path, "REG_EXPAND_SZ")
1040 if Err.Number <> 0 then
1042 call Abort (GetMsg ("MSG_REGWRITEERR"))
1048 '******************************************************************************
1049 ' Add environment variables
1050 '******************************************************************************
1051 sub AddEnvironment ()
1054 if RegWriteStr (SysEnv & "\CC65_LIB", LibDir) <> "" then
1055 call Abort (GetMsg ("MSG_REGWRITEERR"))
1059 if RegWriteStr (SysEnv & "\CC65_INC", IncDir) <> "" then
1060 call Abort (GetMsg ("MSG_REGWRITEERR"))
1063 ' Add the bin directory to the path if it's not already there
1064 if not DirInPath (BinDir) then
1065 call AddToSysPath (BinDir)
1067 ' Run the wm_settingchange program to notify other running programs
1068 ' of the changed environment. Ignore errors.
1069 call Run (BuildPath (BinDir, "wm_settingchange.exe"), 0)
1076 '******************************************************************************
1077 ' Function that tells the user that the install was successful
1078 '******************************************************************************
1080 call MsgBox (GetMsg ("MSG_SUCCESS"), vbOkOnly + vbInformation, Installer)
1085 '******************************************************************************
1087 '******************************************************************************
1090 ' Initialize global variables. This includes the paths used
1091 call InitializeGlobals ()
1093 call ShowPathsAndLocations ()
1096 ' Check that we're running this script as admin
1097 call CheckAdminRights ()
1099 ' Check if there is an old installation and offer to remove it
1100 call CheckOldInstall ()
1102 ' Check if the source directory does really exist
1103 call CheckInstallTarget ()
1105 ' Display the progress bar
1106 call ProgressBar (0)
1108 ' Create the uninstall file
1109 call CreateUninstallCtrlFile ()
1110 call ProgressBar (2)
1112 ' Create registry entries
1114 call Progressbar (5)
1116 ' Copy the application files (will do automatic progress bar updates)
1119 ' Create the menu entries
1120 call CreateMenuEntries ()
1121 call ProgressBar (90)
1123 ' Add entries to the enviroment
1124 call AddEnvironment ()
1125 call ProgressBar (95)
1127 ' Close the uninstall control file
1128 call CloseUninstallCtrlFile ()
1131 call ProgressBar (100)
1132 call ProgressBar (-1)
1135 ' Return a success code
1141 '******************************************************************************
1142 ' The script body just calls Main...
1143 '******************************************************************************