Tweet
Code:
#COMPILE EXE 'Echo server and Echo client combined for either PB/CC or PBWIN
#DIM ALL
%PortNumber = 999
$IP = ""
%CCWIN = 1
#INCLUDE "win32api.inc"
'#INCLUDE "\pbwin90\winapi\WS2_32.INC"
#INCLUDE "\pbcc50\winapi\WS2_32.INC"
%TCP_ACCEPT = %WM_USER + 4093 ' Any value larger than %WM_USER + 500
%TCP_ECHO = %WM_USER + 4094 ' Any value larger than %WM_USER + 500
GLOBAL hwndTCP AS LONG
GLOBAL hThread AS LONG
FUNCTION PBMAIN () AS LONG
OPEN "test.dat" FOR BINARY AS #1
IF ERR = 0 THEN
CALL ServerHere
ELSE
CALL ClientHere
END IF
CLOSE #1
END FUNCTION
SUB ServerHere
' Process socket messages in a separate thread
THREAD CREATE WindowThread(%NULL) TO hThread
' If the user presses the Esc key, exit the server
#IF %DEF(%PB_CC32)
? "Press Esc to exit server on port" + STR$(%PortNumber) + " (run again to start client.)"
DO UNTIL WAITKEY$ = $ESC:LOOP
#ELSE
' ? "Click to exit Echo Server on port" + STR$(%PortNumber) + " (run again to start client.)"
? "Run additional instances to create clients",%MB_ICONERROR OR %MB_SYSTEMMODAL,"SERVER on port" + STR$(%PortNumber) + " (Do not close or click OK)"
#ENDIF
SendMessage hwndTCP, %WM_CLOSE, 0, 0
END SUB
SUB ClientHere
LOCAL nSocket AS LONG
LOCAL x AS LONG
LOCAL sBuffer AS STRING
LOCAL sPacket AS STRING
DO
#IF %DEF(%PB_CC32)
? STRING$(60,"-")
? "Type data to send to server and press Enter. Just press Enter to exit."
LINE INPUT "> ";sBuffer
#ELSE
sBuffer = INPUTBOX$("Send this to server","Client")
#ENDIF
IF LEN(sBuffer) = 0 THEN EXIT DO
nSocket = FREEFILE
TCP OPEN PORT %PortNumber AT $Ip AS #nSocket
IF ERR THEN
? "Client unable to open port" + STR$(%PortNumber) + " AT " + $IP
EXIT SUB
END IF
FOR x = 1 TO 1
TCP PRINT #nSocket, sBuffer
sBuffer = ""
sPacket = ""
DO
TCP RECV nSocket, 1024, sBuffer
sPacket = sPacket & sBuffer
LOOP UNTIL sBuffer = "" OR ISTRUE EOF(nSocket) OR ISTRUE ERR
IF LEN(sPacket) THEN
#IF %DEF(%PB_CC32)
? sPacket
#ELSE
? sPacket,,"Client"
#ENDIF
END IF
NEXT
TCP CLOSE #nSocket
LOOP
END SUB
FUNCTION MakeWindow () AS LONG
LOCAL wce AS WndClassEx
LOCAL szClassName AS ASCIIZ * 64
LOCAL hWnd AS LONG
LOCAL hInst AS LONG
STATIC registered AS LONG
hInst = GetModuleHandle(BYVAL %NULL)
IF ISFALSE registered THEN
szClassName = "PBTCPCOMM"
wce.cbSize = SIZEOF(wce)
wce.style = %CS_HREDRAW OR %CS_VREDRAW
wce.lpfnWndProc = CODEPTR(TcpProc)
wce.cbClsExtra = 0
wce.cbWndExtra = 0
wce.hInstance = hInst
wce.hIcon = %NULL
wce.hCursor = %NULL
wce.hbrBackground = %NULL
wce.lpszMenuName = %NULL
wce.lpszClassName = VARPTR(szClassName)
wce.hIconSm = %NULL
RegisterClassEx wce
registered = %TRUE
END IF
hWnd = CreateWindow(szClassName, _
"TCP Handler", _
%WS_OVERLAPPEDWINDOW, _
5, 5, 10, 10, _
%NULL, _
%NULL, _
hInst, _
BYVAL %NULL)
IF ISFALSE hWnd THEN
hWnd = GetLastError
ELSE
ShowWindow hWnd, %SW_HIDE
UpdateWindow hWnd
END IF
FUNCTION = hWnd
END FUNCTION
'------------------------------------------------------------------------------
' Callback function to handle events for the GUI window
'
FUNCTION TcpProc (BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, _
BYVAL wParam AS LONG, BYVAL lParam AS LONG) EXPORT AS LONG
STATIC hServer AS LONG
STATIC hEcho AS LONG
LOCAL sBuffer AS STRING
LOCAL sPacket AS STRING
SELECT CASE wMsg
CASE %WM_CREATE
hServer = FREEFILE
TCP OPEN SERVER PORT %PortNumber AS hServer TIMEOUT 2000
IF ERR THEN
sBuffer = "Couldn't create socket!"
ELSE
TCP NOTIFY hServer, ACCEPT TO hWnd AS %TCP_ACCEPT
sBuffer = "Connected to Port" + STR$(%PortNumber)
END IF
hEcho = %INVALID_SOCKET
FUNCTION = 1
CASE %TCP_ACCEPT
SELECT CASE LO(WORD, lParam)
CASE %FD_ACCEPT
hEcho = FREEFILE
TCP ACCEPT hServer AS hEcho
TCP NOTIFY hEcho, RECV CLOSE TO hWnd AS %TCP_ECHO
END SELECT
FUNCTION = 1
CASE %TCP_ECHO
SELECT CASE LO(WORD, lParam)
CASE %FD_READ
IF hEcho <> %INVALID_SOCKET THEN
' Perform a receive-loop until there is no data left (ie, the end of stream)
'---------------------------------------------------------------------------
sBuffer = ""
sPacket = ""
DO
TCP RECV hEcho, 1024, sBuffer
sPacket = sPacket & sBuffer
LOOP UNTIL sBuffer = "" OR ISTRUE EOF(hEcho) OR ISTRUE ERR
'---------------------------------------------------------------------------
'Send back to client
IF LEN(sPacket) THEN
TCP SEND hEcho, FORMAT$(LEN(sPacket)) + " bytes received, ok."
END IF
'ELSE
END IF
CASE %FD_CLOSE
TCP CLOSE hEcho
hEcho = %INVALID_SOCKET
'? "Closed hEcho socket"
END SELECT
FUNCTION = 1
CASE %WM_DESTROY
TCP CLOSE hServer
END SELECT
FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)
END FUNCTION
THREAD FUNCTION WindowThread (BYVAL nIgnored AS LONG) AS LONG
LOCAL Msg AS tagMsg
hwndTCP = MakeWindow
DO WHILE IsWindow(hwndTCP) AND GetMessage(Msg, %NULL, 0, 0)
TranslateMessage Msg
DispatchMessage Msg
LOOP
END FUNCTION
Comment