tclu.tcl

genesis 2000 v9.1软件下载

  set TITLE "Calculating checksum for $IN_FILE" 
  set STATUS [tku_long_command $COMMAND \
		  $TITLE   \
		  "" \
		  ignore $PROGRESS_PATH]		 
  catch { file delete $PROGRESS_PATH } 
  if { $STATUS != "ok" } {
    return 0
  }
  
  if {! [catch {open $SUM_PATH r} TFP]} {
    gets $TFP LINE
    close $TFP
    catch { file delete $SUM_PATH } 
    scan $LINE "%s%s" SUM NAME
  } else {
    tku_popup_message error ok \
	"Error Opening $SUM_PATH - checksum set to 0"
    set SUM 0 
  }
  return $SUM 
}


#*******************************************************
#
# Name :	tclu_get_dat_lst_file
#
# Description :	
#               The routine will read from the dat device the
#               products.lst file, and will return the items
#               on dat as a list.
# Input	:	DAT_DEVICE - Path of dat device
#
# Output :      DAT_LIST - List of available procucts on dat
#                            
#               
# Return Value :
#*****************************************************************
#
#................................................................#
proc tclu_get_dat_lst_file {DAT_DEVICE OUT_LIST} {

  global TCLU_G  
  upvar $OUT_LIST DAT_LIST
  
  set SAVDIR [pwd]
  cd [tclu_get_tmp_dir]
  
  set TAR $TCLU_G(TAR)
  set COMMAND "$TAR xf $DAT_DEVICE products.lst end_products.lst"
  set TITLE "Extracting products list from DAT..."
  set STOP_FILE [file join [tclu_get_tmp_dir] "end_products.lst"]

  file delete [file join [tclu_get_tmp_dir] "products.lst"]
  file delete $STOP_FILE
  
  set STATUS [tku_long_command $COMMAND $TITLE "" abort "" $STOP_FILE]		 
  
  if { $STATUS != "ok" } {
    return $STATUS
  }
  
  cd $SAVDIR
  set LST_NAME [file join [tclu_get_tmp_dir] "products.lst"]
  if {[catch {open $LST_NAME r} FP]} {
    return "error"
  }

  catch {unset DAT_LIST}
  while {![eof $FP]} {
    gets $FP LINE
    if { [string length $LINE] == 0 } break ; 
    scan $LINE "%s%s%s%s%s%s%s%s" DUM1 PROD DUM2 VER DUM3 OS DUM4 TITLE 
    set INDEX [string first "title:" $LINE]
    if { $INDEX == -1 } {
      set TITLE "<No Title>"
    } else {
      set START [expr $INDEX + 7]
      set TITLE [string range $LINE $START end]
    }
    
    lappend DAT_LIST $PROD $VER $OS $TITLE
  }

  file delete [file join [tclu_get_tmp_dir] "products.lst"]
  return "ok"
}


#*******************************************************
#
# Name :	tclu_update_file
#
# Description : updates the input file according the input parameters.
# Input	:	IN_FILE - file to edit
#               IN_TAG  - tag to search in file. could contain "*" in it.
#               VAR     - serial number of value in the expected line,
#                         begining with 1.
#                         for exampl, if we wanted to change the next line
#                         maxdsiz 111111 -> To
#                         maxdsiz 222222
#                         the VAR to supply must be 2.
#               NEW_VAL - the new value to set
#               PUT_NEW_VAL - Add value if not found
#               REMARK  - the IN_FILE remark sign
#               DELIM   - delimiter sign, if exists.
#               VAL_TYPE - one of "numeric" or "str", indicates the type
#                          of input parameter.
# Output :      "error" or "ok"
#               
# Note : for "numeric" values, they will be changed only of the input
#        NEW_VAL is greater than the current one.
#        for "str" values, they will be changed when they are different
#        from the current value.
#*****************************************************************
proc tclu_update_file { IN_FILE IN_TAG VAR NEW_VAL \
			    {PUT_NEW_VAL 1} {REMARK \#}  \
			    { DELIM "" } {VAL_TYPE numeric }}  {
			 
  set TMP_FILE [tclu_get_tmp_name tplugin]
  if {[catch {open $IN_FILE r} FP]} {
    tku_popup_message error ok $FP
    return "error"
  }

  if {[catch {open $TMP_FILE w} TFP]} {
    tku_popup_message error ok $TFP
    return "error"
  }
  
  set FOUND 0 
  set TAG $IN_TAG*
  
  while {![eof $FP]} {
    gets $FP LINE
    if { [string length $LINE] == 0 } {
      puts $TFP ""
      continue
    }    
    set MATCH [string match $TAG $LINE]
    if {$MATCH} {
      if { [string range $LINE 0 0] != $REMARK } {
	set DO_BREAK 1
	set FOUND 1
	set F1 ""
	set F2 ""
	set F3 ""
	set F4 ""
	set F5 ""
	set F6 ""
	set COUNT [scan $LINE "%s%s%s%s%s%s" F1 F2 F3 F4 F5 F6]
	if {$COUNT < $VAR} {
	  return "ok"
	}

	if { $DELIM == "" } {
	  set FNAME [set F$VAR]
	  set TEST_VAL $FNAME
	} else {
	  set IND [string first $DELIM $LINE]
	  if { $IND == -1 } {
	    set TEST_VAL 0
	  } else {
	    incr IND
	    set TEST_VAL [string range $LINE $IND end]
	  }
	}
	if { $VAL_TYPE == "numeric" } {
	  set CHANGE {$NEW_VAL > $TEST_VAL}
	} else {
	  if { $NEW_VAL == "" } {
	    set CHANGE 0
	  } else { 
	    set CHANGE [string compare $NEW_VAL $TEST_VAL]
	  }
	}
	if { $CHANGE != 0 } {
	  if { $DELIM == "" } {	  
	    set F$VAR $NEW_VAL
	    puts $TFP "$F1 $F2 $F3 $F4 $F5 $F6"
	  } else {
	    incr IND -1
	    puts -nonewline $TFP [string range $LINE 0 $IND]
	    puts $TFP $NEW_VAL
	  }
	} else {
	  puts $TFP $LINE
	}
      } else {
	puts $TFP $LINE
	set DO_BREAK 0
      }
      if { $DO_BREAK } {
	break
      }
    } else {
      puts $TFP $LINE
    }
  }
  
  if {$FOUND} {
    while {![eof $FP]} {
      gets $FP LINE
      if { [string trim $LINE] == "" } continue
      puts $TFP $LINE
    }
  } else {
    regsub -all {\*} $IN_TAG " " IN_TAG 
    if { $PUT_NEW_VAL } {
      puts $TFP "$IN_TAG $NEW_VAL"
    } else {
      puts $TFP "$IN_TAG"
    }
  }
  
  close $TFP
  close $FP

  if [catch {file copy -force $TMP_FILE $IN_FILE} RESPONSE] {
    tku_popup_message error ok $RESPONSE
    tclu_del_tmp_files tplugin
    return "error"
  }	 
  tclu_del_tmp_files tplugin
  return "ok"
}

#*******************************************************
#
# Name :	tclu_find_str_in_file
#
# Description : The routine searches the IN_FILE for the IN_TAG
#               IN_TAG string. when founds, it adds after
#               string
#               lines begining with the REMARK sign are discarded.
# Input	:	IN_FILE - file to search
#               IN_TAG  - string to search inside the input file
# Output :     -1 - unexpected error
#               0 - string wasn't found
#               1 - string was found
#               
# Return Value : If file match, returns 0, otherwise returns -1
#*****************************************************************
proc tclu_find_str_in_file { IN_FILE IN_TAG {REMARK "\#"} {LIMIT 0} } {
  
  set STATUS 0
  set TAG $IN_TAG*

  if {[catch {open $IN_FILE r} FP]} {
    tku_popup_message error ok $FP
    return -1
  }

  set LCOUNT 0
  while {![eof $FP]} {
    gets $FP LINE
    incr LCOUNT
    if { [string length $LINE] == 0 } continue 
    if { [string range $LINE 0 0] == $REMARK } continue
    set MATCH [string match $TAG $LINE]
    if {$MATCH} {
      set STATUS 1
      break ; 
    }
    if { $LIMIT <= 0 } continue
    if { $LCOUNT > $LIMIT } break 
  }
  close $FP
  
  return $STATUS
}

#*******************************************************
#
# Name :	tclu_put_after
#
# Description : The routine searches the IN_FILE for the
#               IN_TAG string. when founds, it adds after
#               it the VALUE line.
#               lines begining with the REMARK sign are discarded.
#               if IN_TAG wasn't found, nothing is changed
#               in  the IN_FILE file.
# Input	:	IN_FILE - file to search
#               IN_TAG  - string to search inside the input file
#               VALUE   - string to add after the IN_TAG string,
#                         if found
#               REMARK  - remark sign, to ignore lines begining with.
# Output :      "error" or "ok"
#               
# Return Value : If file match, returns 0, otherwise returns -1
#*****************************************************************
#######################################################

proc tclu_put_after { IN_FILE IN_TAG VALUE { REMARK "\#"} } {
  
  set STATUS "error"
  set TAG $IN_TAG*

  set TMP_FILE [tclu_get_tmp_name tplugin]
  if {[catch {open $TMP_FILE w} TFP]} {
    tku_popup_message error ok $TFP
    return "error"
  }

  if {[catch {open $IN_FILE r} FP]} {
    tku_popup_message error ok $FP
    return "error"
  }

  set BLIND 0 
  while {![eof $FP]} {
    gets $FP LINE
    if { [string length $LINE] == 0 } {
      puts $TFP ""
      continue 
    }
    if { $BLIND} {
      puts $TFP $LINE
      continue
    }
    if { [string range $LINE 0 0] == $REMARK }  {
      puts $TFP $LINE
      continue
    }
    set MATCH [string match $TAG $LINE]
    if {$MATCH} {
      puts $TFP $LINE
      puts $TFP $VALUE
      set BLIND 1 
      continue
    } else {
      puts $TFP $LINE
      continue
    }
  }
  
  close $FP
  close $TFP

  file copy -force $TMP_FILE $IN_FILE
  tclu_del_tmp_files tplugin

  return "ok"
}

#*******************************************************
#
# Name :	tclu_put_at_eof
#
# Description : The routine adds at the end of the file the input
#               IN_VALUE
# Input	:	IN_FILE - file to edit
#               VALUE   - string to add at the end of the file
# Output :      "error" or "ok"
#               
# Return Value : If file match, returns 0, otherwise returns -1
#*****************************************************************
proc tclu_put_at_eof { IN_FILE IN_VALUE } {
  
  set STATUS "error"

  set TMP_FILE [tclu_get_tmp_name tplugin]
  if {[catch {open $TMP_FILE w} TFP]} {
    tku_popup_message error ok \
 	"Cannot open file $TMP_FILE To edit $IN_FILE"
    return "error"
  }

  if {[catch {open $IN_FILE r} FP]} {
    tku_popup_message error ok \
 	"Cannot open file $IN_FILE to edit"
    return "error"
  }

  while {![eof $FP]} {
    gets $FP LINE
    puts $TFP $LINE
  }
  
  puts $TFP $IN_VALUE
  close $FP
  close $TFP
  
  file copy -force $TMP_FILE $IN_FILE
  tclu_del_tmp_files tplugin

  return "ok"
}

#******** Private Procedure ***************************
#
# Name :	tclu.log_open
#
# Description :	
#   Make sure the log file is open. If not, creates it with full
#   open privileges. If the file exists, seeks to the end so information
#   will be appended. The PATH is taken from the global var set by 
#   tclu_log_set_path.
# Input	:	None
# Output :	None
# Return Value:	1 if error
#               0 if success
#*******************************************************
#
proc tclu.log_open {} {   
   global TCLU_G
      
   if {$TCLU_G(LOG_FP) == -1} {return 1}
   if {$TCLU_G(LOG_FP) == 0} {
      if [catch {open $TCLU_G(LOG_PATH) {RDWR CREAT} 0777} TCLU_G(LOG_FP)] { 
	 puts "Cannot open log file $TCLU_G(LOG_PATH)"
	 set TCLU_G(LOG_FP) -1 
	 return 1
      } else {
	 seek $TCLU_G(LOG_FP) 0 end
      }
   }
   return 0 
}

#*******************************************************
#
# Name :	tclu_set_system_env
#
# Description : The routine sets a system-wide environment variable
#               permanently!
#
# Note        : Currently implemented for Windows NT only!
#               
# Input	:	VARIABLE - the name of the environment variable
#               VALUE    - the value of the environment variable
# Output :      none
#               
# Return Value : "error" or "ok"
#*****************************************************************
proc tclu_set_system_env {VARIABLE VALUE} {

#   set ROOT "HKEY_LOCAL_MACHINE"
#   set HOST [hostname]
#   set ENV  "\\\\$HOST\\$ROOT\\SYSTEM\\CurrentControlSet\\Control\\Session Manager\\Environment"
#   registry set $ENV $VARIABLE $VALUE sz
   global TCLU_G
   global env

   set PATH "SYSTEM\\CurrentControlSet\\Control\\Session Manager\\Environment"

   set EXEC [file join $TCLU_G(TOOLS) reg_set.exe]
   if { [catch {exec $EXEC $PATH $VARIABLE REG_SZ $VALUE } HOSTLINE] } {
      tku_popup_message error ok \
         "$EXEC :\n$HOSTLINE"
      return error
   }
   set env($VARIABLE) $VALUE
   return ok
}

#*******************************************************
#
# Name :	tclu_null_file
#
# Description : The routine returns the path of a null file
#
# Input	:	none
#               
# Return Value : path of null file
#                (on Unix "/dev/null", on NT "nul")
#*****************************************************************
proc tclu_null_file {} {

   global TCLU_G
   if { $TCLU_G(OS) == "nt" } {
#      return "c:/tmp/null"
      return "nul"
   } else {
      return "/dev/null"
   }
}