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

   1 Option Explicit                 ' Variables must be declared explicitly
   2
   3
   4
   5 '******************************************************************************
   6 ' Global constants and variables
   7 '******************************************************************************
   8 dim Tab, NewLine                ' String constants
   9 dim Shell, FSO                  ' Global objects
  10 dim ProgArgs                    ' Program arguments
  11 dim Dbg                         ' Output debugging stuff
  12 dim Language                    ' Program language
  13 dim AppName                     ' Application name
  14 dim Title                       ' Application title
  15 dim UninstallCtrlFileName       ' Name of the uninstall control file
  16 dim SystemDrive                 ' The system drive
  17 dim SystemRoot                  ' The windows directory
  18 dim UserName                    ' Name if the current user
  19 dim UserProfile                 ' User profile directory
  20 dim ProgramFiles                ' Program files directory
  21 dim Failed                      ' Global flag for removal failed
  22 dim RegList                     ' List of registry entries to remove
  23 dim FileList                    ' List of files to remove
  24 dim DirList                     ' List of directories to remove
  25
  26
  27
  28 '******************************************************************************
  29 ' Display an error message window with an OK button
  30 '******************************************************************************
  31 sub ErrorMsg (Msg)
  32     call MsgBox (Msg, vbOkOnly + vbExclamation, Title)
  33 end sub
  34
  35
  36
  37 '******************************************************************************
  38 ' Display an error message window and abort the installer
  39 '******************************************************************************
  40 sub Abort (Msg)
  41     call ErrorMsg (Msg)
  42     WScript.Quit (1)
  43 end sub
  44
  45
  46
  47 '******************************************************************************
  48 ' Convert a number to a string
  49 '******************************************************************************
  50 function ToString (Num)
  51     ToString = FormatNumber (Num, vbFalse, vbTrue, vbFalse, vbFalse)
  52 end function
  53
  54
  55
  56 '******************************************************************************
  57 ' Return a message in the current language
  58 '******************************************************************************
  59 function GetMsg (Key)
  60     dim Msg
  61
  62     ' Handle other languages here
  63
  64     ' Default is english
  65     if IsEmpty (Msg) then
  66         ' No assignment, use english
  67         select case Key
  68             case "MSG_ABORT"
  69                 Msg = "Do you want to abort the installation?"
  70             case "MSG_ADMIN"
  71                 Msg = "You must be Administrator to remove %1."
  72                 Msg = Msg & " Are you sure you want to continue?"
  73             case "MSG_CTRLFILEERR"
  74                 Msg = "The file %1 is invalid." & NewLine
  75                 Msg = Msg & "Line %2: %3"
  76             case "MSG_DIRDEL"
  77                 Msg = "Some folders could not be removed:"
  78                 Msg = Msg & NewLine & "%1"
  79             case "MSG_DUPLICATE"
  80                 Msg = "Duplicate value"
  81             case "MSG_FAILURE"
  82                 Msg = "Could not remove %1." & NewLine
  83                 Msg = "%2 needs to be run by an Administrator!"
  84             case "MSG_FILEDEL"
  85                 Msg = "Some files could not be deleted:"
  86                 Msg = Msg & NewLine & "%1"
  87             case "MSG_OPENERR"
  88                 Msg = "Error opening %1"
  89             case "MSG_REGDEL"
  90                 Msg = "Some registry entries could not be deleted:"
  91                 Msg = Msg & NewLine & "%1"
  92             case "MSG_REMOVE"
  93                 Msg = "Remove %1?"
  94             case "MSG_SUCCESS"
  95                 Msg = "%1 has been successfully removed."
  96             case "MSG_USAGE"
  97                 Msg = "Usage:" & NewLine & "uninstall appname ctrl-file"
  98             case else
  99                 Msg = Key
 100         end select
 101     end if
 102     GetMsg = Msg
 103 end function
 104
 105
 106
 107 '******************************************************************************
 108 ' Format a string replacing %n specifiers in the format string F
 109 '******************************************************************************
 110 function Fmt (F, Values)
 111     dim I, Count, Key, Val, Start, Pos
 112     Count = UBound (Values)     ' How many values?
 113     for I = Count to 0 step -1
 114         Key = "%" & ToString (I)
 115         select case VarType (Values (I))
 116             case vbEmpty
 117                 Val = ""
 118             case vbInteger
 119                 Val = ToString (Values (I))
 120             case vbLong
 121                 Val = ToString (Values (I))
 122             case vbNull
 123                 Val = ""
 124             case vbSingle
 125                 Val = ToString (Values (I))
 126             case vbDouble
 127                 Val = ToString (Values (I))
 128             case vbString
 129                 Val = Values (I)
 130             case else
 131                 Abort ("Internal error: Invalid conversion in Format()")
 132         end select
 133         F = Replace (F, Key, Val)
 134     next
 135     Fmt = F
 136 end function
 137
 138
 139
 140 '******************************************************************************
 141 ' Format a message replacing %n specifiers in the format string F
 142 '******************************************************************************
 143 function FmtMsg (Msg, Values)
 144     FmtMsg = Fmt (GetMsg (Msg), Values)
 145 end function
 146
 147
 148
 149 '******************************************************************************
 150 ' Return an environment string. Fix up Microsoft "innovative" ideas.
 151 '******************************************************************************
 152 function GetEnv (Key)
 153     dim Value
 154     Value = Shell.ExpandEnvironmentStrings (Key)
 155     if Value = Key then
 156         GetEnv = vbNullString
 157     else
 158         GetEnv = Value
 159     end if
 160 end function
 161
 162
 163
 164 '******************************************************************************
 165 ' Build a path from two components
 166 '******************************************************************************
 167 function BuildPath (Path, Name)
 168     BuildPath = FSO.BuildPath (Path, Name)
 169 end function
 170
 171
 172
 173 '******************************************************************************
 174 ' Delete a folder and return an error string
 175 '******************************************************************************
 176 function DeleteFolder (Path)
 177     on error resume next
 178     call FSO.DeleteFolder (Path, true)
 179     DeleteFolder = Err.Description
 180 end function
 181
 182
 183
 184 '******************************************************************************
 185 ' Delete a file and return an error string
 186 '******************************************************************************
 187 function DeleteFile (Path)
 188     on error resume next
 189     call FSO.DeleteFile (Path, true)
 190     DeleteFile = Err.Description
 191 end function
 192
 193
 194
 195 '******************************************************************************
 196 ' Delete a registry entry
 197 '******************************************************************************
 198 function RegDelete (Key)
 199     on error resume next
 200     call Shell.RegDelete (Key)
 201     RegDelete = Err.Description
 202 end function
 203
 204
 205
 206 '******************************************************************************
 207 ' Sort an array of strings
 208 '******************************************************************************
 209 sub QS (byref A, Lo, Hi)
 210
 211     dim I, J, T
 212
 213     ' Quicksort
 214     do while Hi > Lo
 215         I = Lo + 1
 216         J = Hi
 217         do while I <= J
 218             do while I <= J
 219                 if StrComp (A(Lo), A(I), vbTextCompare) < 0 then
 220                     exit do
 221                 end if
 222                 I = I + 1
 223             loop
 224             do while I <= J
 225                 if StrComp (A(Lo), A(J), vbTextCompare) >= 0 then
 226                     exit do
 227                 end if
 228                 J = J - 1
 229             loop
 230             if I <= J then
 231                 ' Swap A(I) and A(J)
 232                 T = A(I)
 233                 A(I) = A(J)
 234                 A(J) = T
 235                 I = I + 1
 236                 J = J - 1
 237             end if
 238         loop
 239         if J <> Lo then
 240             ' Swap A(J) and A(Lo)
 241             T = A(J)
 242             A(J) = A(Lo)
 243             A(Lo) = T
 244         end if
 245         if (2 * J) > (Hi + Lo) then
 246             call QS (A, J + 1, Hi)
 247             Hi = J - 1
 248         else
 249             call QS (A, Lo, J - 1)
 250             Lo = J + 1
 251         end if
 252     loop
 253 end sub
 254
 255 sub Quicksort (byref A)
 256     if UBound (A) > 1 then
 257         call QS (A, LBound (A), UBound (A))
 258     end if
 259 end sub
 260
 261
 262
 263 '******************************************************************************
 264 ' Initialize global variables
 265 '******************************************************************************
 266 sub InitializeGlobals ()
 267     dim I
 268
 269     ' String stuff used for formatting
 270     Tab     = Chr (9)
 271     NewLine = Chr (13)
 272
 273     ' Global objects
 274     set Shell = WScript.CreateObject ("WScript.Shell")
 275     set FSO   = CreateObject ("Scripting.FileSystemObject")
 276
 277     ' Arguments
 278     set ProgArgs = WScript.Arguments
 279
 280     ' Handle program arguments
 281     AppName = ""
 282     Title = "Uninstaller"
 283     UninstallCtrlFileName = ""
 284     Dbg = false
 285     Language = "de"
 286     for I = 0 to ProgArgs.Count-1
 287         select case ProgArgs(I)
 288             case "-de"
 289                 Language = "de"
 290             case "-debug"
 291                 Dbg = true
 292             case "-en"
 293                 Language = "en"
 294             case else
 295                 if AppName = "" then
 296                     AppName = ProgArgs(I)
 297                 elseif UninstallCtrlFileName = "" then
 298                     UninstallCtrlFileName = ProgArgs(I)
 299                 else
 300                     call ErrorMsg (GetMsg ("MSG_USAGE"))
 301                     WScript.Quit (1)
 302                 end if
 303         end select
 304     next
 305
 306     ' We need the application name and uninstall control file
 307     if AppName = "" or UninstallCtrlFileName = "" then
 308         call Abort (GetMsg ("MSG_USAGE"))
 309     end if
 310
 311     ' Set the title early, because it's used in error messages
 312     Title = AppName & " Uninstaller"
 313
 314     ' Paths and locations
 315     SystemDrive = GetEnv ("%SystemDrive%")
 316     if SystemDrive = vbNullString then
 317         SystemDrive = "c:"
 318     end if
 319     SystemRoot = GetEnv ("%SystemRoot%")
 320     if SystemRoot = vbNullString then
 321         SystemRoot = BuildPath (SystemDrive, "winnt")
 322     end if
 323     UserName = GetEnv ("%USERNAME%")
 324     if UserName = vbNullString then
 325         UserName = "Administrator"
 326     end if
 327     UserProfile = GetEnv ("%USERPROFILE%")
 328     if UserProfile = vbNullString then
 329         UserProfile = BuildPath (SystemDrive, "Dokumente und Einstellungen\" & UserName)
 330     end if
 331     ProgramFiles = GetEnv ("%ProgramFiles%")
 332     if ProgramFiles = vbNullString then
 333         ProgramFiles = BuildPath (SystemDrive, "Programme")
 334     end if
 335
 336     ' Assume we could remove the software
 337     Failed = false
 338
 339 end sub
 340
 341
 342
 343 '******************************************************************************
 344 ' Ask a yes/no question and return the result. "Yes" is default.
 345 '******************************************************************************
 346 function AskYesNo (Question)
 347     AskYesNo = MsgBox (Question, vbYesNo + vbQuestion + vbDefaultButton1, Title)
 348 end function
 349
 350
 351
 352 '******************************************************************************
 353 ' Ask a yes/no question and return the result. "No" is default.
 354 '******************************************************************************
 355 function AskNoYes (Question)
 356     AskNoYes = MsgBox (Question, vbYesNo + vbQuestion + vbDefaultButton2, Title)
 357 end function
 358
 359
 360
 361 '******************************************************************************
 362 ' Ask if the user wants to abort install, and terminate if the answer is yes
 363 '******************************************************************************
 364 sub QueryAbort ()
 365     if AskNoYes (GetMsg ("MSG_ABORT")) = vbYes then
 366         WScript.Quit (1)
 367     end if
 368 end sub
 369
 370
 371
 372 '******************************************************************************
 373 ' Function that displays the paths and locations found
 374 '******************************************************************************
 375 function OneLoc (Key, Value)
 376     dim Result
 377     Result = Trim (Key)
 378     if Len (Result) <= 8 then
 379         Result = Result & Tab
 380     end if
 381     OneLoc = Result & Tab & "=" & Tab & Value & NewLine
 382 end function
 383
 384 sub ShowPathsAndLocations ()
 385     dim Msg
 386     Msg = Msg & OneLoc ("SystemDrive",   SystemDrive)
 387     Msg = Msg & OneLoc ("SystemRoot",    SystemRoot)
 388     Msg = Msg & OneLoc ("UserName",      UserName)
 389     Msg = Msg & OneLoc ("UserProfile",   UserProfile)
 390     Msg = Msg & OneLoc ("ProgramFiles",  ProgramFiles)
 391
 392     MsgBox Msg, vbOkOnly, "Paths and Locations"
 393 end sub
 394
 395
 396
 397 '******************************************************************************
 398 ' Check that were running this script as admin
 399 '******************************************************************************
 400 sub CheckAdminRights ()
 401
 402     ' FIXME: This check is not perfect
 403     if UserName <> "Administrator" then
 404         dim Args(1)
 405         Args(1) = AppName
 406
 407         if AskNoYes (FmtMsg ("MSG_ADMIN", Args)) <> vbYes then
 408             WScript.Quit (1)
 409         end if
 410     end if
 411
 412 end sub
 413
 414
 415
 416 '******************************************************************************
 417 ' Read the uninstall control file and create the data collections
 418 '******************************************************************************
 419 sub InvalidCtrlFile (Line, Val)
 420     dim Args(3)
 421     Args(1) = UninstallCtrlFileName
 422     Args(2) = Line
 423     Args(3) = Val
 424     call Abort (FmtMsg ("MSG_CTRLFILEERR", Args))
 425 end sub
 426
 427 sub ReadUninstallCtrlFile ()
 428
 429     const ForReading = 1
 430     dim File, Line, Tag, Args(3)
 431     dim MyRegList, MyFileList, myDirList
 432
 433     ' Create some dictionaries. These are not really used as dictionaries, but
 434     ' have the nice property of expanding dynamically, and we need that.
 435     set MyRegList  = CreateObject ("Scripting.Dictionary")
 436     set MyFileList = CreateObject ("Scripting.Dictionary")
 437     set MyDirList  = CreateObject ("Scripting.Dictionary")
 438
 439     ' Open the file. Checking Err doesn't work here, don't know why.
 440     set File = nothing
 441     on error resume next
 442     set File = FSO.OpenTextFile (UninstallCtrlFileName, ForReading)
 443     on error goto 0
 444     if File is nothing then
 445         Args(1) = UninstallCtrlFileName
 446         call Abort (FmtMsg ("MSG_OPENERR", Args))
 447     end if
 448
 449     ' Read all lines and insert them in their list
 450     do while File.AtEndOfStream <> true
 451
 452         ' Read the next line
 453         on error resume next
 454         Line = File.ReadLine
 455         on error goto 0
 456
 457         ' Get the type from the line and remove it, so the line contains just
 458         ' the argument name
 459         Tag  = Left (Line, 1)
 460         Line = Mid (Line, 3)
 461
 462         ' Determine the type of the entry
 463         select case Tag
 464
 465             case "D"
 466                 ' A directory. Convert to lowercase to unify names.
 467                 Line = LCase (Line)
 468                 if MyDirList.Exists (Line) then
 469                     call InvalidCtrlFile (File.Line - 1, GetMsg ("MSG_DUPLICATE"))
 470                 else
 471                     call MyDirList.Add (Line, "")
 472                 end if
 473
 474             case "F"
 475                 ' A file. Convert to lowercase to unify names
 476                 Line = LCase (Line)
 477                 if MyFileList.Exists (Line) then
 478                     call InvalidCtrlFile (File.Line - 1, GetMsg ("MSG_DUPLICATE"))
 479                 else
 480                     call MyFileList.Add (Line, "")
 481                 end if
 482
 483             case "R"
 484                 ' A registry entry
 485                 if MyRegList.Exists (Line) then
 486                     call InvalidCtrlFile (File.Line - 1, GetMsg ("MSG_DUPLICATE"))
 487                 else
 488                     call MyRegList.Add (Line, "")
 489                 end if
 490
 491             case else
 492                 call InvalidCtrlFile (File.Line - 1, Tag & " " & Line)
 493
 494         end select
 495
 496     loop
 497
 498     ' Close the file
 499     on error resume next
 500     call File.Close ()
 501     on error goto 0
 502
 503     ' Make the global arrays big enough for the data
 504     RegList  = Array (MyRegList.Count)
 505     FileList = Array (MyFileList.Count)
 506     DirList  = Array (MyDirList.Count)
 507
 508     ' Copy the data into the global arrays
 509     RegList  = MyRegList.Keys
 510     FileList = MyFileList.Keys
 511     DirList  = MyDirList.Keys
 512
 513     ' Sort all the lists. This makes sure nodes are in the array before the
 514     ' leaves that depend on it. Or in other words: Top level directories and
 515     ' registry entries come first. So if we delete the items starting at the
 516     ' other side of the array, we will never delete a subdirectory before its
 517     ' parent directory.
 518     call QuickSort (RegList)
 519     call QuickSort (FileList)
 520     call QuickSort (DirList)
 521
 522 end sub
 523
 524
 525
 526 '******************************************************************************
 527 ' Delete the registry entries
 528 '******************************************************************************
 529 sub DeleteRegistryEntries ()
 530
 531     dim I, Result, NoDel, Args(1)
 532
 533     NoDel = ""
 534     for I = UBound (RegList) to LBound (RegList) step -1
 535         Result = RegDelete (RegList (I))
 536         if Result <> "" then
 537             ' Remember the entries we could not delete
 538             NoDel = NoDel & RegList (I) & NewLine
 539         end if
 540     next
 541
 542     if NoDel <> "" then
 543         Args(1) = NoDel
 544         call ErrorMsg (FmtMsg ("MSG_REGDEL", Args))
 545     end if
 546 end sub
 547
 548
 549
 550 '******************************************************************************
 551 ' Delete the files
 552 '******************************************************************************
 553 sub DeleteFiles ()
 554
 555     dim I, Result, NoDel, Args(1)
 556
 557     NoDel = ""
 558     for I = UBound (FileList) to LBound (FileList) step -1
 559         Result = DeleteFile (FileList (I))
 560         if Result <> "" then
 561             ' Remember the files we could not delete
 562             NoDel = NoDel & FileList (I) & NewLine
 563         end if
 564     next
 565
 566     if NoDel <> "" then
 567         Args(1) = NoDel
 568         call ErrorMsg (FmtMsg ("MSG_FILEDEL", Args))
 569     end if
 570 end sub
 571
 572
 573
 574 '******************************************************************************
 575 ' Delete the directories
 576 '******************************************************************************
 577 sub DeleteDirectories ()
 578
 579     dim I, Result, NoDel, Args(1)
 580
 581     NoDel = ""
 582     for I = UBound (DirList) to LBound (DirList) step -1
 583         Result = DeleteFolder (DirList (I))
 584         if Result <> "" then
 585             ' Remember the directories we could not delete
 586             NoDel = NoDel & DirList (I) & NewLine
 587         end if
 588     next
 589
 590     if NoDel <> "" then
 591         Args(1) = NoDel
 592         call ErrorMsg (FmtMsg ("MSG_DIRDEL", Args))
 593     end if
 594 end sub
 595
 596
 597
 598 '******************************************************************************
 599 ' Function that tells the user that the install was successful
 600 '******************************************************************************
 601 sub Success ()
 602     dim Args(1), App
 603
 604     ' Popup message
 605     Args(1) = AppName
 606     call MsgBox (FmtMsg ("MSG_SUCCESS", Args), vbOkOnly + vbInformation, Title)
 607
 608 end sub
 609
 610
 611
 612 '******************************************************************************
 613 ' Function that tells the user that the uninstall failed
 614 '******************************************************************************
 615 sub Failure ()
 616     dim Args(2)
 617
 618     ' Popup message
 619     Args(1) = AppName
 620     Args(2) = Title
 621     ErrorMsg (FmtMsg ("MSG_FAILURE", Args))
 622     WScript.Quit (1)
 623
 624 end sub
 625
 626
 627
 628 '******************************************************************************
 629 ' Main program
 630 '******************************************************************************
 631 sub Main ()
 632
 633     dim Args(1)
 634
 635     ' Initialize global variables. This includes the paths used
 636     InitializeGlobals ()
 637     if Dbg then
 638         ShowPathsAndLocations ()
 639     end if
 640
 641     ' Check that we're running this script as admin
 642     CheckAdminRights ()
 643
 644     ' Let the user make up his mind
 645     Args(1) = AppName
 646     if AskYesNo (FmtMsg ("MSG_REMOVE", Args)) <> vbYes then
 647         WScript.Quit (1)
 648     end if
 649
 650     ' Read the uninstall control file
 651     call ReadUninstallCtrlFile ()
 652
 653     ' Delete the registry entries
 654     call DeleteRegistryEntries ()
 655
 656     ' Delete all files
 657     call DeleteFiles ()
 658
 659     ' Delete the directories
 660     call DeleteDirectories ()
 661
 662     ' We're done
 663     if Failed then
 664         Failure ()
 665     else
 666         Success ()
 667     end if
 668 end sub
 669
 670
 671
 672 '******************************************************************************
 673 ' The script body just calls Main...
 674 '******************************************************************************
 675 Main ()
 676
 677
 678
 679