socket class


class testt {
inherit itk::Widget
        private variable socket
        public method acceptSocketConnection
 public method processMessage
 public method sendCommand

 constructor {args} {
 set server [socket -server acceptSocketConnection -myaddr 127.0.0.1 2200]

        itk_component add buttone {
        button .b \
  -text "aaa" \
  -command [code $this sendCommand GO]
        }
        pack $itk_component(buttone)
 vwait forever
 }
}

body testt::acceptSocketConnection { a_sock an_addr a_port } {
 
        set socket $a_sock
        fconfigure $socket -buffering line -translation lf -blocking 0 -buffersize 72000
        fileevent $socket readable [code $this processMessage]
        set ready 1
        set datestamp 20110901
 if { ![regexp -nocase windows $::tcl_platform(os)] } {
 set l_genfile [file join [pwd] "strubio_${datestamp}.gen"]
 puts $socket "GENFILE $l_genfile"
 set l_matfile [file join [pwd] "strubio_${datestamp}.mat"]
 puts $socket "NEWMAT $l_matfile"
 puts $socket "NEWMAT $l_matfile"       
 }
}

body testt::processMessage { } {  

        gets $socket l_message
        if {$l_message != ""} {
     puts $l_message
        }
}

body testt::sendCommand { args } {

 puts $socket $args
}

testt .c
pack .c

posted @ 2011-09-03 10:53  greencolor  阅读(198)  评论(0编辑  收藏  举报