uninstall.vbs

6502 c compiler free open source

Option Explicit                 ' Variables must be declared explicitly



'******************************************************************************
' Global constants and variables
'******************************************************************************
dim Tab, NewLine                ' String constants
dim Shell, FSO                  ' Global objects
dim ProgArgs                    ' Program arguments
dim Dbg                         ' Output debugging stuff
dim Language                    ' Program language
dim AppName                     ' Application name
dim Title                       ' Application title
dim UninstallCtrlFileName       ' Name of the uninstall control file
dim SystemDrive                 ' The system drive
dim SystemRoot                  ' The windows directory
dim UserName                    ' Name if the current user
dim UserProfile                 ' User profile directory
dim ProgramFiles                ' Program files directory
dim Failed                      ' Global flag for removal failed
dim RegList                     ' List of registry entries to remove
dim FileList                    ' List of files to remove
dim DirList                     ' List of directories to remove



'******************************************************************************
' Display an error message window with an OK button
'******************************************************************************
sub ErrorMsg (Msg)
    call MsgBox (Msg, vbOkOnly + vbExclamation, Title)
end sub



'******************************************************************************
' Display an error message window and abort the installer
'******************************************************************************
sub Abort (Msg)
    call ErrorMsg (Msg)
    WScript.Quit (1)
end sub



'******************************************************************************
' Convert a number to a string
'******************************************************************************
function ToString (Num)
    ToString = FormatNumber (Num, vbFalse, vbTrue, vbFalse, vbFalse)
end function



'******************************************************************************
' Return a message in the current language
'******************************************************************************
function GetMsg (Key)
    dim Msg

    ' Handle other languages here

    ' Default is english
    if IsEmpty (Msg) then
        ' No assignment, use english
        select case Key
            case "MSG_ABORT"
                Msg = "Do you want to abort the installation?"
            case "MSG_ADMIN"
                Msg = "You must be Administrator to remove %1."
                Msg = Msg & " Are you sure you want to continue?"
            case "MSG_CTRLFILEERR"
                Msg = "The file %1 is invalid." & NewLine
                Msg = Msg & "Line %2: %3"
            case "MSG_DIRDEL"
                Msg = "Some folders could not be removed:"
                Msg = Msg & NewLine & "%1"
            case "MSG_DUPLICATE"
                Msg = "Duplicate value"
            case "MSG_FAILURE"
                Msg = "Could not remove %1." & NewLine
                Msg = "%2 needs to be run by an Administrator!"
            case "MSG_FILEDEL"
                Msg = "Some files could not be deleted:"
                Msg = Msg & NewLine & "%1"
            case "MSG_OPENERR"
                Msg = "Error opening %1"
            case "MSG_REGDEL"
                Msg = "Some registry entries could not be deleted:"
                Msg = Msg & NewLine & "%1"
            case "MSG_REMOVE"
                Msg = "Remove %1?"
            case "MSG_SUCCESS"
                Msg = "%1 has been successfully removed."
            case "MSG_USAGE"
                Msg = "Usage:" & NewLine & "uninstall appname ctrl-file"
            case else
                Msg = Key
        end select
    end if
    GetMsg = Msg
end function



'******************************************************************************
' Format a string replacing %n specifiers in the format string F
'******************************************************************************
function Fmt (F, Values)
    dim I, Count, Key, Val, Start, Pos
    Count = UBound (Values)     ' How many values?
    for I = Count to 0 step -1
        Key = "%" & ToString (I)
        select case VarType (Values (I))
            case vbEmpty
                Val = ""
            case vbInteger
                Val = ToString (Values (I))
            case vbLong
                Val = ToString (Values (I))
            case vbNull
                Val = ""
            case vbSingle
                Val = ToString (Values (I))
            case vbDouble
                Val = ToString (Values (I))
            case vbString
                Val = Values (I)
            case else
                Abort ("Internal error: Invalid conversion in Format()")
        end select
        F = Replace (F, Key, Val)
    next
    Fmt = F
end function



'******************************************************************************
' Format a message replacing %n specifiers in the format string F
'******************************************************************************
function FmtMsg (Msg, Values)
    FmtMsg = Fmt (GetMsg (Msg), Values)
end function



'******************************************************************************
' Return an environment string. Fix up Microsoft "innovative" ideas.
'******************************************************************************
function GetEnv (Key)
    dim Value
    Value = Shell.ExpandEnvironmentStrings (Key)
    if Value = Key then
        GetEnv = vbNullString
    else
        GetEnv = Value
    end if
end function



'******************************************************************************
' Build a path from two components
'******************************************************************************
function BuildPath (Path, Name)
    BuildPath = FSO.BuildPath (Path, Name)
end function



'******************************************************************************
' Delete a folder and return an error string
'******************************************************************************
function DeleteFolder (Path)
    on error resume next
    call FSO.DeleteFolder (Path, true)
    DeleteFolder = Err.Description
end function



'******************************************************************************
' Delete a file and return an error string
'******************************************************************************
function DeleteFile (Path)
    on error resume next
    call FSO.DeleteFile (Path, true)
    DeleteFile = Err.Description
end function



'******************************************************************************
' Delete a registry entry
'******************************************************************************
function RegDelete (Key)
    on error resume next
    call Shell.RegDelete (Key)
    RegDelete = Err.Description
end function



'******************************************************************************
' Sort an array of strings
'******************************************************************************
sub QS (byref A, Lo, Hi)

    dim I, J, T

    ' Quicksort
    do while Hi > Lo
       	I = Lo + 1
       	J = Hi
       	do while I <= J
       	    do while I <= J
                if StrComp (A(Lo), A(I), vbTextCompare) < 0 then
                    exit do
                end if
       	       	I = I + 1
       	    loop
       	    do while I <= J
                if StrComp (A(Lo), A(J), vbTextCompare) >= 0 then
                    exit do
                end if
       	       	J = J - 1
       	    loop
       	    if I <= J then
                ' Swap A(I) and A(J)
                T = A(I)
                A(I) = A(J)
                A(J) = T
       	     	I = I + 1
       	     	J = J - 1
       	    end if
      	loop
   	if J <> Lo then
            ' Swap A(J) and A(Lo)
            T = A(J)
            A(J) = A(Lo)
            A(Lo) = T
   	end if
       	if (2 * J) > (Hi + Lo) then
 	    call QS (A, J + 1, Hi)
	    Hi = J - 1
	else
	    call QS (A, Lo, J - 1)
    	    Lo = J + 1
	end if
    loop
end sub

sub Quicksort (byref A)
    if UBound (A) > 1 then
        call QS (A, LBound (A), UBound (A))
    end if
end sub



'******************************************************************************
' Initialize global variables
'******************************************************************************
sub InitializeGlobals ()
    dim I

    ' String stuff used for formatting
    Tab     = Chr (9)
    NewLine = Chr (13)

    ' Global objects
    set Shell = WScript.CreateObject ("WScript.Shell")
    set FSO   = CreateObject ("Scripting.FileSystemObject")

    ' Arguments
    set ProgArgs = WScript.Arguments

    ' Handle program arguments
    AppName = ""
    Title = "Uninstaller"
    UninstallCtrlFileName = ""
    Dbg = false
    Language = "de"
    for I = 0 to ProgArgs.Count-1
        select case ProgArgs(I)
            case "-de"
                Language = "de"
            case "-debug"
                Dbg = true
            case "-en"
                Language = "en"
            case else
                if AppName = "" then
                    AppName = ProgArgs(I)
                elseif UninstallCtrlFileName = "" then
                    UninstallCtrlFileName = ProgArgs(I)
                else
                    call ErrorMsg (GetMsg ("MSG_USAGE"))
                    WScript.Quit (1)
                end if
        end select
    next

    ' We need the application name and uninstall control file
    if AppName = "" or UninstallCtrlFileName = "" then
        call Abort (GetMsg ("MSG_USAGE"))
    end if

    ' Set the title early, because it's used in error messages
    Title = AppName & " Uninstaller"

    ' Paths and locations
    SystemDrive = GetEnv ("%SystemDrive%")
    if SystemDrive = vbNullString then
        SystemDrive = "c:"
    end if
    SystemRoot = GetEnv ("%SystemRoot%")
    if SystemRoot = vbNullString then
        SystemRoot = BuildPath (SystemDrive, "winnt")
    end if
    UserName = GetEnv ("%USERNAME%")
    if UserName = vbNullString then
        UserName = "Administrator"
    end if
    UserProfile = GetEnv ("%USERPROFILE%")
    if UserProfile = vbNullString then
        UserProfile = BuildPath (SystemDrive, "Dokumente und Einstellungen\" & UserName)
    end if
    ProgramFiles = GetEnv ("%ProgramFiles%")
    if ProgramFiles = vbNullString then
        ProgramFiles = BuildPath (SystemDrive, "Programme")
    end if

    ' Assume we could remove the software
    Failed = false

end sub