📄 install.tcl
字号:
proc uninstFileClose {} {
global setupVals
if {"$setupVals(uninstFileOpen)" == "opened"} {
catch { close $setupVals(fInstallFile) } err
catch { close $setupVals(fInstallInfo) } err
catch { close $setupVals(fInstallBackup) } err
catch { close $setupVals(fInstallResource) } err
catch { close $setupVals(fInstallCDnumber) } err
puts $setupVals(fSetupLog) ""
catch { close $setupVals(fSetupLog) } err
set setupVals(uninstFileOpen) closed
}
}
##############################################################################
#
# uninstFileOpen - opens files for recording uninstall info.
#
# This procedure opens disk files for writing the temporary uninstall records.
# These files will be closed by calling uninstFileClose()
#
# SYNOPSIS
# uninstFileOpen
#
# PARAMETERS: N/A
#
# RETURNS: N/A
#
# ERRORS: N/A
#
set setupVals(uninstFileOpen) ""
proc uninstFileOpen {} {
global setupVals
if {"$setupVals(uninstFileOpen)" != "opened"} {
set setupLog [tempDirGet]/setup.log.tmp
set uninstFile [tempDirGet]/installFile.tmp
set uninstResource [tempDirGet]/installResource.tmp
set uninstCDnumber [tempDirGet]/installCDnumber.tmp
set uninstBackup [tempDirGet]/installBackup.tmp
set uninstInfo [tempDirGet]/installInfo.tmp
set setupVals(fSetupLog) [open $setupLog "w"]
set setupVals(fInstallFile) [open $uninstFile "w"]
set setupVals(fInstallInfo) [open $uninstInfo "w"]
set setupVals(fInstallBackup) [open $uninstBackup "w"]
set setupVals(fInstallResource) [open $uninstResource "w"]
set setupVals(fInstallCDnumber) [open $uninstCDnumber "w"]
set setupVals(uninstFileOpen) opened
}
}
##############################################################################
#
# uninstBinCopy - copies uninstall agent
#
# This procedure copies neccessary files from CDROM to the destination
# directory for the uninstall program to work. No-op if patch installation
# is detected.
#
# SYNOPSIS
# uninstBinCopy
#
# PARAMETERS: N/A
#
# RETURNS: N/A
#
# ERRORS: N/A
#
proc uninstBinCopy {} {
global env
if {[instTypeGet] == "patch"} {
return
} elseif {[windHostTypeGet] == "x86-win32"} {
# all the required binary files are copied by setupCopy
fileDup [file join [cdromRootDirGet] RESOURCE BITMAPS UNINST.BMP] \
[file join [uninstHomeDirGet] UNINST.BMP] update
fileDup [file join [cdromRootDirGet] RESOURCE TCL UNINST.TCL] \
[file join [uninstHomeDirGet] UNINST.TCL] update
fileDup [file join [cdromRootDirGet] RESOURCE TCL INCLUDE.TCL] \
[file join [uninstHomeDirGet] INCLUDE.TCL] update
} else {
# Other shared libraries are copied by the UNINST shell script
# because those are untarred from MWUITCL.TAR
set usrBinDir [file join [destDirGet] host [windHostTypeGet] bin]
set usrSetupDir [file join [destDirGet] SETUP]
set env(PATH) $usrBinDir:$env(PATH)
fileDup [file join [cdromRootDirGet] RESOURCE TCL UNINST.TCL] \
[file join [uninstHomeDirGet] UNINST.TCL] update
fileDup [file join [cdromRootDirGet] RESOURCE TCL INCLUDE.TCL] \
[file join [uninstHomeDirGet] INCLUDE.TCL] update
fileDup [file join [cdromRootDirGet] RESOURCE BITMAPS/UNINST.BMP] \
[file join [uninstHomeDirGet] UNINST.BMP] update
fileDup [file join [cdromRootDirGet] UNINST] \
[file join $usrBinDir UNINST] update
fileDup [file join [cdromRootDirGet] SETUP] \
[file join $usrSetupDir SETUP] update
fileDup [file join [cdromBinDirGet] ZIP] \
[file join $usrBinDir ZIP] update
fileDup [file join [cdromBinDirGet] SETUPTCL[string toupper \
[info sharedlibextension]]] \
[file join $usrBinDir setuptcl[info sharedlibextension]] update
}
}
##############################################################################
#
# uninstStop - wraps up the uninstall process.
#
# This procedure copies uninstall agent, executes all queued commands, closes
# all tempfiles, saves the temporary uninstall records into a zip file.
#
# SYNOPSIS
# uninstStop
#
# PARAMETERS:
# prodName - Product Name e.g. Tornado
# prodVer - Product Version e.g. 3.0
#
# RETURNS: N/A
#
# ERRORS: N/A
#
proc uninstStop {prodName prodVer} {
global setupVals
if {"$setupVals(uninstLog)" > "0"} {
uninstBinCopy
if {[windHostTypeGet] == "x86-win32"} {
# For Windows hosts, create registry entries and uninstall icon
# uninstallInitWin32 was previously called uninstallSetup
uninstallInitWin32 $prodName $prodVer
queueExecute
} else {
queueExecute
}
uninstFileClose
if [file exists $setupVals(uninstFile)] {
catch {setupUnzip -o -qq $setupVals(uninstFile) \
-d [tempDirGet] "install*"}
}
fileAppend [file join [tempDirGet] installFile.tmp] \
[file join [tempDirGet] installFile]
fileAppend [file join [tempDirGet] installResource.tmp] \
[file join [tempDirGet] installResource]
fileAppend [file join [tempDirGet] installCDnumber.tmp] \
[file join [tempDirGet] installCDnumber]
fileAppend [file join [tempDirGet] installBackup.tmp] \
[file join [tempDirGet] installBackup]
fileAppend [file join [tempDirGet] installInfo.tmp] \
[file join [tempDirGet] installInfo]
fileAppend [file join [tempDirGet] setup.log.tmp] \
[file join [destDirGet] setup.log]
cd [tempDirGet]
if [catch {exec [cdromBinDirGet]/ZIP $setupVals(uninstFile) -g -q -1 -m \
"installFile" "installInfo" "installBackup"\
"installResource" "installCDnumber"} error] {
puts "$error"
}
cd [cdromRootDirGet]
} else {
uninstFileClose
}
}
##############################################################################
#
# fileAppend - appends the content of the source to the destination file.
#
# This procedure takes the content of the source file and appends it to the
# destination file.
#
# SYNOPSIS
# fileAppend <srcFilePath> <destFilePath>
#
# PARAMETERS:
# srcFilePath : a path to the source filename
# destFilePath : a path to the destination filename
#
# RETURNS: N/A
#
# ERRORS: N/A
#
proc fileAppend {srcFilePath destFilePath} {
set ftmp [open $srcFilePath "r"]
set f [open $destFilePath "a+"]
while {[gets $ftmp line] != "-1"} {
puts $f $line
}
catch { close $ftmp } err
catch { close $f } err
}
##############################################################################
#
# uninstLog - stores the specified string into the appropriate disk file.
#
# SYNOPSIS
# uninstLog <key> <string>
#
# PARAMETERS:
# key : a string that long enough to differentiate between disk filenames,
# <r>esource, <b>ackup, <f>ileNew, <i>nfo, <s>etupLog, <c>dNumber
# string : string to be stored.
#
# RETURNS: N/A
#
# ERRORS: N/A
#
proc uninstLog {key string} {
global setupVals
set exitSetup 0
uninstFileOpen
if [catch { switch -glob $key {
c* {
puts $setupVals(fInstallCDnumber) $string
}
r* {
puts $setupVals(fInstallResource) $string
incr setupVals(uninstLog)
}
b* {
puts $setupVals(fInstallBackup) $string
incr setupVals(uninstLog)
}
f* {
puts $setupVals(fInstallFile) $string
incr setupVals(uninstLog)
}
i* {
puts $setupVals(fInstallInfo) $string
}
s* {
puts $setupVals(fSetupLog) "[installDate]\t$string"
if {[destDirGet] != ""} {
if [catch {flush $setupVals(fSetupLog)} result] {
set msg "SETUP detected error\(s\)\n$result\
\n\n[strTableGet TEMP_DISK_FULL_WARN]"
dialog ok_with_title "ERROR: Installation" $msg
set exitSetup 1
}
catch {file copy -force \
[tempDirGet]/setup.log.tmp \
[destDirGet]/setup.log.abort}
}
}
default {
puts "uninstLog error: $key does not exist"
}
}
} error] {
puts "cannot record \"$string\": $error"
}
if { $exitSetup } {
set setupVals(cancel) 1
applicationExit
dialog ok_with_title "Setup" "Setup will terminate now"
return 0
}
}
##############################################################################
#
# installDate - forms a simple date string
#
# SYNOPSIS
# installDate
#
# PARAMETERS: N/A
#
# RETURNS: a date string (i.e, 08-Apr-97.18:30)
#
# ERRORS: N/A
#
proc installDate {} {
return [clock format [clock second] -format "%d-%b-%y.%H:%M"]
}
##############################################################################
#
# fileDup - copies a file
#
# This routine copies srcFile to destFile. The default option flag is 'none'
# which means doing nothing if destFile exists, update: if srcFile is newer,
# backup destFile then copies, overwrite: backup then copies. In case of
# failure, a message will be displayed, and user has a chance to decide next
# action. All successful copied filename will be logged for later uninstall.
#
# SYNOPSIS
# fileDup <srcFile> <destFile> [option]
#
# PARAMETERS:
# <srcFile> : an absolute path filename
# <destFile> : an absolute path filename
# [option] : none | update | overwrite
#
# RETURNS: True or False bases on success or failure.
#
# ERRORS: N/A
#
proc fileDup {sourceFilePath destFilePath {option none}} {
global ctrlVals setupVals
if ![file exists $sourceFilePath] {
dbgputs "$sourceFilePath not found"
return 0
}
regsub -all {\\} $destFilePath {/} destFilePathUnixStyle
regsub -all {\\} [destDirGet] {/} destDir
regsub "$destDir/" $destFilePathUnixStyle "" relDestFilePathUnix
switch $option {
none {
if [file exists $destFilePath] {return 1}
}
checkVersion {
# this option is mainly used for checking version of DLLs in
# the Windows System directory; we don't backup the file and
# we don't keep track of the file for uninstall purpose
if [catch {setupFileVersionInfoGet $sourceFilePath} wrsVersion] {
dbgputs "Cannot get file version of $sourceFilePath: $wrsVersion"
}
if {[file exists $destFilePath] &&
[catch {setupFileVersionInfoGet $destFilePath} userVersion]} {
dbgputs "Cannot get file version of $destFilePath: $userVersion"
}
if {[file exists $destFilePath] && $wrsVersion < $userVersion} {
return 1
}
# if we reach this, we need to overwrite the old file
# no backup here because we'd like to keep the new version
set noLog 1
}
update {
if {[file exists $destFilePath] &&
[file mtime $sourceFilePath] <= [file mtime $destFilePath]} {
return 1
} elseif {[file exists $destFilePath]} {
backup $relDestFilePathUnix
}
}
overwrite {
if {[file exists $destFilePath]} {
backup $relDestFilePathUnix
}
}
default {
puts "fileDup $sourceFilePath $destFilePath $option"
puts "unknown option: $option"
}
}
set destDir [file dirname $destFilePath]
if {![file isdirectory $destDir] && [catch {file mkdir $destDir} error]} {
puts "$error"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -