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.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
  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 "MSG_INCOMPLETE"
 144                 Msg = "The package seems to be incomplete and cannot be"
 145                 Msg = Msg & " installed."
 146             case else
 147                 Msg = Key
 148         end select
 149     end if
 150     GetMsg = Msg
 151 end function
 152
 153
 154
 155 '******************************************************************************
 156 ' Format a string replacing %n specifiers in the format string F
 157 '******************************************************************************
 158 function Fmt (F, Values)
 159     dim I, Count, Key, Val, Start, Pos
 160     Count = UBound (Values)     ' How many values?
 161     for I = Count to 0 step -1
 162         Key = "%" & ToString (I)
 163         select case VarType (Values (I))
 164             case vbEmpty
 165                 Val = ""
 166             case vbInteger
 167                 Val = ToString (Values (I))
 168             case vbLong
 169                 Val = ToString (Values (I))
 170             case vbNull
 171                 Val = ""
 172             case vbSingle
 173                 Val = ToString (Values (I))
 174             case vbDouble
 175                 Val = ToString (Values (I))
 176             case vbString
 177                 Val = Values (I)
 178             case else
 179                 Abort ("Internal error: Invalid conversion in Format()")
 180         end select
 181         F = Replace (F, Key, Val)
 182     next
 183     Fmt = F
 184 end function
 185
 186
 187
 188 '******************************************************************************
 189 ' Format a message replacing %n specifiers in the format string F
 190 '******************************************************************************
 191 function FmtMsg (Msg, Values)
 192     FmtMsg = Fmt (GetMsg (Msg), Values)
 193 end function
 194
 195
 196
 197 '******************************************************************************
 198 ' Return an environment string. Fix up Microsofts "innovative" ideas.
 199 '******************************************************************************
 200 function GetEnv (Key)
 201     dim Value
 202     Value = Shell.ExpandEnvironmentStrings (Key)
 203     if Value = Key then
 204         GetEnv = vbNullString
 205     else
 206         GetEnv = Value
 207     end if
 208 end function
 209
 210
 211
 212 '******************************************************************************
 213 ' Build a path from two components
 214 '******************************************************************************
 215 function BuildPath (Path, Name)
 216     BuildPath = FSO.BuildPath (Path, Name)
 217 end function
 218
 219
 220
 221 '******************************************************************************
 222 ' Return true if the file with the given name exists
 223 '******************************************************************************
 224 function FileExists (Name)
 225     On Error Resume Next
 226     FileExists = FSO.FileExists (Name)
 227 end function
 228
 229
 230
 231 '******************************************************************************
 232 ' Return true if the folder with the given name exists
 233 '******************************************************************************
 234 function FolderExists (Name)
 235     On Error Resume Next
 236     FolderExists = FSO.FolderExists (Name)
 237 end function
 238
 239
 240
 241 '******************************************************************************
 242 ' Copy a file and return an error message (empty string if no error)
 243 '******************************************************************************
 244 function CopyFile (Source, Target)
 245     if Right (Target, 1) <> "\" and FolderExists (Target) then
 246         Target = Target & "\"
 247     end if
 248     On Error Resume Next
 249     call FSO.CopyFile (Source, Target)
 250     on error goto 0
 251     CopyFile = Err.Description
 252 end function
 253
 254
 255
 256 '******************************************************************************
 257 ' Create a folder and all parent folders and return an error string
 258 '******************************************************************************
 259 function CreateFolder (Path)
 260
 261     ' If the parent folder does not exist, try to create it
 262     dim ParentFolder
 263     ParentFolder = FSO.GetParentFolderName (Path)
 264     if ParentFolder <> "" and not FolderExists (ParentFolder) then
 265         CreateFolder (ParentFolder)
 266     end if
 267
 268     ' Now try to create the actual folder
 269     On Error Resume Next
 270     FSO.CreateFolder (Path)
 271     CreateFolder = Err.Description
 272
 273 end function
 274
 275
 276
 277 '******************************************************************************
 278 ' Delete a file and return an error string
 279 '******************************************************************************
 280 function DeleteFile (Name)
 281     On Error Resume Next
 282     call FSO.DeleteFile (Name, true)
 283     DeleteFile = Err.Description
 284 end function
 285
 286
 287
 288 '******************************************************************************
 289 ' Delete a folder and return an error string
 290 '******************************************************************************
 291 function DeleteFolder (Path)
 292     On Error Resume Next
 293     call FSO.DeleteFolder (Path, true)
 294     DeleteFolder = Err.Description
 295 end function
 296
 297
 298
 299 '******************************************************************************
 300 ' Return the type of a registry entry
 301 '******************************************************************************
 302 function RegType (Value)
 303
 304     dim Result
 305
 306     ' Determine the type of the registry value. If the string contains percent
 307     ' signs, use REG_EXPAND_SZ, otherwise use REG_SZ. This isn't always safe,
 308     ' but there is no way to determine the type, and VBS itself is too stupid
 309     ' to choose the correct type itself. Add the usual curse over Microsoft
 310     ' here...
 311     Result = InStr (1, Value, "%")
 312     if Result = 0 then
 313         RegType = "REG_SZ"
 314     else
 315         RegType = "REG_EXPAND_SZ"
 316     end if
 317 end function
 318
 319
 320
 321 '******************************************************************************
 322 ' Read a string from the registry. Return an empty string if nothing was found.
 323 '******************************************************************************
 324 function RegReadStr (Key)
 325     On Error Resume Next
 326     RegReadStr = Shell.RegRead (Key)
 327     if Err.Number <> 0 then
 328         RegReadStr = ""
 329     end if
 330 end function
 331
 332
 333
 334 '******************************************************************************
 335 ' Write a binary value to the registry, return an error description
 336 '******************************************************************************
 337 function RegWriteBin (Key, Value)
 338     on error resume next
 339     Shell.RegWrite Key, Value, "REG_BINARY"
 340     RegWriteBin = Err.Description
 341     on error goto 0
 342     WriteUninstallCtrlFile ("R " & Key)
 343 end function
 344
 345
 346
 347 '******************************************************************************
 348 ' Write a string value to the registry, return an error description
 349 '******************************************************************************
 350 function RegWriteStr (Key, Value)
 351     on error resume next
 352     Shell.RegWrite Key, Value, "REG_SZ"
 353     RegWriteStr = Err.Description
 354     on error goto 0
 355     WriteUninstallCtrlFile ("R " & Key)
 356 end function
 357
 358
 359
 360 '******************************************************************************
 361 ' Run a program, wait for its termination and return an error code.
 362 '******************************************************************************
 363 function Run (Cmd, WinState)
 364     dim ErrCode
 365
 366     On Error Resume Next
 367     ErrCode = Shell.Run (Cmd, WinState, true)
 368     if Err.Number <> 0 then
 369         ErrCode = Err.Number
 370     end if
 371     Run = ErrCode
 372 end function
 373
 374
 375
 376 '******************************************************************************
 377 ' Display a progress bar using the internet exploder
 378 '******************************************************************************
 379 dim PBDoc               ' Progress bar document object
 380 dim PBVal               ' Current progress bar setting
 381 dim IEApp               ' Internet exploder application object
 382 set PBDoc = nothing
 383 set IEApp = nothing
 384 PBVal = -1
 385
 386 sub ProgressBar (Percent)
 387
 388     ' Remember the last setting
 389     PBVal = Percent
 390
 391     'Create the progress bar window
 392     if PBDoc is nothing then
 393
 394         if ((Cint (Percent) < 0) or (Cint (Percent) > 100)) then
 395             ' Close request, but object already destroyed
 396             exit sub
 397         end if
 398
 399         ' Create an object that control the internet exploder
 400         set IEApp = CreateObject ("InternetExplorer.Application")
 401
 402         ' Set the exploder to fullscreen and retrieve its size
 403         dim ScreenHeight, ScreenWidth
 404         IEApp.Visible    = false
 405         IEApp.FullScreen = true
 406         ScreenWidth      = IEApp.Width
 407         ScreenHeight     = IEApp.Height
 408         IEApp.FullScreen = false
 409
 410         ' Now prepare the actual window
 411         IEApp.Offline    = true
 412         IEApp.AddressBar = false
 413         IEApp.Height     = 100
 414         IEApp.Width      = 250
 415         IEApp.MenuBar    = false
 416         IEApp.StatusBar  = false
 417         IEApp.Silent     = true
 418         IEApp.ToolBar    = false
 419         IEApp.Resizable  = false
 420         IEApp.Left       = (ScreenWidth  - IEApp.Width)  / 2
 421         IEApp.Top        = (ScreenHeight - IEApp.Height) / 2
 422         call IEApp.Navigate ("about:blank")
 423         do while IEApp.Busy
 424             call WScript.Sleep (100)
 425         loop
 426
 427         ' Connect to the displayed document
 428         do until not PBDoc is nothing
 429             call WScript.Sleep (100)
 430             set PBDoc = IEApp.Document
 431         loop
 432
 433         ' Generate a new document showing a progress bar
 434         PBDoc.Open
 435         call PBDoc.Write ("<html><head><title>" & Installer & " progress</title></head>")
 436         call PBDoc.Write ("<body bgcolor=#C0C0C0><center>")
 437         call PBDoc.Write ("<table width=100% border=1 frame=box><tr><td>")
 438         call PBDoc.Write ("<table id=progress width=0 border=0 cellpadding=0 cellspacing=0 bgcolor=#FFFFFF>")
 439         call PBDoc.Write ("<tr><td>&nbsp</td></tr></table>")
 440         call PBDoc.Write ("</td></tr></table>")
 441         call PBDoc.Write ("</center></body></html>")
 442         PBDoc.Close
 443
 444         ' Display the exploder window
 445         IEApp.Visible = true
 446
 447     else
 448         if ((Cint (Percent) < 0) or (Cint (Percent) > 100)) then
 449             ' Request for shutdown
 450             IEApp.Visible = false
 451             set PBDoc = nothing
 452             IEApp.Quit
 453             set IEApp = nothing
 454         else
 455             ' Update the progress bar
 456             if Cint (Percent) = 0 then
 457                 PBDoc.all.progress.width = "1%"
 458                 PBDoc.all.progress.bgcolor = "#C0C0C0"
 459             else
 460                 PBDoc.all.progress.width = Cstr (Cint (Percent)) & "%"
 461                 PBDoc.all.progress.bgcolor = "#0000C0"
 462             end if
 463         end if
 464     end if
 465 end sub
 466
 467
 468
 469 '******************************************************************************
 470 ' Initialize global variables
 471 '******************************************************************************
 472 sub InitializeGlobals ()
 473     dim I
 474
 475     ' String stuff used for formatting
 476     Tab     = Chr (9)
 477     NewLine = Chr (13)
 478
 479     ' Global objects
 480     set Shell = WScript.CreateObject ("WScript.Shell")
 481     set FSO   = CreateObject ("Scripting.FileSystemObject")
 482
 483     ' Arguments
 484     set ProgArgs = WScript.Arguments
 485
 486     ' Handle program arguments
 487     Dbg = false
 488     Language = "de"
 489     for I = 0 to ProgArgs.Count-1
 490         select case ProgArgs(I)
 491             case "-de"
 492                 Language = "de"
 493             case "-debug"
 494                 Dbg = true
 495             case "-en"
 496                 Language = "en"
 497         end select
 498     next
 499
 500     ' Paths and locations
 501     SystemDrive = GetEnv ("%SystemDrive%")
 502     if SystemDrive = vbNullString then
 503         SystemDrive = "c:"
 504     end if
 505     SystemRoot = GetEnv ("%SystemRoot%")
 506     if SystemRoot = vbNullString then
 507         SystemRoot = BuildPath (SystemDrive, "winnt")
 508     end if
 509     UserName = GetEnv ("%USERNAME%")
 510     if UserName = vbNullString then
 511         UserName = "Administrator"
 512     end if
 513     UserProfile = GetEnv ("%USERPROFILE%")
 514     if UserProfile = vbNullString then
 515         UserProfile = BuildPath (SystemDrive, "Dokumente und Einstellungen\" & UserName)
 516     end if
 517     ProgramFiles = GetEnv ("%ProgramFiles%")
 518     if ProgramFiles = vbNullString then
 519         ProgramFiles = BuildPath (SystemDrive, "Programme")
 520     end if
 521     AppData = GetEnv ("%AppData%")
 522     if AppData = vbNullString then
 523         AppData = UserProfile
 524     end if
 525     InstallSource = FSO.GetParentFolderName (WScript.ScriptFullName)
 526     InstallTarget = BuildPath (ProgramFiles, AppName)
 527
 528     Programs = Shell.SpecialFolders ("AllUsersPrograms")
 529     Desktop  = Shell.SpecialFolders ("AllUsersDesktop")
 530
 531     ' Uninstaller
 532     set UninstallCtrlFile = nothing
 533     Uninstaller = BuildPath (InstallTarget, "uninstall.vbs")
 534     UninstallCtrlFileName = BuildPath (InstallTarget, "uninstall.lst")
 535     UninstallerCmdLine = "-" & Language & " " & AppName & " " & UninstallCtrlFileName
 536
 537     ' Registry paths
 538     RegUninstall = "HKLM\Software\Microsoft\Windows\CurrentVersion\Uninstall\" & AppName & "\"
 539
 540     ' Directories
 541     BinDir = BuildPath (InstallTarget, "bin")
 542     LibDir = BuildPath (InstallTarget, "lib")
 543     IncDir = BuildPath (InstallTarget, "include")
 544
 545     ' Files
 546     AnnouncementFile = "announce.txt"
 547     DocIndexFile     = "doc\index.html"
 548 end sub
 549
 550
 551
 552 '******************************************************************************
 553 ' Ask a yes/no question and return the result. "Yes" is default.
 554 '******************************************************************************
 555 function AskYesNo (Question)
 556     AskYesNo = MsgBox (Question, vbYesNo + vbQuestion + vbDefaultButton1, Installer)
 557 end function
 558
 559
 560
 561 '******************************************************************************
 562 ' Ask a yes/no question and return the result. "No" is default.
 563 '******************************************************************************
 564 function AskNoYes (Question)
 565     AskNoYes = MsgBox (Question, vbYesNo + vbQuestion + vbDefaultButton2, Installer)
 566 end function
 567
 568
 569
 570 '******************************************************************************
 571 ' Tell the user that the installation was aborted and terminate the script
 572 '******************************************************************************
 573 sub InfoAbort ()
 574     call MsgBox (GetMsg ("MSG_ABORTINFO"), vbOkOnly + vbInformation, Installer)
 575     WScript.Quit (0)
 576 end sub
 577
 578
 579
 580 '******************************************************************************
 581 ' Input routine with the window caption preset
 582 '******************************************************************************
 583 function Input (Prompt, Default)
 584     Input = InputBox (Prompt, Installer, Default)
 585 end function
 586
 587
 588
 589 '******************************************************************************
 590 ' Check if a directory is a given the path
 591 '******************************************************************************
 592 function DirInPath (ByVal Dir)
 593
 594     dim Path, Entries, I
 595
 596     ' Get the path in lower case
 597     Path = LCase (GetEnv ("%Path%"))
 598
 599     ' Convert the directory to lower case
 600     Dir = LCase (Dir)
 601
 602     ' Split the path into separate entries
 603     Entries = Split (Path, ";")
 604
 605     ' Check all entries
 606     for I = LBound (Entries) to UBound (Entries)
 607         if Entries(I) = Dir then
 608             DirInPath = true
 609             exit function
 610         end if
 611     next
 612
 613     DirInPath = false
 614 end function
 615
 616
 617
 618
 619 '******************************************************************************
 620 ' Function that displays the paths and locations found
 621 '******************************************************************************
 622 function OneLoc (Key, Value)
 623     dim Result
 624     Result = Trim (Key)
 625     if Len (Result) <= 8 then
 626         Result = Result & Tab
 627     end if
 628     OneLoc = Result & Tab & "=" & Tab & Value & NewLine
 629 end function
 630
 631 sub ShowPathsAndLocations ()
 632     dim Msg
 633     Msg = Msg & OneLoc ("SystemDrive",   SystemDrive)
 634     Msg = Msg & OneLoc ("SystemRoot",    SystemRoot)
 635     Msg = Msg & OneLoc ("UserName",      UserName)
 636     Msg = Msg & OneLoc ("UserProfile",   UserProfile)
 637     Msg = Msg & OneLoc ("ProgramFiles",  ProgramFiles)
 638     Msg = Msg & OneLoc ("AppData",       AppData)
 639     Msg = Msg & OneLoc ("InstallSource", InstallSource)
 640     Msg = Msg & OneLoc ("InstallTarget", InstallTarget)
 641     Msg = Msg & OneLoc ("Programs",      Programs)
 642     Msg = Msg & OneLoc ("Desktop",       Desktop)
 643     Msg = Msg & OneLoc ("Free space",    ToString (GetDriveSpace (InstallTarget)))
 644
 645     call MsgBox (Msg, vbOkOnly, "Paths and Locations")
 646 end sub
 647
 648
 649
 650 '******************************************************************************
 651 ' Return the amount of free space for a path (in Megabytes)
 652 '******************************************************************************
 653 function GetDriveSpace (Path)
 654     dim Drive
 655     On Error Resume Next
 656     set Drive = FSO.GetDrive (FSO.GetDriveName (Path))
 657     if Err.Number <> 0 then
 658         GetDriveSpace = 0
 659     else
 660         GetDriveSpace = Drive.FreeSpace / (1024 * 1024)
 661     end if
 662 end function
 663
 664
 665
 666 '******************************************************************************
 667 ' Check that there's something to install
 668 '******************************************************************************
 669 sub CheckFilesToInstall ()
 670
 671     ' If the uninstaller is unavailable for some reason or the other, we
 672     ' have a problem, because the installer will create an uninstaller entry
 673     ' in the registry, but it will not work, which means that the package
 674     ' cannot be deinstalled or overwritten. So we have to check that at least
 675     ' the uninstaller is available in the same directory as the installer.
 676     if not FileExists (Uninstaller) then
 677         Abort (GetMsg ("MSG_INCOMPLETE"))
 678     end if
 679 end sub
 680
 681
 682
 683 '******************************************************************************
 684 ' Check that were running this script as admin
 685 '******************************************************************************
 686 sub CheckAdminRights ()
 687
 688     ' FIXME: This check is not perfect
 689     if UserName <> "Administrator" then
 690         dim Args(1)
 691         Args(1) = AppName
 692
 693         if AskNoYes (FmtMsg ("MSG_ADMIN", Args)) <> vbYes then
 694             WScript.Quit (1)
 695         end if
 696     end if
 697
 698 end sub
 699
 700
 701
 702 '******************************************************************************
 703 ' Remove an old installation.
 704 '******************************************************************************
 705 sub RemoveOldInstall (UninstallCmd)
 706
 707     dim ErrCode
 708
 709     ' Execute the uninstall
 710     ErrCode = Run (UninstallCmd, 0)
 711
 712     ' Tell the user that the uninstall is done
 713     if ErrCode <> 0 then
 714         call Abort (GetMsg ("MSG_UNINSTALLERR"))
 715     end if
 716 end sub
 717
 718
 719
 720 '******************************************************************************
 721 ' Check if there is an old installation. Offer to remove it.
 722 '******************************************************************************
 723 sub CheckOldInstall ()
 724
 725     dim UninstallCmd
 726
 727     ' Read the uninstall command from the registry
 728     UninstallCmd = RegReadStr (RegUninstall & "UninstallString")
 729
 730     ' Check if there is already an executable
 731     if UninstallCmd <> "" then
 732
 733         ' Ask to remove an old install
 734         if AskYesNo (GetMsg ("MSG_REMOVEOLD")) = vbYes then
 735             ' Remove the old installation
 736             call RemoveOldInstall (UninstallCmd)
 737         end if
 738
 739     end if
 740
 741 end sub
 742
 743
 744
 745 '******************************************************************************
 746 ' Check that the install target exists. Offer to create it.
 747 '******************************************************************************
 748 sub CheckInstallTarget ()
 749
 750     dim Msg, Result, Args(2)
 751
 752     ' Tell the user about the install target and ask if it's ok
 753     Args(1) = InstallTarget
 754     Msg = FmtMsg ("MSG_INSTALLPATH", Args)
 755     if MsgBox (Msg, vbOkCancel, Installer) <> vbOk then
 756         call InfoAbort ()
 757     end if
 758
 759     ' Check if there's enough space left on the target drive
 760     if GetDriveSpace (InstallTarget) < SpaceNeeded then
 761         Args(1) = FSO.GetDriveName (InstallTarget)
 762         Args(2) = SpaceNeeded
 763         call Abort (FmtMsg ("MSG_DRIVESPACE", Args))
 764     end if
 765
 766     ' Check if the install path exist, create it if necessary
 767     if not FolderExists (InstallTarget) then
 768         Result = CreateFolder (InstallTarget)
 769         if Result <> "" then
 770             Args(1) = InstallTarget
 771             Args(2) = Result
 772             call Abort (FmtMsg ("MSG_CREATEERR", Args))
 773         end if
 774     end if
 775
 776 end sub
 777
 778
 779
 780 '******************************************************************************
 781 ' Create the uninstall control file
 782 '******************************************************************************
 783 sub CreateUninstallCtrlFile ()
 784
 785     dim Filename
 786
 787     ' Generate the filename
 788     on Error resume next
 789     set UninstallCtrlFile = FSO.CreateTextFile (UninstallCtrlFileName, true)
 790     on error goto 0
 791     if Err.Number <> 0 then
 792         dim Args(2)
 793         Args(1) = UninstallCtrlFileName
 794         Args(2) = Err.Description
 795         call ErrorMsg (FmtMsg ("MSG_CREATEERR", Args))
 796         WScript.Quit (1)
 797     end if
 798
 799     ' Write the name of the target directory to the file
 800     call WriteUninstallCtrlFile ("D " & InstallTarget)
 801
 802     ' Write the name of the file itself to the file
 803     call WriteUninstallCtrlFile ("F " & UninstallCtrlFileName)
 804
 805 end sub
 806
 807
 808
 809 '******************************************************************************
 810 ' Write to the uninstall control file
 811 '******************************************************************************
 812 sub WriteUninstallCtrlFile (Line)
 813
 814     on error resume next
 815     UninstallCtrlFile.WriteLine (Line)
 816     if Err.Number <> 0 then
 817         dim Args(2)
 818         Args(1) = UninstallCtrlFileName
 819         Args(2) = Err.Description
 820         call ErrorMsg (FmtMsg ("MSG_WRITEERR", Args))
 821         WScript.Quit (1)
 822     end if
 823
 824 end sub
 825
 826
 827
 828 '******************************************************************************
 829 ' Close the uninstall control file
 830 '******************************************************************************
 831 sub CloseUninstallCtrlFile ()
 832
 833     on error resume next
 834     UninstallCtrlFile.Close
 835     if Err.Number <> 0 then
 836         dim Args(2)
 837         Args(1) = UninstallCtrlFileName
 838         Args(2) = Err.Description
 839         call ErrorMsg (FmtMsg ("MSG_WRITEERR", Args))
 840         WScript.Quit (1)
 841     end if
 842
 843 end sub
 844
 845
 846
 847 '******************************************************************************
 848 ' Copy the application files
 849 '******************************************************************************
 850 sub RecursiveCopy (Dir, SourcePath, TargetPath)
 851
 852     dim File, TargetFile, SubDir, SourceName, TargetName, Result, Args(3)
 853
 854     ' Copy all files in this folder
 855     for each File in Dir.Files
 856
 857         ' Generate source and target file names
 858         SourceName = BuildPath (SourcePath, File.Name)
 859         TargetName = BuildPath (TargetPath, File.Name)
 860
 861         ' Copy the file. The error check doesn't seem to work.
 862         on error resume next
 863         File.Copy (TargetName)
 864         on error goto 0
 865         if Err.Number <> 0 then
 866             Args(1) = SourceName
 867             Args(2) = TargetName
 868             Args(3) = Err.Description
 869             call ErrorMsg (FmtMsg ("MSG_COPYERR", Args))
 870             call AbortInfo ()
 871         end if
 872
 873         ' Remove the r/o attribute from the target file if set
 874         set TargetFile = FSO.GetFile (TargetName)
 875         if TargetFile.Attributes mod 2 = 1 then
 876             TargetFile.Attributes = TargetFile.Attributes - 1
 877         end if
 878
 879         ' Remember this file in the uninstall control file
 880         call WriteUninstallCtrlFile ("F " & TargetName)
 881     next
 882
 883     ' Handle all subdirectories
 884     for each SubDir in Dir.SubFolders
 885
 886         ' Update the progress bar with each copied directory
 887         if PBVal <= 80 then
 888             call ProgressBar (PBVal + 5)
 889         end if
 890
 891         ' Generate the new directory names
 892         SourceName = BuildPath (SourcePath, SubDir.Name)
 893         TargetName = BuildPath (TargetPath, SubDir.Name)
 894
 895         ' Generate the new target dir. Notify the user about errors, but
 896         ' otherwise ignore them.
 897         Result = CreateFolder (TargetName)
 898         if Result <> "" then
 899             ' Display an error but try to continue
 900             Args(1) = TargetName
 901             Args(2) = Result
 902             call ErrorMsg (FmtMsg ("MSG_CREATEERR", Args))
 903         end if
 904
 905         ' Recursively process files in the subdirectory
 906         call RecursiveCopy (SubDir, SourceName, TargetName)
 907
 908         ' Remember the subdirectory in the uninstall control file
 909         WriteUninstallCtrlFile ("D " & TargetName)
 910
 911     next
 912 end sub
 913
 914 sub CopyFiles ()
 915
 916     ' Update the progress bar
 917     call ProgressBar (10)
 918
 919     ' Copy all files generating entries in the uninstall control file
 920     call RecursiveCopy (FSO.GetFolder (InstallSource), InstallSource, InstallTarget)
 921
 922     ' Update the progress bar
 923     call ProgressBar (90)
 924 end sub
 925
 926
 927
 928 '******************************************************************************
 929 ' Create the registry entries
 930 '******************************************************************************
 931 sub CreateRegEntries ()
 932
 933     dim Cmd
 934
 935     ' Create the entry in Systemsteuerung -> Software. Check if the first write
 936     ' succeeds. If not, we don't have admin rights.
 937     if RegWriteBin (RegUninstall, 1) <> "" then
 938         call Abort (GetMsg ("MSG_REGWRITEERR"))
 939     end if
 940     call RegWriteStr (RegUninstall & "DisplayName", AppName & " " & Version)
 941     call RegWriteStr (RegUninstall & "UninstallString", "wscript //nologo " & Uninstaller & " " & UninstallerCmdLine)
 942
 943 end sub
 944
 945
 946
 947 '******************************************************************************
 948 ' Function that creates an URL
 949 '******************************************************************************
 950 sub CreateUrl (Name, Url, Description)
 951     ' Ignore errors
 952     On Error Resume Next
 953
 954     dim Link
 955     set Link = Shell.CreateShortcut (Name)
 956     Link.TargetPath = Url
 957     Link.Description = Description
 958     Link.Save
 959
 960     ' Allow errors again
 961     on error goto 0
 962
 963     ' Write the file name to the uninstall control file
 964     WriteUninstallCtrlFile ("F " & Name)
 965 end sub
 966
 967
 968
 969 '******************************************************************************
 970 ' Function that creates a shortcut
 971 '******************************************************************************
 972 sub CreateShortcut (Name, Exe, Args, Description)
 973     ' Ignore errors
 974     On Error Resume Next
 975
 976     dim Link
 977     set Link = Shell.CreateShortcut (Name)
 978     Link.TargetPath  = Exe
 979     Link.Arguments   = Args
 980     Link.WindowStyle = 1
 981     Link.Description = Description
 982     Link.WorkingDirectory = AppData
 983     Link.Save
 984
 985     ' Allow errors again
 986     on error goto 0
 987
 988     ' Write the file name to the uninstall control file
 989     WriteUninstallCtrlFile ("F " & Name)
 990 end sub
 991
 992
 993
 994 '******************************************************************************
 995 ' Function that creates the menu entries
 996 '******************************************************************************
 997 sub CreateMenuEntries ()
 998     dim Folder, Result, Name, Desc, Target, Args(2)
 999
1000     ' Create the start menu folder.
1001     Folder = BuildPath (Programs, AppName)
1002     Result = CreateFolder (Folder)
1003     if Result <> "" then
1004         ' Display an error but try to continue
1005         Args(1) = Folder
1006         Args(2) = Result
1007         call ErrorMsg (FmtMsg ("MSG_CREATEERR", Args))
1008     end if
1009
1010     ' Create an uninstall shortcut in the menu folder
1011     Args(1) = AppName
1012     Desc = FmtMsg ("MSG_REMOVEENTRY", Args)
1013     Name = BuildPath (Folder, Desc & ".lnk")
1014     call CreateShortcut (Name, Uninstaller, UninstallerCmdLine, Desc)
1015
1016     ' Create a documentation shortcut in the menu folder
1017     Target = BuildPath (InstallTarget, DocIndexFile)
1018     if FileExists (Target) then
1019         Args(1) = AppName
1020         Desc = FmtMsg ("MSG_DOCENTRY", Args)
1021         Name = BuildPath (Folder, Desc & ".url")
1022         call CreateUrl (Name, "file://" & Target, Desc)
1023     end if
1024
1025     ' Create the shortcut to the announcement in the menu folder
1026     Target = BuildPath (InstallTarget, AnnouncementFile)
1027     if FileExists (Target) then
1028         Desc = GetMsg ("MSG_ANNOUNCEMENT")
1029         Name = BuildPath (Folder, Desc & ".url")
1030         call CreateUrl (Name, "file://" & Target, Desc)
1031     end if
1032
1033     ' Update the uninstall control file
1034     call WriteUninstallCtrlFile ("D " & Folder)
1035 end sub
1036
1037
1038
1039 '******************************************************************************
1040 ' Add a directory to the system path
1041 '******************************************************************************
1042 sub AddToSysPath (Dir)
1043
1044     dim Path
1045
1046     ' Handle errors. Assume failure
1047     on error resume next
1048
1049     ' Retrieve the PATH setting
1050     Path = Shell.RegRead (SysPath)
1051     if Err.Number <> 0 then
1052         ' Could not read
1053         call Abort (GetMsg ("MSG_REGREADERR"))
1054     end if
1055
1056     ' Add the new directory to the path
1057     if (Len (Path) > 0) and (Right (Path, 1) <> ";") then
1058         Path = Path + ";"
1059     end if
1060     Path = Path + Dir
1061
1062     ' Write the new path
1063     call Shell.RegWrite (SysPath, Path, "REG_EXPAND_SZ")
1064     if Err.Number <> 0 then
1065         ' Could not set
1066         call Abort (GetMsg ("MSG_REGWRITEERR"))
1067     end if
1068 end sub
1069
1070
1071
1072 '******************************************************************************
1073 ' Add environment variables
1074 '******************************************************************************
1075 sub AddEnvironment ()
1076
1077     ' Add CC65_LIB
1078     if RegWriteStr (SysEnv & "\CC65_LIB", LibDir) <> "" then
1079         call Abort (GetMsg ("MSG_REGWRITEERR"))
1080     end if
1081
1082     ' Add CC65_INC
1083     if RegWriteStr (SysEnv & "\CC65_INC", IncDir) <> "" then
1084         call Abort (GetMsg ("MSG_REGWRITEERR"))
1085     end if
1086
1087     ' Add the bin directory to the path if it's not already there
1088     if not DirInPath (BinDir) then
1089         call AddToSysPath (BinDir)
1090
1091         ' Run the wm_envchange program to notify other running programs
1092         ' of the changed environment. Ignore errors.
1093         call Run (BuildPath (BinDir, "wm_envchange.exe"), 0)
1094     end if
1095
1096 end sub
1097
1098
1099
1100 '******************************************************************************
1101 ' Function that tells the user that the install was successful
1102 '******************************************************************************
1103 sub Success ()
1104     call MsgBox (GetMsg ("MSG_SUCCESS"), vbOkOnly + vbInformation, Installer)
1105 end sub
1106
1107
1108
1109 '******************************************************************************
1110 ' Main program
1111 '******************************************************************************
1112 sub Main ()
1113
1114     ' Initialize global variables. This includes the paths used
1115     call InitializeGlobals ()
1116     if Dbg then
1117         call ShowPathsAndLocations ()
1118     end if
1119
1120     ' Check that there's something to install
1121     call CheckFilesToInstall ()
1122
1123     ' Check that we're running this script as admin
1124     call CheckAdminRights ()
1125
1126     ' Check if there is an old installation and offer to remove it
1127     call CheckOldInstall ()
1128
1129     ' Check if the source directory does really exist
1130     call CheckInstallTarget ()
1131
1132     ' Display the progress bar
1133     call ProgressBar (0)
1134
1135     ' Create the uninstall file
1136     call CreateUninstallCtrlFile ()
1137     call ProgressBar (2)
1138
1139     ' Create registry entries
1140     CreateRegEntries ()
1141     call Progressbar (5)
1142
1143     ' Copy the application files (will do automatic progress bar updates)
1144     call CopyFiles ()
1145
1146     ' Create the menu entries
1147     call CreateMenuEntries ()
1148     call ProgressBar (90)
1149
1150     ' Add entries to the enviroment
1151     call AddEnvironment ()
1152     call ProgressBar (95)
1153
1154     ' Close the uninstall control file
1155     call CloseUninstallCtrlFile ()
1156
1157     ' We're done
1158     call ProgressBar (100)
1159     call ProgressBar (-1)
1160     call Success ()
1161
1162     ' Return a success code
1163     WScript.Quit (0)
1164 end sub
1165
1166
1167
1168 '******************************************************************************
1169 ' The script body just calls Main...
1170 '******************************************************************************
1171 Main ()
1172
1173
1174
1175
1176