uninst.tcl

好东西,欢迎下在,联系方式E-mail:[e-mail]

# UNINST.TCL - Uninstallation program for Unix/Windows platforms.
#
# history
# -------
# 01q,11aug97,pdn  fixed uninstFile() to handle case fileList is null.
# 01p,13jun97,pdn  started to use the DLL version of the setup APIs.
# 01o,15apr97,pdn  fixed the logging machanism.
# 01n,28mar97,pdn  stopped removing user private files
# 01m,12mar97,pdn  fixed typo.
# 01l,04feb97,pdn  added retry option for uninstFile(), and fix uninstResource 
# 01k,27feb97,pdn  reset the PATH environment variable (Windows 95)
# 01j,24feb97,pdn  reduced the time to switch between uninstall choices.
# 01i,24jan97,pdn  added way to remove files under Windows directory
# 01h,18dec96,sks  changed location of TCL and BITMAP files; renamed
#                  TEXT.TCL to MESSAGES.TCL                   
# 01g,09dec96,pdn  used tcl 7.6 file utilities
# 01f,27nov96,pdn  used deltree to remove temp dir for Window 95
# 01e,14nov96,pdn  fixed meter bug occurs when totalItem is 0
# 01d,13nov96,pdn  added seedUninstall function.
# 01c,08nov96,pdn  adjusted the binding of the Return key to match the default
#                  button
# 01c,08nov96,pdn  fixed uninstInfoGet() to obtain a completed list
#                  of file when trying to uninstall all.
# 01b,05nov96,pdn  added support for Windows.
# 01a,16oct96,pdn  written.
#

set uninst(WIND_BASE) [lindex $argv 0]

########################################################################
#
# TK functions
#

proc uninstTK {} {
    tkInit
    uninstTkDialog
}

proc uninstTkDialog {} {
    global ctrlVals
    global uninst
    global env
    global string

    # Creating the dialog

    wm maxsize . $ctrlVals(dlgWidth) $ctrlVals(dlgHeight)
    wm minsize . $ctrlVals(dlgWidth) $ctrlVals(dlgHeight)
    wm geometry . $ctrlVals(dlgPos)
    wm iconname . Uninstall

    . configure -bg $ctrlVals(mainBg)

    # Display the bitmap

    label .bitmap -image $ctrlVals(dlgImage)
    place .bitmap -in . -x 20 -y 18

    # Creating the buttons.

    frame .buts -relief raised -bd 1 
    pack .buts -side bottom -fill both

    # Create the "OK" button

    button .buts.ok -text "OK" -command "onTkDialogOk" -font $ctrlVals(bldFont)
    frame .buts.default -relief sunken -bd 1
    raise .buts.ok .buts.default
    pack .buts.default -in .buts -side left -expand 1 -padx 13 -pady 9
    pack .buts.ok -in .buts.default -padx 9 -pady 5
    bind . <Return> ".buts.ok flash; onTkDialogOk"

    # Create the "Cancel" button

    button .buts.cancel -text "Cancel" -command "onTkDialogCancel" \
            -font $ctrlVals(bldFont)
    pack .buts.cancel -in .buts -side left -expand 1 -padx 13 -pady 9

    wm title . "Uninstall"

    update

    frame .mainFrm -width 340 -height 295 
    place .mainFrm -in . -x 180 -y 15
    labelCreate .mainFrm.header $string(header)
    place .mainFrm.header -in .mainFrm 

    labelCreate .mainFrm.installInfo ""
    place .mainFrm.installInfo -in .mainFrm -x 22 -y 80
    labelCreate .mainFrm.message ""
    place .mainFrm.message -in .mainFrm -y 210

    radiobutton .mainFrm.uninstAll -text $string(button1) \
                                  -variable uninst(mode)\
                                  -font $ctrlVals(textFont) \
                                  -highlightthickness 0 \
                                  -relief flat -pady 0 \
                                  -value "all" \
                                  -command onUninstallAll
    place .mainFrm.uninstAll -in .mainFrm -y 40

    radiobutton .mainFrm.uninstPart -text $string(button2)\
                                   -variable uninst(mode) \
                                   -font $ctrlVals(textFont) \
                                   -highlightthickness 0 \
                                   -relief flat -pady 0 \
                                   -value "part" \
                                   -command onUninstallPart

    place .mainFrm.uninstPart -in .mainFrm -y 60

    if {"$uninst(mode)" == "none"} {
       .mainFrm.message config -text \
            "There is no uninstall information available from \
             $uninst(WIND_BASE).  Press the Cancel button to exit."
       destroy .buts.ok
       destroy .buts.default
       .mainFrm.uninstAll config -state disabled
       .mainFrm.uninstPart config -state disabled

    } elseif {$uninst(mode) == "all"} {
       .mainFrm.uninstPart config -state disabled
       onUninstallAll

    } {
       onUninstallPart
    }
}

proc onTkDialogOk {} {
    global uninst
    global env

    .buts.ok config -state disabled
    .mainFrm.uninstAll config -state disabled
    .mainFrm.uninstPart config -state disabled
    destroy .buts.cancel
    destroy .mainFrm.message
    meterCreate .mainFrm
    update

    uninstInfoGet
    uninstFile

    if {"$uninst(mode)" == "part"} {
       uninstBackup
    }

    set setupLog ""


    if {"$uninst(mode)" == "all"} {
        catch {file delete -force $uninst(WIND_BASE)/.wind/uninst}
        catch {file delete -force $uninst(WIND_BASE)/.wind/license}
        catch {file delete $uninst(WIND_BASE)/.wind}
        catch {file delete $uninst(WIND_BASE)/setup.log}
        cd /
        if [catch {file delete $uninst(WIND_BASE)} error] {
   	    incr uninst(errorCount)
	}
    } {
        catch {
            set setupLog [open $uninst(WIND_BASE)/setup.log "a+"]
            foreach line [split $uninst(info) "\n"] {
                if {"$line" != ""} {
                    puts $setupLog "[date]\tUninst\t$line"
                }
            }
            file delete $uninst(zipFile)
        }
    }

    meterDestroy .mainFrm

    if {$uninst(errorCount) > 0} {
       set msg "Warning: Not all files/directories are removed.  You may\
                need to remove them manually.  Press the OK button to exit."
       if {"$setupLog" != ""} {
            puts $setupLog "\tUninstall did not complete successfully."
       }
    } {
       set msg "Uninstall completed successfully.\
                Press the OK button to exit."
    }

    if {"$setupLog" != ""} {
       puts $setupLog ""
       close $setupLog
    }

    .buts.ok config -command onTkDialogCancel
    bind . <Return> ".buts.ok flash; onTkDialogCancel"
    labelCreate .mainFrm.message $msg
    place .mainFrm.message -in .mainFrm -y 230

    .buts.ok config -state normal
}

proc onTkDialogCancel {} {
    global env

    destroy .
    exit
}

proc findFont {w {weight medium} {sizes {14 12 10}} {slant r}} {
    foreach vendor {adobe xerox linotype} {
        foreach family {times helvetica} {
            foreach size $sizes {
                set testFont -$vendor-$family-$weight-$slant-*-*-$size-*
                if {[catch {$w config -font $testFont}] == 0} {
                    return $testFont
                }
            }
        }
    }
    $w config -font fixed
    return fixed
}

proc setWidth {w width} {
    set pixels [expr ($width * [winfo width $w]) / 100]
    $w coords poly 0 0 0 20 $pixels 20 $pixels 0 0 0
    $w itemconfigure [$w find withtag percent] -text "$width%"
}

proc labelCreate {wid txt} {
    global ctrlVals

    label $wid -font $ctrlVals(textFont) -wraplength 300 \
           -justify left -text $txt 
}

proc meterDestroy {w} {
    destroy $w.meterFrm
    destroy $w.nameTag
}

proc meterCreate {w} {
    global ctrlVals

    frame $w.meterFrm -borderwidth 1
    set meter $w.meterFrm.canvas

    canvas $meter -width 290 -height 18 \
       -highlightthickness 0 -borderwidth 2 -relief sunken

    $meter create polygon 0 0 1 1 2 2 -fill DeepSkyBlue3 -tags poly
    $meter create text 150 10 -text "" -width 40 \
       -justify center -tags percent

    pack $meter -side bottom
    label $w.nameTag -font $ctrlVals(textFont) -justify left -text "" 

    place $w.meterFrm -in $w -y 260
    place $w.nameTag -in $w -y 235

    set ctrlVals(meterWg) $meter
    set ctrlVals(meterTagWg) $w.nameTag
}

proc tkInit {} {
    global uninst
    global ctrlVals
    global env

    set ctrlVals(screenWidth) [winfo screenwidth .]
    set ctrlVals(screenHeight) [winfo screenheight .]
    set ctrlVals(dlgWidth) 500
    set ctrlVals(dlgHeight) 400

    if [file exists $uninst(home)/UNINST.PPM] {
        set ctrlVals(dlgImage) [image create photo -palette 3/8/5 \
           -file $uninst(home)/UNINST.PPM]
           
    } { 
        set ctrlVals(dlgImage) ""
    }
    
    #
    # Find the appropriate font
    #
    
    button .test -text Test 
    set ctrlVals(bldFont) [findFont .test bold]
    set ctrlVals(textFont) [findFont .test]
    set ctrlVals(smallFont) [findFont .test medium {12}]
    catch {destroy .test}
    
    set ctrlVals(dlgIndex) 1
    set ctrlVals(dlgIndexMax) 10

    set ctrlVals(dlgPos) \
       [format "%sx%s+%s+%s" $ctrlVals(dlgWidth) $ctrlVals(dlgHeight)\
       [expr ($ctrlVals(screenWidth)/2) - ($ctrlVals(dlgWidth)/2)]\
       [expr ($ctrlVals(screenHeight)/2) - ($ctrlVals(dlgHeight)/2)]]

    set ctrlVals(mtrPos) [format "%sx%s+%s+%s" 333 66 \
                [expr $ctrlVals(screenWidth) - 353] \
                [expr $ctrlVals(screenHeight) - 86]]
    
    
    if {[winfo depth .] > 1} {
        set ctrlVals(blinkBg) "#ce5555"
        set ctrlVals(mainBg) "#ccf"
        set ctrlVals(secondBg) "#bbf"
    } else {
        set ctrlVals(blinkBg) "black"
        set ctrlVals(mainBg) gray80
        set ctrlVals(secondBg) gray60
    }
    
    option add *background $ctrlVals(mainBg)
    option add *activeBackground $ctrlVals(secondBg)
    option add *entry*background $ctrlVals(secondBg)
    option add *selectForeground $ctrlVals(mainBg)
    option add *selectBackground black 
}

#######################################################################
#
# UITcl functions
#

proc uninstWin32 {} {
    uninstUITclDialog
}

proc uninstUITclDialog {} {
    global string

    dialogCreate \
       -name uninstDlg \
       -title "Tornado Uninstall" \
       -width 323 -height 218 \
       -nocontexthelp \
       -init uninstUITclDialogInit \
       -control [list \
           [list bitmap -name bitmap -title uninst.bmp -stretch \
                    -xpos 10 -ypos 10 -width 94 -height 170] \
           [list label -name headerMsg \
                   -title $string(header) \
                   -xpos 117 -ypos 11 -width 199 -height 17] \
           [list choice -title $string(button1) \
                    -name uninstAll -newgroup -auto \
                    -xpos 117 -ypos 35 -width 140 -height 10  \
                    -callback {onUninstallAll callback}] \
           [list choice -title $string(button2) \
                   -name uninstPart -auto \
                   -xpos 117 -ypos 47 -width 171 -height 10  \
                   -callback {onUninstallPart callback}] \
           [list label -title "" -name installInfo  \
                   -xpos 130 -ypos 60 -width 186 -height 72] \
           [list label -name message  \
                   -xpos 117 -ypos 138 -width 199 -height 40] \
           [list frame -gray -name separator  \
                   -xpos 7 -ypos 188 -width 309 -height 1] \
           [list button -title "OK" -name okButt -default \
                   -xpos 207 -ypos 197 -width 50 -height 14  \