uninstall.vbs

6502 c compiler free open source

'******************************************************************************
' Ask a yes/no question and return the result. "Yes" is default.
'******************************************************************************
function AskYesNo (Question)
    AskYesNo = MsgBox (Question, vbYesNo + vbQuestion + vbDefaultButton1, Title)
end function



'******************************************************************************
' Ask a yes/no question and return the result. "No" is default.
'******************************************************************************
function AskNoYes (Question)
    AskNoYes = MsgBox (Question, vbYesNo + vbQuestion + vbDefaultButton2, Title)
end function



'******************************************************************************
' Ask if the user wants to abort install, and terminate if the answer is yes
'******************************************************************************
sub QueryAbort ()
    if AskNoYes (GetMsg ("MSG_ABORT")) = vbYes then
        WScript.Quit (1)
    end if
end sub



'******************************************************************************
' Function that displays the paths and locations found
'******************************************************************************
function OneLoc (Key, Value)
    dim Result
    Result = Trim (Key)
    if Len (Result) <= 8 then
        Result = Result & Tab
    end if
    OneLoc = Result & Tab & "=" & Tab & Value & NewLine
end function

sub ShowPathsAndLocations ()
    dim Msg
    Msg = Msg & OneLoc ("SystemDrive",   SystemDrive)
    Msg = Msg & OneLoc ("SystemRoot",    SystemRoot)
    Msg = Msg & OneLoc ("UserName",      UserName)
    Msg = Msg & OneLoc ("UserProfile",   UserProfile)
    Msg = Msg & OneLoc ("ProgramFiles",  ProgramFiles)

    MsgBox Msg, vbOkOnly, "Paths and Locations"
end sub



'******************************************************************************
' Check that were running this script as admin
'******************************************************************************
sub CheckAdminRights ()

    ' FIXME: This check is not perfect
    if UserName <> "Administrator" then
        dim Args(1)
        Args(1) = AppName

        if AskNoYes (FmtMsg ("MSG_ADMIN", Args)) <> vbYes then
            WScript.Quit (1)
        end if
    end if

end sub



'******************************************************************************
' Read the uninstall control file and create the data collections
'******************************************************************************
sub InvalidCtrlFile (Line, Val)
    dim Args(3)
    Args(1) = UninstallCtrlFileName
    Args(2) = Line
    Args(3) = Val
    call Abort (FmtMsg ("MSG_CTRLFILEERR", Args))
end sub

sub ReadUninstallCtrlFile ()

    const ForReading = 1
    dim File, Line, Tag, Args(3)
    dim MyRegList, MyFileList, myDirList

    ' Create some dictionaries. These are not really used as dictionaries, but
    ' have the nice property of expanding dynamically, and we need that.
    set MyRegList  = CreateObject ("Scripting.Dictionary")
    set MyFileList = CreateObject ("Scripting.Dictionary")
    set MyDirList  = CreateObject ("Scripting.Dictionary")

    ' Open the file. Checking Err doesn't work here, don't know why.
    set File = nothing
    on error resume next
    set File = FSO.OpenTextFile (UninstallCtrlFileName, ForReading)
    on error goto 0
    if File is nothing then
        Args(1) = UninstallCtrlFileName
        call Abort (FmtMsg ("MSG_OPENERR", Args))
    end if

    ' Read all lines and insert them in their list
    do while File.AtEndOfStream <> true

        ' Read the next line
        on error resume next
        Line = File.ReadLine
        on error goto 0

        ' Get the type from the line and remove it, so the line contains just
        ' the argument name
        Tag  = Left (Line, 1)
        Line = Mid (Line, 3)

        ' Determine the type of the entry
        select case Tag

            case "D"
                ' A directory. Convert to lowercase to unify names.
                Line = LCase (Line)
                if MyDirList.Exists (Line) then
                    call InvalidCtrlFile (File.Line - 1, GetMsg ("MSG_DUPLICATE"))
                else
                    call MyDirList.Add (Line, "")
                end if

            case "F"
                ' A file. Convert to lowercase to unify names
                Line = LCase (Line)
                if MyFileList.Exists (Line) then
                    call InvalidCtrlFile (File.Line - 1, GetMsg ("MSG_DUPLICATE"))
                else
                    call MyFileList.Add (Line, "")
                end if

            case "R"
                ' A registry entry
                if MyRegList.Exists (Line) then
                    call InvalidCtrlFile (File.Line - 1, GetMsg ("MSG_DUPLICATE"))
                else
                    call MyRegList.Add (Line, "")
                end if

            case else
                call InvalidCtrlFile (File.Line - 1, Tag & " " & Line)

        end select

    loop

    ' Close the file
    on error resume next
    call File.Close ()
    on error goto 0

    ' Make the global arrays big enough for the data
    RegList  = Array (MyRegList.Count)
    FileList = Array (MyFileList.Count)
    DirList  = Array (MyDirList.Count)

    ' Copy the data into the global arrays
    RegList  = MyRegList.Keys
    FileList = MyFileList.Keys
    DirList  = MyDirList.Keys

    ' Sort all the lists. This makes sure nodes are in the array before the
    ' leaves that depend on it. Or in other words: Top level directories and
    ' registry entries come first. So if we delete the items starting at the
    ' other side of the array, we will never delete a subdirectory before its
    ' parent directory.
    call QuickSort (RegList)
    call QuickSort (FileList)
    call QuickSort (DirList)

end sub



'******************************************************************************
' Delete the registry entries
'******************************************************************************
sub DeleteRegistryEntries ()

    dim I, Result, NoDel, Args(1)

    NoDel = ""
    for I = UBound (RegList) to LBound (RegList) step -1
        Result = RegDelete (RegList (I))
        if Result <> "" then
            ' Remember the entries we could not delete
            NoDel = NoDel & RegList (I) & NewLine
        end if
    next

    if NoDel <> "" then
        Args(1) = NoDel
        call ErrorMsg (FmtMsg ("MSG_REGDEL", Args))
    end if
end sub



'******************************************************************************
' Delete the files
'******************************************************************************
sub DeleteFiles ()

    dim I, Result, NoDel, Args(1)

    NoDel = ""
    for I = UBound (FileList) to LBound (FileList) step -1
        Result = DeleteFile (FileList (I))
        if Result <> "" then
            ' Remember the files we could not delete
            NoDel = NoDel & FileList (I) & NewLine
        end if
    next

    if NoDel <> "" then
        Args(1) = NoDel
        call ErrorMsg (FmtMsg ("MSG_FILEDEL", Args))
    end if
end sub



'******************************************************************************
' Delete the directories
'******************************************************************************
sub DeleteDirectories ()

    dim I, Result, NoDel, Args(1)

    NoDel = ""
    for I = UBound (DirList) to LBound (DirList) step -1
        Result = DeleteFolder (DirList (I))
        if Result <> "" then
            ' Remember the directories we could not delete
            NoDel = NoDel & DirList (I) & NewLine
        end if
    next

    if NoDel <> "" then
        Args(1) = NoDel
        call ErrorMsg (FmtMsg ("MSG_DIRDEL", Args))
    end if
end sub



'******************************************************************************
' Function that tells the user that the install was successful
'******************************************************************************
sub Success ()
    dim Args(1), App

    ' Popup message
    Args(1) = AppName
    call MsgBox (FmtMsg ("MSG_SUCCESS", Args), vbOkOnly + vbInformation, Title)

end sub



'******************************************************************************
' Function that tells the user that the uninstall failed
'******************************************************************************
sub Failure ()
    dim Args(2)

    ' Popup message
    Args(1) = AppName
    Args(2) = Title
    ErrorMsg (FmtMsg ("MSG_FAILURE", Args))
    WScript.Quit (1)

end sub



'******************************************************************************
' Main program
'******************************************************************************
sub Main ()

    dim Args(1)

    ' Initialize global variables. This includes the paths used
    InitializeGlobals ()
    if Dbg then
        ShowPathsAndLocations ()
    end if

    ' Check that we're running this script as admin
    CheckAdminRights ()

    ' Let the user make up his mind
    Args(1) = AppName
    if AskYesNo (FmtMsg ("MSG_REMOVE", Args)) <> vbYes then
        WScript.Quit (1)
    end if

    ' Read the uninstall control file
    call ReadUninstallCtrlFile ()

    ' Delete the registry entries
    call DeleteRegistryEntries ()

    ' Delete all files
    call DeleteFiles ()

    ' Delete the directories
    call DeleteDirectories ()

    ' We're done
    if Failed then
        Failure ()
    else
        Success ()
    end if
end sub



'******************************************************************************
' The script body just calls Main...
'******************************************************************************
Main ()