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