Prev: حصريا فيلم ولاد العم بطوله كريم عبد العزيز بجوده DVDScr نسخه Rmvb بمساحه 285 ميجا
Next: ffidl: call dll function wiith var by ref
From: Anton Prokofiev on 5 Mar 2010 15:34
Hello, All!
I have to write application that will work like a service under
Windows Platform.

I've found following article: http://wiki.tcl.tk/12798
but it's looks too fragmented.

So could someone provide me with a simple example of a service that
reacts on stop/start events?

Thanks in advance.




From: Patrick on 5 Mar 2010 15:55
What you'll want to use is the twapi package. it has everything you
need to get going. http://twapi.magicsplat.com/services.html

Here is a script that you can start from.

I don't claim credit here, I found it on the web after going through
the same exercise you are doing now. However I have taken this base
and used it successfully to create a production grade enterprise
application wrapped into a starkit exe that is very reliable.

Once you install the example, you can telnet to port 2008 and play
echo with it.

Good luck,
Patrick



# A sample Windows service implemented in Tcl using TWAPI's windows
# services module.
#

proc usage {} {
puts stderr {
Usage:
tclsh echoservice.tcl install SERVICENAME
-- installs the service as SERVICENAME
tclsh echoservice.tcl uninstall SERVICENAME
-- uninstalls the service
Then start/stop the service using either "net start" or the services
control
manager GUI.
}
exit 1
}

package require twapi

################################################################
# The echo_server code is almost verbatim from the Tcl Developers
# Exchange samples.

set echo(server_port) 2008; # Port the echo server should listen
on
set echo(state) stopped; # State of the server

# echo_server --
# Open the server listening socket
# and enter the Tcl event loop
#
# Arguments:
# port The server's port number

proc echo_server {} {
global echo
set echo(server_socket) [socket -server echo_accept
$echo(server_port)]
}

# echo_accept --
# Accept a connection from a new client.
# This is called after a new socket connection
# has been created by Tcl.
#
# Arguments:
# sock The new socket connection to the client
# addr The client's IP address
# port The client's port number

proc echo_accept {sock addr port} {
global echo

if {$echo(server_state) ne "running"} {
close $sock
return
}

# Record the client's information

set echo(addr,$sock) [list $addr $port $sock]

# Ensure that each "puts" by the server
# results in a network transmission

fconfigure $sock -buffering line

# Set up a callback for when the client sends data

fileevent $sock readable [list echo $sock]
}

# echo --
# This procedure is called when the server
# can read data from the client
#
# Arguments:
# sock The socket connection to the client

proc echo {sock} {
global echo

# Check end of file or abnormal connection drop,
# then echo data back to the client.

if {[eof $sock] || [catch {gets $sock line}]} {
close $sock
unset -nocomplain echo(addr,$sock)
} else {
puts $sock $line
}
}

#
# Close all sockets
proc echo_close_shop {{serveralso true}} {
global echo

# Loop and close all client connections
foreach {index conn} [array get echo addr,*] {
close [lindex $conn 2]; # 3rd element is socket handle
unset -nocomplain echo($index)
}

if {$serveralso} {
close $echo(server_socket)
unset -nocomplain echo(server_socket)
}
}

#
# A client of the echo service.
#

proc echo_client {host port} {
set s [socket $host $port]
fconfigure $s -buffering line
return $s
}

# A sample client session looks like this
# set s [echo_client localhost 2540]
# puts $s "Hello!"
# gets $s line


################################################################
# The actual service related code

#
# Update the SCM with our state
proc report_state {name seq} {
if {[catch {
set ret [twapi::update_service_status $name $seq
$::echo(server_state)]
} msg]} {
::twapi::eventlog_log "Service $name failed to update status: $msg"
}
}

# Callback handler
proc service_control_handler {control {name ""} {seq 0} args} {
global echo
switch -exact -- $control {
start {
if {[catch {
# Start the echo server
echo_server
set echo(server_state) running
} msg]} {
twapi::eventlog_log "Could not start echo server: $msg"
}
report_state $name $seq
}
stop {
echo_close_shop
set echo(server_state) stopped
report_state $name $seq
}
pause {
# Close all client connections but leave server socket open
echo_close_shop false
set echo(server_state) paused
report_state $name $seq
}
continue {
set echo(server_state) running
report_state $name $seq
}
userdefined {
# Note we do not need to call update_service_status
set ::done 1; # Hard exit
}
all_stopped {
# Mark we are all done so we can exit at global level
set ::done 1
}
default {
# Ignore
}
}
}


################################################################
# Main code

# Parse arguments
if {[llength $argv] != 2} {
usage
}

set service_name [lindex $argv 1]
switch -exact -- [lindex $argv 0] {
service {
# We are running as a service
if {[catch {
twapi::run_as_service [list [list
$service_name ::service_control_handler]]
} msg]} {
twapi::eventlog_log "Service error: $msg"
}
# We sit in the event loop until service control stop us through
# the event handler
vwait ::done
}
install {
if {[twapi::service_exists $service_name]} {
puts stderr "Service $service_name already exists"
exit 1
}

# Make the names a short name to not have to deal with
# quoting of spaces in the path

set exe [file nativename [file attributes [info nameofexecutable] -
shortname]]
set script [file nativename [file attributes [file normalize [info
script]] -shortname]]
twapi::create_service $service_name "$exe $script service
$service_name"
}
uninstall {
if {[twapi::service_exists $service_name]} {
twapi::delete_service $service_name
}
}
default {
usage
}
}

exit 0



From: Patrick on 5 Mar 2010 16:00
Also, if you are looking for a nice way to install it as a service,
take a look at Installjammer, a tcl/tk based install package that
rivals commercial installers.
 | 
Pages: 1
Prev: حصريا فيلم ولاد العم بطوله كريم عبد العزيز بجوده DVDScr نسخه Rmvb بمساحه 285 ميجا
Next: ffidl: call dll function wiith var by ref