⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 global.tcl

📁 windml3.0
💻 TCL
📖 第 1 页 / 共 4 页
字号:
## RETURNS: N/A## ERRORS: N/A#proc defGroupSet {group} {    global defGroup setupVals    if { [isTornadoProduct] } {        if {[portMapperIconExist $group] == 1} {            set defGroup $setupVals(defGroup)        } else {            set defGroup $group        }    } else {        # non-tornado        set defGroup $group    }}################################################################################ defGroupGet - returns the default group.## This routine returns the default group.  If it does not exist an empty# string is returned.## SYNOPSIS:# defGroupGet## PARAMETERS: N/A## RETURNS: the default group if it exists, else an empty string.## ERRORS: N/A#proc defGroupGet {} {    global defGroup    if ![info exists defGroup] {        set defGroup ""    }    return $defGroup}################################################################################ dirSizeGet - returns the size of a directory## This routine returns the size of a directory## SYNOPSIS:# setupSizeGet## PARAMETERS: path## RETURNS:  the size of given directory or 0 if path is not a directory## ERRORS: N/A#proc dirSizeGet {path} {    if {[file isdirectory $path] == 0} {        return 0    }    set totsz 0    set list [glob $path/*]    foreach file $list {        set totsz [expr $totsz + [file size [file join $path $file]]]    }    return $totsz}################################################################################ setupSizeGet - returns the size of setup directory## This routine returns the size of setup directory## SYNOPSIS:# setupSizeGet## PARAMETERS: N/A## RETURNS:  the size of setup directory## ERRORS: N/A#proc setupSizeGet {} {    set docSize 0    set path [file join [cdromRootDirGet] DOCS]    set docSize [byteToMbyte [dirSizeGet $path]]    switch [windHostTypeGet] {        x86-win32 {            return [expr 10.9 + $docSize]        }        sun4-solaris2 {            return [expr 13.0 + $docSize]        }        parisc-hpux10 {            return [expr 14.3 + $docSize]        }        default {            return [expr 10.9 + $docSize]        }    }}################################################################################ instTypeSet - sets the installation type.## Sets the global variable instType to the installation type (for example,# "icon" for an icon-only installation).## SYNOPSIS:# instTypeSet type## PARAMETERS:# <type># The installation type.## RETURNS: N/A## ERRORS: N/A#proc instTypeSet {type} {    global instType    set instType $type}################################################################################ instTypeGet - returns the installation type.## This routine returns the installation type (for example, "icon" for# an icon-only installation).  If the installation type has not been# set, an empty string is returned.## SYNOPSIS:# userNameGet## PARAMETERS: N/A## RETURNS: the installation type if it exists, else an empty string.## ERRORS: N/A#proc instTypeGet {} {    global instType    if ![info exists instType] {        set instType ""    }    return $instType}################################################################################ checkPathLen - checks the path length and trims the path if necessary.## This routine checks the length of a given path.  If the length is# over 50 characters, part of the path is replaced with "..."  This# allows a long path to fit in a dialog window.## SYNOPSIS:# checkPathLen path## PARAMETERS:# <path># A directory path.## RETURNS: The original path partially replaced with "..." if over#          50 characters.## ERRORS: N/A#proc checkPathLen {path} {    if {[string length $path] >= 50} {        set totLen [string length $path]        set lastIndex [string last "/" $path]        if {$lastIndex > [string last "\\" $path]} {            # Unix type path            set path2 [string range $path 0 [expr $lastIndex - 1]]            set fname [string range $path [expr $lastIndex + 1] $totLen]            set lastIndex2 [string last "/" $path2]            while {[expr [string length $path2] + [string length $fname] + 5] \                >= 50} {                set path2 [string range $path2 0 [expr $lastIndex2 -1]]                set lastIndex2 [string last "/" $path2]                if {$lastIndex2 == -1} {                    break;                }            }           set path [format "%s/.../%s" $path2 $fname]        } else {            # DOS type path            set lastIndex [string last "\\" $path]            set path2 [string range $path 0 [expr $lastIndex - 1]]            set fname [string range $path [expr $lastIndex + 1] $totLen]            set lastIndex2 [string last "\\" $path2]            while {[expr [string length path2] + [string length $fname] + 5] \                >= 50} {                set path2 [string range $path2 0 [expr $lastIndex2 -1]]                set lastIndex2 [string last "\\" $path2]                if {$lastIndex2 == -1} {                    break;                }            }            set $path [format "%s\\...\\%s" $path2 $fname]        }    }    return $path}############################################################################### fspace - returns free space available on Unix hosts## This procedure returns the amount of free space avaiable on the given drive.## SYNOPSIS:# fspace dir## PARAMETERS:# <dir># a directory path.## RETURNS: the number of free space in kilobytes avaiable## ERRORS: N/A#proc fspace {dir} {    if {![file isdirectory $dir]} {        return "$dir: bad directory name"    }    # get the directory name in extension    set here [pwd]    cd $dir    set dir [pwd]    set free "unknown"    switch [windHostTypeGet] {        sun4-solaris2 -        x86-linux2 {            if {![catch {exec /bin/df -k $dir} result]} {                set free [lindex $result 10]            } else {                set free [lindex $result 10]            }        }        parisc-hpux10 {            set found 0            set ix 0            while {$found == 0} {                incr ix                if {$ix > 30} {                    break                }                if {[catch "exec /bin/df $dir" res]} {                    # go backward one step looking for actual mounting                    # point or device name alias                    set dir [file dirname $dir]                } else {                    set freeSize [lindex [exec /bin/df -k $dir | /bin/sed -e "/total/d" -e "/used/d" ] 0]                    if {[regexp {[^0-9]+} $freeSize] == 0} {                        set free $freeSize                    }                    set found 1                }            }        }        default {}    }    cd $here    return $free}################################################################################ debug - turns on debug mode## SYNOPSIS# debug## PARAMETERS: N/A## RETURNS: true if the environment var SETUP_DEBUG exists, otherwise false## ERRORS: N/A#proc debug {} {    global env    global setupVals    if {[info exists env(SETUP_DEBUG)]} {        return 1    } else {        return 0    }}################################################################################ openSetupDebugLog - open the setup log file## SYNOPSIS# openSetupDeubgLog## PARAMETERS: N/A## RETURNS: N/A## ERRORS: N/A#proc openSetupDebugLog {} {    global env setupVals    if {[info exists env(SETUP_DEBUG)] && $env(SETUP_DEBUG) != 0} {        if {[info exists env(SETUP_DBGLOGFILE)]} {            if {![info exists setupVals(DBGLOG_FD)]} {                if {[catch {open $env(SETUP_DBGLOGFILE) "w"} setupVals(DBGLOG_FD)]} {                    puts "Can't open $env(SETUP_DBGLOGFILE)"                }            }        }    }    if {[info exists env(INF_DEBUG)] &&  $env(INF_DEBUG) != 0} {        if {[info exists env(SETUP_DBGLOGFILE)]} {            if {![info exists setupVals(DBGLOG_FD)]} {                if {[catch {open $env(SETUP_DBGLOGFILE) "w"} setupVals(DBGLOG_FD)]} {                    puts "Can't open $env(SETUP_DBGLOGFILE)"                }            }        }    }}################################################################################ closeSetupDebugLog - close the setup log file## SYNOPSIS# closeSetupLog## PARAMETERS: N/A## RETURNS: N/A## ERRORS: N/A#proc closeSetupDebugLog {} {    global env    global setupVals    if {[info exists setupVals(DBGLOG_FD)]} {        catch {close $setupVals(DBGLOG_FD)}    }}############################################################################### dbgputs - wrapper for debug puts function.## Wrapper for the puts function.  Only prints out the specified string# either to the setup debug log file in env(SETUP_DBGLOGFILE) or the console,# if the environment variable SETUP_DEBUG exists and is set to a nonzero value.## SYNOPSIS# dbgputs <line>## PARAMETERS:#   line : string to output.## RETURNS: N/A## ERRORS: N/A#proc dbgputs {line} {    global env    global setupVals    if {[info exists env(SETUP_DEBUG)]} {        if {$env(SETUP_DEBUG) != 0 && [info exists setupVals(DBGLOG_FD)]} {            puts $setupVals(DBGLOG_FD) $line            flush $setupVals(DBGLOG_FD)        } else {            puts $line        }    }}############################################################################### fileContentGet - return the content of a file as a string## This procedure opens a file and return the content of the file as a# string separated by new lines## SYNOPSIS# .tS# fileContentGet <file># .tE## PARAMETERS:# .IP file# file name relative to the root of the CD## RETURNS: N/A## ERRORS: N/A#proc fileContentGet {file} {    set file [cdFileNameGet $file]    if {[file exists $file] == 0} {        puts "Error: $file does not exists."        return    }    if [catch {open $file r} infile] {        puts "Error: can't open $file"        return    }    set contents ""    foreach line  [split [read $infile] \n] {        string trimright $line        append contents [format "%s\r\n" $line]    }    close $infile    return $contents}proc licFileGet {} {    global setupVals    if {[info exists setupVals(licFile)]} {        return $setupVals(licFile)    } else {        return ""    }}proc licFileSet {licFile} {    global setupVals    set setupVals(licFile) $licFile}################################################################################ authCodeGet - returns the Authorization Code.## This routine returns the user authorization code to access WRS database## SYNOPSIS:# authCodeGet## PARAMETERS: N/A## RETURNS: the Authorization Code if it exists, else an empty string.## ERRORS: N/A#proc authCodeGet {} {    global setupVals    if {[info exists setupVals(authCode)]} {        return $setupVals(authCode)    } else {        return ""    }}###############################################################################

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -