I have integrated a winsock server in my app and have some problems with respone time and broken connections. My server returns HTML code (a user form) with the senddata() method. Sometimes, only half forms are shown in the users browser and it takes long time. I have played some with the size of packets sent but the problem remains.
I have read some hints for VB that the sendcomplete() event should be used before sending the next chunk of data. The problem is that this event doesn't trigger for VFP. Maybe there is another name for this event in VFP.
Q1: Any hints to improve the performance of server below?
Q2: Does anyone have the Winsock API reference for VFP where I can see all event and method names (it doesn't seem to be the same as for VB)?
Thanks,
Micael
I have read some hints for VB that the sendcomplete() event should be used before sending the next chunk of data. The problem is that this event doesn't trigger for VFP. Maybe there is another name for this event in VFP.
Q1: Any hints to improve the performance of server below?
Q2: Does anyone have the Winsock API reference for VFP where I can see all event and method names (it doesn't seem to be the same as for VB)?
Thanks,
Micael
Code:
*-----------------| Location Section |--------------------
*) Procedure.. : TCP/IP server form
*) Description...: A server for TCP/IP. Uses Winsock OCX for communications.
*-------------------| Usage Section |---------------------
*$ Scope.........:
*$ Parameters....: tnPort - Numeric. The port number. If not supplied, 63333 is used.
*$ Usage.........: Simple run it. Parameter is optional.
*$ Example.......: DO tcpserver WITH 63333
*$ Returns.......:
*$ Globals.......: G_SERVER, G_USER, MAINTOOL
*---------------------------------------------------------
* Parameters:
* Port no
* Name of command program
lparameters TNPORT
*on error
*#define DEBUG
* Winsock Constants
#define SCKCLOSED 0
#define SCKOPEN 1
#define SCKLISTENING 2
#define SCKCONNECTIONPENDING 3
#define SCKRESOLVINGHOST 4
#define SCKHOSTRESOLVED 5
#define SCKCONNECTING 6
#define SCKCONNECTED 7
#define SCKCLOSING 8
#define SCKERROR 9
#define EOT chr(4) && End of Transmission sign
clear
if vartype(TNPORT) # "N"
TNPORT = 63333
endif
OFORM = createobject("MYFORM",TNPORT)
OFORM.show()
* --- The form class
define class MYFORM as form
alwaysontop=.t.
allowoutput=.t.
halfheightcaption=.t.
showwindow=0
windowstate=2
windowtype=1
desktop=.f.
minbutton=.f.
maxbutton=.f.
controlbox=.f.
closable=.f.
borderstyle=0
icon="..\util\server\server.ico"
NPROTOCOL = 0
NPORT = 0 && this should be filled with a normally unusued port
NUMBER_OF_CONNECTIONS=0
MAX_NUMBER_OF_CONNECTIONS=50
BUSY=.f.
OLDSTATE=0
autocenter = .t.
height=380
width=600
* caption = 'TCP-Server --- Port '+alltrim(str( this.NPORT) )
NSTAT = 0
procedure load
G_SERVER=.t.
G_NODIALOGS=.t.
sys(2333,0)
_vfp.autoyield = .f.
endproc
procedure unload
G_SERVER=.f.
G_NODIALOGS=.f.
release OSOCK
MAINTOOL.push("start")
_vfp.autoyield = .t.
endproc
procedure gotfocus
MAINTOOL.push("disable_all")
return
procedure keypress
lparameters NKEYCODE, NSHIFTALTCTRL
if NKEYCODE=27
thisform.ACT_EXIT.click
endif
endproc
procedure resize
this.log.width = _screen.width-20
this.log.height = _screen.height-70
this.ACT_CLEAR.top = _screen.height-50
this.ACT_EXIT.top = _screen.height-50
this.ACT_EXIT.left = _screen.width-50
endproc
add object ACT_CLEAR as commandbutton with ;
left = 10, ;
autosize=.t.,;
caption = "Reset log", ;
name = "act_clear"
add object ACT_EXIT as commandbutton with ;
left = _screen.width-50, ;
autosize=.t.,;
caption = "Exit", ;
name = "act_exit"
procedure init
lparameters TNPORT
this.NPORT = TNPORT
this.addobject('log', 'bEditBox')
with this.log
.top = 10
.left = 10
.enabled = .t.
.readonly = .t.
.value = ''
.visible = .t.
endwith
this.resize
this.addobject('oSock', 'frmSock' )
this.OSOCK.listen()
this.caption = "TCP/IP server - Local IP: "+this.OSOCK.LOCALIP+" Port: "+alltrim(str(this.NPORT))
endproc
procedure ACT_CLEAR.click
thisform.log.CLEAN
endproc
procedure ACT_EXIT.click
G_NODIALOGS=.f.
thisform.BUSY=.t.
if LOGIN("gui")
release thisform
else
thisform.BUSY=.f.
G_NODIALOGS=.t.
endif
endproc
procedure SETSTATE
#ifdef debug
if thisform.OSOCK.STATE<>thisform.OLDSTATE
do case
case thisform.OSOCK.STATE=SCKCLOSED
thisform.log.PUT(ttoc(datetime())+" : " + 'Closed' + chr(13) + chr(10))
case thisform.OSOCK.STATE=SCKOPEN
thisform.log.PUT(ttoc(datetime())+" : " + 'Open' + chr(13) + chr(10))
case thisform.OSOCK.STATE=SCKLISTENING
thisform.log.PUT(ttoc(datetime())+" : " + 'Listening' + chr(13) + chr(10))
case thisform.OSOCK.STATE=SCKCONNECTIONPENDING
thisform.log.PUT(ttoc(datetime())+" : " + 'Connection Pending...' + chr(13) + chr(10))
case thisform.OSOCK.STATE=SCKRESOLVINGHOST
thisform.log.PUT(ttoc(datetime())+" : " + 'Resolving Host...' + chr(13) + chr(10))
case thisform.OSOCK.STATE=SCKHOSTRESOLVED
thisform.log.PUT(ttoc(datetime())+" : " + 'Host Resolved' + chr(13) + chr(10))
case thisform.OSOCK.STATE=SCKCONNECTING
thisform.log.PUT(ttoc(datetime())+" : " + 'Connecting...' + chr(13) + chr(10))
case thisform.OSOCK.STATE=SCKCONNECTED
thisform.log.PUT(ttoc(datetime())+" : " + 'Connected' + chr(13) + chr(10))
case thisform.OSOCK.STATE=SCKCLOSING
thisform.log.PUT(ttoc(datetime())+" : " + 'Closing...' + chr(13) + chr(10))
case thisform.OSOCK.STATE=SCKERROR
thisform.log.PUT(ttoc(datetime())+" : " + 'Error' + chr(13) + chr(10))
endcase
thisform.OLDSTATE=thisform.OSOCK.STATE
endif
#endif
endproc
procedure REMOVE_INSTANCES
thisform.NUMBER_OF_CONNECTIONS=0
for each LCONTROL in thisform.controls
* This DoEvent might not really be necessary, but
* it helps to get a correct state from the instance
doevents
if lower(LCONTROL.class) != 'frmsock2'
loop
else
if (seconds()-LCONTROL.NCREATETIME < 5) .or. LCONTROL.SENDING .or. ;
(LCONTROL.STATE = 7) &&.and. (seconds()-LCONTROL.NCREATETIME < 20))
thisform.NUMBER_OF_CONNECTIONS=thisform.NUMBER_OF_CONNECTIONS+1
loop
endif
endif
* If we have an instance to skip we show this to the user
thisform.log.PUT(ttoc(datetime())+" : " + 'Remove ' + ltrim(str(LCONTROL.REQUESTID)) + chr(13) + chr(10))
thisform.removeobject(LCONTROL.name )
endfor
endproc
#ifdef debug
* Timer för visning av 'state'
add object TIMER1 as timer with ;
top = 13, ;
left = 42, ;
height = 23, ;
width = 23, ;
enabled = .t., ;
interval = 2000, ;
name = "timer1"
procedure TIMER1.timer
thisform.SETSTATE
endproc
#endif
enddefine
* --- WinSock ActiveX Abstract
*define class AWINSOCK as olecontrol
* oleclass = "MSWinsock.Winsock"
* Use the the sub-classed winsock in \util\inherited due
* to licensing problem.
define class AWINSOCK as MYWINSOCK
procedure init
this.PROTOCOL = thisform.NPROTOCOL
this.LOCALPORT = thisform.NPORT
endproc
enddefine
* --- WinSock ActiveX "the listener"
define class FRMSOCK as AWINSOCK
* Because it might be, that we want to have more than one single
* connection active, we need a method to do a pseudo multi
* threading. I have "stolen" this idea from EETAServer ---
* Thx btw --- and have later on noticed that this already is
* recommended in the online help.
procedure CONNECTIONREQUEST
lparameter TNREQUESTID
* Check if busy
if thisform.BUSY
return
endif
* This ActiveX is a performance hog, so we need to get
* rid of older connections that aren't active anymore.
* So before adding a new one we check if we can skip
* another.
thisform.REMOVE_INSTANCES
* Now let's add another TCP server, that is able to handle
* the intended connection. The SYS(2015) function is a simple
* way to get an almost unique object name. In a serious production
* app it might be necessary to catch it's weaknesses for fast
* consequtive calls.
* Check max number of connections
if thisform.NUMBER_OF_CONNECTIONS<thisform.MAX_NUMBER_OF_CONNECTIONS
* thisform.ADDTIME=seconds()
thisform.addobject(sys(2015),'frmSock2',m.TNREQUESTID)
* If we have an instance to add we also show this to the user
thisform.log.PUT(ttoc(datetime())+" : " + 'Connection ' + ;
ltrim(str(m.TNREQUESTID)) + " added ("+ltrim(str(thisform.NUMBER_OF_CONNECTIONS+1))+ ") IP="+this.remotehostip + chr(13) + chr(10))
else
thisform.log.PUT(ttoc(datetime())+" : " + 'Maximum number of connections reached' + chr(13) + chr(10))
endif
return
endproc
enddefine
* --- WinSock ActiveX for multiple Connections
define class FRMSOCK2 as AWINSOCK
NCREATETIME = 0 && The creation time
CRECEIVEBUFFER = '' && a buffer to stitch incomming transmission together
REQUESTID=""
EOT_STRING="" && Require this string to be part of the data
LCBUFFER=""
SENDBUF=""
SENDPAK=""
SENDING=.f.
procedure init
lparameters TNREQUESTID
this.REQUESTID=TNREQUESTID
local LLRETVAL
this.NCREATETIME = seconds()
this.accept(TNREQUESTID)
thisform.NSTAT = this.STATE
thisform.refresh()
return
endproc
procedure SENDDATACOMPLETED
this.close()
endproc
*XXXXXXXXXXXXXX DATAARRIVAL XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
procedure DATAARRIVAL
lparameters TNBYTECOUNT
local GNFILEHANDLE,NSIZE,FILE_CONTENT
local LCBUFFER &&,SENDBUF,SENDPAK
#define CRLF chr(13)+chr(10)
#define PAK_SIZE 4096
LCBUFFER = space(TNBYTECOUNT) && Receive buffer
this.getdata( @LCBUFFER, , TNBYTECOUNT )
#ifdef debug
thisform.log.PUT(ttoc(datetime())+" : " + LCBUFFER + chr(13) + chr(10))
#else
thisform.log.PUT(ttoc(datetime())+" : " + "Data arrival "+ltrim(str(this.REQUESTID)) + chr(13) + chr(10))
#endif
do case
case "GET /" $ LCBUFFER
this.EOT_STRING="connection:"
case "POST /" $ LCBUFFER
this.EOT_STRING="submit="
endcase
this.CRECEIVEBUFFER = this.CRECEIVEBUFFER + LCBUFFER && Add to buffer
if atc(this.EOT_STRING, LCBUFFER ) = 0 && Decide if this was the last piece of data
return
endif
if !empty(this.CRECEIVEBUFFER)
this.SENDBUF=SERV_CMD(this.CRECEIVEBUFFER) && Do the job
if len(this.SENDBUF)>0
if this.STATE=SCKCONNECTED
this.SENDING=.t.
this.SENDDATA(CRLF)
this.SENDING=.f.
endif
* Split in packets
do while len(this.SENDBUF)>0
if len(this.SENDBUF)>PAK_SIZE
this.SENDPAK = left(this.SENDBUF,PAK_SIZE)
this.SENDBUF= substr(this.SENDBUF,PAK_SIZE+1)
else
this.SENDPAK = this.SENDBUF
this.SENDBUF = ''
endif
inkey(.1) && Annars verkar browsern inte hinna med
if this.STATE=SCKCONNECTED
this.SENDING=.t.
this.SENDDATA(this.SENDPAK)
this.SENDING=.f.
endif
doevents
enddo
if this.STATE=SCKCONNECTED
this.SENDING=.t.
this.SENDDATA(CRLF)
this.SENDING=.f.
endif
endif
endif
inkey(.4)
this.close()
return
endproc
* Error proc. Critical to have. Otherwise, memory bloat!
procedure error
lparameters NERROR, description, SCODE, source, HELPFILE, helpcontext, CANCELDISPLAY
thisform.log.PUT(ttoc(datetime())+" : " + description + chr(13) + chr(10))
this.close
endproc
procedure close
this.CRECEIVEBUFFER = ''
this.SENDPAK = ''
this.SENDBUF = ''
thisform.log.PUT(ttoc(datetime())+" : " + 'Close ' + ltrim(str(this.REQUESTID)) + chr(13) + chr(10))
this.object.close()
endproc
procedure destroy
* It's used to close the socket if the user close the form
this.object.close()
endproc
enddefine
* AutoScrolling EditBox
define class BEDITBOX as editbox
procedure PUT
parameters INTEXT
this.value = rightc(this.value + INTEXT,5000) && Limit size of string
endproc
procedure CLEAN
this.value = ""
endproc
procedure refresh
with this
.selstart = len(.text)
endwith
endproc
procedure programmaticchange
this.refresh
endproc
enddefine