Announcement

Collapse
No announcement yet.

EchoServ by PowerBASIC converted to DDT using PBFORMS

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

  • EchoServ by PowerBASIC converted to DDT using PBFORMS

    Code:
    #PBFORMS CREATED V1.51
    #COMPILE EXE
    #DIM ALL
    '------------------------------------------------------------------------------
    '   ** Includes **
    '------------------------------------------------------------------------------
    #PBFORMS BEGIN INCLUDES
    #IF NOT %DEF(%WINAPI)
        #INCLUDE "WIN32API.INC"
    #ENDIF
    #PBFORMS END INCLUDES
    '------------------------------------------------------------------------------
    '------------------------------------------------------------------------------
    '   ** Constants **
    '------------------------------------------------------------------------------
    #PBFORMS BEGIN CONSTANTS
    %IDD_DIALOG1  = 100
    %IDC_LISTBOX1 = 101
    %IDC_QUIT     = 102
    #PBFORMS END CONSTANTS
    '------------------------------------------------------------------------------
    %TCP_ACCEPT = %WM_USER + 4093  ' Any value larger than %WM_USER + 500
    %TCP_ECHO   = %WM_USER + 4094  ' Any value larger than %WM_USER + 500
    %FD_ACCEPT      = 8
    %INVALID_SOCKET = &HFFFFFFFF???
    %FD_READ        = 1
    %FD_CLOSE       = 32
    '------------------------------------------------------------------------------
    '   ** Declarations **
    '------------------------------------------------------------------------------
    DECLARE CALLBACK FUNCTION ShowDIALOG1Proc()
    DECLARE FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
    #PBFORMS DECLARATIONS
    '------------------------------------------------------------------------------
    '------------------------------------------------------------------------------
    '   ** Main Application Entry Point **
    '------------------------------------------------------------------------------
    FUNCTION PBMAIN()
        ShowDIALOG1 %HWND_DESKTOP
    END FUNCTION
    '------------------------------------------------------------------------------
    '------------------------------------------------------------------------------
    '   ** CallBacks **
    '------------------------------------------------------------------------------
    CALLBACK FUNCTION DlgProc()
        STATIC nServer   AS LONG
        STATIC hEcho     AS DWORD
        LOCAL  sBuffer   AS STRING
        LOCAL  sPacket   AS STRING
        SELECT CASE AS LONG CBMSG
            CASE %WM_INITDIALOG
                ' Initialization handler
              'hList = GetDlgItem(hDlg, 101)
              nServer = FREEFILE
              TCP OPEN SERVER PORT 62002 AS nServer  TIMEOUT 3000
              IF ERR THEN
                sBuffer = "Couldn't create socket!"
              ELSE
                TCP NOTIFY nServer, ACCEPT TO CBHNDL AS %TCP_ACCEPT
                sBuffer = "Connected to Port 62002"
              END IF
              LogEvent CBHNDL, %IDC_LISTBOX1, sBuffer
              hEcho = %INVALID_SOCKET
              FUNCTION = 1
            CASE %TCP_ACCEPT
              SELECT CASE CBLPARAM
                CASE %FD_ACCEPT
                  hEcho = FREEFILE
                  TCP ACCEPT nServer AS hEcho
                  TCP NOTIFY hEcho, RECV CLOSE TO CBHNDL AS %TCP_ECHO
              END SELECT
              FUNCTION = 1
            CASE %TCP_ECHO
                SELECT CASE CBLPARAM
                   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
                   
                        IF sBuffer = "" THEN EXIT DO '? "Buffer empty":exit do
                        IF ISTRUE EOF(hEcho) THEN EXIT DO '? " EOF":EXIT DO
                        IF ISTRUE ERR        THEN  EXIT DO '? "ERR" + STR$(ERRCLEAR)
                         SLEEP 5
                      LOOP
                      
                     LogEvent CBHNDL, %IDC_LISTBOX1, FORMAT$(LEN(sPacket)) + " bytes"
                    
                     IF LEN(sBuffer) THEN TCP SEND hEcho,  "Received Ok!"
                    
                   ELSE
                      LogEvent CBHNDL, %IDC_LISTBOX1, "* FD_READ Error!"
                   END IF
                 CASE %FD_CLOSE
                    TCP CLOSE hEcho
                    hEcho = %INVALID_SOCKET
                END SELECT
                FUNCTION = 1
    
            CASE %WM_NCACTIVATE
                STATIC hWndSaveFocus AS DWORD
                IF ISFALSE CBWPARAM THEN
                    ' Save control focus
                    hWndSaveFocus = GetFocus()
                ELSEIF hWndSaveFocus THEN
                    ' Restore control focus
                    SetFocus(hWndSaveFocus)
                    hWndSaveFocus = 0
                END IF
            CASE %WM_COMMAND
                ' Process control notifications
                SELECT CASE AS LONG CBCTL
                  
                     CASE %IDC_QUIT
                       DIALOG END CBHNDL
                       FUNCTION = 1
                 END SELECT
            CASE %WM_DESTROY
                TCP CLOSE nServer
                
            CASE %WM_SYSCOMMAND
                   IF CBWPARAM = %SC_CLOSE AND &H00000FFF0 THEN
                       FUNCTION = 1 'end program
                       REM FUNCTION = 0 'don't end program
                   END IF
                
        END SELECT
    END FUNCTION
    '------------------------------------------------------------------------------
    '------------------------------------------------------------------------------
    '   ** Dialogs **
    '------------------------------------------------------------------------------
    FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
        LOCAL lRslt AS LONG
    #PBFORMS BEGIN DIALOG %IDD_DIALOG1->->
        LOCAL hDlg  AS DWORD
        DIALOG NEW hParent, "Dialog1", 589, 393, 201, 110, %WS_POPUP OR _
            %WS_BORDER OR %WS_DLGFRAME OR %WS_THICKFRAME OR %WS_CAPTION OR _
            %WS_SYSMENU OR %WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX OR _
            %WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_MODALFRAME OR %DS_3DLOOK OR _
            %DS_NOFAILCREATE OR %DS_SETFONT, %WS_EX_CONTROLPARENT OR %WS_EX_LEFT _
            OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg
        CONTROL ADD LISTBOX, hDlg, %IDC_LISTBOX1, , 5, 5, 185, 80
        CONTROL ADD BUTTON,  hDlg, %IDC_QUIT, "Quit", 75, 90, 65, 15
    #PBFORMS END DIALOG
        DIALOG SHOW MODAL hDlg, CALL DlgProc TO lRslt
    #PBFORMS BEGIN CLEANUP %IDD_DIALOG1
    #PBFORMS END CLEANUP
        FUNCTION = lRslt
    END FUNCTION
    '------------------------------------------------------------------------------
    SUB LogEvent (hDlg AS DWORD, ID AS LONG, BYVAL Buffer AS STRING)
        LOCAL idx AS LONG
        Buffer = TIME$ + " - " + Buffer
        LISTBOX ADD hDlg, ID, Buffer
    END SUB
Working...
X