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.11.9"
  10 const Installer   = "cc65 Installer"
  11 const SpaceNeeded = 20                  ' Free space needed on drive in MiB.
  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, Quote         ' 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 Microsoft's "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     Quote   = Chr (34)
 479
 480     ' Global objects
 481     set Shell = WScript.CreateObject ("WScript.Shell")
 482     set FSO   = CreateObject ("Scripting.FileSystemObject")
 483
 484     ' Arguments
 485     set ProgArgs = WScript.Arguments
 486
 487     ' Handle program arguments
 488     Dbg = false
 489     Language = "de"
 490     for I = 0 to ProgArgs.Count-1
 491         select case ProgArgs(I)
 492             case "-de"
 493                 Language = "de"
 494             case "-debug"
 495                 Dbg = true
 496             case "-en"
 497                 Language = "en"
 498         end select
 499     next
 500
 501     ' Paths and locations
 502     SystemDrive = GetEnv ("%SystemDrive%")
 503     if SystemDrive = vbNullString then
 504         SystemDrive = "c:"
 505     end if
 506     SystemRoot = GetEnv ("%SystemRoot%")
 507     if SystemRoot = vbNullString then
 508         SystemRoot = BuildPath (SystemDrive, "winnt")
 509     end if
 510     UserName = GetEnv ("%USERNAME%")
 511     if UserName = vbNullString then
 512         UserName = "Administrator"
 513     end if
 514     UserProfile = GetEnv ("%USERPROFILE%")
 515     if UserProfile = vbNullString then
 516         UserProfile = BuildPath (SystemDrive, "Dokumente und Einstellungen\" & UserName)
 517     end if
 518     ProgramFiles = GetEnv ("%ProgramFiles%")
 519     if ProgramFiles = vbNullString then
 520         ProgramFiles = BuildPath (SystemDrive, "Programme")
 521     end if
 522     AppData = GetEnv ("%AppData%")
 523     if AppData = vbNullString then
 524         AppData = UserProfile
 525     end if
 526     InstallSource = FSO.GetParentFolderName (WScript.ScriptFullName)
 527     InstallTarget = BuildPath (ProgramFiles, AppName)
 528
 529     Programs = Shell.SpecialFolders ("AllUsersPrograms")
 530     Desktop  = Shell.SpecialFolders ("AllUsersDesktop")
 531
 532     ' Uninstaller
 533     set UninstallCtrlFile = nothing
 534     Uninstaller = Quote & BuildPath (InstallTarget, "uninstall.vbs") & Quote
 535     UninstallCtrlFileName = BuildPath (InstallTarget, "uninstall.lst")
 536     UninstallerCmdLine = "-" & Language & " " & AppName & " " & Quote & UninstallCtrlFileName & Quote
 537
 538     ' Registry paths
 539     RegUninstall = "HKLM\Software\Microsoft\Windows\CurrentVersion\Uninstall\" & AppName & "\"
 540
 541     ' Directories
 542     BinDir = BuildPath (InstallTarget, "bin")
 543     LibDir = BuildPath (InstallTarget, "lib")
 544     IncDir = BuildPath (InstallTarget, "include")
 545
 546     ' Files
 547     AnnouncementFile = "announce.txt"
 548     DocIndexFile     = "doc\index.html"
 549 end sub
 550
 551
 552
 553 '******************************************************************************
 554 ' Ask a yes/no question and return the result. "Yes" is default.
 555 '******************************************************************************
 556 function AskYesNo (Question)
 557     AskYesNo = MsgBox (Question, vbYesNo + vbQuestion + vbDefaultButton1, Installer)
 558 end function
 559
 560
 561
 562 '******************************************************************************
 563 ' Ask a yes/no question and return the result. "No" is default.
 564 '******************************************************************************
 565 function AskNoYes (Question)
 566     AskNoYes = MsgBox (Question, vbYesNo + vbQuestion + vbDefaultButton2, Installer)
 567 end function
 568
 569
 570
 571 '******************************************************************************
 572 ' Tell the user that the installation was aborted and terminate the script
 573 '******************************************************************************
 574 sub InfoAbort ()
 575     call MsgBox (GetMsg ("MSG_ABORTINFO"), vbOkOnly + vbInformation, Installer)
 576     WScript.Quit (0)
 577 end sub
 578
 579
 580
 581 '******************************************************************************
 582 ' Input routine with the window caption preset
 583 '******************************************************************************
 584 function Input (Prompt, Default)
 585     Input = InputBox (Prompt, Installer, Default)
 586 end function
 587
 588
 589
 590 '******************************************************************************
 591 ' Check if a directory is a given the path
 592 '******************************************************************************
 593 function DirInPath (ByVal Dir)
 594
 595     dim Path, Entries, I
 596
 597     ' Get the path in lower case
 598     Path = LCase (GetEnv ("%Path%"))
 599
 600     ' Convert the directory to lower case
 601     Dir = LCase (Dir)
 602
 603     ' Split the path into separate entries
 604     Entries = Split (Path, ";")
 605
 606     ' Check all entries
 607     for I = LBound (Entries) to UBound (Entries)
 608         if Entries(I) = Dir then
 609             DirInPath = true
 610             exit function
 611         end if
 612     next
 613
 614     DirInPath = false
 615 end function
 616
 617
 618
 619
 620 '******************************************************************************
 621 ' Function that displays the paths and locations found
 622 '******************************************************************************
 623 function OneLoc (Key, Value)
 624     dim Result
 625     Result = Trim (Key)
 626     if Len (Result) <= 8 then
 627         Result = Result & Tab
 628     end if
 629     OneLoc = Result & Tab & "=" & Tab & Value & NewLine
 630 end function
 631
 632 sub ShowPathsAndLocations ()
 633     dim Msg
 634     Msg = Msg & OneLoc ("SystemDrive",   SystemDrive)
 635     Msg = Msg & OneLoc ("SystemRoot",    SystemRoot)
 636     Msg = Msg & OneLoc ("User Name",     UserName)
 637     Msg = Msg & OneLoc ("UserProfile",   UserProfile)
 638     Msg = Msg & OneLoc ("ProgramFiles",  ProgramFiles)
 639     Msg = Msg & OneLoc ("AppData",       AppData)
 640     Msg = Msg & OneLoc ("InstallSource", InstallSource)
 641     Msg = Msg & OneLoc ("InstallTarget", InstallTarget)
 642     Msg = Msg & OneLoc ("Programs",      Programs)
 643     Msg = Msg & OneLoc ("Desktop",       Desktop)
 644     Msg = Msg & OneLoc ("Free space",    ToString (GetDriveSpace (InstallTarget)))
 645
 646     call MsgBox (Msg, vbOkOnly, "Paths and Locations")
 647 end sub
 648
 649
 650
 651 '******************************************************************************
 652 ' Return the amount of free space for a path (in Megabytes)
 653 '******************************************************************************
 654 function GetDriveSpace (Path)
 655     dim Drive
 656     On Error Resume Next
 657     set Drive = FSO.GetDrive (FSO.GetDriveName (Path))
 658     if Err.Number <> 0 then
 659         GetDriveSpace = 0
 660     else
 661         GetDriveSpace = Drive.FreeSpace / (1024 * 1024)
 662     end if
 663 end function
 664
 665
 666
 667 '******************************************************************************
 668 ' Check that there's something to install
 669 '******************************************************************************
 670 sub CheckFilesToInstall ()
 671
 672     ' If the uninstaller is unavailable for some reason or the other, we
 673     ' have a problem, because the installer will create an uninstaller entry
 674     ' in the registry, but it will not work, which means that the package
 675     ' cannot be deinstalled or overwritten. So we have to check that at least
 676     ' the uninstaller is available in the same directory as the installer.
 677     if not FileExists (BuildPath (InstallSource, "uninstall.vbs")) then
 678         Abort (GetMsg ("MSG_INCOMPLETE"))
 679     end if
 680 end sub
 681
 682
 683
 684 '******************************************************************************
 685 ' Check that were running this script as admin
 686 '******************************************************************************
 687 sub CheckAdminRights ()
 688
 689     ' FIXME: This check is not perfect
 690     if UserName <> "Administrator" then
 691         dim Args(1)
 692         Args(1) = AppName
 693
 694         if AskNoYes (FmtMsg ("MSG_ADMIN", Args)) <> vbYes then
 695             WScript.Quit (1)
 696         end if
 697     end if
 698
 699 end sub
 700
 701
 702
 703 '******************************************************************************
 704 ' Remove an old installation.
 705 '******************************************************************************
 706 sub RemoveOldInstall (UninstallCmd)
 707
 708     dim ErrCode
 709
 710     ' Execute the uninstall
 711     ErrCode = Run (UninstallCmd, 0)
 712
 713     ' Tell the user that the uninstall is done
 714     if ErrCode <> 0 then
 715         call Abort (GetMsg ("MSG_UNINSTALLERR"))
 716     end if
 717 end sub
 718
 719
 720
 721 '******************************************************************************
 722 ' Check if there is an old installation. Offer to remove it.
 723 '******************************************************************************
 724 sub CheckOldInstall ()
 725
 726     dim UninstallCmd
 727
 728     ' Read the uninstall command from the registry
 729     UninstallCmd = RegReadStr (RegUninstall & "UninstallString")
 730
 731     ' Check if there is already an executable
 732     if UninstallCmd <> "" then
 733
 734         ' Ask to remove an old install
 735         if AskYesNo (GetMsg ("MSG_REMOVEOLD")) = vbYes then
 736             ' Remove the old installation
 737             call RemoveOldInstall (UninstallCmd)
 738         end if
 739
 740     end if
 741
 742 end sub
 743
 744
 745
 746 '******************************************************************************
 747 ' Check that the install target exists. Offer to create it.
 748 '******************************************************************************
 749 sub CheckInstallTarget ()
 750
 751     dim Msg, Result, Args(2)
 752
 753     ' Tell the user about the install target and ask if it's ok
 754     Args(1) = InstallTarget
 755     Msg = FmtMsg ("MSG_INSTALLPATH", Args)
 756     if MsgBox (Msg, vbOkCancel, Installer) <> vbOk then
 757         call InfoAbort ()
 758     end if
 759
 760     ' Check if there's enough space left on the target drive
 761     if GetDriveSpace (InstallTarget) < SpaceNeeded then
 762         Args(1) = FSO.GetDriveName (InstallTarget)
 763         Args(2) = SpaceNeeded
 764         call Abort (FmtMsg ("MSG_DRIVESPACE", Args))
 765     end if
 766
 767     ' Check if the install path exist, create it if necessary
 768     if not FolderExists (InstallTarget) then
 769         Result = CreateFolder (InstallTarget)
 770         if Result <> "" then
 771             Args(1) = InstallTarget
 772             Args(2) = Result
 773             call Abort (FmtMsg ("MSG_CREATEERR", Args))
 774         end if
 775     end if
 776
 777 end sub
 778
 779
 780
 781 '******************************************************************************
 782 ' Create the uninstall control file
 783 '******************************************************************************
 784 sub CreateUninstallCtrlFile ()
 785
 786     dim Filename
 787
 788     ' Generate the filename
 789     on Error resume next
 790     set UninstallCtrlFile = FSO.CreateTextFile (UninstallCtrlFileName, true)
 791     on error goto 0
 792     if Err.Number <> 0 then
 793         dim Args(2)
 794         Args(1) = UninstallCtrlFileName
 795         Args(2) = Err.Description
 796         call ErrorMsg (FmtMsg ("MSG_CREATEERR", Args))
 797         WScript.Quit (1)
 798     end if
 799
 800     ' Write the name of the target directory to the file
 801     call WriteUninstallCtrlFile ("D " & InstallTarget)
 802
 803     ' Write the name of the file itself to the file
 804     call WriteUninstallCtrlFile ("F " & UninstallCtrlFileName)
 805
 806 end sub
 807
 808
 809
 810 '******************************************************************************
 811 ' Write to the uninstall control file
 812 '******************************************************************************
 813 sub WriteUninstallCtrlFile (Line)
 814
 815     on error resume next
 816     UninstallCtrlFile.WriteLine (Line)
 817     if Err.Number <> 0 then
 818         dim Args(2)
 819         Args(1) = UninstallCtrlFileName
 820         Args(2) = Err.Description
 821         call ErrorMsg (FmtMsg ("MSG_WRITEERR", Args))
 822         WScript.Quit (1)
 823     end if
 824
 825 end sub
 826
 827
 828
 829 '******************************************************************************
 830 ' Close the uninstall control file
 831 '******************************************************************************
 832 sub CloseUninstallCtrlFile ()
 833
 834     on error resume next
 835     UninstallCtrlFile.Close
 836     if Err.Number <> 0 then
 837         dim Args(2)
 838         Args(1) = UninstallCtrlFileName
 839         Args(2) = Err.Description
 840         call ErrorMsg (FmtMsg ("MSG_WRITEERR", Args))
 841         WScript.Quit (1)
 842     end if
 843
 844 end sub
 845
 846
 847
 848 '******************************************************************************
 849 ' Copy the application files
 850 '******************************************************************************
 851 sub RecursiveCopy (Dir, SourcePath, TargetPath)
 852
 853     dim File, TargetFile, SubDir, SourceName, TargetName, Result, Args(3)
 854
 855     ' Copy all files in this folder
 856     for each File in Dir.Files
 857
 858         ' Generate source and target file names
 859         SourceName = BuildPath (SourcePath, File.Name)
 860         TargetName = BuildPath (TargetPath, File.Name)
 861
 862         ' Copy the file. The error check doesn't seem to work.
 863         on error resume next
 864         File.Copy (TargetName)
 865         on error goto 0
 866         if Err.Number <> 0 then
 867             Args(1) = SourceName
 868             Args(2) = TargetName
 869             Args(3) = Err.Description
 870             call ErrorMsg (FmtMsg ("MSG_COPYERR", Args))
 871             call AbortInfo ()
 872         end if
 873
 874         ' Remove the r/o attribute from the target file if set
 875         set TargetFile = FSO.GetFile (TargetName)
 876         if TargetFile.Attributes mod 2 = 1 then
 877             TargetFile.Attributes = TargetFile.Attributes - 1
 878         end if
 879
 880         ' Remember this file in the uninstall control file
 881         call WriteUninstallCtrlFile ("F " & TargetName)
 882     next
 883
 884     ' Handle all subdirectories
 885     for each SubDir in Dir.SubFolders
 886
 887         ' Update the progress bar with each copied directory
 888         if PBVal <= 80 then
 889             call ProgressBar (PBVal + 5)
 890         end if
 891
 892         ' Generate the new directory names
 893         SourceName = BuildPath (SourcePath, SubDir.Name)
 894         TargetName = BuildPath (TargetPath, SubDir.Name)
 895
 896         ' Generate the new target dir. Notify the user about errors, but
 897         ' otherwise ignore them.
 898         Result = CreateFolder (TargetName)
 899         if Result <> "" then
 900             ' Display an error but try to continue
 901             Args(1) = TargetName
 902             Args(2) = Result
 903             call ErrorMsg (FmtMsg ("MSG_CREATEERR", Args))
 904         end if
 905
 906         ' Recursively process files in the subdirectory
 907         call RecursiveCopy (SubDir, SourceName, TargetName)
 908
 909         ' Remember the subdirectory in the uninstall control file
 910         WriteUninstallCtrlFile ("D " & TargetName)
 911
 912     next
 913 end sub
 914
 915 sub CopyFiles ()
 916
 917     ' Update the progress bar
 918     call ProgressBar (10)
 919
 920     ' Copy all files generating entries in the uninstall control file
 921     call RecursiveCopy (FSO.GetFolder (InstallSource), InstallSource, InstallTarget)
 922
 923     ' Update the progress bar
 924     call ProgressBar (90)
 925 end sub
 926
 927
 928
 929 '******************************************************************************
 930 ' Create the registry entries
 931 '******************************************************************************
 932 sub CreateRegEntries ()
 933
 934     dim Cmd
 935
 936     ' Create the entry in Systemsteuerung -> Software. Check if the first write
 937     ' succeeds. If not, we don't have admin rights.
 938     if RegWriteBin (RegUninstall, 1) <> "" then
 939         call Abort (GetMsg ("MSG_REGWRITEERR"))
 940     end if
 941     call RegWriteStr (RegUninstall & "DisplayName", AppName & " " & Version)
 942     call RegWriteStr (RegUninstall & "UninstallString", "wscript /nologo " & Uninstaller & " " & UninstallerCmdLine)
 943
 944 end sub
 945
 946
 947
 948 '******************************************************************************
 949 ' Function that creates an URL
 950 '******************************************************************************
 951 sub CreateUrl (Name, Url, Description)
 952     ' Ignore errors
 953     On Error Resume Next
 954
 955     dim Link
 956     set Link = Shell.CreateShortcut (Name)
 957     Link.TargetPath = Url
 958     Link.Description = Description
 959     Link.Save
 960
 961     ' Allow errors again
 962     on error goto 0
 963
 964     ' Write the file name to the uninstall control file
 965     WriteUninstallCtrlFile ("F " & Name)
 966 end sub
 967
 968
 969
 970 '******************************************************************************
 971 ' Function that creates a shortcut
 972 '******************************************************************************
 973 sub CreateShortcut (Name, Exe, Args, Description)
 974     ' Ignore errors
 975     On Error Resume Next
 976
 977     dim Link
 978     set Link = Shell.CreateShortcut (Name)
 979     Link.TargetPath  = Exe
 980     Link.Arguments   = Args
 981     Link.WindowStyle = 1
 982     Link.Description = Description
 983     Link.WorkingDirectory = AppData
 984     Link.Save
 985
 986     ' Allow errors again
 987     on error goto 0
 988
 989     ' Write the file name to the uninstall control file
 990     WriteUninstallCtrlFile ("F " & Name)
 991 end sub
 992
 993
 994
 995 '******************************************************************************
 996 ' Function that creates the menu entries
 997 '******************************************************************************
 998 sub CreateMenuEntries ()
 999     dim Folder, Result, Name, Desc, Target, Args(2)
1000
1001     ' Create the start menu folder.
1002     Folder = BuildPath (Programs, AppName)
1003     Result = CreateFolder (Folder)
1004     if Result <> "" then
1005         ' Display an error but try to continue
1006         Args(1) = Folder
1007         Args(2) = Result
1008         call ErrorMsg (FmtMsg ("MSG_CREATEERR", Args))
1009     end if
1010
1011     ' Create an uninstall shortcut in the menu folder
1012     Args(1) = AppName
1013     Desc = FmtMsg ("MSG_REMOVEENTRY", Args)
1014     Name = BuildPath (Folder, Desc & ".lnk")
1015     call CreateShortcut (Name, Uninstaller, UninstallerCmdLine, Desc)
1016
1017     ' Create a documentation shortcut in the menu folder
1018     Target = BuildPath (InstallTarget, DocIndexFile)
1019     if FileExists (Target) then
1020         Args(1) = AppName
1021         Desc = FmtMsg ("MSG_DOCENTRY", Args)
1022         Name = BuildPath (Folder, Desc & ".url")
1023         call CreateUrl (Name, "file://" & Target, Desc)
1024     end if
1025
1026     ' Create the shortcut to the announcement in the menu folder
1027     Target = BuildPath (InstallTarget, AnnouncementFile)
1028     if FileExists (Target) then
1029         Desc = GetMsg ("MSG_ANNOUNCEMENT")
1030         Name = BuildPath (Folder, Desc & ".url")
1031         call CreateUrl (Name, "file://" & Target, Desc)
1032     end if
1033
1034     ' Update the uninstall control file
1035     call WriteUninstallCtrlFile ("D " & Folder)
1036 end sub
1037
1038
1039
1040 '******************************************************************************
1041 ' Add a directory to the system path
1042 '******************************************************************************
1043 sub AddToSysPath (Dir)
1044
1045     dim Path
1046
1047     ' Handle errors. Assume failure
1048     on error resume next
1049
1050     ' Retrieve the PATH setting
1051     Path = Shell.RegRead (SysPath)
1052     if Err.Number <> 0 then
1053         ' Could not read
1054         call Abort (GetMsg ("MSG_REGREADERR"))
1055     end if
1056
1057     ' Add the new directory to the path
1058     if (Len (Path) > 0) and (Right (Path, 1) <> ";") then
1059         Path = Path + ";"
1060     end if
1061     Path = Path + Dir
1062
1063     ' Write the new path
1064     call Shell.RegWrite (SysPath, Path, "REG_EXPAND_SZ")
1065     if Err.Number <> 0 then
1066         ' Could not set
1067         call Abort (GetMsg ("MSG_REGWRITEERR"))
1068     end if
1069 end sub
1070
1071
1072
1073 '******************************************************************************
1074 ' Add environment variables
1075 '******************************************************************************
1076 sub AddEnvironment ()
1077
1078     ' Add CC65_LIB
1079     if RegWriteStr (SysEnv & "\CC65_LIB", LibDir) <> "" then
1080         call Abort (GetMsg ("MSG_REGWRITEERR"))
1081     end if
1082
1083     ' Add CC65_INC
1084     if RegWriteStr (SysEnv & "\CC65_INC", IncDir) <> "" then
1085         call Abort (GetMsg ("MSG_REGWRITEERR"))
1086     end if
1087
1088     ' Add the bin directory to the path if it's not already there
1089     if not DirInPath (BinDir) then
1090         call AddToSysPath (BinDir)
1091     end if
1092
1093     ' Run the wm_envchange program to notify other running programs
1094     ' of the changed environment. Ignore errors.
1095     call Run (BuildPath (BinDir, "wm_envchange.exe"), 0)
1096
1097 end sub
1098
1099
1100
1101 '******************************************************************************
1102 ' Function that tells the user that the install was successful
1103 '******************************************************************************
1104 sub Success ()
1105     call MsgBox (GetMsg ("MSG_SUCCESS"), vbOkOnly + vbInformation, Installer)
1106 end sub
1107
1108
1109
1110 '******************************************************************************
1111 ' Main program
1112 '******************************************************************************
1113 sub Main ()
1114
1115     ' Initialize global variables. This includes the paths used
1116     call InitializeGlobals ()
1117     if Dbg then
1118         call ShowPathsAndLocations ()
1119     end if
1120
1121     ' Check that there's something to install
1122     call CheckFilesToInstall ()
1123
1124     ' Check that we're running this script as admin
1125     call CheckAdminRights ()
1126
1127     ' Check if there is an old installation and offer to remove it
1128     call CheckOldInstall ()
1129
1130     ' Check if the source directory does really exist
1131     call CheckInstallTarget ()
1132
1133     ' Display the progress bar
1134     call ProgressBar (0)
1135
1136     ' Create the uninstall file
1137     call CreateUninstallCtrlFile ()
1138     call ProgressBar (2)
1139
1140     ' Create registry entries
1141     CreateRegEntries ()
1142     call Progressbar (5)
1143
1144     ' Copy the application files (will do automatic progress bar updates)
1145     call CopyFiles ()
1146
1147     ' Create the menu entries
1148     call CreateMenuEntries ()
1149     call ProgressBar (90)
1150
1151     ' Add entries to the enviroment
1152     call AddEnvironment ()
1153     call ProgressBar (95)
1154
1155     ' Close the uninstall control file
1156     call CloseUninstallCtrlFile ()
1157
1158     ' We're done
1159     call ProgressBar (100)
1160     call ProgressBar (-1)
1161     call Success ()
1162
1163     ' Return a success code
1164     WScript.Quit (0)
1165 end sub
1166
1167
1168
1169 '******************************************************************************
1170 ' The script body just calls Main...
1171 '******************************************************************************
1172 Main ()
1173
1174
1175
1176
1177