TCP Chat Server

This takes a different approach from Slighthaze's UDP Chat ( http://www.tek-tips.com/faqs.cfm?fid=3883 faq184-3883 on Tek Tips Forums ), which uses the asynchronous, connectionless UDP protocol.

This example, uses the connection-oriented, synchronous TCP protocol, and a client-server structure for the two chat 'participants'.

This concept can be extended, so that at the "chat" server is actually just a VFP program, rather than an actual person, as a server program for any purpose you can imagine:

• An authentication server,
• an HTTP web server
• « or perhaps a generic DBMS server using a proprietary protocal, or maybe, even something that can be connected to using ODBC, ie: a Vfp Back End !

The possibilities are as endless as the internet itself, since this is the basic structure for all server-oriented things happening on the internet.

The basic structure of this example are four classes in this hierarchy:

	Form
	 |
	 +-- frmChat -- Provides basic TCP interfaces to a Form
	 |    |
	 |    +--frmClient -- uses TCP to connect to a chat server
	 |    |
	 |    +--frmInstanceServer -- uses TCP to be connected to
	 |
	 +--frmServer -- Opens a socket waiting for connections.  When an incoming connection is
 detected, this form launches a "frmInstanceServer" to handle the connecting-client. This leaves
 this server's socket free to receive another client's connection.

Potentially, frmInstanceServer could be encapsulated in a multi-threaded DLL (of course, with no user interface... I'm not sure being based on the form class would work in this way or not...) and could be instantiated through COM by the frmServer to provide a Multi-Threaded server.

( For some reason, you must run the client in a different VFP instance than you run the server in... I haven't determined why this .PRG based example acts this way, because the original .VCX based code doesn't have this problem. )

---

Pardon me for jumping in here, but this seems like it could be very useful for a current project I'm trying to spec out. I need to do some "behind the scenes" messaging between 2 workstations (A & B) running VFP8 app designed for touchscreen navigation. Basically, a truck driver walks up to a touchscreen terminal with a signature capture device (workstation B) for signing that their load was dumped and that they have reviewed the QC information. They press a big button that says "Display Ticket for Signature" and a message gets sent (somehow) to another PC (workstation A) and a dialog is displayed that "Driver Waiting for Ticket". Workstation A brings up a the appropriate record and presses a button that says "Display Ticket for Driver Signature" and a message is sent back to workstation B causing a screen to appear and prompting for a signature. Workstation B touches a "Finished" button after they are finished signing. Screen goes back to first screen that prompts the next driver to display a ticket. A message is sent to Workstation A that signature is captured and ticket is ready for printing.
Now, I'm thinking that using this socket control would be ideal for this, but I'm not sure. Are there better ways to accomplish this with tables, timer objects, etc? (these 2 stations will be sharing a Foxpro database) Keep in mind that workstation A will be doing "other" data entry in the same application (entering weights, etc.) and we don't want their work to be interrupted, but they still need to get the "messages" from workstation B. Any thoughts, considerations, etc. would be appreciated -- Randy Jean

Randy, In VFP you could do this communication via tables. With a transaction type table that adds requests and another with a timer that looks for and responds to them. However, if you want to do this more at the system you might want to consider MSMQ and/or COMPlus Events. I know Marcus did an article on COMPlus Events in CODE a while ago. I think Randy Brown has an article on them too. -- Bob Archer

Tables work quite well, though if there's no UI interaction on A, then I would reccommend a loop (it'll be simpler to program, you can assume a process won't be interrupted. Something like:

DO WHILE llDontQuit
 SCAN FOR lNotHandled
  DoSomething()
 ENDSCAN
 InKey(.1)
ENDDO

-- Peter Crabtree

Randy - you could contact Andrew Coates who just did an eventhandler session at OzFox as he mentioned the example of binding to the com event that occurs when a file is written to a folder. You could simply shoot files from one machine to the other and your app would react to them. -- Jamie Osborn

On my PC, when I run tcpChat as a server, close it, and rerun it, FoxPro hangs on the Listen line, and sometimes crashes. This seems to happen with other WinSock listeners in the same way. Does anyone else have this problem? Rick Graves

---

* Program: tcpChat.PRG
*  Author: William GC Steinford
*
* Pass in a .T. if this is to be a listening server,
*  or pass in .F. if you want to instantiate a client
*
LPARAMETERS plServer

* DEFINE Constants could be extracted into a header file so they could

* be referred to by VCX classes.
* 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 crlf chr(13)+chr(10)
********************************

  if plServer
    RELEASE oServer
    PUBLIC  oServer
    oServer = CreateObject('frmServer')
    oServer.Show
  else
    RELEASE oClient
    PUBLIC  oClient
    oClient = CreateObject('frmClient')
    oClient.Show
  endif
  READ EVENTS

RETURN
* End of main code
****************************************************************

* DEFINES's could be extracted into a header file like this:
*#INCLUDE "c:\source\chat\ex\chatexample.h"

DEFINE CLASS frmchat AS form

	Top = 0
	Left = 0
	Height = 382
	Width = 449
	DoCreate = .T.
	Caption = "Chat Client"
	datatosend = ('')
	server = '127.0.0.1'
	serverport = 8181
	username = ('')
	incomingdata = ('')
	enableonerror = .F.
	Name = "frmchat"
	incomingcommand = .F.


    ADD OBJECT sock AS WSControl

	ADD OBJECT tmrstate AS timer WITH ;
		Top = 13, ;
		Left = 42, ;
		Height = 23, ;
		Width = 23, ;
		Enabled = .T., ;
		Interval = 50, ;
		Name = "tmrState"


	ADD OBJECT lblstate AS label WITH ;
		AutoSize = .T., ;
		Caption = "State", ;
		Height = 17, ;
		Left = 75, ;
		Top = 10, ;
		Width = 30, ;
		Name = "lblState"


	ADD OBJECT lblsnd AS label WITH ;
		AutoSize = .T., ;
		FontBold = .T., ;
		Caption = ". . . .", ;
		Height = 17, ;
		Left = 3, ;
		Top = 3, ;
		Width = 23, ;
		Name = "lblSnd"


	ADD OBJECT lblrcv AS label WITH ;
		AutoSize = .T., ;
		FontBold = .T., ;
		Caption = ". . . .", ;
		Height = 17, ;
		Left = 3, ;
		Top = 21, ;
		Width = 23, ;
		Name = "lblRcv"


	PROCEDURE senddata
		LPARAMETERS pcData
		EXTERNAL ARRAY pcData
		LOCAL lcOutData, lcSendingData, lcDataToSend
		lcOutData = ''
		do case
		  case type('pcData[1]')!='U' && it is an array
		    lnR = ALEN(pcData,1) && Rows
		    lnC = ALEN(pcData,2) && Cols, 0 if one dimension
		    lcOutData = "ARRAY ROWS="+tran( max(lnR,1) )+"&COLS="+tran( max(lnC,1) )+"&DATA="
		    if lnC=0
		      for lnI = 1 to lnR
		        lcOutData = lcOutData+THISFORM.URLEncode(tran(pcData[lnI]))+","
		      endfor
		    else
		      for lnI = 1 to lnR
		        lcOutData = lcOutData+"("
		        for lnJ = 1 to lnC
		          lcOutData = lcOutData+THISFORM.URLEncode(tran(pcData[lnI,lnJ]))+","
		        endfor
		        lcOutData = lcOutData+"),"
		      endfor
		    endif
		    if Right(lcOutData,1)=','
		      lcOutData = left( lcOutData, Len(lcOutData)-1 )
		    endif
		  case type('pcData')='C'
		    lcOutData = pcData
		  case inlist(VARTYPE(pcData),'D','T','N','L')
		    lcOutData = tran(pcData)
		  otherwise
		    lcOutData = 'ERROR BAD%20DATA'
		endcase

		if right(lcOutData,2)!=chr(13)+chr(10)
		  lcOutData = lcOutData+chr(13)+chr(10)
		endif

		if THISFORM.sock.State=sckConnected
		  lcSendingData = lcOutData
		  DO WHILE Len(lcSendingData)>0
		    if len(lcSendingData)>1024
		      lcDataToSend  = LEFT(lcSendingData,1024)
		      lcSendingData = Substr(lcSendingData,1025)
		    else
		      lcDataToSend = lcSendingData
		      lcSendingData = ''
		    endif

		    THISFORM.Sending()
		    THISFORM.Sock.object.SendData( (lcDataToSend) ) && CANNOT be passed by Reference!!
		*    StrToFile( 'SENT ['+lcDataToSend+']'+chr(10)+chr(13), 'CHAT.TXT', .T. )
		  ENDDO
		else
		  THISFORM.AddHistory('Not Connected! State='+tran(THISFORM.sock.State))
		endif
	ENDPROC


	PROCEDURE sendmessage
		LPARAMETERS pcMsg
		if type('pcMsg')='C'
		  THISFORM.AddHistory("Sending Message: "+pcMsg)
		  THISFORM.SendData('CHAT '+THISFORM.UrlEncode(pcMsg))
		endif
	ENDPROC


	PROCEDURE connected
		THISFORM.AddHistory("Connected at "+tran(datetime()))
	ENDPROC


	PROCEDURE addhistory
		LPARAMETERS pcMsg
	ENDPROC


	PROCEDURE handlecommand
		LPARAMETER pcCommand
		pcCommand = strTran(pcCommand,CRLF,' ')
		* Command descriptor is followed by a space,
		*  then, if applicable, by a URL encoded string of parameters
		*   (just like a form submission)
		*  Finally, a CrLf ends the command.
		LOCAL lcVal,lcResp,laArr[1],lnCnt,lnI
		* THISFORM.AddHistory( pcCommand )
		do case
		  case pcCommand='OK ' or pcCommand=='OK'
		    * Nothing necessary
		  case pcCommand='CHAT '
		    lcVal = THISFORM.URLUnEncode( SubStr(pcCommand,6) )
		    THISFORM.AddHistory('CHAT '+lcVal)
		    THISFORM.SendData('OK')
		  case pcCommand='ERROR '
		    THISFORM.AddHistory(pcCommand)
		  case pcCommand='PING ' or pcCommand=='PING'
		    THISFORM.SendData('PONG')
		    THISFORM.AddHistory('PING requested. PONG sent.')
		  case pcCommand='PONG ' or pcCommand=='PONG'
		    THISFORM.AddHistory('PONG received.')
		    THISFORM.SendData('OK')
		  case pcCommand='BYE ' or pcCommand=='BYE'
		    THISFORM.AddHistory('Other side said "BYE"')
		    THISFORM.SendData('OK')
		    THISFORM.Close
		  OTHERWISE
		    THISFORM.SendData('ERROR Unrecognized Command ('+alltrim(pcCommand)+')')
		endcase
	ENDPROC


	PROCEDURE handledata
		LPARAM pcData
		LOCAL lcCommands, lnCmds, lnI, laCmds[1]
		* If HandleData gets called again before this one ends, the new command
		*   might execute before all the commands this is processing (particularly
		*   if some of *these* commands take a long time)
		* We really Should Queue the commands, and let a separate process run them,
		*   maybe a process on a timer (not one command per tick, but check at each
		*   tick for commands, and process all commands till empty)

		* THISFORM.AddHistory("Data Received: "+alltrim(pcData))

		* StrToFile( 'RCV ['+pcData+']'+chr(10)+chr(13), 'CHAT.TXT', .T. )
		THISFORM.IncomingData = THISFORM.IncomingData + pcData
		THISFORM.Receiving()

		if chr(13)+chr(10) $ THISFORM.IncomingData && Complete Line +
		  lcCommands = THISFORM.IncomingData
		  * Clear all complete lines:
		  THISFORM.IncomingData = iif( right(THISFORM.IncomingData,2)=chr(13)+chr(10), ;
		                               '', Substr( THISFORM.IncomingData, RAT(chr(13)+chr(10),THISFORM.IncomingData)+2 ) )
		  * Take only complete lines:
		  lcCommands = iif( right(lcCommands,2)=chr(13)+chr(10), ;
		                    lcCommands, LEFT( lcCommands, RAT(chr(13)+chr(10),THISFORM.IncomingData)-1 ) )
		  lnCmds = ALINES(laCmds,lcCommands)
		  for lnI = 1 to lnCmds
		    THISFORM.IncomingCommand = laCmds[lnI]
		    if not empty(laCmds[lnI])
		      THISFORM.HandleCommand(laCmds[lnI])
		    endif
		  endfor
		endif
	ENDPROC


	PROCEDURE setstate
		THISFORM.lblState.caption = tran(THISFORM.sock.state)
		do case
		  case THISFORM.sock.state=sckClosed
		    THISFORM.lblState.caption = THISFORM.lblState.caption+' Closed'
		  case THISFORM.sock.state=sckOpen
		    THISFORM.lblState.caption = THISFORM.lblState.caption+' Open'
		  case THISFORM.sock.state=sckListening
		    THISFORM.lblState.caption = THISFORM.lblState.caption+' Listening'
		  case THISFORM.sock.state=sckConnectionPending
		    THISFORM.lblState.caption = THISFORM.lblState.caption+' Connection Pending...'
		  case THISFORM.sock.state=sckResolvingHost
		    THISFORM.lblState.caption = THISFORM.lblState.caption+' Resolving Host...'
		  case THISFORM.sock.state=sckHostResolved
		    THISFORM.lblState.caption = THISFORM.lblState.caption+' Host Resolved'
		  case THISFORM.sock.state=sckConnecting
		    THISFORM.lblState.caption = THISFORM.lblState.caption+' Connecting...'
		  case THISFORM.sock.state=sckConnected
		    THISFORM.lblState.caption = THISFORM.lblState.caption+' Connected'
		  case THISFORM.sock.state=sckClosing
		    THISFORM.lblState.caption = THISFORM.lblState.caption+' Closing...'
		  case THISFORM.sock.state=sckError
		    THISFORM.lblState.caption = THISFORM.lblState.caption+' Error'
		endcase
	ENDPROC


	PROCEDURE close
		THISFORM.Sock.object.Close
	ENDPROC


	PROCEDURE sending
		if len(THISFORM.lblSnd.caption)>16
		  THISFORM.lblSnd.caption = '.'
		else
		  THISFORM.lblSnd.caption = THISFORM.lblSnd.caption + ' .'
		endif
		THISFORM.FastDoEvents
	ENDPROC


	PROCEDURE receiving
		if len(THISFORM.lblRcv.caption)>16
		  THISFORM.lblRcv.caption = '.'
		else
		  THISFORM.lblRcv.caption = THISFORM.lblRcv.caption + ' .'
		endif
		THISFORM.FastDoEvents
	ENDPROC


	PROCEDURE fastdoevents
		DOEVENTS
		RETURN
		local lnRow, lnCol, lcWindow

		lcWindow = wontop()
		lnRow = mrow( lcWindow )
		lnCol = mcol( lcWindow )
		if ( lnRow > 0 ) and ( lnCol > 0 )
		   * mouse still within VFP window, so it's ok to mouse
		   mouse at mrow(), mcol() window (lcWindow)
		else
		   keyboard " "
		   =inkey()
		endif

		DoEvents
	ENDPROC


	PROCEDURE sendfile
		LPARAMETERS pcFile
		LOCAL lcCont, lcRes
		if File(pcFile)
		      lcCont = FileToStr( pcFile )
		      lcRes = 'FILE name='+THISFORM.UrlEncode(JustFName(pcFile))+'&' ;
		             +'compressed=No&' ;
		             +'size='+Tran(len(lcCont))+'&' ;
		             +'content='+THISFORM.URLEncode( lcCont )
		      THISFORM.SendData(lcRes)
		  RETURN .T.
		endif
		RETURN .F.

	ENDPROC


	PROCEDURE parsedata
		LPARAMETERS pcData
		* pcData is a form-encoded string,
		*  in the form "name=value&name2=value2"
		*  where each piece of the string has been URL encoded.
		* The return value should be a collection object
		LOCAL laLines[1], lnLines, loRet
		loRet = CREATEOBJECT( "aasCollection" )
		lnLines = ALINES(laLines,StrTran(pcData,'&',chr(13)))

		for lnI = 1 to lnLines
		  lnAt = AT('=',laLines[lnI])
		  if lnAt>0
		    lcNm = left( laLines[lnI], lnAt-1 )
		    lcVl = SUBSTR( laLines[lnI], lnAt+1 )
		    lcNm = THISFORM.URLUnEncode( lcNm )
		    lcVl = THISFORM.URLUnEncode( lcVl )
		    loRet.Add( lcVl, lcNm )
		  endif
		endfor
		RETURN loRet
	ENDPROC


	PROCEDURE receivefile
		LPARAMETERS pcCommand
		LOCAL lcData, loData, lcNm, lcCmp, llCmp, lnSize, lcCont
		lcFileName = ''
		    lcData = SUBSTR(pcCommand,6)
		    loData = THISFORM.ParseData( lcData )
		    lcNm  = iif( loData.indexOf('name')>0, loData.Items['name'], 'Unknown' )
		    lcNm  = set('defa')+curdir()+JustFName(lcNm) && make sure no path info is provided
		    lcCmp = iif( loData.indexOf('compressed')>0, loData.Items['compressed'], 'No' )
		    llCmp = iif( upper(lcCmp)='Y', .T., .f. )
		    lnSize = val( iif( loData.indexOf('size')>0, loData.Items['size'], '0' ) )
		    lcCont = iif( loData.indexOf('content')>0, loData.Items['content'], '' )
		    THISFORM.AddHistory('File Name='+lcNm+' Size='+tran(lnSize)+' '+iif(llCmp,'Compressed','Not Compressed') )
		    DO WHILE .T.
		      if lnSize = 0 or empty(lcCont)
		        THISFORM.SendData('ERROR Missing Descriptors')
		        EXIT
		      endif
		      if lnSize!=Len(lcCont)
		        THISFORM.SendData('ERROR Incorrect Size of Data (reported '+tran(lnSize)+'; actual '+tran(Len(lcCont))+')')
		        EXIT
		      endif
		      if llCmp
		        lcCont = '' && TODO..Add compression/decompression
		        if empty(lcCont)
		          THISFORM.SendData('ERROR Corrupted Compressed Data')
		          EXIT
		        endif
		      endif
		      if File( lcNm )
		        if NOT THISFORM.SafeDel(lcNm)
		          THISFORM.SendData('ERROR Could not overwrite local file')
		          EXIT
		        endif
		      endif
		      STRTOFILE(lcCont,lcNm)
		      if file(lcNm)
		        THISFORM.SendData('OK')
		        lcFileName = lcNm
		      else
		        THISFORM.SendData('ERROR Could not create local file')
		      endif
		      EXIT
		    enddo
		RETURN lcFileName
	ENDPROC


	PROCEDURE getarray
		*    THISFORM.GetArray( @laData, pcCommand )
		LPARAMETERS paData, pcCommand
		* Format for pcCommand:
		* ARRAY ROWS=##&COLS=##&DATA=(1,2,3),(1,2,3),(1,2,3)
		LOCAL laDt[3], lcDT, lnI, laCols[1], lnRw, lnCl
		ALINES( laDt, strtran(substr(pcCommand,7),'&',chr(13) ) )
		lnRows = val( Substr(laDt[1],6 ) )
		lnCols = val( Substr(laDt[2],6 ) )
		lcDt = Substr( laDt[3], 6 )
		paData = ''

		IF lnRows>0 and lnCols>0
		  DIMENSION paData[lnRows,lnCols]
		  paData = ''
		  lcDt = strtran( lcDt, '),(', chr(13) )
		  lcDt = chrtran( lcDt, ')(',  ''      ) && delete start/end ()
		  lnRw = ALINES(laDT, lcDt )
		  for lnI = 1 to Min( lnRw, lnRows )
		    lnCl = ALINES( laCols, StrTran( laDt[lnI], ',', chr(13) ) )
		    for lnJ = 1 to Min( lnCl, lnCols )
		      paData[lnI, lnJ] = THISFORM.UrlUnencode( laCols[lnJ] )
		    endfor
		  endfor
		  RETURN .T.
		ENDIF
		RETURN .F.
	ENDPROC


	PROCEDURE Load
		_VFP.AutoYield = .F.
	ENDPROC


	PROCEDURE Error
		LPARAMETERS nError, cMethod, nLine
		THISFORM.AddHistory("Internal ERROR #"+tran(nError)+" Msg:"+Message()+" Method:"+tran(cMethod)+" Line:"+tran(nLine))
		if THISFORM.EnableOnError
		  err=ON("ERROR")
		  &Err
		endif
	ENDPROC


	PROCEDURE Unload
		DODEFAULT()
	ENDPROC


	PROCEDURE sock.DataArrival
		*** ActiveX Control Event ***
		LPARAMETERS bytestotal
		LOCAL lcData
		lcData = space(bytesTotal)
		THIS.GetData(@lcData)
		THISFORM.HandleData(lcData)
	ENDPROC


	PROCEDURE sock.Connect
		*** ActiveX Control Event ***
		THISFORM.Connected
	ENDPROC


	PROCEDURE sock.Close
		*** ActiveX Control Event ***
		THIS.Object.Close
	ENDPROC

	PROCEDURE sock.Error
		LPARAMETERS nError, description, scode, source, helpfile, helpcontext, canceldisplay
		*** ActiveX Control Event ***
		THISFORM.AddHistory("Socket ERROR #"+tran(nError)+": "+description+" sCode:"+tran(sCode))
		THIS.Object.Close
	ENDPROC


	PROCEDURE tmrstate.Timer
		THISFORM.SetState
	ENDPROC


	PROCEDURE lblstate.MouseMove
		LPARAMETERS nButton, nShift, nXCoord, nYCoord
		THISFORM.SetState
	ENDPROC


	PROCEDURE lblsnd.MouseMove
		LPARAMETERS nButton, nShift, nXCoord, nYCoord
		THISFORM.SetState
	ENDPROC


	PROCEDURE lblrcv.MouseMove
		LPARAMETERS nButton, nShift, nXCoord, nYCoord
		THISFORM.SetState
	ENDPROC

	***********************************************************
	Function URLunencode
	PARAMETER pcInStr
	*  ' unencode EVERY %XX
	*  ' (keep track of current position so you don't unencode
	*  '  a percent that just came out of an URLencoded char
	LOCAL I, tStr, tChr, tOut
	  tStr = pcInStr
	  tOut = ""
	  tStr = StrTran(tStr, "+", " ")
	  I = 1
	  do While I <= Len(tStr)
	    If (SubStr(tStr, I, 1) = "%") ;
	       And SubStr(tStr, I + 1, 1) $ "0123456789ABCDEF" ;
	       And SubStr(tStr, I + 2, 1) $ "0123456789ABCDEF"
	      tChr = (( At( SubStr(tStr, I + 1, 1), "0123456789ABCDEF" )-1) * 16 ) ;
	           + (( At( SubStr(tStr, I + 2, 1), "0123456789ABCDEF" )-1)      )
	      I = I + 2
	*03/18/03 Zero's are now allowed.
	      if between(tChr,0,255) && 03/18/03
	*      if tChr > 0 and tChr < 255
	        tOut = tOut + chr( tChr )
	      endif
	    else
	      tOut = tOut + SubStr(tStr, I, 1)
	    EndIf
	    I = I + 1
	  EndDo
	RETURN tOut
	**********************************************************
	Function URLencode
	PARAMETER pcInStr
	*  ' encode Percent signs
	*  '        Double Quotes
	*  '        CarriageReturn / LineFeeds
        * Thanks to Michael's contribution on Fox.Wikis.com,
        *   this now encodes everything except the characters
        *   that are specifically allowed by http://www.ietf.org/rfc/rfc2396.txt
	LOCAL lcOut, lnI
	  lcOut = ''
	  for lnI = 1 to len(pcInStr)
	    lcCh = Substr(pcInStr,lnI,1)

	    DO CASE
	      CASE ISALPHA(lcCh) ;
	        OR ISDIGIT(lcCh) ;
	        OR INLIST(lcCh, "-" , "_" , "." , "!" , "~" , "*" , "'" , "(" , ")")
	          * do nothing
	      CASE lcch = " "
	        lcCh = "+"
	      OTHERWISE
	        lcCh = '%' + RIGHT( TRANSFORM(ASC(lcCh),'@0'), 2 )
	    ENDCASE

	    lcOut = lcOut + lcCh
	  endfor
	RETURN lcOut
	ENDFUNC

	
	***********************************************************
	* SafeDel - Returns .T. if the file was deleted successfully
	*          (DeleteFile returns 0 if there is an error)
	FUNCTION SafeDel
	LPARAMETERS pcFile
	DECLARE INTEGER DeleteFile IN kernel32 ;
	  STRING lpFileName
	res = DeleteFile(pcFile)
	RETURN res!=0
	ENDFUNC

ENDDEFINE
*
*-- EndDefine: frmchat
**************************************************


**************************************************
*-- Class:        frmclient (c:\source\chat\ex\chatexample.vcx)
*-- ParentClass:  frmchat (c:\source\chat\ex\chatexample.vcx)
*-- BaseClass:    form
*-- Time Stamp:   05/23/03 01:59:10 PM
*
* DEFINES's could be extracted into a header file like this:
*#INCLUDE "c:\source\chat\ex\chatexample.h"
*
DEFINE CLASS frmclient AS frmchat


	Top = 0
	Left = 0
	Height = 411
	Width = 449
	ShowWindow = 0
	DoCreate = .T.
	Caption = "Chat Client"
	WindowType = 0
	localalias = ('')
	datatosend = ('')
	server = '127.0.0.1'
	serverport = 8181
	username = ('')
	incomingdata = ('')
	enableonerror = .F.
	Name = "frmclient"
	Sock.Top = 10
	Sock.Left = 10
	Sock.Height = 100
	Sock.Width = 100
	Sock.Name = "Sock"
	tmrState.Name = "tmrState"
	lblState.TabIndex = 17
	lblState.Name = "lblState"
	lblSnd.TabIndex = 18
	lblSnd.Name = "lblSnd"
	lblRcv.TabIndex = 19
	lblRcv.Name = "lblRcv"


	ADD OBJECT timer1 AS timer WITH ;
		Top = 13, ;
		Left = 42, ;
		Height = 23, ;
		Width = 23, ;
		Enabled = .F., ;
		Interval = 50, ;
		Name = "Timer1"


	ADD OBJECT label1 AS label WITH ;
		AutoSize = .T., ;
		Caption = "User Name", ;
		Height = 17, ;
		Left = 16, ;
		Top = 50, ;
		Width = 66, ;
		TabIndex = 1, ;
		Name = "Label1"


	ADD OBJECT text1 AS textbox WITH ;
		ControlSource = "THISFORM.UserName", ;
		Height = 23, ;
		Left = 90, ;
		TabIndex = 2, ;
		Top = 50, ;
		Width = 290, ;
		Name = "Text1"


	ADD OBJECT label2 AS label WITH ;
		AutoSize = .T., ;
		Caption = "Server", ;
		Height = 17, ;
		Left = 41, ;
		Top = 82, ;
		Width = 37, ;
		TabIndex = 3, ;
		Name = "Label2"


	ADD OBJECT text3 AS textbox WITH ;
		ControlSource = "THISFORM.ServerPort", ;
		Height = 23, ;
		Left = 302, ;
		TabIndex = 6, ;
		Top = 79, ;
		Width = 80, ;
		Name = "Text3"


	ADD OBJECT label3 AS label WITH ;
		AutoSize = .T., ;
		Caption = "Port", ;
		Height = 17, ;
		Left = 270, ;
		Top = 82, ;
		Width = 24, ;
		TabIndex = 5, ;
		Name = "Label3"


	ADD OBJECT combo1 AS combobox WITH ;
		RowSourceType = 1, ;
		RowSource = "127.0.0.1", ;
		ControlSource = "THISFORM.Server", ;
		Height = 24, ;
		Left = 89, ;
		TabIndex = 4, ;
		Top = 79, ;
		Width = 151, ;
		Name = "Combo1"


	ADD OBJECT list AS listbox WITH ;
		Height = 160, ;
		Left = 10, ;
		TabIndex = 13, ;
		Top = 239, ;
		Width = 340, ;
		ItemTips = .T., ;
		Name = "List"


	ADD OBJECT command3 AS commandbutton WITH ;
		Top = 359, ;
		Left = 370, ;
		Height = 23, ;
		Width = 59, ;
		Caption = "Close", ;
		TabIndex = 15, ;
		Name = "Command3"


	ADD OBJECT cmdsend AS commandbutton WITH ;
		Top = 139, ;
		Left = 380, ;
		Height = 23, ;
		Width = 59, ;
		Caption = "Send", ;
		TabIndex = 10, ;
		Name = "cmdSend"


	ADD OBJECT edit1 AS editbox WITH ;
		Height = 60, ;
		Left = 10, ;
		SelectOnEntry = .T., ;
		TabIndex = 9, ;
		Top = 139, ;
		Width = 361, ;
		ControlSource = "THISFORM.DataToSend", ;
		Name = "Edit1"


	ADD OBJECT label4 AS label WITH ;
		AutoSize = .T., ;
		Caption = "Enter a message to send to Tech Support", ;
		Height = 17, ;
		Left = 10, ;
		Top = 119, ;
		Width = 230, ;
		TabIndex = 8, ;
		Name = "Label4"


	ADD OBJECT label5 AS label WITH ;
		AutoSize = .T., ;
		Caption = "History", ;
		Height = 17, ;
		Left = 10, ;
		Top = 219, ;
		Width = 40, ;
		TabIndex = 12, ;
		Name = "Label5"


	ADD OBJECT command2 AS commandbutton WITH ;
		Top = 319, ;
		Left = 370, ;
		Height = 23, ;
		Width = 59, ;
		Caption = "Ping", ;
		TabIndex = 14, ;
		Name = "Command2"


	ADD OBJECT command4 AS commandbutton WITH ;
		Top = 179, ;
		Left = 380, ;
		Height = 40, ;
		Width = 59, ;
		FontSize = 8, ;
		WordWrap = .T., ;
		Caption = "Send Command", ;
		TabIndex = 11, ;
		Name = "Command4"


	ADD OBJECT cmdconnect AS commandbutton WITH ;
		Top = 60, ;
		Left = 390, ;
		Height = 40, ;
		Width = 59, ;
		FontSize = 8, ;
		WordWrap = .T., ;
		Caption = "Connect", ;
		TabIndex = 7, ;
		Name = "cmdConnect"


	PROCEDURE connect
		if THISFORM.Sock.state!=sckClosed
		  THISFORM.Sock.Object.Close
		endif
		THISFORM.Sock.RemoteHost = THISFORM.Server
		THISFORM.Sock.RemotePort = THISFORM.ServerPort
		THISFORM.Sock.object.Connect

	ENDPROC


	PROCEDURE setstate
		DODEFAULT()
		IF not THISFORM.LocalAlias==alias()
		  THISFORM.LocalAlias = Alias()
		  THISFORM.SendData("ALIAS "+alias())
		ENDIF
	ENDPROC


	PROCEDURE Unload
		DODEFAULT()
		CLEAR EVENTS
	ENDPROC


	PROCEDURE Init
		THISFORM.left = sysmetric(1) - ( THISFORM.width + 8 )
		DODEFAULT()
	ENDPROC


	PROCEDURE handlecommand
		LPARAMETER pcCommand
		pcCommand = strTran(pcCommand,CRLF,' ')
		* Command descriptor is followed by a space,
		*  then, if applicable, by a URL encoded string of parameters
		*   (just like a form submission)
		*  Finally, a CrLf ends the command.
		LOCAL lcVal,lcResp,laArr[1],lnCnt,lnI,laArr2[1]
		* THISFORM.AddHistory( 'C: Got Command: '+pcCommand )
		do case
		  case pcCommand='DIR '
		    lcVal = THISFORM.URLUnEncode( SubStr(pcCommand,5) )
		    lcVal = ChrTran(lcVal, '"', '' )
		    if not empty(lcVal)
		      lnCnt = aDir(laArr,lcVal,'DHS')
		    else
		      lnCnt = aDir(laArr,SET('DEFA')+curDir(),'DHS')
		    endif
		    THISFORM.SendData(@laArr)
		  case pcCommand='CD '
		    lcVal = THISFORM.URLUnEncode( SubStr(pcCommand,4) )
		    lcVal = ChrTran(lcVal, '"', '' )
		    Err = 'OK'
		    if not empty(lcVal)
		      THISFORM.EnableOnError=.T.
		      oErr = ON('ERROR')
		      ON ERROR ERR='ERROR:'+tran(ERROR())+':'+Message()
		      SET DEFAULT TO (lcVal)
		      ON ERROR &oErr
		      THISFORM.EnableOnError=.F.
		    endif
		    if ERR="ERROR"
		      THISFORM.SendData(Err)
		    else
		      THISFORM.SendData('PATH '+Set('DEFA')+CurDir())
		    endif
		  case pcCommand='CMD '
		    lcVal = THISFORM.URLUnEncode( SubStr(pcCommand,5) )
		    Err = 'OK'
		    if not empty(lcVal)
		      THISFORM.EnableOnError=.T.
		      oErr = ON('ERROR')
		      ON ERROR ERR='ERROR:'+tran(ERROR())+':'+Message()
		      &lcVal
		      ON ERROR &oErr
		      THISFORM.EnableOnError=.F.
		    endif
		    THISFORM.SendData(Err)
		  case pcCommand='USE '
		    lcVal = THISFORM.URLUnEncode( SubStr(pcCommand,5) )
		    Err = 'OK'
		    if not empty(lcVal)
		      THISFORM.EnableOnError=.T.
		      oErr = ON('ERROR')
		      ON ERROR ERR='ERROR:'+tran(ERROR())+':'+Message()
		      USE &lcVal
		      ON ERROR &oErr
		      THISFORM.EnableOnError=.F.
		    endif
		    THISFORM.SendData(Err)
		  case pcCommand='FUNC '
		    lcVal = THISFORM.URLUnEncode( SubStr(pcCommand,6) )
		    llIsArr = (Type(lcVal)!='U' and type(lcVal+'[1]')!='U')
		    Err = 'OK'
		    lcRes = ''
		    if not empty(lcVal) and not llIsArr
		      THISFORM.EnableOnError=.T.
		      oErr = ON('ERROR')
		      ON ERROR ERR='ERROR '+tran(ERROR())+': '+Message()
		      lcRes = &lcVal
		      ON ERROR &oErr
		      THISFORM.EnableOnError=.F.
		    endif
		    do case
		      case ERR='OK' and llIsArr
		        THISFORM.SendData(@&lcVal) && Translate array
		      case ERR='OK'
		        THISFORM.SendData('RESULT '+Tran(lcRes))
		      otherwise
		        THISFORM.SendData(Err)
		    endcase
		  case pcCommand='GET '
		    lcVal = THISFORM.URLUnEncode( alltrim(SubStr(pcCommand,5)) )
		    lcPath = JustPath(lcVal)
		    if empty(lcPath)
		      lcPath = Set('Defa')+curdir()
		      lcVal  = lcPath+lcVal
		    endif
		    lcPath = addbs(lcPath)
		    lnCnt = adir(laArr,lcVal,'HS') && find all matching files
		    if lnCnt = 0
		      THISFORM.AddHistory('no files found matching '+lcVal)
		    endif
		    for lnI = 1 to lnCnt
		      THISFORM.AddHistory('Sending File '+lcPath+laArr[1])
		      THISFORM.SendFile(lcPath+laArr[1])
		      THISFORM.AddHistory('Done.')
		    endfor
		  case pcCommand='FILE '
		    * data items:  Name (no path allowed)
		    *              Compressed: Y/N
		    *              Size: (of uuencoded data) Before Uncompressing.
		    *              Content: the actual file.
		    THISFORM.AddHistory('Incoming File!')
		    THISFORM.ReceiveFile(pcCommand)
		  case pcCommand='SCATTER ' or pcCommand=='SCATTER'
		    if not empty(alias())
		      SCATTER TO laArr
		      lnCnt = Min( aLen(laArr,1), FCOUNT() )
		      if lnCnt > 0
		        DIMENSION laArr2[ lnCnt, 2 ]
		        for lnI = 1 to lnCnt
		          laArr2[lnI,1] = Field(lnI)
		          laArr2[lnI,2] = laArr[lnI]
		        endfor
		        THISFORM.SendData( @laArr2 )
		      endif
		    endif
		*!*	  CASE pcCommand='PRTSCR ' or pcCommand=='PRTSCR'
		*!*	    THISFORM.AddHistory('Sending Screenshot...')
		  OTHERWISE
		    DODEFAULT(pcCommand)
		endcase
	ENDPROC


	PROCEDURE addhistory
		LPARAMETERS pcMsg
		THISFORM.List.AddItem(pcMsg)
		THISFORM.List.ListIndex = THISFORM.List.ListCount
	ENDPROC


	PROCEDURE connected
		THISFORM.AddHistory("Connected at "+tran(datetime()))
		THISFORM.SendData('USER '+THISFORM.UserName)
		THISFORM.SendData('USERIP '+THISFORM.sock.LocalIP)
		THISFORM.SendData('PATH '+Set("DEFA")+CurDir())
	ENDPROC


	PROCEDURE timer1.Timer
		THISFORM.SetState
	ENDPROC


	PROCEDURE combo1.LostFocus
		if empty(THISFORM.Server) and not empty(THIS.DisplayValue)
		  THIS.RowSource = alltrim(ThiS.RowSource)+','+alltrim(THIS.DisplayValue)
		  THISFORM.Server = THIS.DisplayValue

		endif
	ENDPROC


	PROCEDURE command3.Click
		THISFORM.SendData('BYE')
		THISFORM.Close
	ENDPROC


	PROCEDURE cmdsend.Click
		THISFORM.SendMessage( THISFORM.DataToSend )
	ENDPROC


	PROCEDURE edit1.KeyPress
		LPARAMETERS nKeyCode, nShiftAltCtrl
		if nKeyCode=13
		  THIS.Parent.cmdSend.SetFocus
		  THISFORM.SendMessage
		  NODEFAULT
		  THIS.SetFocus
		endif
	ENDPROC


	PROCEDURE command2.Click
		THISFORM.SendData('PING')
	ENDPROC


	PROCEDURE command4.Click
		THISFORM.SendData(THISFORM.DataToSend)
	ENDPROC


	PROCEDURE cmdconnect.Click
		THISFORM.Connect
	ENDPROC


ENDDEFINE
*
*-- EndDefine: frmclient
**************************************************


**************************************************
*-- Class:        frminstanceserver (c:\source\chat\ex\chatexample.vcx)
*-- ParentClass:  frmchat (c:\source\chat\ex\chatexample.vcx)
*-- BaseClass:    form
*-- Time Stamp:   05/23/03 01:55:04 PM
*
* DEFINES's could be extracted into a header file like this:
*#INCLUDE "c:\source\chat\ex\chatexample.h"
*
DEFINE CLASS frminstanceserver AS frmchat


	Top = 0
	Left = 0
	Height = 418
	Width = 549
	ShowWindow = 0
	DoCreate = .T.
	Caption = "Instance Server"
	WindowType = 0
	csessioninfo = ('')
	remoteuser = ('')
	remoteip = ('')
	connecttime = {}
	chatmsg = ('')
	cmd = ('')
	remotepath = ('')
	result = ('')
	now = {}
	lcmd = ('')
	vfpcmd = ('')
	totcmds = 1
	thiscmd = 1
	remotealias = ('')
	incomingcommand = ('')
	incomingdata = ('')
	Name = "frminstanceserver"
	Sock.Top = 10
	Sock.Left = 10
	Sock.Height = 100
	Sock.Width = 100
	Sock.ZOrderSet = 1
	Sock.Name = "Sock"
	tmrState.Interval = 200
	tmrState.Name = "tmrState"
	lblState.Left = 2
	lblState.Top = 56
	lblState.TabIndex = 17
	lblState.ZOrderSet = 19
	lblState.Name = "lblState"
	lblSnd.Left = 3
	lblSnd.Top = 62
	lblSnd.TabIndex = 18
	lblSnd.ZOrderSet = 3
	lblSnd.Name = "lblSnd"
	lblRcv.Left = 3
	lblRcv.Top = 70
	lblRcv.TabIndex = 19
	lblRcv.ZOrderSet = 0
	lblRcv.Name = "lblRcv"
	DIMENSION acmds[100]


	ADD OBJECT list AS listbox WITH ;
		Height = 119, ;
		Left = 0, ;
		TabIndex = 16, ;
		Top = 111, ;
		Width = 542, ;
		ZOrderSet = 4, ;
		ItemTips = .T., ;
		Name = "List"


	ADD OBJECT edtchat AS editbox WITH ;
		Comment = "", ;
		Height = 27, ;
		Left = 0, ;
		SelectOnEntry = .T., ;
		TabIndex = 1, ;
		Top = 240, ;
		Width = 437, ;
		ZOrderSet = 5, ;
		ControlSource = "THISFORM.ChatMsg", ;
		Name = "edtChat"


	ADD OBJECT edtcmd AS editbox WITH ;
		Height = 41, ;
		Left = 0, ;
		SelectOnEntry = .T., ;
		TabIndex = 4, ;
		Top = 288, ;
		Width = 437, ;
		ZOrderSet = 6, ;
		ControlSource = "THISFORM.Cmd", ;
		Name = "edtCMD"


	ADD OBJECT cmdsendchat AS commandbutton WITH ;
		Top = 240, ;
		Left = 449, ;
		Height = 27, ;
		Width = 84, ;
		Caption = "Send Chat", ;
		TabIndex = 2, ;
		ZOrderSet = 7, ;
		Name = "cmdSendChat"


	ADD OBJECT cmdsendcmd AS commandbutton WITH ;
		Top = 295, ;
		Left = 449, ;
		Height = 27, ;
		Width = 84, ;
		Caption = "Send Cmd", ;
		TabIndex = 5, ;
		ZOrderSet = 8, ;
		Name = "cmdSendCmd"


	ADD OBJECT label1 AS label WITH ;
		AutoSize = .T., ;
		Caption = "History", ;
		Height = 17, ;
		Left = 4, ;
		Top = 91, ;
		Width = 40, ;
		TabIndex = 15, ;
		ZOrderSet = 9, ;
		Name = "Label1"


	ADD OBJECT sessioninfo AS editbox WITH ;
		FontSize = 7, ;
		BorderStyle = 1, ;
		Height = 102, ;
		Left = 340, ;
		TabIndex = 14, ;
		Top = 7, ;
		Width = 200, ;
		BackColor = RGB(192,192,192), ;
		ZOrderSet = 10, ;
		ControlSource = "THISFORM.cSessionInfo", ;
		Name = "SessionInfo"


	ADD OBJECT lblsessioninfo AS label WITH ;
		AutoSize = .T., ;
		Caption = "Session Info", ;
		Height = 17, ;
		Left = 346, ;
		Top = -3, ;
		Width = 71, ;
		TabIndex = 13, ;
		ZOrderSet = 11, ;
		Name = "lblSessionInfo"


	ADD OBJECT command3 AS commandbutton WITH ;
		Top = 26, ;
		Left = 0, ;
		Height = 28, ;
		Width = 49, ;
		Caption = "Close", ;
		TabIndex = 10, ;
		ZOrderSet = 12, ;
		Name = "Command3"


	ADD OBJECT label3 AS label WITH ;
		AutoSize = .T., ;
		FontSize = 8, ;
		FontCondense = .T., ;

		Caption = "DIR, CD, LCD, CMD, FUNC, ?, CHAT, PING, GET, PUT, USE, SCATTER, SELECT, PUBLIC,", ;
		Height = 16, ;
		Left = 10, ;
		Top = 272, ;
		Width = 418, ;
		TabIndex = 3, ;
		ZOrderSet = 14, ;
		Name = "Label3"


	ADD OBJECT chat AS listbox WITH ;
		Height = 110, ;
		Left = 60, ;
		TabIndex = 11, ;
		Top = 0, ;
		Width = 270, ;
		ZOrderSet = 15, ;
		ItemTips = .T., ;
		Name = "Chat"


	ADD OBJECT lblchatlog AS label WITH ;
		AutoSize = .T., ;
		Caption = "Chat Log", ;
		Height = 17, ;
		Left = 4, ;
		Top = 5, ;
		Width = 52, ;
		TabIndex = 20, ;
		ZOrderSet = 16, ;
		Name = "lblChatLog"


	ADD OBJECT edtlcmd AS editbox WITH ;
		Height = 27, ;
		Left = 0, ;
		SelectOnEntry = .T., ;
		TabIndex = 8, ;
		Top = 385, ;
		Width = 437, ;
		ZOrderSet = 17, ;
		ControlSource = "THISFORM.lCmd", ;
		Name = "edtLCMD"


	ADD OBJECT edtvfpcmd AS editbox WITH ;
		Height = 27, ;
		Left = 0, ;
		SelectOnEntry = .T., ;
		TabIndex = 6, ;
		Top = 340, ;
		Width = 437, ;
		ZOrderSet = 17, ;
		ControlSource = "THISFORM.VfpCmd", ;
		Name = "edtVfpCmd"


	ADD OBJECT cmdsendvfpcmd AS commandbutton WITH ;
		Top = 340, ;
		Left = 449, ;
		Height = 27, ;
		Width = 84, ;
		Caption = "Send VFP", ;
		TabIndex = 7, ;
		ZOrderSet = 18, ;
		Name = "cmdSendVfpCmd"


	ADD OBJECT cmdlocalcmd AS commandbutton WITH ;
		Top = 385, ;
		Left = 449, ;
		Height = 27, ;
		Width = 84, ;
		Caption = "Local VFP", ;
		TabIndex = 9, ;
		ZOrderSet = 18, ;
		Name = "cmdLocalCmd"


	PROCEDURE refreshinfo
		LOCAL lcCnct
		lcCnct =''
		if THISFORM.Sock.State=sckConnected
		  THISFORM.Now = DateTime()
		else
		  lcCnct = "Disconnected!"
		endif
		THISFORM.cSessionInfo = ;
		  +'Session Started '+tran(THISFORM.ConnectTime)+crlf;
		  +'Remote User: '+THISFORM.RemoteUser+crlf;
		  +'Remote IP: '+THISFORM.RemoteIP+crlf;
		  +'Remote Dir: '+THISFORM.RemotePath+crlf;
		  +'Remote Alias: '+THISFORM.RemoteAlias+crlf;
		  +'Local Dir: '+set('defa')+CurDir()+crlf;
		  +'Connected Time: '+tran(THISFORM.Now-THISFORM.ConnectTime)+' min'+crlf;
		  +lcCnct
		if empty(THISFORM.RemoteUser)
		  THISFORM.Caption = [Chat Server: Connected to "]+THISFORM.RemoteIP+["]
		else
		  THISFORM.Caption = [Chat Server: Connected to "]+THISFORM.RemoteUser+["]
		endif
		THISFORM.SessionInfo.Refresh
	ENDPROC


	PROCEDURE addchat
		LPARAMETERS pcNote
		THISFORM.Chat.AddItem(pcNote)
		THISFORM.Chat.ListIndex = THISFORM.Chat.ListCount
	ENDPROC


	PROCEDURE sendcommand
		LOCAL lcCmd, lcStr, lcLine, lcArg, lnI, lnCnt, laArr[1], lcPath
		lcLine = alltrim(THISFORM.Cmd)
		if lcLine='?'
		  lcLine = "FUNC "+SubStr(lcLine,2)
		endif
		if upper(lcLine)='CD\'
		  lcLine = "CD \"+SubStr(lcLine,4)
		endif
		if upper(alltrim(lcLine))=='DIR'
		  lcLine = "DIR *.*"
		endif
		if ' ' $ lcLine
		  * UrlEncode the Data for the command
		  lcCmd = UPPER( Left(lcLine, at(' ',lcLine)-1 ) )
		  lcArg = Substr(lcLine, at(' ',lcLine)+1 )
		  lcStr = THISFORM.UrlEncode(lcArg)
		  lcLine = lcCmd+' '+lcStr
		else
		  lcCmd = upper(lcLine)
		  lcArg = ''
		  lcStr = ''
		  lcLine = lcCmd
		endif
		if not THISFORM.aCmds[THISFORM.TotCmds] == lcLine
		  if THISFORM.TotCmds < alen(THISFORM.aCmds)
		    THISFORM.TotCmds = THISFORM.TotCmds+1
		  else
		    for lnI = 2 to THISFORM.TotCmds
		      THISFORM.aCmds[lnI-1] = THISFORM.aCmds[lnI]
		    endfor
		  endif
		  THISFORM.aCmds[THISFORM.TotCmds] = THISFORM.Cmd
		endif
		THISFORM.ThisCmd = THISFORM.TotCmds
		do case
		  case lcCmd='SELECT ' or lcCmd='PUBLIC '
		    THISFORM.SendData('CMD '+lcLine)

		&& Handle Local commands
		  case lcCmd='LCD'  && Local CD
		    SET DEFAULT TO (lcArg)
		  case lcCmd='PUT'  && Send a file
		    lcVal = lcArg
		    lcPath = JustPath(lcVal)
		    if empty(lcPath)
		      lcPath = Set('Defa')+curdir()
		      lcVal  = lcPath+lcVal
		    endif
		    lcPath = addbs(lcPath)
		    lnCnt = adir(laArr,lcVal,'HS') && find all matching files
		    if lnCnt = 0
		      THISFORM.AddHistory('no files found matching '+lcVal)
		    endif
		    for lnI = 1 to lnCnt
		      THISFORM.AddHistory('Sending File '+lcPath+laArr[1])
		      lcCont = FileToStr( lcPath+laArr[1] )
		      *TODO: Add compression
		      lcRes = 'FILE name='+THISFORM.UrlEncode(laArr[1])+'&' ;
		             +'compressed=No&' ;
		             +'size='+Tran(len(lcCont))+'&' ;
		             +'content='+THISFORM.URLEncode( lcCont )
		      THISFORM.SendData(lcRes)
		      THISFORM.AddHistory('Done.')
		    endfor
		  otherwise
		    THISFORM.SendData(lcLine)
		endcase
	ENDPROC


	PROCEDURE sendvfpcommand
		LOCAL lcLine
		lcLine = 'CMD '+alltrim(THISFORM.VfpCmd)
		THISFORM.SendData(lcLine)
	ENDPROC


	PROCEDURE sendmessage
		LPARAMETER pcMsg
		DODEFAULT(pcMsg)
		THISFORM.AddChat('<< '+alltrim(pcMsg))
	ENDPROC


	PROCEDURE handlecommand
		LPARAMETER pcCommand
		if NOT ' ' $ pcCommand
		  pcCommand = pcCommand + ' '
		endif
		* Command descriptor is followed by a space,
		*  then, if applicable, by a URL encoded string of parameters
		*   (just like a form submission)
		*  Finally, a CrLf ends the command.
		THISFORM.AddHistory("IS: Got Command (Len="+tran(len(pcCommand))+" CR Cnt="+tran(occurs(chr(13),pcCommand))+") "+pcCommand)
		LOCAL lcVal, lnData, lcData, laData[1,1], loData
		do case
		  case pcCommand='CHAT '
		    lcVal = THISFORM.URLUnEncode( SubStr(pcCommand,6) )
		    THISFORM.SendData('OK')
		    THISFORM.AddChat('>> '+lcVal)
		  case pcCommand='USER '
		    THISFORM.SendData('OK')
		    THISFORM.RemoteUser = alltrim( THISFORM.URLUnencode(Substr(pcCommand,5)) )
		    THISFORM.RefreshInfo
		  case pcCommand='USERIP '
		    THISFORM.SendData('OK')
		    THISFORM.RemoteIP = alltrim( THISFORM.URLUnencode(Substr(pcCommand,7)) )
		    THISFORM.RefreshInfo
		  case pcCommand='PATH '
		    THISFORM.SendData('OK')
		    THISFORM.RemotePath = alltrim( THISFORM.URLUnencode(Substr(pcCommand,5)) )
		    THISFORM.RefreshInfo
		  case pcCommand='ALIAS '
		    THISFORM.SendData('OK')
		    THISFORM.RemoteAlias = alltrim( THISFORM.URLUnencode(Substr(pcCommand,7)) )
		    THISFORM.RefreshInfo
		  case pcCommand='RESULT '
		    THISFORM.SendData('OK')
		    RELEASE Result
		    PUBLIC Result
		    THISFORM.Result = THISFORM.URLUnencode(Substr(pcCommand,8))
		    m.Result = THISFORM.Result
		    THISFORM.AddHistory('RESULT = '+THISFORM.Result)
		  case pcCommand='FILE '
		    * data items:  Name (no path allowed)
		    *              Compressed: Y/N
		    *              Size: (of uuencoded data) Before Uncompressing.
		    *              Content: the actual file.
		    THISFORM.AddHistory('Incoming File!')
		    lcFile = THISFORM.ReceiveFile(pcCommand)
		    if '.BMP' $ lcFile && View image
		      DO FORM ResultViewer with lcFile, THISFORM
		    endif
		  case pcCommand='XMLDBF '
		    * data items:  CursorToXml'd table.
		    * TODO: Convert XML back to a table
		    THISFORM.AddHistory('Incoming XML File!')
		    THISFORM.SendData('OK')
		  case pcCommand='TABLE '
		    * data items:  CursorToXml'd table.
		    * TODO: Convert XML back to a table... This could be the result of a SELECT query.
		    THISFORM.AddHistory('Incoming Table!')
		    THISFORM.SendData('OK')
		  case pcCommand='ARRAY '
		    THISFORM.AddHistory('Incoming Array!')
		    if THISFORM.GetArray( @laData, pcCommand )
		      * TODO: Show array to the user somehow
		      WAIT WINDOW NOWAIT "TODO: Launching Array Viewer"
		    else
		      THISFORM.AddHistory('Array is Malformed!')
		    endif
		    THISFORM.SendData('OK')
		  case pcCommand='BYE '
		    THISFORM.AddHistory('Other side said "BYE"')
		    THISFORM.SendData('OK')
		    THISFORM.Close
		  OTHERWISE
		    DODEFAULT(pcCommand)
		endcase
	ENDPROC


	PROCEDURE addhistory
		LPARAMETERS pcNote
		THISFORM.List.AddItem(pcNote)
		THISFORM.List.ListIndex = THISFORM.List.ListCount
	ENDPROC


	PROCEDURE Resize
		WITh thiSFORM
		  .List.Width = .Width - .List.Left
		  .cmdSendChat.Left = .Width - .cmdSendChat.Width - 15
		  .cmdSendCmd.Left  = .Width - .cmdSendCmd.Width - 15
		  .cmdLocalCmd.Left = .Width - .cmdLocalCmd.Width - 15
		  .edtChat.width = .cmdSendChat.Left - 15 - .edtChat.Left
		  .edtCmd.width  = .cmdSendCmd.Left  - 15 - .edtCmd.Left
		  .edtLCmd.width = .cmdLocalCmd.Left - 15 - .edtLCmd.Left
		  .Chat.Width = (.Width - .Chat.Left )/2
		  .SessionInfo.Left = .Chat.Left + .Chat.Width + 4

		  .lblSessionInfo.Left = .SessionInfo.Left + 4
		  .SessionInfo.Width = .Width - .SessionInfo.Left - 4
		ENDWITH
	ENDPROC


	PROCEDURE Load
		_vfp.autoyield=.f.
		THISFORM.aCmds = '' && Clear the array
	ENDPROC


	PROCEDURE Init
		LPARAMETER pcReqID
		if THISFORM.Sock.State!=sckClosed
		  THISFORM.Sock.Close
		endif
		THISFORM.Sock.Accept( pcReqID )
		THISFORM.ConnectTime = dateTime()
		THISFORM.RefreshInfo
	ENDPROC


	PROCEDURE setstate
		DODEFAULT()
		THISFORM.RefreshInfo
	ENDPROC


	PROCEDURE edtchat.KeyPress
		LPARAMETERS nKeyCode, nShiftAltCtrl
		if nKeyCode=13
		  THISFORM.cmdSendChat.SetFocus
		  THISFORM.cmdSendChat.Click
		  THIS.SetFocus
		  NODEFAULT
		endif
	ENDPROC


	PROCEDURE edtcmd.KeyPress
		LPARAMETERS nKeyCode, nShiftAltCtrl
		do case
		  case nKeyCode=13
		    THISFORM.cmdSendCmd.SetFocus
		    THISFORM.cmdSendCmd.Click
		    THIS.SetFocus
		    NODEFAULT
		  case nKeyCode=18 or nKeyCode=3 && pgup,pgdn
		    if nKeyCode=18 && pgup
		      IF THISFORM.ThisCmd > 1
		        THISFORM.ThisCmd = THISFORM.ThisCmd - 1
		      endif
		    else && pgDn
		      IF THISFORM.ThisCmd < THISFORM.TotCmds
		        THISFORM.ThisCmd = THISFORM.ThisCmd + 1
		      endif
		    endif
		    THISFORM.Cmd = THISFORM.aCmds[THISFORM.ThisCmd]
		    THISFORM.edtCmd.Refresh
		endcase
	ENDPROC


	PROCEDURE cmdsendchat.Click
		THISFORM.SendMessage(THISFORM.ChatMsg)
		THISFORM.ChatMsg = ''
		THISFORM.edtChat.SetFocus
	ENDPROC


	PROCEDURE cmdsendcmd.Click
		THISFORM.SendCommand
	ENDPROC


	PROCEDURE command3.Click
		THISFORM.Close
	ENDPROC


	PROCEDURE edtlcmd.KeyPress
		LPARAMETERS nKeyCode, nShiftAltCtrl
		if nKeyCode=13
		  THISFORM.cmdLocalCmd.SetFocus
		  THISFORM.cmdLocalCmd.Click
		  THIS.SetFocus
		  NODEFAULT
		endif
	ENDPROC


	PROCEDURE edtvfpcmd.KeyPress
		LPARAMETERS nKeyCode, nShiftAltCtrl
		if nKeyCode=13
		  THISFORM.cmdSendVfpCmd.SetFocus
		  THISFORM.cmdSendVfpCmd.Click
		  THIS.SetFocus
		  NODEFAULT
		endif
	ENDPROC


	PROCEDURE cmdsendvfpcmd.Click
		THISFORM.SendVfpCommand
	ENDPROC


	PROCEDURE cmdlocalcmd.Click
		LOCAL lcCmd, lcStr, lcLine
		lcLine = alltrim(THISFORM.LCmd)
		ACTIVATE SCREEN
		&lcLine
		THISFORM.edtLCMD.SetFocus
	ENDPROC


ENDDEFINE
*
*-- EndDefine: frminstanceserver
**************************************************


**************************************************
*-- Class:        frmserver (c:\source\chat\ex\chatexample.vcx)
*-- ParentClass:  form
*-- BaseClass:    form
*-- Time Stamp:   05/23/03 01:48:01 PM
*
* DEFINES's could be extracted into a header file like this:
*#INCLUDE "c:\source\chat\ex\chatexample.h"
*
DEFINE CLASS frmserver AS form


	Top = 0
	Left = 0
	Height = 227
	Width = 527
	ShowWindow = 0
	DoCreate = .T.
	Caption = "Chat Server"
	Name = "frmserver"


    ADD OBJECT sock AS WSControl


	ADD OBJECT list AS listbox WITH ;
		Height = 201, ;
		Left = 70, ;
		Top = 13, ;
		Width = 450, ;
		Name = "List"


	ADD OBJECT command1 AS commandbutton WITH ;
		Top = 110, ;
		Left = 10, ;
		Height = 40, ;
		Width = 50, ;
		Caption = "Close", ;
		Name = "Command1"


	ADD OBJECT command2 AS commandbutton WITH ;
		Top = 180, ;
		Left = 10, ;
		Height = 40, ;
		Width = 50, ;
		WordWrap = .T., ;
		Caption = "Launch Client", ;
		Name = "Command2"


	PROCEDURE acceptrequest
		LPARAM ReqID
		THISFORM.List.AddItem(tran(dateTime())+" Server Connection Requested ID:"+tran(ReqID))
		LOCAL lcName
		lcName = sys(2015)
		PUBLIC &lcName
		&lcName = CreateObject('frmInstanceServer',ReqID)
		&lcName..Show
	ENDPROC


	PROCEDURE senddata
		LPARAMETERS pcData
		THISFORM.Server.Object.SendData(pcData)
	ENDPROC


	PROCEDURE Init
		_VFP.AutoYield = .F.
		THISFORM.List.AddItem(tran(dateTime())+" Tech Support Server Started")
		THISFORM.Sock.LocalPort = 8181
		THISFORM.Sock.object.Listen
		THISFORM.Left = _SCREEN.Width - THISFORM.Width
	ENDPROC


	PROCEDURE Unload
		DODEFAULT()
		CLEAR EVENTS
	ENDPROC


	PROCEDURE sock.DataArrival
		*** ActiveX Control Event ***
		LPARAMETERS len
		LOCAL lcData
		lcData = space(len*2)
		lcData = THIS.Object.GetData(@lcData)
		THISFORM.List.AddItem(tran(dateTime())+" Sock Data Received:("+tran(len)+")"+alltrim(lcData))
		THIS.Object.SendData(lcData)
	ENDPROC


	PROCEDURE sock.Connect
		*** ActiveX Control Event ***
		THISFORM.List.AddItem(tran(dateTime())+" Sock Connect Event")
	ENDPROC


	PROCEDURE sock.ConnectionRequest
		*** ActiveX Control Event ***
		LPARAMETERS requestid
		THISFORM.AcceptRequest(RequestID)
	ENDPROC


	PROCEDURE sock.Close
		*** ActiveX Control Event ***
		THIS.Object.Close
		THISFORM.List.AddItem("Sock Close Event")
	ENDPROC


	PROCEDURE command1.Click
		THISFORM.Sock.Object.Close
		THISFORM.Release
	ENDPROC


	PROCEDURE command2.Click
	    IF 1=MessageBox('You must start another VFP instance to view the client.'+chr(13);
	               +'Click "OK" to try to do this now...'+chr(13);
	               +chr(13)+'or open another VFP window, and type "DO tcpChat"',1,'Launch Client')
          DECLARE INTEGER ShellExecute IN SHELL32.DLL ;
            INTEGER nWinHandle, STRING cOperation, STRING cFileName, STRING cParameters,;
            STRING cDirectory,  INTEGER nShowWindow
          ShellExecute( 0, 'OPEN', FullPath('tcpChat.prg'), '', set('default')+curdir(), 1 )
	    ENDIF
	    RETURN .f.
	
		LOCAL lcName
		lcName = sys(2015)
		PUBLIC &lcName
		&lcName = CreateObject('frmClient')
		&lcName..Show
	ENDPROC


ENDDEFINE
*
*-- EndDefine: frmserver
**************************************************

Define Class WSControl As OleControl
  * Thanks for Slighthaze for this WinSock control class
  *   that can be added to a form in a DEFINE CLASS!
        OleClass='MSWinsock.Winsock.1'
        Top = 228
        Left = 24
        Height = 100
        Width = 100
        Name = "Sock"

    PROCEDURE Init
        this.object.Protocol = 0 && TCP
    ENDPROC

Enddefine

---

Author: wgcs

---

There is I believe a problem with the URLencode function used here
(I've seen it in other places too).

I noticed it first when trying to URLencode something that had a # in it (don't ask - well, OK, it's an Audio Tron application). This code does not escape it, but it should. When I've fixed the code, I'll post a replacement here.

Michael

---

Here is the code I used:

FUNCTION urlencode
*
* from http://www.tek-tips.com/gviewthread.cfm/lev2/4/lev3/27/pid/184/qid/597112
* also http://fox.wikis.com/wc.dll?Wiki~VFPPortListener~VFP
* I'm confused by this code.
* I believe it doesn't translate spaces correctly
*
* a proper definition is in: http://www.ietf.org/rfc/rfc2396.txt
* starting about half way down page 5
* unreserved characters include all alphas, all digits and the following unreserved marks
* mark  = "-" | "_" | "." | "!" | "~" | "*" | "'" | "(" | ")"
*
LPARAMETER pcinstr
*  ' encode Percent signs
*  '        Double Quotes
*  '        CarriageReturn / LineFeeds
LOCAL lcout, lni
lcout = ''
FOR lni = 1 TO LEN(pcinstr)
	lcch = SUBSTR(pcinstr,lni,1)
	DO CASE
		CASE ISALPHA(lcch) OR ISDIGIT(lcch) OR INLIST(lcch, "-" , "_" , "." , "!" , "~" , "*" , "'" , "(" , ")")
			* do nothing
		CASE lcch = " "
			lcch = "+"
		OTHERWISE
			lcch = '%' + RIGHT( TRANSFORM(ASC(lcch),'@0'), 2 )
	ENDCASE
	lcout = lcout + lcch
ENDFOR
RETURN lcout
ENDFUNC && UrlEncode

Michael
#n# Now Michael's code is incorporated into the Classes above. Thanks Michael, for doing the research to find out what exactly UrlEncode ing requires. -- wgcs

---

See also: What are Sockets? http://www.developerweb.net/forum/showthread.php?t=2961

---

Category Code Samples Category Client / Server