Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Echo Server and Client combined (run twice)

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • PBWin/PBCC Echo Server and Client combined (run twice)

    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
    Last edited by Mike Doty; 10 Oct 2009, 10:48 AM. Reason: Tell user to run twice and not end original

  • #2
    Documention

    Client and server code in one program.
    The program will run in either PBCC or PBWIN.
    I did this so code could be easily tested and moved between compilers.

    Step 1. Compile
    Step 2. Create shortcut to the executable program.
    Step 3. Click shortcut multiple times.

    The first execution becomes the server. All other exeuctions become clients.
    This is the PowerBASIC Echo server and client demo modified.
    The code can be easily inserted into PowerBASIC PBForms to add a graphical interface.



    Comment


    • #3
      Now returns remote IP and remote port number of clients

      Code:
      ' Step 1. Compile                        'Modified 12/8/09  1:30 AM
      ' 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 http://www.powerbasic.com/support/pbforums/showthread.php?t=41648
      ' 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 http://powerbasic.com/support/pbforums/showthread.php?t=28744
      '------------------------------------------------------------------------------
      
      #COMPILE EXE  'Echo server and client 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
      
      FUNCTION PBMAIN () AS LONG
        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 by first copy of program in memory (server only)
      
        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
        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
      
        'Client open
        nSocket = FREEFILE
        TCP OPEN PORT %PortNumber AT $Ip AS #nSocket
        IF ERR THEN
          ? "Client unable to open port" + STR$(%PortNumber)
          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)
            ? 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
          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
                        TCP SEND hEcho, FORMAT$(LEN(sPacket)) + " bytes received from " + TCPADDR(hEcho)
                      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
      '------------------------------------------------------------------------------
      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

      Comment


      • #4
        Allows changing IP/machine name, returns machine name easier to use with PBCC

        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

        Comment

        Working...
        X