Code:
' Step 1. Compile 'Modified 12/28/09
' Step 2. Create shortcut to executable 'EchoServerEitherCompiler.Bas
' Step 3. Click shortcut multiple times.
' The first execution is server and others are clients.
' This thread [URL]http://www.powerbasic.com/support/pbforums/showthread.php?t=41648[/URL]
' Code works in PBCC or PBWIN.
' Thanks to Jeff Blakeney for GetPeerName.
' Thanks to Paul Purvis for new TCPADDR function for remote port and address. 12/8/09 12:34 AM
' Florent Heyworth [URL]http://powerbasic.com/support/pbforums/showthread.php?t=28744[/URL]
' 12/28 Returns machine name of server
' Only responses fill screen using PBCC
' Allows entering IP or machine name for easier testing on remote machines
'------------------------------------------------------------------------------
#COMPILE EXE 'Echo server and client for either PB/CC or PBWIN
#DIM ALL
%PortNumber = 999
%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
%TCP_TimeOut = 5000
GLOBAL hwndTCP AS LONG
GLOBAL gzMachineName AS ASCIIZ * 16
$QuestionIP = "IP address, machine name or Enter for 127.0.0.1 > "
FUNCTION PBMAIN () AS LONG
GetComputerName(gzMachineName,16)
OPEN "test.tmp" FOR BINARY AS #1 'if open become a client
IF ERR = 0 THEN
CALL ServerHere
ELSE
CALL ClientHere
END IF
CLOSE #1
END FUNCTION
'------------------------------------------------------------------------------
SUB ServerHere 'Executed if test.tmp not open and become server
LOCAL Clicked AS LONG
' Process socket messages in a separate thread
LOCAL hThread AS LONG
THREAD CREATE WindowThread(%NULL) TO hThread
THREAD CLOSE hThread 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
DO
clicked = ?("Leave this copy running and run again for clients." + $CRLF + _
"End server?", _
%MB_ICONINFORMATION OR %MB_YESNO, _
"Server on port" + STR$(%PortNumber))
LOOP UNTIL clicked = %IDYES
#ENDIF
SendMessage hwndTCP, %WM_CLOSE, 0, 0
END SUB
'-------------------------- Client code --------------------------------------------------------
SUB ClientHere
'port opened, message sent, wait response, close port
LOCAL nSocket AS LONG
LOCAL x AS LONG
LOCAL sBuffer AS STRING
LOCAL sPacket AS STRING
LOCAL sIP AS STRING
#IF %DEF(%PB_CC32) 'PBCC '
LINE INPUT $QuestionIP;sIP 'ask for IP
LOCATE CURSORY -1 'back to same line
? TAB(78); 'clear it
LOCATE CURSORY,1 'beginning of line
#ELSE
sIP = INPUTBOX$ ($QuestionIP)
#ENDIF
DO
#IF %DEF(%PB_CC32) 'PBCC
? "Send> "; 'send this to this IP
LINE INPUT sBuffer
#ELSE 'PBWIN
sBuffer = INPUTBOX$("Send","Client") 'send this to server
#ENDIF
IF LEN(sBuffer) = 0 THEN EXIT DO 'nothing typed exit program on client
'Client open
nSocket = FREEFILE
TCP OPEN PORT %PortNumber AT sIP AS #nSocket TIMEOUT %TCP_TIMEOUT 'timeout mainly if remote server
IF ERR THEN
BEEP
? "Client unable to open port" + STR$(%PortNumber) " at " + sIP + " error" + STR$(ERRCLEAR)
SLEEP 3000 'for PBCC
EXIT SUB
END IF
'Client send
TCP PRINT #nSocket, sBuffer
sBuffer = ""
sPacket = ""
'Client wait for response
DO
TCP RECV nSocket, 1024, sBuffer
sPacket = sPacket & sBuffer
LOOP UNTIL sBuffer = "" OR ISTRUE EOF(nSocket) OR ISTRUE ERR
TCP CLOSE #nSocket 'no reason to leave open
IF LEN(sPacket) THEN
#IF %DEF(%PB_CC32)
LOCATE CURSORY-1 'we know what we typed
? sPacket
#ELSE
? sPacket,,"Client disconnected from port" + STR$(%PortNumber)
#ENDIF
END IF
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
LOCAL SendBack 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
'---------------------------------------------------------------------------
'Server will send back
IF LEN(sPacket) THEN
SendBack = CHR$(gzMachineName," received" + STR$(LEN(sPacket)) + " bytes from ip " + TCPADDR(hEcho))
TCP SEND hEcho, SendBack$
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
'Called only by server and only 1-time
'Creates background window with CALLBACK FUNCTION TCPProc
'TCPProc: TCP OPEN server and accepts/processes requests
LOCAL Msg AS tagMsg
hwndTCP = MakeWindow
DO WHILE IsWindow(hwndTCP) AND GetMessage(Msg, %NULL, 0, 0)
TranslateMessage Msg
DispatchMessage Msg
LOOP
END FUNCTION
'------------------------------------------------------------------------------
FUNCTION TCPADDR(BYVAL lSock AS LONG) AS STRING
'Paul Purvis code to get remote IP and port from client
LOCAL sa AS sockaddr_in
LOCAL l AS LONG
LOCAL lHandle AS LONG
LOCAL b AS BYTE PTR
LOCAL lSockHandle AS LONG
lSockHandle = FILEATTR(lSock,2)
l = SIZEOF(sa)
IF getpeername(lSockHandle, BYVAL VARPTR(sa), l) = 0 THEN
b = VARPTR(sa.sin_addr.s_addr) 'return IP address of connection
FUNCTION = USING$("#_.#_.#_.#", @b, @b[1], @b[2], @b[3]) + " on remote port" + STR$(sa.sin_port)
END IF
END FUNCTION
Leave a comment: