Graphics 800,600,16

SetBuffer BackBuffer()

server=CreateTCPServer(81)

While Not KeyHit(1)
Cls
 stream=AcceptTCPStream(server)
 If stream Then
  message$=ReadString$(stream)
 End If
 Text 10,10,">"+message$+"<"
Flip
Wend
CloseTCPServer(server)

Private Sub Command1_Click()          'verbinden
 Winsock1.Connect "192.168.126.13", 81 'Verbindungsanfrage zu "Server", Port 81 (auf den der Server hört)
End Sub

Private Sub Command2_Click()          'senden
 Winsock1.SendData Text1.Text 'Daten senden
 Text1.Text = "" 'Üblicherweise den Chattext löschen
End Sub

Private Sub Form_Load()

End Sub

Private Sub Winsock1_Connect()
 Text2.Text="Verbindung aufgebaut"
End Sub

Private Sub cmd_send_Click()

 'MR 02.11.2002

 'send the text from textbox

 'COMMAND:PARAMETER1,PARAMETER2,PARAMETER3 ... AND CRLF

 SendData c_send.Text

End Sub

Private Function SendData(ByVal s$)

 'MR 02.11.2002

 On Error GoTo er

 If Main.Winsock.State = sckConnected Then 'if connected then send but + on error it's better !
  Main.Winsock.SendData s$
 End If

 Exit Function

er:

  Main.c_empf.Text = "ERR:" & Err.Description

End Function

Private Sub cmd_Connnect_Click()
 
 'MR 02.11.2002
 
 'connection to TCPServer (written in BlitzBasic3D)
 
 If Winsock.State <> sckClosed Then Winsock.Close
 Winsock.Connect r_ip.Text, r_port.Text

End Sub

Private Sub cmdClear_Click()
 
 'MR 02.11.2002
 
 c_empf.Text = ""

End Sub

Private Sub cmdClose_Click()
 
 'MR 02.11.2002
 
 Winsock.Close

End Sub

Private Sub Form_Load()
 
 'MR 02.11.2002
 
 l_port = Winsock.LocalPort
 l_ip = Winsock.LocalIP
 
 r_ip.Text = "127.0.0.1" 'Locale IP
   
 c_send.Text = "NOP" & vbCrLf
 
End Sub

Private Sub Timer1_Timer()
 
 'MR 02.11.2002
 
 Timer1.Interval = 500 '1000 ms
 
 Dim t As String
 Dim st As Integer
 
 st = Winsock.State
 
 t = "?"
 If st = sckClosed Then t = "Closed"
 If st = sckClosing Then t = "Closing"
 If st = sckConnected Then t = "Connected"
 If st = sckConnecting Then t = "Connecting"
 If st = sckConnectionPending Then t = "ConnectionPending"
 If st = sckError Then t = "Error"
 If st = sckHostResolved Then t = "HostResolved"
 If st = sckListening Then t = "Listening"
 If st = sckOpen Then t = "Open"
 If st = sckResolvingHost Then t = "ResolvingHost"
 
 c_state.Text = t 'show me the winsock state
 
 If st = sckConnected Then
 
  'SendData "NOP:" & vbCrLf 'BlitzBasic wait for incomming crlf by ReadLine$(TCPStream)
  SendData vbCrLf 'BlitzBasic wait for incomming crlf by ReadLine$(TCPStream)
 
 End If
 
End Sub

Private Sub Winsock_DataArrival(ByVal bytesTotal As Long)
 
 'MR 02.11.2002
 
 'Read Input Buffer from TCP
 
 Dim Message
 
 Winsock.GetData Message, vbString
 c_empf.Text = c_empf.Text & Message 'show me in textbox (rtf has no limit)

End Sub

Private Sub Winsock_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
 
 'MR 02.11.2002
 
 Winsock.Close

 ':-(

End Sub

Private Sub Winsock_SendComplete()
 
 'MR 02.11.2002

 ':-)

End Sub

;TCP

Global TCPServer
Global TCPStream
Global TCPInput$
Global TCPInputLast$
Dim TCPInputP$(128)

TCPServer=CreateTCPServer(8080)
TCPTimeouts 60000,0 ;1 Minute before TimeOut and connection close :-) Allways send to Server NOP CRLF

Function TCPRemoteInput()

 ;----------------------------------------------------------------------------- Waiting Connect , Connect , Read Input from TCP Stream

 ;Read a Line from TCP until crlf come :-)

 Local r$

 TCPInput$=""

 If TCPServer = 0 Then
 
  oText 10,10+9*fonty,"Blitz Server not started !?"

 Else
  If TCPStream Then
   oText 10,10+9*fonty,"IP "+DottedIP$(TCPStreamIP(TCPStream))+" READ STREAM (WAIT UNTIL CRLF)"
   ;Flip
   If Not Eof(TCPStream)
    r$=ReadLine(TCPStream) ;Here it waits until incomming crlf
    If Len(r$)>0
     TCPInput=TCPInput+r$
     TCPInputLast=TCPInput
     TCPInput=TCPInput+Chr$(13)
    EndIf
   EndIf
   
   If Eof(TCPStream) Then CloseTCPStream TCPStream:TCPStream=0
   
  Else
   TCPStream=AcceptTCPStream(TCPServer)
   oText 10,10+9*fonty,"Server waiting for connect"
  EndIf
 EndIf

 ;----------------------------------------------------------------------------- Stream to Functions :-)

 otext 10,10+10*fonty,"TCPInputLast "+TCPInputLast$

 Local c$,o$,x,x1,x2,p,i
 c$=""
 o$=""

 ;---------------------------------------------------------

 ;Command
 x=Instr(TCPInput,":")
 If x>1 Then
  c$=Mid(TCPInput,1,x-1)
  c$=Upper(c$)
 EndIf

 ;---------------------------------------------------------

 ;Clear Parameter
 p=0
 For i=1 To 128
  TCPInputP(i)=""
 Next

 ;Search for Parameters
 x2=0
 If Len(TCPInput)>x Then
  x1=x+1
  Repeat
   x2=Instr(TCPInput,",",x1)
   If x2=0 Then x2=Instr(TCPInput,Chr(13),x1) ;or to End
   If x2>x1 Then
    p=p+1
    TCPInputP(p)=Mid(TCPInput,x1,x2-x1)
    x1=x2+1
   EndIf
   If x2=Len(TCPInput) Then x2=0 ;no endless loop ;-)
  Until x2=0
 EndIf

 ;------------------------------------------------------------> COMMADS <---

.TCPCommands

 Local br ;Brush Handle

 ;Functions
 If Len(c$)>0 Then
 Select c$
 Case "SETMOUSE","MOUSEXY","MOUSE"
  RSetMouseXY TCPInputP(1),TCPInputP(2)
  o$=c$
 Case "MOVEMOUSE","MOUSEMOVE"
  RMoveMouseXY TCPInputP(1),TCPInputP(2)
  o$=c$
 Case "SETMOUSEBUTTON","MOUSEBUTTON"
  RSetMouseButton TCPInputP(1),TCPInputP(2)
  o$=c$
 Case "CAMERAPOSITION","POSITIONCAMERA"
  RSetCameraPosition TCPInputP(1),TCPInputP(2),TCPInputP(3)
  o$=c$
 Case "CAMERAMOVE","MOVECAMERA"
  RSetCameraMove TCPInputP(1),TCPInputP(2),TCPInputP(3)
  o$=c$
 Case "CAMERATURN","TURNCAMERA"
  RSetCameraTurn TCPInputP(1),TCPInputP(2),TCPInputP(3)
  o$=c$
 Case "CAMERAROTATE"
  RSetCameraRotate TCPInputP(1),TCPInputP(2),TCPInputP(3)
  o$=c$
 Case "BRUSH","CREATEBRUSH","NEWBRUSH","ADDBRUSH"
  RAddBrush TCPInputP(1),TCPInputP(2),TCPInputP(3),TCPInputP(4)
  o$=c$
 Case "FINDBRUSH"
  RFindBrush TCPInputP(1)
  o$=c$
 Case "DELETEBRUSH"
  RDeleteBrush TCPInputP(1)
  o$=c$
 Case "CUBE"
  x=CreateMyCube(NewMesh,TCPInputP(2),TCPInputP(3),TCPInputP(4),ALLBrushes\Brush)
  NameEntity x,TCPInputP(1)
  AddEntity x
  o$=c$
 Case "CUBEX"
  br=ALLBrushes\Brush
  x=AddMyMeshCube(NewMesh,TCPInputP(2),TCPInputP(3),TCPInputP(4),br,br,br,br,br,br)
  NameEntity x,TCPInputP(1)
  AddEntity x
  o$=c$
 Case "DELETEENTITY","DELETE"
  RDeleteEntity TCPInputP(1)
  o$=c$
 Case "HELP"
  o$="Sorry no Help there :-("
 Case "NOP"
  o$="NOP"
 Default
  o$="UNKNOWN COMMAND "+c$
 End Select
 EndIf ;Command >0

 ;---------------------------------------------------------

 ;Output what i have done :-)

 If Len(o$)>0 Then o$=o$+":"

 If p>0 Then
  For i=1 To p
   o$=o$+TCPInputP(i)
   If i<p Then o$=o$+","
  Next
 EndIf

 If Len(o$)>0 Then
    If  TCPStream Then WriteLine  TCPStream,o$
 EndIf
 
End Function