git.sur5r.net Git - cc65/blob - packages/windows/install.vbs

   1 Option Explicit                 ' Variables must be declared explicitly
   2
   3
   4
   5 '******************************************************************************
   6 ' Installer defaults.
   7 '******************************************************************************
   8 const AppName     = "cc65"
   9 const Version     = "2.10.1"
  10 const Installer   = "cc65 Installer"
  11 const SpaceNeeded = 20                  ' Free space needed on drive in MB
  12 const Shortcut    = true                ' Create shortcut on desktop
  13
  14
  15
  16 '******************************************************************************
  17 ' Global constants
  18 '******************************************************************************
  19 const SysEnv  = "HKLM\System\CurrentControlSet\Control\Session Manager\Environment"
  20 const SysPath = "HKLM\System\CurrentControlSet\Control\Session Manager\Environment\Path"
  21
  22
  23
  24 '******************************************************************************
  25 ' Global variables
  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
  52
  53
  54
  55 '******************************************************************************
  56 ' Display an error message window with an OK button
  57 '******************************************************************************
  58 sub ErrorMsg (Msg)
  59     call MsgBox (Msg, vbOkOnly + vbExclamation, Installer)
  60 end sub
  61
  62
  63
  64 '******************************************************************************
  65 ' Display an error message window and abort the installer
  66 '******************************************************************************
  67 sub Abort (Msg)
  68     call ErrorMsg (Msg)
  69     WScript.Quit (1)
  70 end sub
  71
  72
  73
  74 '******************************************************************************
  75 ' Display a message with an OK button
  76 '******************************************************************************
  77 sub Message (Msg)
  78     call MsgBox (Msg, vbOkOnly + vbInformation, Installer)
  79 end sub
  80
  81
  82
  83 '******************************************************************************
  84 ' Convert a number to a string
  85 '******************************************************************************
  86 function ToString (Num)
  87     ToString = FormatNumber (Num, vbFalse, vbTrue, vbFalse, vbFalse)
  88 end function
  89
  90
  91
  92 '******************************************************************************
  93 ' Return a message in the current language
  94 '******************************************************************************
  95 function GetMsg (Key)
  96     dim Msg
  97
  98     ' Handle other languages here
  99
 100     ' Default is english
 101     if IsEmpty (Msg) then
 102         ' No assignment, use english
 103         select case Key
 104             case "MSG_ABORTINFO"
 105                 Msg = "Installation was aborted."
 106             case "MSG_ADMIN"
 107                 Msg = "You must be Administrator to install %1."
 108                 Msg = Msg & " Are you sure you want to continue?"
 109             case "MSG_COPYERR"
 110                 Msg = "Cannot copy %1 to %2: " & NewLine & "%3"
 111             case "MSG_CREATEDIR"
 112                 Msg = "%1 does not exist." & NewLine & "Create it?"
 113             case "MSG_CREATEERR"
 114                 Msg = "Cannot create %1:" & NewLine & "%2"
 115             case "MSG_DELETEERR"
 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"
 122             case "MSG_DOCENTRY"
 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"
 129                 Msg = "Remove %1"
 130             case "MSG_REMOVEDIR"
 131                 Msg = "A folder with the name %1 does already exist."
 132                 Msg = Msg & " Is it ok to remove the folder?"
 133             case "MSG_REMOVEOLD"
 134                 Msg = "Found an old version. Remove it?"
 135             case "MSG_SUCCESS"
 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"
 143             case else
 144                 Msg = Key
 145         end select
 146     end if
 147     GetMsg = Msg
 148 end function
 149
 150
 151
 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))
 161             case vbEmpty
 162                 Val = ""
 163             case vbInteger
 164                 Val = ToString (Values (I))
 165             case vbLong
 166                 Val = ToString (Values (I))
 167             case vbNull
 168                 Val = ""
 169             case vbSingle
 170                 Val = ToString (Values (I))
 171             case vbDouble
 172                 Val = ToString (Values (I))
 173             case vbString
 174                 Val = Values (I)
 175             case else
 176                 Abort ("Internal error: Invalid conversion in Format()")
 177         end select
 178         F = Replace (F, Key, Val)
 179     next
 180     Fmt = F
 181 end function
 182
 183
 184
 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)
 190 end function
 191
 192
 193
 194 '******************************************************************************
 195 ' Return an environment string. Fix up Microsofts "innovative" ideas.
 196 '******************************************************************************
 197 function GetEnv (Key)
 198     dim Value
 199     Value = Shell.ExpandEnvironmentStrings (Key)
 200     if Value = Key then
 201         GetEnv = vbNullString
 202     else
 203         GetEnv = Value
 204     end if
 205 end function
 206
 207
 208
 209 '******************************************************************************
 210 ' Build a path from two components
 211 '******************************************************************************
 212 function BuildPath (Path, Name)
 213     BuildPath = FSO.BuildPath (Path, Name)
 214 end function
 215
 216
 217
 218 '******************************************************************************
 219 ' Return true if the file with the given name exists
 220 '******************************************************************************
 221 function FileExists (Name)
 222     On Error Resume Next
 223     FileExists = FSO.FileExists (Name)
 224 end function
 225
 226
 227
 228 '******************************************************************************
 229 ' Return true if the folder with the given name exists
 230 '******************************************************************************
 231 function FolderExists (Name)
 232     On Error Resume Next
 233     FolderExists = FSO.FolderExists (Name)
 234 end function
 235
 236
 237
 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 & "\"
 244     end if
 245     On Error Resume Next
 246     call FSO.CopyFile (Source, Target)
 247     on error goto 0
 248     CopyFile = Err.Description
 249 end function
 250
 251
 252
 253 '******************************************************************************
 254 ' Create a folder and all parent folders and return an error string
 255 '******************************************************************************
 256 function CreateFolder (Path)
 257
 258     ' If the parent folder does not exist, try to create it
 259     dim ParentFolder
 260     ParentFolder = FSO.GetParentFolderName (Path)
 261     if ParentFolder <> "" and not FolderExists (ParentFolder) then
 262         CreateFolder (ParentFolder)
 263     end if
 264
 265     ' Now try to create the actual folder
 266     On Error Resume Next
 267     FSO.CreateFolder (Path)
 268     CreateFolder = Err.Description
 269
 270 end function
 271
 272
 273
 274 '******************************************************************************
 275 ' Delete a file and return an error string
 276 '******************************************************************************
 277 function DeleteFile (Name)
 278     On Error Resume Next
 279     call FSO.DeleteFile (Name, true)
 280     DeleteFile = Err.Description
 281 end function
 282
 283
 284
 285 '******************************************************************************
 286 ' Delete a folder and return an error string
 287 '******************************************************************************
 288 function DeleteFolder (Path)
 289     On Error Resume Next
 290     call FSO.DeleteFolder (Path, true)
 291     DeleteFolder = Err.Description
 292 end function
 293
 294
 295
 296 '******************************************************************************
 297 ' Return the type of a registry entry
 298 '******************************************************************************
 299 function RegType (Value)
 300
 301     dim Result
 302
 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
 307     ' here...
 308     Result = InStr (1, Value, "%")
 309     if Result = 0 then
 310         RegType = "REG_SZ"
 311     else
 312         RegType = "REG_EXPAND_SZ"
 313     end if
 314 end function
 315
 316
 317
 318 '******************************************************************************
 319 ' Read a string from the registry. Return an empty string if nothing was found.
 320 '******************************************************************************
 321 function RegReadStr (Key)
 322     On Error Resume Next
 323     RegReadStr = Shell.RegRead (Key)
 324     if Err.Number <> 0 then
 325         RegReadStr = ""
 326     end if
 327 end function
 328
 329
 330
 331 '******************************************************************************
 332 ' Write a binary value to the registry, return an error description
 333 '******************************************************************************
 334 function RegWriteBin (Key, Value)
 335     on error resume next
 336     Shell.RegWrite Key, Value, "REG_BINARY"
 337     RegWriteBin = Err.Description
 338     on error goto 0
 339     WriteUninstallCtrlFile ("R " & Key)
 340 end function
 341
 342
 343
 344 '******************************************************************************
 345 ' Write a string value to the registry, return an error description
 346 '******************************************************************************
 347 function RegWriteStr (Key, Value)
 348     on error resume next
 349     Shell.RegWrite Key, Value, "REG_SZ"
 350     RegWriteStr = Err.Description
 351     on error goto 0
 352     WriteUninstallCtrlFile ("R " & Key)
 353 end function
 354
 355
 356
 357 '******************************************************************************
 358 ' Run a program, wait for its termination and return an error code.
 359 '******************************************************************************
 360 function Run (Cmd, WinState)
 361     dim ErrCode
 362
 363     On Error Resume Next
 364     ErrCode = Shell.Run (Cmd, WinState, true)
 365     if Err.Number <> 0 then
 366         ErrCode = Err.Number
 367     end if
 368     Run = ErrCode
 369 end function
 370
 371
 372
 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
 379 set PBDoc = nothing
 380 set IEApp = nothing
 381 PBVal = -1
 382
 383 sub ProgressBar (Percent)
 384
 385     ' Remember the last setting
 386     PBVal = Percent
 387
 388     'Create the progress bar window
 389     if PBDoc is nothing then
 390
 391         if ((Cint (Percent) < 0) or (Cint (Percent) > 100)) then
 392             ' Close request, but object already destroyed
 393             exit sub
 394         end if
 395
 396         ' Create an object that control the internet exploder
 397         set IEApp = CreateObject ("InternetExplorer.Application")
 398
 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
 406
 407         ' Now prepare the actual window
 408         IEApp.Offline    = true
 409         IEApp.AddressBar = false
 410         IEApp.Height     = 100
 411         IEApp.Width      = 250
 412         IEApp.MenuBar    = false
 413         IEApp.StatusBar  = false
 414         IEApp.Silent     = true
 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")
 420         do while IEApp.Busy
 421             call WScript.Sleep (100)
 422         loop
 423
 424         ' Connect to the displayed document
 425         do until not PBDoc is nothing
 426             call WScript.Sleep (100)
 427             set PBDoc = IEApp.Document
 428         loop
 429
 430         ' Generate a new document showing a progress bar
 431         PBDoc.Open
 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>&nbsp</td></tr></table>")
 437         call PBDoc.Write ("</td></tr></table>")
 438         call PBDoc.Write ("</center></body></html>")
 439         PBDoc.Close
 440
 441         ' Display the exploder window
 442         IEApp.Visible = true
 443
 444     else
 445         if ((Cint (Percent) < 0) or (Cint (Percent) > 100)) then
 446             ' Request for shutdown
 447             IEApp.Visible = false
 448             set PBDoc = nothing
 449             IEApp.Quit
 450             set IEApp = nothing
 451         else
 452             ' Update the progress bar
 453             if Cint (Percent) = 0 then
 454                 PBDoc.all.progress.width = "1%"
 455                 PBDoc.all.progress.bgcolor = "#C0C0C0"
 456             else
 457                 PBDoc.all.progress.width = Cstr (Cint (Percent)) & "%"
 458                 PBDoc.all.progress.bgcolor = "#0000C0"
 459             end if
 460         end if
 461     end if
 462 end sub
 463
 464
 465
 466 '******************************************************************************
 467 ' Initialize global variables
 468 '******************************************************************************
 469 sub InitializeGlobals ()
 470     dim I
 471
 472     ' String stuff used for formatting
 473     Tab     = Chr (9)
 474     NewLine = Chr (13)
 475
 476     ' Global objects
 477     set Shell = WScript.CreateObject ("WScript.Shell")
 478     set FSO   = CreateObject ("Scripting.FileSystemObject")
 479
 480     ' Arguments
 481     set ProgArgs = WScript.Arguments
 482
 483     ' Handle program arguments
 484     Dbg = false
 485     Language = "de"
 486     for I = 0 to ProgArgs.Count-1
 487         select case ProgArgs(I)
 488             case "-de"
 489                 Language = "de"
 490             case "-debug"
 491                 Dbg = true
 492             case "-en"
 493                 Language = "en"
 494         end select
 495     next
 496
 497     ' Paths and locations
 498     SystemDrive = GetEnv ("%SystemDrive%")
 499     if SystemDrive = vbNullString then
 500         SystemDrive = "c:"
 501     end if
 502     SystemRoot = GetEnv ("%SystemRoot%")
 503     if SystemRoot = vbNullString then
 504         SystemRoot = BuildPath (SystemDrive, "winnt")
 505     end if
 506     UserName = GetEnv ("%USERNAME%")
 507     if UserName = vbNullString then
 508         UserName = "Administrator"
 509     end if
 510     UserProfile = GetEnv ("%USERPROFILE%")
 511     if UserProfile = vbNullString then
 512         UserProfile = BuildPath (SystemDrive, "Dokumente und Einstellungen\" & UserName)
 513     end if
 514     ProgramFiles = GetEnv ("%ProgramFiles%")
 515     if ProgramFiles = vbNullString then
 516         ProgramFiles = BuildPath (SystemDrive, "Programme")
 517     end if
 518     AppData = GetEnv ("%AppData%")
 519     if AppData = vbNullString then
 520         AppData = UserProfile
 521     end if
 522     InstallSource = FSO.GetParentFolderName (WScript.ScriptFullName)
 523     InstallTarget = BuildPath (ProgramFiles, AppName)
 524
 525     Programs = Shell.SpecialFolders ("AllUsersPrograms")
 526     Desktop  = Shell.SpecialFolders ("AllUsersDesktop")
 527
 528     ' Uninstaller
 529     set UninstallCtrlFile = nothing
 530     Uninstaller = BuildPath (InstallTarget, "uninstall.vbs")
 531     UninstallCtrlFileName = BuildPath (InstallTarget, "uninstall.lst")
 532     UninstallerCmdLine = "-" & Language & " " & AppName & " " & UninstallCtrlFileName
 533
 534     ' Registry paths
 535     RegUninstall = "HKLM\Software\Microsoft\Windows\CurrentVersion\Uninstall\" & AppName & "\"
 536
 537     ' Directories
 538     BinDir = BuildPath (InstallTarget, "bin")
 539     LibDir = BuildPath (InstallTarget, "lib")
 540     IncDir = BuildPath (InstallTarget, "include")
 541
 542     ' Files
 543     AnnouncementFile = "announce.txt"
 544     DocIndexFile     = "doc\index.html"
 545 end sub
 546
 547
 548
 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)
 554 end function
 555
 556
 557
 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)
 563 end function
 564
 565
 566
 567 '******************************************************************************
 568 ' Tell the user that the installation was aborted and terminate the script
 569 '******************************************************************************
 570 sub InfoAbort ()
 571     call MsgBox (GetMsg ("MSG_ABORTINFO"), vbOkOnly + vbInformation, Installer)
 572     WScript.Quit (0)
 573 end sub
 574
 575
 576
 577 '******************************************************************************
 578 ' Input routine with the window caption preset
 579 '******************************************************************************
 580 function Input (Prompt, Default)
 581     Input = InputBox (Prompt, Installer, Default)
 582 end function
 583
 584
 585
 586 '******************************************************************************
 587 ' Check if a directory is a given the path
 588 '******************************************************************************
 589 function DirInPath (ByVal Dir)
 590
 591     dim Path, Entries, I
 592
 593     ' Get the path in lower case
 594     Path = GetEnv ("%Path%")
 595
 596     ' Convert the directory to lower case
 597     Dir = LCase (Dir)
 598
 599     ' Split the path into separate entries
 600     Entries = Split (Path, ";")
 601
 602     ' Check all entries
 603     for I = LBound (Entries) to UBound (Entries)
 604         if Entries(I) = Dir then
 605             DirInPath = true
 606             exit function
 607         end if
 608     next
 609
 610     DirInPath = false
 611 end function
 612
 613
 614
 615
 616 '******************************************************************************
 617 ' Function that displays the paths and locations found
 618 '******************************************************************************
 619 function OneLoc (Key, Value)
 620     dim Result
 621     Result = Trim (Key)
 622     if Len (Result) <= 8 then
 623         Result = Result & Tab
 624     end if
 625     OneLoc = Result & Tab & "=" & Tab & Value & NewLine
 626 end function
 627
 628 sub ShowPathsAndLocations ()
 629     dim Msg
 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)))
 641
 642     call MsgBox (Msg, vbOkOnly, "Paths and Locations")
 643 end sub
 644
 645
 646
 647 '******************************************************************************
 648 ' Return the amount of free space for a path (in Megabytes)
 649 '******************************************************************************
 650 function GetDriveSpace (Path)
 651     dim Drive
 652     On Error Resume Next
 653     set Drive = FSO.GetDrive (FSO.GetDriveName (Path))
 654     if Err.Number <> 0 then
 655         GetDriveSpace = 0
 656     else
 657         GetDriveSpace = Drive.FreeSpace / (1024 * 1024)
 658     end if
 659 end function
 660
 661
 662
 663 '******************************************************************************
 664 ' Check that were running this script as admin
 665 '******************************************************************************
 666 sub CheckAdminRights ()
 667
 668     ' FIXME: This check is not perfect
 669     if UserName <> "Administrator" then
 670         dim Args(1)
 671         Args(1) = AppName
 672
 673         if AskNoYes (FmtMsg ("MSG_ADMIN", Args)) <> vbYes then
 674             WScript.Quit (1)
 675         end if
 676     end if
 677
 678 end sub
 679
 680
 681
 682 '******************************************************************************
 683 ' Remove an old installation.
 684 '******************************************************************************
 685 sub RemoveOldInstall (UninstallCmd)
 686
 687     dim ErrCode
 688
 689     ' Execute the uninstall
 690     ErrCode = Run (UninstallCmd, 0)
 691
 692     ' Tell the user that the uninstall is done
 693     if ErrCode <> 0 then
 694         call Abort (GetMsg ("MSG_UNINSTALLERR"))
 695     end if
 696 end sub
 697
 698
 699
 700 '******************************************************************************
 701 ' Check if there is an old installation. Offer to remove it.
 702 '******************************************************************************
 703 sub CheckOldInstall ()
 704
 705     dim UninstallCmd
 706
 707     ' Read the uninstall command from the registry
 708     UninstallCmd = RegReadStr (RegUninstall & "UninstallString")
 709
 710     ' Check if there is already an executable
 711     if UninstallCmd <> "" then
 712
 713         ' Ask to remove an old install
 714         if AskYesNo (GetMsg ("MSG_REMOVEOLD")) = vbYes then
 715             ' Remove the old installation
 716             call RemoveOldInstall (UninstallCmd)
 717         end if
 718
 719     end if
 720
 721 end sub
 722
 723
 724
 725 '******************************************************************************
 726 ' Check that the install target exists. Offer to create it.
 727 '******************************************************************************
 728 sub CheckInstallTarget ()
 729
 730     dim Msg, Result, Args(2)
 731
 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
 736         call InfoAbort ()
 737     end if
 738
 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))
 744     end if
 745
 746     ' Check if the install path exist, create it if necessary
 747     if not FolderExists (InstallTarget) then
 748         Result = CreateFolder (InstallTarget)
 749         if Result <> "" then
 750             Args(1) = InstallTarget
 751             Args(2) = Result
 752             call Abort (FmtMsg ("MSG_CREATEERR", Args))
 753         end if
 754     end if
 755
 756 end sub
 757
 758
 759
 760 '******************************************************************************
 761 ' Create the uninstall control file
 762 '******************************************************************************
 763 sub CreateUninstallCtrlFile ()
 764
 765     dim Filename
 766
 767     ' Generate the filename
 768     on Error resume next
 769     set UninstallCtrlFile = FSO.CreateTextFile (UninstallCtrlFileName, true)
 770     on error goto 0
 771     if Err.Number <> 0 then
 772         dim Args(2)
 773         Args(1) = UninstallCtrlFileName
 774         Args(2) = Err.Description
 775         call ErrorMsg (FmtMsg ("MSG_CREATEERR", Args))
 776         WScript.Quit (1)
 777     end if
 778
 779     ' Write the name of the target directory to the file
 780     call WriteUninstallCtrlFile ("D " & InstallTarget)
 781
 782     ' Write the name of the file itself to the file
 783     call WriteUninstallCtrlFile ("F " & UninstallCtrlFileName)
 784
 785 end sub
 786
 787
 788
 789 '******************************************************************************
 790 ' Write to the uninstall control file
 791 '******************************************************************************
 792 sub WriteUninstallCtrlFile (Line)
 793
 794     on error resume next
 795     UninstallCtrlFile.WriteLine (Line)
 796     if Err.Number <> 0 then
 797         dim Args(2)
 798         Args(1) = UninstallCtrlFileName
 799         Args(2) = Err.Description
 800         call ErrorMsg (FmtMsg ("MSG_WRITEERR", Args))
 801         WScript.Quit (1)
 802     end if
 803
 804 end sub
 805
 806
 807
 808 '******************************************************************************
 809 ' Close the uninstall control file
 810 '******************************************************************************
 811 sub CloseUninstallCtrlFile ()
 812
 813     on error resume next
 814     UninstallCtrlFile.Close
 815     if Err.Number <> 0 then
 816         dim Args(2)
 817         Args(1) = UninstallCtrlFileName
 818         Args(2) = Err.Description
 819         call ErrorMsg (FmtMsg ("MSG_WRITEERR", Args))
 820         WScript.Quit (1)
 821     end if
 822
 823 end sub
 824
 825
 826
 827 '******************************************************************************
 828 ' Copy the application files
 829 '******************************************************************************
 830 sub RecursiveCopy (Dir, SourcePath, TargetPath)
 831
 832     dim File, TargetFile, SubDir, SourceName, TargetName, Result, Args(3)
 833
 834     ' Copy all files in this folder
 835     for each File in Dir.Files
 836
 837         ' Generate source and target file names
 838         SourceName = BuildPath (SourcePath, File.Name)
 839         TargetName = BuildPath (TargetPath, File.Name)
 840
 841         ' Copy the file. The error check doesn't seem to work.
 842         on error resume next
 843         File.Copy (TargetName)
 844         on error goto 0
 845         if Err.Number <> 0 then
 846             Args(1) = SourceName
 847             Args(2) = TargetName
 848             Args(3) = Err.Description
 849             call ErrorMsg (FmtMsg ("MSG_COPYERR", Args))
 850             call AbortInfo ()
 851         end if
 852
 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
 857         end if
 858
 859         ' Remember this file in the uninstall control file
 860         call WriteUninstallCtrlFile ("F " & TargetName)
 861     next
 862
 863     ' Handle all subdirectories
 864     for each SubDir in Dir.SubFolders
 865
 866         ' Update the progress bar with each copied directory
 867         if PBVal <= 80 then
 868             call ProgressBar (PBVal + 5)
 869         end if
 870
 871         ' Generate the new directory names
 872         SourceName = BuildPath (SourcePath, SubDir.Name)
 873         TargetName = BuildPath (TargetPath, SubDir.Name)
 874
 875         ' Generate the new target dir. Notify the user about errors, but
 876         ' otherwise ignore them.
 877         Result = CreateFolder (TargetName)
 878         if Result <> "" then
 879             ' Display an error but try to continue
 880             Args(1) = TargetName
 881             Args(2) = Result
 882             call ErrorMsg (FmtMsg ("MSG_CREATEERR", Args))
 883         end if
 884
 885         ' Recursively process files in the subdirectory
 886         call RecursiveCopy (SubDir, SourceName, TargetName)
 887
 888         ' Remember the subdirectory in the uninstall control file
 889         WriteUninstallCtrlFile ("D " & TargetName)
 890
 891     next
 892 end sub
 893
 894 sub CopyFiles ()
 895
 896     ' Update the progress bar
 897     call ProgressBar (10)
 898
 899     ' Copy all files generating entries in the uninstall control file
 900     call RecursiveCopy (FSO.GetFolder (InstallSource), InstallSource, InstallTarget)
 901
 902     ' Update the progress bar
 903     call ProgressBar (90)
 904 end sub
 905
 906
 907
 908 '******************************************************************************
 909 ' Create the registry entries
 910 '******************************************************************************
 911 sub CreateRegEntries ()
 912
 913     dim Cmd
 914
 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"))
 919     end if
 920     call RegWriteStr (RegUninstall & "DisplayName", AppName & " " & Version)
 921     call RegWriteStr (RegUninstall & "UninstallString", "wscript //nologo " & Uninstaller & " " & UninstallerCmdLine)
 922
 923 end sub
 924
 925
 926
 927 '******************************************************************************
 928 ' Function that creates an URL
 929 '******************************************************************************
 930 sub CreateUrl (Name, Url, Description)
 931     ' Ignore errors
 932     On Error Resume Next
 933
 934     dim Link
 935     set Link = Shell.CreateShortcut (Name)
 936     Link.TargetPath = Url
 937     Link.Description = Description
 938     Link.Save
 939
 940     ' Allow errors again
 941     on error goto 0
 942
 943     ' Write the file name to the uninstall control file
 944     WriteUninstallCtrlFile ("F " & Name)
 945 end sub
 946
 947
 948
 949 '******************************************************************************
 950 ' Function that creates a shortcut
 951 '******************************************************************************
 952 sub CreateShortcut (Name, Exe, Args, Description)
 953     ' Ignore errors
 954     On Error Resume Next
 955
 956     dim Link
 957     set Link = Shell.CreateShortcut (Name)
 958     Link.TargetPath  = Exe
 959     Link.Arguments   = Args
 960     Link.WindowStyle = 1
 961     Link.Description = Description
 962     Link.WorkingDirectory = AppData
 963     Link.Save
 964
 965     ' Allow errors again
 966     on error goto 0
 967
 968     ' Write the file name to the uninstall control file
 969     WriteUninstallCtrlFile ("F " & Name)
 970 end sub
 971
 972
 973
 974 '******************************************************************************
 975 ' Function that creates the menu entries
 976 '******************************************************************************
 977 sub CreateMenuEntries ()
 978     dim Folder, Result, Name, Desc, Exe, Args(2)
 979
 980     ' Create the start menu folder.
 981     Folder = BuildPath (Programs, AppName)
 982     Result = CreateFolder (Folder)
 983     if Result <> "" then
 984         ' Display an error but try to continue
 985         Args(1) = Folder
 986         Args(2) = Result
 987         call ErrorMsg (FmtMsg ("MSG_CREATEERR", Args))
 988     end if
 989
 990     ' Create an uninstall shortcut in the menu folder
 991     Args(1) = AppName
 992     Desc = FmtMsg ("MSG_REMOVEENTRY", Args)
 993     Name = BuildPath (Folder, Desc & ".lnk")
 994     call CreateShortcut (Name, Uninstaller, UninstallerCmdLine, Desc)
 995
 996     ' Create a documentation shortcut in the menu folder
 997     Args(1) = AppName
 998     Desc = FmtMsg ("MSG_DOCENTRY", Args)
 999     Name = BuildPath (Folder, Desc & ".url")
1000     Exe  = "file://" & BuildPath (InstallTarget, DocIndexFile)
1001     call CreateUrl (Name, Exe, Desc)
1002
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)
1008
1009     ' Update the uninstall control file
1010     call WriteUninstallCtrlFile ("D " & Folder)
1011 end sub
1012
1013
1014
1015 '******************************************************************************
1016 ' Add a directory to the system path
1017 '******************************************************************************
1018 sub AddToSysPath (Dir)
1019
1020     dim Path
1021
1022     ' Handle errors. Assume failure
1023     on error resume next
1024
1025     ' Retrieve the PATH setting
1026     Path = Shell.RegRead (SysPath)
1027     if Err.Number <> 0 then
1028         ' Could not read
1029         call Abort (GetMsg ("MSG_REGREADERR"))
1030     end if
1031
1032     ' Add the new directory to the path
1033     if (Len (Path) > 0) and (Right (Path, 1) <> ";") then
1034         Path = Path + ";"
1035     end if
1036     Path = Path + Dir
1037
1038     ' Write the new path
1039     call Shell.RegWrite (SysPath, Path, "REG_EXPAND_SZ")
1040     if Err.Number <> 0 then
1041         ' Could not set
1042         call Abort (GetMsg ("MSG_REGWRITEERR"))
1043     end if
1044 end sub
1045
1046
1047
1048 '******************************************************************************
1049 ' Add environment variables
1050 '******************************************************************************
1051 sub AddEnvironment ()
1052
1053     ' Add CC65_LIB
1054     if RegWriteStr (SysEnv & "\CC65_LIB", LibDir) <> "" then
1055         call Abort (GetMsg ("MSG_REGWRITEERR"))
1056     end if
1057
1058     ' Add CC65_INC
1059     if RegWriteStr (SysEnv & "\CC65_INC", IncDir) <> "" then
1060         call Abort (GetMsg ("MSG_REGWRITEERR"))
1061     end if
1062
1063     ' Add the bin directory to the path
1064     call AddToSysPath (BinDir)
1065
1066     ' Run the wm_settingchange program to notify other running programs
1067     ' of the changed environment. Ignore errors.
1068     call Run (BuildPath (BinDir, "wm_settingchange.exe"), 0)
1069
1070
1071 end sub
1072
1073
1074
1075 '******************************************************************************
1076 ' Function that tells the user that the install was successful
1077 '******************************************************************************
1078 sub Success ()
1079     call MsgBox (GetMsg ("MSG_SUCCESS"), vbOkOnly + vbInformation, Installer)
1080 end sub
1081
1082
1083
1084 '******************************************************************************
1085 ' Main program
1086 '******************************************************************************
1087 sub Main ()
1088
1089     ' Initialize global variables. This includes the paths used
1090     call InitializeGlobals ()
1091     if Dbg then
1092         call ShowPathsAndLocations ()
1093     end if
1094
1095     ' Check that we're running this script as admin
1096     call CheckAdminRights ()
1097
1098     ' Check if there is an old installation and offer to remove it
1099     call CheckOldInstall ()
1100
1101     ' Check if the source directory does really exist
1102     call CheckInstallTarget ()
1103
1104     ' Display the progress bar
1105     call ProgressBar (0)
1106
1107     ' Create the uninstall file
1108     call CreateUninstallCtrlFile ()
1109     call ProgressBar (2)
1110
1111     ' Create registry entries
1112     CreateRegEntries ()
1113     call Progressbar (5)
1114
1115     ' Copy the application files (will do automatic progress bar updates)
1116     call CopyFiles ()
1117
1118     ' Create the menu entries
1119     call CreateMenuEntries ()
1120     call ProgressBar (90)
1121
1122     ' Add entries to the enviroment
1123     call AddEnvironment ()
1124     call ProgressBar (95)
1125
1126     ' Close the uninstall control file
1127     call CloseUninstallCtrlFile ()
1128
1129     ' We're done
1130     call ProgressBar (100)
1131     call ProgressBar (-1)
1132     call Success ()
1133
1134     ' Return a success code
1135     WScript.Quit (0)
1136 end sub
1137
1138
1139
1140 '******************************************************************************
1141 ' The script body just calls Main...
1142 '******************************************************************************
1143 Main ()
1144
1145
1146
1147
1148