1# $Id: idnconf.tcl,v 1.1 2003/06/04 00:27:42 marka Exp $ 2# 3# idnconf.tcl - configure idn wrapper 4# 5 6############################################################################# 7# Copyright (c) 2000,2002 Japan Network Information Center. 8# All rights reserved. 9# 10# By using this file, you agree to the terms and conditions set forth bellow. 11# 12# LICENSE TERMS AND CONDITIONS 13# 14# The following License Terms and Conditions apply, unless a different 15# license is obtained from Japan Network Information Center ("JPNIC"), 16# a Japanese association, Kokusai-Kougyou-Kanda Bldg 6F, 2-3-4 Uchi-Kanda, 17# Chiyoda-ku, Tokyo 101-0047, Japan. 18# 19# 1. Use, Modification and Redistribution (including distribution of any 20# modified or derived work) in source and/or binary forms is permitted 21# under this License Terms and Conditions. 22# 23# 2. Redistribution of source code must retain the copyright notices as they 24# appear in each source code file, this License Terms and Conditions. 25# 26# 3. Redistribution in binary form must reproduce the Copyright Notice, 27# this License Terms and Conditions, in the documentation and/or other 28# materials provided with the distribution. For the purposes of binary 29# distribution the "Copyright Notice" refers to the following language: 30# "Copyright (c) 2000-2002 Japan Network Information Center. All rights reserved." 31# 32# 4. The name of JPNIC may not be used to endorse or promote products 33# derived from this Software without specific prior written approval of 34# JPNIC. 35# 36# 5. Disclaimer/Limitation of Liability: THIS SOFTWARE IS PROVIDED BY JPNIC 37# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 38# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A 39# PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL JPNIC BE LIABLE 40# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 41# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 42# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR 43# BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, 44# WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR 45# OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF 46# ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. 47############################################################################# 48 49global configFile configBack 50global registryKey registryEnc registryDef 51global filesCpy filesRen filesDel 52 53# idnkit version 54set version "1.0" 55 56set configFile "idnconf.lst" ;# list of wrapped program 57set configBack "idnconf.bak" ;# backup of previous data 58 59set serverKey "HKEY_LOCAL_MACHINE\\Software\\JPNIC\\IDN" 60set serverLogLevel LogLevel 61set serverLogLevelDef -1 62set serverLogLevelNone -1 63set serverLogFile LogFile 64set serverLogFileDef {C:\idn_wrapper.log} 65set serverConfFile ConfFile 66 67set perprogKey "HKEY_LOCAL_MACHINE\\Software\\JPNIC\\IDN\\PerProg\\" 68set perprogEnc Encoding 69set perprogDef Default 70 71set logFileNameDef idn_wrapper.log 72set confFileNameDef idn.conf 73 74set filesCpy11 { "wsock32.dll" } 75set filesCpy20 { "wsock32.dll" "ws2_32.dll" } 76set filesDel11 { "wsock32.dll" } 77set filesDel20 { "wsock32.dll" "ws2_32.dll" } 78 79set local_dll 0 80 81######################################################################## 82# 83# OS version check 84# 85 86proc get_os_version {} { 87 global os_version tcl_platform 88 89 if {[llength [info globals os_version]] > 0} { 90 return $os_version 91 } 92 93 switch -- $tcl_platform(os) { 94 "Windows 95" { 95 switch -- $tcl_platform(osVersion) { 96 4.0 { 97 set os_version {Windows 95} 98 } 99 4.10 { 100 set os_version {Windows 98} 101 } 102 4.90 { 103 set os_version {Windows Me} 104 } 105 } 106 } 107 "Windows NT" { 108 switch -- $tcl_platform(osVersion) { 109 3.51 - 110 4.0 { 111 set os_version {Windows NT} 112 } 113 5.0 { 114 set os_version {Windows 2000} 115 } 116 default { 117 # XP or .NET 118 set os_version {Windows XP} 119 } 120 } 121 } 122 "Win32s" { 123 error "idn wrapper does not support Windows 3.1" 124 } 125 default { 126 set os_version "Unknown" 127 } 128 } 129 set os_version 130} 131 132proc support_dll_redirection {} { 133 global dll_redirection 134 135 if {[llength [info globals dll_redirection]] > 0} { 136 return $dll_redirection 137 } 138 139 switch -- [get_os_version] { 140 {Windows 95} - 141 {Windows NT} { 142 # cannot force local DLL reference by .local file. 143 set dll_redirection 0 144 } 145 default { 146 set dll_redirection 1 147 } 148 } 149 set dll_redirection 150} 151 152######################################################################## 153# 154# handling pathname 155# 156 157proc getExeName { prg } { 158 set elem [file split $prg] 159 set leng [expr {[llength $elem] - 1}] 160 set name [lindex $elem $leng] 161 set exe [file rootname $name] 162 return $exe 163} 164 165proc getDirName { prg } { 166 file dirname $prg 167} 168 169proc getSystemDir {} { 170 global env 171 switch -- [get_os_version] { 172 "Windows 95" - 173 "Windows 98" - 174 "Windows Me" { 175 set sysDir $env(windir)/system 176 } 177 default { 178 set sysDir $env(SystemRoot)/system32 179 } 180 } 181 return $sysDir 182} 183 184######################################################################## 185# 186# loadList / saveList 187# 188# loadList - load list of wrapped executables from $configFile 189# saveList - save list of wrapped executables into $configFile 190# 191 192proc loadList {} { 193 194 global configFile configBack 195 196 if { [file exists $configFile] } { 197 file copy -force $configFile $configBack 198 } 199 200 set aList {} 201 set fd [open $configFile {CREAT RDONLY}] 202 while { ! [eof $fd]} { 203 set line [gets $fd] 204 if { [string length $line] > 0} { 205 lappend aList "$line" 206 } 207 } 208 close $fd 209 return $aList 210} 211 212proc saveList { aList } { 213 global configFile 214 file delete -force $configFile 215 set fd [open $configFile {CREAT WRONLY}] 216 foreach e $aList { 217 puts $fd $e 218 } 219 close $fd 220} 221 222######################################################################## 223# 224# putList / getList - set/get list to/from listbox 225# 226 227proc putList { lb aList } { 228 foreach e $aList { 229 $lb insert end $e 230 } 231} 232 233proc getList { lb } { 234 $lb get 0 end 235} 236 237######################################################################## 238# 239# checkList / appendList / deleteList - check / append / delete program from/to listbox 240# 241 242proc checkList { lb prg } { 243 set cnt 0 244 set lst [getList $lb] 245 246 foreach n $lst { 247 if { [string compare $prg $n] == 0 } { 248 incr cnt 249 } 250 } 251 return $cnt 252} 253 254proc appendList { lb prg } { 255 256 if { [checkList $lb $prg] == 0 } { 257 $lb insert end $prg 258 } 259} 260 261proc deleteList { lb prg } { 262 set cnt 0 263 set lst [getList $lb] 264 265 foreach n $lst { 266 if { [string compare $n $prg] == 0 } { 267 $lb delete $cnt 268 } 269 incr cnt 270 } 271} 272 273######################################################################## 274# 275# registry operations 276# 277 278proc regGetEncode { prg } { 279 280 global perprogKey perprogEnc perprogDef 281 282 if { [string compare $prg "" ] == 0 } { 283 return $perprogDef 284 } 285 286 if {![isWindows]} { 287 return $perprogDef 288 } 289 package require registry 1.0 290 291 set name [getExeName $prg] 292 set key $perprogKey$name 293 294 if { [catch {set enc [registry get $key $perprogEnc]} err] } { 295 return $perprogDef 296 } 297 if { [string compare $enc ""] == 0 } { 298 return $perprogDef 299 } 300 return $enc 301} 302 303proc regSetEncode { prg enc } { 304 305 global perprogKey perprogEnc perprogDef 306 307 if {![isWindows]} { 308 return 1 309 } 310 311 package require registry 1.0 312 313 set name [getExeName $prg] 314 set key $perprogKey$name 315 316 if { [string compare $enc $perprogDef] == 0 } { 317 set enc "" 318 } 319 if { [catch {registry set $key $perprogEnc $enc sz} ] } { 320 return 2 321 } 322 return 0 323} 324 325proc regGetLogLevel {} { 326 global serverKey serverLogLevel serverLogLevelDef 327 regGetValue $serverKey $serverLogLevel $serverLogLevelDef 328} 329 330proc regSetLogLevel {level} { 331 global serverKey serverLogLevel 332 regSetValue $serverKey $serverLogLevel $level dword 333} 334 335proc regGetLogFile {} { 336 global serverKey serverLogFile serverLogFileDef 337 set file [regGetValue $serverKey $serverLogFile $serverLogFileDef] 338 if {[catch {file attributes $file -longname} lfile]} { 339 # Maybe $file doesn't exist (yet). Get the longname of 340 # directory portion. 341 set dir [file dirname $file] 342 if {[catch {file attributes $dir -longname} ldir]} { 343 set ldir $dir 344 } 345 set lfile [file join $ldir [file tail $file]] 346 } 347 file nativename $lfile 348} 349 350proc regSetLogFile {file} { 351 global serverKey serverLogFile 352 regSetValue $serverKey $serverLogFile [file nativename $file] 353} 354 355proc regGetConfFile {} { 356 global serverKey serverConfFile 357 set file [regGetValue $serverKey $serverConfFile {}] 358 if {[string compare $file {}] == 0} { 359 return {} 360 } 361 if {[catch {file attributes $file -longname} lfile]} { 362 # Maybe $file doesn't exist (yet). Get the longname of 363 # directory portion. 364 set dir [file dirname $file] 365 if {[catch {file attributes $dir -longname} ldir]} { 366 set ldir $dir 367 } 368 set lfile [file join $ldir [file tail $file]] 369 } 370 file nativename $lfile 371} 372 373proc regSetConfFile {file} { 374 global serverKey serverConfFile 375 regSetValue $serverKey $serverConfFile [file nativename $file] 376} 377 378proc regGetWhere {} { 379 global serverKey 380 regGetValue $serverKey Where 0 381} 382 383proc regSetWhere {where} { 384 global serverKey 385 regSetValue $serverKey Where $where dword 386} 387 388proc regGetValue {key name default} { 389 if {![isWindows]} { 390 puts "--regGetValue $key $name" 391 return $default 392 } 393 package require registry 1.0 394 395 if {[catch {registry get $key $name} value]} { 396 return $default 397 } 398 if {[string compare $value {}] == 0} { 399 return $default 400 } 401 return $value 402} 403 404proc regSetValue {key name value {type sz}} { 405 if {![isWindows]} { 406 puts "--regSetValue $key $name $value" 407 return 1 408 } 409 410 package require registry 1.0 411 412 if {[catch {registry set $key $name $value $type}]} { 413 return 2 414 } 415 return 0 416} 417 418######################################################################## 419# 420# install / uninstall DLL s 421# 422 423proc fileInstall { prg } { 424 425 global env 426 global filesCpy11 filesCpy20 427 428 if {![isWindows]} { 429 return 1 430 } 431 432 switch -- [get_os_version] { 433 "Windows 95" - 434 "Windows 98" - 435 "Windows Me" { 436 set winDir $env(windir) 437 set sysDir $winDir/system 438 set filesCpy $filesCpy11 439 } 440 default { 441 set winDir $env(SystemRoot) 442 set sysDir $winDir/system32 443 set filesCpy $filesCpy20 444 } 445 } 446 447 set toDir [getDirName $prg ] 448 449 foreach n $filesCpy { 450 file copy -force $n $toDir 451 } 452 return 0 453} 454 455proc fileRemove { prg } { 456 457 global filesDel11 filesDel20 458 459 if {![isWindows]} { 460 return 1 461 } 462 463 switch -- [get_os_version] { 464 "Windows 95" { 465 set filesDel $filesDel11 466 } 467 "Windows 98" - 468 "Windows Me" { 469 set filesDel $filesDel20 470 } 471 default { 472 set filesDel $filesDel20 473 } 474 } 475 476 set fromDir [getDirName $prg ] 477 478 foreach n $filesDel { 479 file delete -force $fromDir/$n 480 } 481 return 0 482} 483 484######################################################################## 485# 486# Wrap/Unwrap program 487# 488 489proc execWrap { pw lb dlg prg enc } { 490 491 set prgName [$prg get] 492 set encName [$enc get] 493 494 # Make sure the program name is not empty 495 if {[string compare $prgName {}] == 0} { 496 confErrorDialog $dlg "Program must be specified.\nClick \"Browse..\" button for browsing." 497 return 498 } 499 500 # It is dangerous to wrap programs in the system directory. 501 set prgdir [file nativename [getDirName $prgName]] 502 set sysdir [file nativename [getSystemDir]] 503 if {[string compare -nocase $prgdir $sysdir] == 0} { 504 tk_messageBox -icon error -type ok -title "Directory Error" \ 505 -parent $dlg \ 506 -message "Cannot wrap applications in the system directory.\nPlease copy the EXE file to elsewhere and wrap the copied one." 507 destroy $dlg 508 return 1 509 } 510 511 # Okay, copy the wrapper DLLs. 512 if { [fileInstall $prgName] } { 513 tk_messageBox -icon warning -type ok \ 514 -title "Warning" \ 515 -message "Cannot install DLLs" \ 516 -parent $dlg 517 destroy $dlg 518 return 1 519 } 520 if { [regSetEncode $prgName $encName] } { 521 tk_messageBox -icon warning -type ok \ 522 -title "Warning" \ 523 -message "Cannot set encoding" \ 524 -parent $dlg 525 fileRemove $prgName 526 destroy $dlg 527 return 2 528 } 529 530 # if local flag is on, create $prgName.local. 531 global local_dll 532 if {$local_dll} { 533 create_dot_local $prgName $dlg 534 } else { 535 remove_dot_local $prgName $dlg 536 } 537 538 if { [checkList $lb $prgName] == 0 } { 539 appendList $lb $prgName 540 } 541 saveList [getList $lb] 542 destroy $dlg 543} 544 545proc execUnwrap { pw lb dlg prg } { 546 547 set prgName [$prg get] 548 549 if {[support_dll_redirection] && [file exists $prgName.local]} { 550 set ans [tk_messageBox -icon question -type yesno \ 551 -title "Confirmation" \ 552 -message "Also remove $prgName.local file?" \ 553 -parent $dlg] 554 if {[string compare $ans yes] == 0} { 555 remove_dot_local $prgName $dlg 556 } 557 } 558 559 if { [checkList $lb $prgName] == 1 } { 560 fileRemove $prgName 561 } 562 deleteList $lb $prgName 563 saveList [getList $lb] 564 destroy $dlg 565} 566 567proc create_dot_local {path {parent .}} { 568 set dotlocal $path.local 569 if {[file exists $dotlocal]} { 570 return 0 571 } 572 if {[catch {open $dotlocal w} fh]} { 573 tk_messageBox -icon warning -type ok -title "Warning" \ 574 -message "Cannot create $dotlocal" -parent $parent 575 return -1 576 } 577 close $fh 578 return 0 579} 580 581proc remove_dot_local {path {parent .}} { 582 set dotlocal $path.local 583 if {[file exists $dotlocal] && [catch {file delete $dotlocal}]} { 584 tk_messageBox -icon warning -type ok -title "Warning" \ 585 -message "Cannot remove $dotlocal" -parent $parent 586 return -1 587 } 588 return 0 589} 590 591######################################################################## 592# 593# dialog for Wrap / Unwrap 594# 595 596proc syncEncode { v i op } { 597 global prgName encName 598 set enc [regGetEncode $prgName] 599 if { [string compare $encName $enc] != 0 } { 600 set encName $enc 601 } 602} 603 604proc confBrowse { p ePrg eEnc } { 605 606 set types { 607 { "Executable" .exe } 608 } 609 610 set file [tk_getOpenFile -filetypes $types -parent $p ] 611 612 if { [string compare $file ""] == 0 } { 613 return 614 } 615 set enc [regGetEncode $file] 616 $ePrg delete 0 end 617 $ePrg insert 0 $file 618} 619 620proc confWrap { pw lb } { 621 622 global prgName encName local_dll 623 624 set idx [$lb curselection] 625 if { [llength $idx] == 1 } { 626 set prg [$lb get $idx] 627 set local_dll [file exists $prg.local] 628 } else { 629 set prg "" 630 } 631 632 set top .wrap 633 toplevel $top 634 grab $top 635 wm title $top "idn wrapper - Wrap Executable" 636 637 frame $top.f1 -bd 1 -relief raised 638 frame $top.f2 -bd 1 -relief raised 639 pack $top.f1 -side top -fill x -expand on 640 pack $top.f2 -side top -fill x -expand on 641 642 frame $top.f1.f 643 pack $top.f1.f -fill both -expand on -padx 4 -pady 4 644 645 set w $top.f1.f 646 label $w.prgtitle -text "Program:" 647 label $w.enctitle -text "Encoding:" 648 649 entry $w.prgname -relief sunken -width 56 -textvariable prgName 650 entry $w.encname -relief sunken -width 8 -textvariable encName 651 set w_prgname $w.prgname 652 set w_encname $w.encname 653 button $w.browse -text "Browse.." \ 654 -command [list confBrowse $w $w_prgname $w_encname] 655 656 frame $w.rbf 657 radiobutton $w.rbf.encdef -text "Default" -variable encName \ 658 -value "Default" 659 radiobutton $w.rbf.encutf -text "UTF-8" -variable encName \ 660 -value "UTF-8" 661 pack $w.rbf.encdef $w.rbf.encutf -side left -padx 4 662 663 grid $w.prgtitle -row 0 -column 0 -sticky e 664 grid $w.enctitle -row 1 -column 0 -sticky e 665 grid $w.prgname -row 0 -column 1 -sticky we -pady 4 -padx 2 -columnspan 2 666 grid $w.browse -row 0 -column 3 -sticky w -pady 4 -padx 4 667 grid $w.encname -row 1 -column 1 -sticky we -pady 4 -padx 2 668 grid $w.rbf -row 1 -column 2 -sticky w -padx 2 669 if {[support_dll_redirection]} { 670 checkbutton $w.local -text "Force local DLL reference" \ 671 -variable local_dll 672 grid $w.local -row 2 -column 1 -sticky w -padx 4 -pady 4 673 } 674 grid columnconfig $w 1 -weight 1 -minsize 20 675 grid columnconfig $w 2 -weight 2 -minsize 20 676 677 trace variable prgName w syncEncode 678 679 $w.prgname delete 0 end 680 $w.prgname insert 0 $prg 681 682 focus $w.prgname 683 684 set w $top.f2 685 button $w.wrap -text "Wrap" \ 686 -command [list execWrap $pw $lb $top $w_prgname $w_encname] 687 button $w.cancel -text "Cancel" \ 688 -command [list destroy $top] 689 pack $w.cancel -side right -fill y -padx 12 -pady 4 690 pack $w.wrap -side right -fill y -padx 12 -pady 4 691 692 tkwait window $top 693} 694 695proc confUnwrap { pw lb } { 696 697 set idx [$lb curselection] 698 if { [llength $idx] != 1 } { 699 tk_messageBox -icon warning -type ok \ 700 -title "Warning" \ 701 -message "first, select unwrapping executable" \ 702 -parent $pw 703 return 0 704 } 705 set prg [$lb get $idx] 706 if { [string length $prg] == 0 } { 707 tk_messageBox -icon warning -type ok \ 708 -title "Warning" \ 709 -message "first, select unwrapping executable" \ 710 -parent $pw 711 return 0 712 } 713 714 set top .unwrap 715 toplevel $top 716 grab $top 717 wm title $top "idn wrapper - Unwrap Executable" 718 719 frame $top.f1 -bd 1 -relief raised 720 frame $top.f2 -bd 1 -relief raised 721 pack $top.f2 -side bottom -fill x 722 pack $top.f1 -side bottom -fill x -expand on 723 724 frame $top.f1.f 725 pack $top.f1.f -padx 4 -pady 4 -fill both -expand on 726 set w $top.f1.f 727 label $w.prgtitle -text "Program:" 728 entry $w.prgname -relief sunken -width 56 -textvariable prgName 729 $w.prgname delete 0 end 730 $w.prgname insert 0 $prg 731 732 set w_prgname $w.prgname 733 734 grid $w.prgtitle -row 0 -column 0 -sticky w 735 grid $w.prgname -row 0 -column 1 -sticky we -pady 4 736 grid columnconfig $w 1 -weight 1 -minsize 20 737 738 set w $top.f2 739 button $w.wrap -text "Unwrap" \ 740 -command [list execUnwrap $pw $lb $top $w_prgname] 741 button $w.cancel -text "Cancel" \ 742 -command [list destroy $top] 743 744 pack $w.cancel -side right -padx 12 -pady 6 745 pack $w.wrap -side right -padx 12 -pady 6 746 747 focus $w.wrap 748 tkwait window $top 749} 750 751proc unwrapAll {pw lb} { 752 set ans [tk_messageBox -type yesno -default no -icon question \ 753 -parent $pw -title {idn wrapper Configuration} \ 754 -message {Really unwrap all programs?}] 755 if {[string compare $ans yes] != 0} { 756 return 757 } 758 759 foreach prog [$lb get 0 end] { 760 fileRemove $prog 761 } 762 763 if {[support_dll_redirection]} { 764 set delete_type yes 765 foreach prog [$lb get 0 end] { 766 if {![file exists $prog.local]} continue 767 switch -- $delete_type { 768 yes - 769 no { 770 set delete_type [dotLocalDialog $prog $delete_type] 771 } 772 } 773 switch -- $delete_type { 774 yes - 775 yesall { 776 remove_dot_local $prog $pw 777 } 778 } 779 } 780 } 781 782 $lb delete 0 end 783 saveList {} 784} 785 786proc rewrapAll {pw lb} { 787 set ans [tk_messageBox -type yesno -default yes -icon question \ 788 -parent $pw -title {idn wrapper Configuration} \ 789 -message {Really rewrap all programs?}] 790 if {[string compare $ans yes] != 0} { 791 return 792 } 793 foreach prog [$lb get 0 end] { 794 fileInstall $prog 795 } 796} 797 798proc confLog {pw} { 799 global _logLevel _logFile 800 801 set top .log 802 catch {destroy $top} 803 toplevel $top 804 wm title $top "idn wrapper - Log Configuration" 805 # wm transient $top $pw 806 807 set _logLevel [regGetLogLevel] 808 set _logFile [regGetLogFile] 809 810 frame $top.f1 -bd 1 -relief raised 811 frame $top.f2 -bd 1 -relief raised 812 pack $top.f2 -side bottom -fill x 813 pack $top.f1 -side top -fill both -expand on 814 815 set w $top.f1 816 label $w.lv_l -text "Log Level:" 817 frame $w.lv_v 818 global serverLogLevelNone 819 set i 0 820 foreach {lvl text} [list $serverLogLevelNone None \ 821 0 Fatal 1 Error 2 Warning 3 Info 4 Trace] { 822 radiobutton $w.lv_v.btn$i -text $text -value $lvl -variable _logLevel 823 pack $w.lv_v.btn$i -side left -padx 3 824 incr i 825 } 826 label $w.ld_l -text "Log File:" 827 frame $w.ld_v 828 entry $w.ld_v.e -width 40 -textvariable _logFile 829 focus $w.ld_v.e 830 button $w.ld_v.b -text "Browse.." -command [list selectLog $top $w.ld_v.e] 831 pack $w.ld_v.b -side right -fill y -padx 6 832 pack $w.ld_v.e -side left -fill both -expand yes 833 #label $w.lo_l -text "Log Operation:" 834 frame $w.lo_v 835 button $w.lo_v.show -text "View" -command [list showLog $top] 836 button $w.lo_v.delete -text "Delete" -command [list deleteLog $top] 837 pack $w.lo_v.show $w.lo_v.delete -side left -padx 4 838 839 grid $w.lv_l -row 0 -column 0 -sticky e -padx 4 840 grid $w.ld_l -row 1 -column 0 -sticky e -padx 4 841 #grid $w.lo_l -row 2 -column 0 -sticky e -padx 4 842 grid $w.lv_v -row 0 -column 1 -sticky w -padx 4 -pady 4 843 grid $w.ld_v -row 1 -column 1 -sticky we -padx 4 -pady 4 844 grid $w.lo_v -row 2 -column 1 -sticky w -padx 4 -pady 4 845 846 set w $top.f2 847 button $w.ok -text "OK" -command [list configureLog $top] 848 button $w.cancel -text "Cancel" -command [list destroy $top] 849 pack $w.cancel -side right -padx 12 -pady 6 850 pack $w.ok -side right -padx 12 -pady 6 851} 852 853proc configureLog {top} { 854 global _logLevel _logFile 855 856 if {$_logLevel != [regGetLogLevel] || 857 [string compare $_logFile [regGetLogFile]] != 0} { 858 set dir [file dirname $_logFile] 859 if {[string compare $dir {}]} { 860 if {![file exists $dir]} { 861 confErrorDialog $top "Directory $dir doesn't exist" 862 return 863 } elseif {![file isdirectory $dir]} { 864 confErrorDialog $top "$dir is not a directory" 865 return 866 } 867 } 868 regSetLogLevel $_logLevel 869 regSetLogFile $_logFile 870 tk_messageBox -type ok -default ok -icon info -parent $top \ 871 -title "idn wrapper Configuration" \ 872 -message "Changing log level or file does not affect already running processes." 873 } 874 destroy $top 875} 876 877proc selectLog {top e} { 878 global logFileNameDef 879 set file [tk_getSaveFile -title {idn wrapper Logfile Selection} \ 880 -defaultextension .log \ 881 -filetypes {{{Log Files} .log} {{All Files} *}} \ 882 -initialfile $logFileNameDef \ 883 -parent $top] 884 if {[string compare $file {}]} { 885 $e delete 0 end 886 $e insert insert $file 887 } 888} 889 890proc showLog {top} { 891 global _logFile 892 if {[catch {exec notepad.exe $_logFile &} r]} { 893 confErrorDialog $top "Cannot execute notepad" 894 } 895} 896 897proc deleteLog {top} { 898 global _logFile 899 set ans [tk_messageBox -type yesno -default no -icon question \ 900 -parent $top -title "idn wrapper Configuration" \ 901 -message "Really delete $_logFile?"] 902 if {[string compare $ans yes] == 0} { 903 file delete $_logFile 904 } 905} 906 907######################################################################## 908# 909# dialog for .local deletion 910# 911 912proc dotLocalDialog {path {default yes}} { 913 set parent . 914 set dlg .dotlocaldlg 915 catch {destroy $dlg} 916 toplevel $dlg 917 918 wm iconname $dlg Dialog 919 wm title $dlg Confirmation 920 wm transient $dlg $parent 921 wm protocol $dlg WM_DELETE_WINDOW {} 922 923 frame $dlg.f1 -bd 1 -relief raised 924 frame $dlg.f2 -bd 1 -relief raised 925 pack $dlg.f1 -side top -fill x -expand on -ipadx 2m -ipady 4m 926 pack $dlg.f2 -side top -fill x -ipadx 2m 927 928 label $dlg.f1.bm -bitmap question -bd 0 929 label $dlg.f1.msg -text "Remove $path.local?" -wraplength 10c 930 pack $dlg.f1.bm -side left -padx 3m -pady 2m 931 pack $dlg.f1.msg -side left -padx 2m -pady 2m 932 933 global dotlocal_selection 934 foreach {btn lbl} {yes Yes no No yesall {Yes to All} noall {No to All}} { 935 set bw $dlg.f2.btn$btn 936 button $bw -text $lbl -default normal \ 937 -command [list set dotlocal_selection $btn] 938 if {[string compare $default $btn] == 0} { 939 $bw configure -default active 940 focus $bw 941 } 942 bind $bw <Return> {%W flash; %W invoke} 943 pack $bw -side left -padx 3m -pady 2m 944 } 945 946 grab $dlg 947 ::tk::PlaceWindow $dlg widget $parent 948 949 vwait dotlocal_selection 950 destroy $dlg 951 return $dotlocal_selection 952} 953 954######################################################################## 955# 956# dialog for advanced configuration 957# 958 959proc advancedConf {pw} { 960 set top .adv 961 catch {destroy $top} 962 toplevel $top 963 wm title $top "idn wrapper - Advanced Configuration" 964 965 global _mdnOperation _confFile 966 set _mdnOperation [regGetWhere] 967 set _confFile [regGetConfFile] 968 969 foreach f {f1 f2 f3} { 970 frame $top.$f -bd 1 -relief raised 971 pack $top.$f -side top -fill x 972 } 973 974 set f $top.f1 975 label $f.lbl -text {IDN Wrapping Mode} 976 set w $f.f 977 frame $w 978 foreach {rb val txt} [list \ 979 rb1 0 {Wrap both WINSOCK 1.1 and WINSOCK 2.0} \ 980 rb2 2 {Wrap only WINSOCK 1.1} \ 981 rb3 3 {Wrap only WINSOCK 2.0} \ 982 rb4 1 "Wrap only WINSOCK2.0 if it exists.\nOtherwise wrap only WINSOCK1.1"] { 983 radiobutton $w.$rb -text $txt -variable _mdnOperation -value $val \ 984 -anchor w -justify left 985 pack $w.$rb -side top -fill x -pady 1 986 } 987 pack $f.lbl -side top -fill x -pady 4 988 pack $w -side top -fill both -padx 20 -pady 10 989 990 set f $top.f2 991 label $f.lbl -text {IDN Configuration} 992 pack $f.lbl -side top -fill x -pady 6 993 994 set w $f.f 995 frame $w 996 pack $w -side top -fill both -padx 10 -pady 6 997 label $w.l1 -text {Config File:} 998 #label $w.l2 -text {Config Operation:} 999 entry $w.e -width 40 -textvariable _confFile 1000 focus $w.e 1001 button $w.br -text "Browse.." -command [list selectConf $top $w.e] 1002 button $w.b -text Edit -command [list editConf $top] 1003 grid $w.l1 -row 0 -column 0 -sticky e -padx 4 1004 #grid $w.l2 -row 1 -column 0 -sticky e -padx 4 1005 grid $w.e -row 0 -column 1 -sticky we -padx 4 -pady 4 1006 grid $w.b -row 1 -column 1 -sticky w -padx 4 -pady 4 1007 grid $w.br -row 0 -column 2 -sticky w -padx 4 -pady 4 1008 1009 set w $top.f3 1010 button $w.ok -text "OK" -command [list advConf $top] 1011 button $w.cancel -text "Cancel" -command [list destroy $top] 1012 pack $w.cancel -side right -padx 12 -pady 8 1013 pack $w.ok -side right -padx 12 -pady 8 1014} 1015 1016proc editConf {top} { 1017 global _confFile 1018 if {[catch {exec notepad.exe $_confFile &} r]} { 1019 confErrorDialog $top "Cannot execute notepad" 1020 } 1021} 1022 1023proc selectConf {top e} { 1024 global confFileNameDef 1025 set file [tk_getOpenFile -title {idn wrapper Config File Selection} \ 1026 -defaultextension .conf \ 1027 -filetypes {{{Config Files} .conf} {{All Files} *}} \ 1028 -initialfile $confFileNameDef \ 1029 -parent $top] 1030 if {[string compare $file {}]} { 1031 $e delete 0 end 1032 $e insert insert $file 1033 } 1034} 1035 1036proc advConf {top} { 1037 global _mdnOperation _confFile 1038 regSetWhere $_mdnOperation 1039 regSetConfFile $_confFile 1040 destroy $top 1041} 1042 1043######################################################################## 1044# 1045# utility 1046# 1047 1048proc confErrorDialog {top message} { 1049 tk_messageBox -default ok -icon error -parent $top -type ok \ 1050 -title {idn wrapper Configuration Error} -message $message 1051} 1052 1053proc isWindows {} { 1054 global tcl_platform 1055 expr {[string compare $tcl_platform(platform) "windows"] == 0} 1056} 1057 1058######################################################################## 1059# 1060# config program start here 1061# 1062 1063wm title . "idn wrapper - Configuration" 1064wm iconname . "idn wrapper - Configuration" 1065 1066 1067label .title -bd 1 -relief raised -pady 5 \ 1068 -text "idn wrapper Configuration Program version $version" 1069 1070frame .left -bd 1 -relief raised 1071frame .right -bd 1 -relief raised 1072 1073frame .lst 1074label .lst.title -text "Wrapped Programs" -pady 3 1075listbox .lst.list -width 64 -height 16 -setgrid 1 \ 1076 -xscrollcommand ".lst.xscroll set" \ 1077 -yscrollcommand ".lst.yscroll set" 1078scrollbar .lst.yscroll -orient vertical -command ".lst.list yview" 1079scrollbar .lst.xscroll -orient horizontal -command ".lst.list xview" 1080grid .lst.title -row 0 -column 0 -columnspan 2 -sticky news 1081grid .lst.list -row 1 -column 0 -sticky news 1082grid .lst.xscroll -row 2 -column 0 -sticky news 1083grid .lst.yscroll -row 1 -column 1 -sticky news 1084grid rowconfig .lst 1 -weight 1 1085grid columnconfig .lst 0 -weight 1 1086 1087frame .btn 1088button .btn.wrap -text "Wrap.." -command [list confWrap . .lst.list] 1089button .btn.unwrap -text "Unwrap.." -command [list confUnwrap . .lst.list] 1090button .btn.unwrapall -text "Unwrap All" -command [list unwrapAll . .lst.list] 1091button .btn.rewrapall -text "Rewrap All" -command [list rewrapAll . .lst.list] 1092frame .btn.spacing1 -width 1 -height 12 -bd 0 1093button .btn.log -text "Log.." -command [list confLog .] 1094frame .btn.spacing2 -width 1 -height 12 -bd 0 1095button .btn.adv -text "Advanced.." -command [list advancedConf .] 1096button .btn.exit -text Exit -command exit 1097pack .btn.wrap -side top -fill x -pady 4 1098pack .btn.unwrap -side top -fill x -pady 4 1099pack .btn.unwrapall -side top -fill x -pady 4 1100pack .btn.rewrapall -side top -fill x -pady 4 1101pack .btn.spacing1 -side top 1102pack .btn.log -side top -fill x -pady 4 1103pack .btn.spacing2 -side top 1104pack .btn.adv -side top -fill x -pady 4 1105pack .btn.exit -side bottom -fill x -pady 4 1106 1107pack .lst -in .left -padx 4 -pady 4 -fill both -expand on 1108pack .btn -in .right -padx 6 -pady 4 -fill both -expand on 1109 1110pack .title -side top -fill x 1111pack .right -side right -fill y 1112pack .left -side left -fill y -expand on 1113 1114# 1115# then set current list into listbox 1116# 1117 1118set theList [loadList] 1119#saveList $theList 1120putList .lst.list $theList 1121 1122# 1123######################################################################## 1124