PUBLIC oForm, oForm2
Local lnPortNo, lcPortNo, lnCount
Set exclusive off
Set multilocks on
Set deleted on
Set refresh to 1,1
_VFP.Visible = .F.
If !file('ChatPort.dbf')
Create table ChatPort (PortNo C(10), IPAddress C(20))
Index on PortNo tag PortNo
endif
Use ChatPort order PortNo
CursorSetProp('Buffering', 5)
lnPortNo = 1000
Count for !deleted()
If (_tally > 0)
Go bottom
lnPortNo = int(val(PortNo) + 1)
endif
lcPortNo = alltrim(str(lnPortNo))
Insert into ChatPort (PortNo) Values (lcPortNo)
TableUpdate(0, .T.)
Set order to
oForm = CREATEOBJECT("clsChat", lnPortNo)
oForm.visible = .t.
Read events
Go top
Scan for (alltrim(PortNo) == lcPortNo)
Delete
EndScan
TableUpdate(1, .T.)
Store Null to oForm, oForm2
Release oForm, oForm2
Count for !deleted()
Close databases all
If (_tally == 0)
Erase ChatPort.*
endif
Clear all
Close all
DEFINE CLASS clschat AS form
Top = 0
Left = 0
Height = 268
Width = 376
DoCreate = .T.
Caption = "VFP CHAT"
Name = "clschat"
ShowWindow = 2
ADD OBJECT txtchatname AS textbox WITH ;
Height = 23, ;
Left = 216, ;
Top = 12, ;
Width = 132, ;
Name = "txtChatname"
ADD OBJECT edtchat AS editbox WITH ;
Height = 134, ;
Left = 24, ;
ReadOnly = .T., ;
Top = 48, ;
Width = 324, ;
DisabledBackColor = RGB(255,255,255), ;
DisabledForeColor = RGB(0,0,0), ;
Name = "edtChat"
ADD OBJECT txtmessage AS textbox WITH ;
Height = 23, ;
Left = 84, ;
Top = 194, ;
Width = 264, ;
Name = "txtMessage"
ADD OBJECT command1 AS commandbutton WITH ;
Top = 221, ;
Left = 298, ;
Height = 25, ;
Width = 50, ;
Caption = "Send", ;
Name = "Command1"
ADD OBJECT winsock1 AS WSControl
ADD OBJECT label2 AS label WITH ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "MESSAGE", ;
Height = 17, ;
Left = 24, ;
Top = 197, ;
Width = 59, ;
Name = "Label2"
ADD OBJECT label1 AS label WITH ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "CHAT NAME", ;
Height = 17, ;
Left = 144, ;
Top = 15, ;
Width = 70, ;
Name = "Label1"
PROCEDURE Init
LPARAMETERS tnPortNo
With ThisForm
.winsock1.object.bind(tnPortNo)
Replace IPAddress with .winsock1.LocalIP
TableUpdate(0, .T.)
.txtchatname.value = "Chat Port#: " + alltrim(str(.winsock1.LocalPort))
.txtmessage.setfocus()
EndWith
EndProc
Procedure Destroy
ThisForm.RemoveObject('WinSock1')
EndProc
PROCEDURE Unload
CLEAR events
EndProc
PROCEDURE txtmessage.KeyPress
LPARAMETERS nKeyCode, nShiftAltCtrl
IF nKeyCode = 13 AND nShiftAltCtrl = 0
IF !EMPTY(thisform.txtmessage.value)
thisform.command1.Click()
ENDIF
ENDIF
EndProc
PROCEDURE command1.Click
LOCAL sChatName, sMessageSent, lnPort
WITH thisform
sChatName = ALLTRIM(thisform.txtchatname.value)
sMessageSent = sChatName +" says: " + ALLTRIM(thisform.txtmessage.value)
WITH .winsock1.object
Go top
Scan while !eof()
.RemotePort = int(val(PortNo))
.RemoteHost = IPAddress
.SendData(sMessageSent)
EndScan
ENDWITH
.txtmessage.value = ""
.txtmessage.setfocus()
EndWith
EndProc
EndDefine
Define Class WSControl As OleControl
OleClass='MSWinsock.Winsock.1'
Top = 228
Left = 24
Height = 100
Width = 100
Name = "winsock1"
PROCEDURE Init
this.object.Protocol = 1
EndProc
Procedure Error(nError, cMethod, nLine)
If (nError == 1429)
Delete
TableUpdate(0, .T.)
endif
EndProc
PROCEDURE DataArrival
LPARAMETERS bytestotal
sMessage = SPACE(bytestotal)
With ThisForm
.winsock1.object.GetData(@sMessage)
.edtchat.Value = .edtchat.Value + sMessage + CHR(13)
.edtchat.refresh()
.edtchat.SelStart = len(alltrim(.edtchat.Value))
EndWith
EndProc
EndDefine