Posted to tcl by kostix at Wed Dec 06 14:14:46 GMT 2006view raw
- #! /usr/bin/wish
- set host aquinas.domain007.com
- set port 6666
- set timeout 2000 ;# msec
- variable socket
- proc connect {host port timeout} {
- set sock [socket -async $host $port]
- fileevent $sock writable [list connected $host $port $sock]
- after $timeout timed_out $sock
- }
- proc connected {host port sock} {
- after cancel timed_out $sock
- fileevent $sock writable {}
- set failed [catch {fconfigure $sock -peername} msg]
- if {$failed} {
- tk_messageBox -message "Failed to connect:\
- [fconfigure $sock -error]"
- } else {
- global socket
- set socket $sock
- tk_messageBox -message "Connected: [fconfigure $sock]"
- }
- .connect config -state normal
- }
- proc timed_out {sock} {
- shutdown $sock
- .connect config -state normal
- tk_messageBox -message "Connection timed out"
- }
- proc shutdown {sock} {
- catch { close $sock }
- }
- proc do_connect {} {
- global host port timeout
- .connect config -state disabled
- connect $host $port $timeout
- }
- proc do_disc {} {
- global socket
- shutdown $socket
- }
- foreach t {host port timeout} {
- pack [entry .$t -textvariable ::$t]
- }
- pack [button .connect -text "Connect" -command do_connect]
- pack [button .disc -text "Disconnect" -command do_disc]