1 which wish;
2 /usr/bin/wish

1 which tclsh;
2 /usr/bin/tclsh

  1 #!/usr/bin/wish -f
  2 #
  3 # this is test login, Tk-style
  4
  5 set filename "usrfile.pwd";
  6
  7 proc splitf { str index } {
  8     set y [ split $str | ];
  9     list  $y;
 10     set w [ lindex $y $index ];
 11     return $w;
 12 }
 13
 14 proc checkinfo {name pwd} {
 15     global filename;
 16     set iflag 0;
 17     set isUser 0;
 18
 19     if { $name eq "" || $pwd eq "" } {
 20         return 005;
 21     }
 22
 23     set fileId [ open $filename r ];
 24     while { [ gets $fileId line ] >= 0 } {
 25         set nameInfile [ splitf $line 0 ];
 26         set cmp [ string compare $name $nameInfile ];
 27
 28         if { $cmp != 0 } {
 29             set isUser [ expr $isUser + 1 ];
 30         } elseif { $cmp == 0 } {
 31             set pwdInfile [ splitf $line 1 ];
 32             set cmp [ string compare $pwd $pwdInfile ];
 33             if { $cmp == 0 } {
 34                 close $fileId;
 35                 return 001; #login successful
 36             } else {
 37                 close $fileId;
 38                 return 004; #err user pwd
 39             }
 40         }
 41         set iflag [ expr $iflag + 1 ];
 42     }
 43     close $fileId;
 44
 45     if { $iflag == 0 } {
 46         return 002; #file is null,creat user;
 47     }
 48     if { $iflag == $isUser } {
 49         return 002; #creat user
 50     }
 51 }
 52
 53 proc process { uname pwd } {
 54     global filename;
 55     set returnCheck [ checkinfo $uname $pwd ];
 56     switch -- $returnCheck {
 57         001 { tk_messageBox -type ok -message "you are login successful" }
 58         002 { set answer [ tk_messageBox -type yesno -icon question \
 59                  -message "you need creat a user" ] ;
 60                 switch -- $answer {
 61                     no { }
 62                     yes { puts stdout [ createusr $uname $pwd ] }
 63                 }
 64             }
 65         //003 { tk_messageBox -type ok -icon warning -message "$filename file is null" }
 66         004 { tk_messageBox -type ok -icon error -message "input err of user pwd" }
 67         005 { tk_messageBox -type ok -icon info -message "user and pwd is not null" }
 68         default { tk_messageBox -type ok -icon error -message "system err" }
 69     }
 70 }
 71
 72 proc createusr { uname pwd } {
 73     global filename;
 74     set fileId [ open $filename a ];
 75     puts $fileId "$uname|$pwd" ;
 76     close $fileId;
 77     return 1;
 78 }
 79 wm title . LOGIN
 80 wm maxsize . 500 300
 81 wm minsize . 500 300
 82 wm resizable . 500 300
 83 wm geometry . 500x300+300+200
 84
 85 label .ulname -text "userName"
 86
 87 entry .tuname -textvariable name
 88
 89 label .ulpwd -text "userPwd"
 90
 91 entry .tupwd -textvariable pwd
 92
 93 button .bOK -text OK \
 94   -command { puts stdout [ process $name $pwd] }
 95
 96 button .bExit -text Exit \
 97   -command {exit}
 98
 99
100 place .ulname -x 110 -y 50
101 place .tuname -x 200 -y 50
102 place .ulpwd -x 110 -y 100
103 place .tupwd -x 200 -y 100
104
105 place .bOK -x 150 -y 150
106 place .bExit -x 280 -y 150

1 wish tk.tcl

1 cat usrfile.pwd2 userTmp|abc123

1 proc sum { arg1 arg2 }
2
3 {
4
5 　　....
6
7 }

1 proc sum { arg1 arg2 } {
2
3 　　....
4
5 }

git clone https://github.com/galoishelley/tcltk