uninst.tcl

这是vxworks 的图形界面开发软件windML2.0和另一个CP2可以构成完整的界面开发。

# SYNOPSIS
# uninstBackup
#
# PARAMETERS: N/A
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc uninstBackup {} {
    global uninst
    global env

    foreach line $uninst(bakList) {
       set file [lindex $line 1]

       switch [lindex $line 0] {
           wind_base { 
               incr uninst(currItem)
               set percent [expr ($uninst(currItem) * 99) / $uninst(totalItem)]
               uninstMeterUpdate $percent "Restoring " $file
               if {[catch {setupUnzip -o -qq $uninst(zipFile) \
                      -d $uninst(WIND_BASE) $file} error]} {
                   incr uninst(errorCount) 
                   message "Cannot restore $file: $error"
               } 
           }
           default { puts "unknown rootdir token" }
       }
    }
}

##############################################################################
#
# dirInsert - inserts the head directory of the path into array dirArray().
#
# SYNOPSIS
# dirInsert <pathName>
#
# PARAMETERS: pathname - path from which to extract the head of the tree.
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc dirInsert {pathName} {
    global dirArray

    set dirArray($pathName) ""

    while { 1 } {
        set pathName [file dirname $pathName]
        if {$pathName == "."} {
            break
        } else {
            set dirArray($pathName) ""
        }
    }
}

##############################################################################
#
# dirRemove - removes the directories listed in the tcl array dirArray().
#
# SYNOPSIS
# dirRemove
#
# PARAMETERS: N/A
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc dirRemove {} {
    global dirArray uninst

    # delete the innermost empty directory first

    foreach dir [lsort -decreasing [array names dirArray]] {
        catch {file delete $uninst(WIND_BASE)/$dir}
    }
}

##############################################################################
#
# uninstFile - removes the files and directories to be uninstalled.
#
# This procedure is the main procedure which coordinates the removal of the
# list of files and directories that are to be uninstalled.
#
# SYNOPSIS
# uninstFile
#
# PARAMETERS: N/A
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc uninstFile {} {
    global uninst
    global env

    foreach line $uninst(fileList) {
       set file [lindex $line 1]

       switch [lindex $line 0] {
           wind_base { 
               set filePath $uninst(WIND_BASE)/$file 
               dirInsert [file dirname $file]
           }
           window {
               if {[file extension $file] == ".CPL"} {
                   catch {setupWindowClose "Control Panel"}
               }
               set filePath [setupWinDirGet]/$file
           }
           default { puts "unknown rootdir [lindex $line 0]" }
       }

       incr uninst(currItem)
       set percent [expr ($uninst(currItem) * 99) / $uninst(totalItem)]

       uninstMeterUpdate $percent "Removing " $file

       if {[file exists $filePath]} {
           while {[catch {file delete $filePath} error]} {
               switch [dialog re_ig_cancel "Uninstall" "$error" question 0] {
                   0 { unset error }
                   1 { incr uninst(errorCount); break } 
                   2 { incr uninst(errorCount); return }
               }
           }
       }
    }

    # remove all empty directory
    set percent [expr ($uninst(currItem) * 99) / $uninst(totalItem)]
    uninstMeterUpdate $percent "Removing" "directories..."
    dirRemove
}

##############################################################################
#
# onUninstallPart - callback proc for the uninstall "partial" choice button
#
# This procedure is called as a result of the user checking the partial
# (last install session) uninstall choice button.  It displays for the
# user the list of products to be removed.
#
# SYNOPSIS
#  onUninstallPart <{default direct}>
#
# PARAMETERS: {default direct} - these parameters are used as a debugging aid
#     indicate it invocation to this routine is via choice button (callback
#     is passed) or it was called programmatically (direct being the default).
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc onUninstallPart {{default direct}} {
    global uninst
    global env

    set uninst(mode) part
    lastInstSessionInfoGet

    set message "Uninstall will remove the above component(s) \
                from $uninst(WIND_BASE) and restore the previous state."

    set i 0
    foreach line [split $uninst(info) "\n"] {
       if {$i > 5} { 
           append info "..."
           break
       }
       incr i
       if {"$line" != ""} {
           append info "$line\n"
       }
    }

    controlValuesSet uninstDlg.message $message
    controlValuesSet uninstDlg.installInfo $uninst(info)    

    if {$uninst(useInputScript)} {
        autoUninstLog $message
        autoUninstLog $info
    }
}


##############################################################################
#
# onUninstallAll - callback proc for the uninstall "all" choice button
#
# This procedure is called as a result of the user checking the remove "all"
# choice button.  It displays for the user a warning of what is about to occur.
#
# SYNOPSIS
# onUninstallAll <{default direct}>
#
# PARAMETERS: {default direct} - these parameters are used as a debugging aid
#     indicate it invocation to this routine is via choice button (callback
#     is passed) or it was called programmatically (direct being the default).
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc onUninstallAll {{default direct}} {
    global uninst
    global env
    global uninstallOption

    if {$uninstallOption == "partial"} {
        return
    } else {
        set uninst(mode) all
    }

    set warningMessage "Warning:"
    set message "Uninstall removes ALL of the standard Tornado files\
            under $uninst(WIND_BASE), including files you may have modified. \
            Be sure to backup any modified files before continuing.  Note that\
	    user private files are not removed."
 
    set exitMessage "Note: You must exit all Tornado applications, including\
                     the Tornado Registry and all target servers,\
                     before proceeding with Uninstall."
    controlValuesSet uninstDlg.warningMessage $warningMessage
    controlValuesSet uninstDlg.message $message
    controlValuesSet uninstDlg.exitMessage $exitMessage

    controlValuesSet uninstDlg.installInfo "" 

    controlPropertySet uninstDlg.warningMessage -bold 1
    controlPropertySet uninstDlg.exitMessage -bold 1

    if {$uninst(useInputScript)} {
        autoUninstLog $message
        autoUninstLog $exitMessage
    }
}

###################################################################
#
# autoUninstLog - writes log messages to the automated uninstall log file
#
# SYNOPSIS: autoUnistLog <msg>
#
# PARAMETERS:  msg - a quoted string to write to the log file
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc autoUninstLog {msg} {
    global autoUninstLogFile

    if {[catch {open $autoUninstLogFile a+} file]} {
	puts "Error in writing $autoUninstLogFile"
	return -1
    }
    puts $file "[getDate]: $msg"
    close $file
}


#############################################################################
#
# addSlash - add extra slashes for eval use later
#
# This procedure will add extra slashes for eval user later
#
# SYNOPSIS
# .tS
# addSlash <path>
# .tE
#
# PARAMETERS:
# .IP path
# path with slashes
#
# RETURNS: new path with extra slashes
#
# ERRORS: N/A
#

proc addSlash {path} {
    regsub -all {\\} $path {\\\\} newpath
    return $newpath
}


#############################################################################
#
# unregTornado - unregister all tornado dlls and executables
#
# This procedure will unregister all tornado dlls and executables
#
# SYNOPSIS
# .tS
# unregTornado
# .tE
#
# PARAMETERS: N/A
#
# RETURNS: N/A
#
# ERRORS: N/A
#

proc unregTornado {} {
    global ctrlVals
    global setupVals
    global uninst

    if {![isUnix]} {
        if ![catch {setupSysDirGet} dir] {
            set sysDirGet $dir
        } else {
            puts "Cannot determine system directory: $dir"
        }
    }

    set regsvr32 "$sysDirGet\\Regsvr32.exe"
    set binFile(ComTcl.dll) \
        "$uninst(WIND_BASE)\\host\\x86-win32\\bin\\ComTcl.dll"
    set binFile(WrsDebugger.dll) \
        "$uninst(WIND_BASE)\\host\\x86-win32\\bin\\WrsDebugger.dll"
    set binFile(Tornado.exe) \
        "$uninst(WIND_BASE)\\host\\x86-win32\\bin\\Tornado.exe"
    set regCommand(ComTcl.dll) "$regsvr32 /u /s /c $binFile(ComTcl.dll)"
    set regCommand(WrsDebugger.dll) "$regsvr32 /u /s /c\
                                     $binFile(WrsDebugger.dll)"
    set regCommand(Tornado.exe) "$binFile(Tornado.exe) /unregserver"

    set gdbFiles [glob -nocomplain [file join $uninst(WIND_BASE) \
                 host x86-win32 bin Cgdb*exe]]

    foreach absFile $gdbFiles {
        set f [file tail $absFile]
        set binFile($f) [unixToDos $absFile]
        set regCommand($f) "$binFile($f) /unregserver"
    }

    # check for file existence
    # Unregister only those files that exist

    foreach f [array names binFile] {
        if [file exists $binFile($f)] {
            set existingBinFile($f) $binFile($f) 
        } else {
            puts "Warning: $binFile($f) not found"
        }
    }

    if ![file exists $regsvr32] {
        puts "Error: $regsvr32 not found"
    }

    set totalCmds [llength [array names existingBinFile]]

    foreach b [array names existingBinFile] {
        if {![catch {eval exec [addSlash $regCommand($b)]} result]} {
            puts "$b unregistration successful!"
        } else {
            puts "$b unregistration failed: $result"
        }
        after 4000
    }
}

###################################################################
#
# start - entry point for the Uninstall program.
#
# SYNOPSYS
# start
#
# PARAMETERS:  N/A
#
# RETURNS: N/A
#
# ERRORS: N/A
#


proc start {} {
    global uninst
    global env
    global argv
    global uninstallOption
    global autoUninstLogFile

    foreach elem [array names env] {
       if {[isUnix]} {
           if {[string compare [string tolower $elem] "tmp"] == 0} {
               regsub -all {\\} $env($elem) {/} env(TMP)
           }
       }
    }

    if {![isUnix]} {
        set env(TMP) [lindex $argv 1]
    }

    load $env(TMP)/setuptcl[info sharedlibextension]
    dllLoad $env(TMP)/uitclcontrols[info sharedlibextension] \
            _UITclControls_Init

    # check to see if there is an automated script file to source

    if { [info exists env(UNINSTALL_ANS_FILE)] } {
	puts "Use Uninstall Answer file"
	
	set uninst(useInputScript) 1
	if { [info exists env(UNINSTALL_LOG_FILE)] } {
	    set autoUninstLogFile $env(UNINSTALL_LOG_FILE)
	} else {
	    set autoUninstLogFile "c:\\autoUninstall.log"
	}
	puts "log file is $autoUninstLogFile"

	if { ![file exists $env(UNINSTALL_ANS_FILE)] } {
	    autoUninstLog "Input script $env(UNINSTALL_ANS_FILE) not exists!\n"
	    return -1
	}
	if {[catch {source $env(UNINSTALL_ANS_FILE)} e]} {
	    puts "Error in sourcing $env(UNINSTALL_ANS_FILE)\n"
	    return -1
	}
    } else {
        set uninstallOption 0
        set uninst(useInputScript) 0
    }

    set uninst(errorCount) 0
    set uninst(home) $uninst(WIND_BASE)/.wind/uninst
    
    switch [llength [glob -nocomplain $uninst(home)/data.???]] {
       "0" {
           set uninst(mode) "none"
       }
       "1" {
           set uninst(mode) "all"
       }
       default {
           set uninst(mode) "part"
       }
    }

    uninstWin32

    set binDir [unixToDos "$uninst(WIND_BASE)\\SETUP\\X86\\WIN32"]
    set uninstallCleanup $env(TMP)\\t2UninstallCleanup.exe

    # cd out of env(TMP) directory so we could actually remove the directory!!

    cd "\\"

    if [catch {processCreate "$uninstallCleanup [pid] $env(TMP)"} error] {
        puts "$error"
    }
}

#########################################################################
#
# initializing code starts here
#

set string(header) "This program uninstalls Tornado software\
                    from this machine.  Please select one of\
                    following choices."

set string(button1) "Uninstall Tornado entirely."
set string(button2) "Uninstall the last installed session."

source $uninst(WIND_BASE)/.wind/uninst/INCLUDE.TCL

if {"[lindex $argv 1]" == "-seed"} {
    dllLoad $uninst(WIND_BASE)/SETUP/X86/WIN32/UITCLCONTROLS.DLL \
            _UITclControls_Init
    load $uninst(WIND_BASE)/SETUP/X86/WIN32/setuptcl.dll
    seedUninstall
} {
    start
}