Hi,
A few DAYs agoo I was dooing SOME testing concering PROGRESS sockets
IN v91B. AS an example, i've made a little C/S system which does the next
thing (CODE mentioned below FOR SERVER.w AND client.w):
SERVER.W:
* CHECK IF ip-address OF SERVER IS AVAIL, IF NOT, manual INPUT ip
* Creates a SERVER SOCKET which listens FOR incoming clients
* Puts logon INFO IN a WINDOW list (username AND login TIME)
CLIENT.W
* CHECK IF ip-address OF SERVER IS AVAIL, IF NOT, manual INPUT ip
* sends logon INFO TO SERVER AT login TIME.
* sends logoff INFO TO SERVER AT logoff TIME.
Everything seems TO work smoothly, the SERVER starts UP, clients can LOG ON AND
are viewed IN the window-list OF the SERVER. But there's a slight problem
WITH the logoff PROCEDURE OF the client, only the LAST DISCONNECT fires IF
more THEN one client IS CONNECTED TO the SERVER.
Example: See attached FILE.
Have a Clue ?
Greetings,
Emmanuel Nuyttens
Analist Programmer
C&C Oudenaarde Belgium
/*
Contens OF SERVER.w
*/
&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v9r12 GUI
&ANALYZE-RESUME
&Scoped-define WINDOW-NAME C-Win
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS C-Win
/*------------------------------------------------------------------------
File: server.w
Description: Socket server voorbeeld
Input Parameters:
<none>
Output Parameters:
<none>
Author: emnu
Created: 08/01
------------------------------------------------------------------------*/
/* This .W file was created with the Progress AppBuilder. */
/*----------------------------------------------------------------------*/
/* Create an unnamed pool to store all the widgets created
by this procedure. This is a good default which assures
that this procedure's triggers and internal procedures
will execute in this procedure's storage, and that proper
cleanup will occur on deletion of the procedure. */
CREATE WIDGET-POOL.
/* *************************** Definitions ************************** */
/* Parameters Definitions --- */
/* Local Variable Definitions --- */
DEFINE VARIABLE hServerSocket AS HANDLE.
DEFINE VARIABLE aOk AS LOGICAL.
DEFINE VARIABLE mBuffer AS MEMPTR.
DEFINE VARIABLE cString AS CHAR NO-UNDO.
DEF VAR hSocket AS HANDLE NO-UNDO.
DEF VAR cIP AS CHAR NO-UNDO.
DEF VAR cConnectString AS CHAR NO-UNDO.
DEF VAR hStatus AS HANDLE NO-UNDO.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
/* ******************** Preprocessor Definitions ******************** */
&Scoped-define PROCEDURE-TYPE Window
&Scoped-define DB-AWARE no
/* Name of first Frame and/or Browse and/or first Query */
&Scoped-define FRAME-NAME DEFAULT-FRAME
/* Standard List Definitions */
&Scoped-Define ENABLED-OBJECTS SELECT-LOGON BUTTON-START BUTTON-SLUIT ~
FILL-IN-IP FILL-IN-MSG
&Scoped-Define DISPLAYED-OBJECTS SELECT-LOGON FILL-IN-IP FILL-IN-MSG
/* Custom List Definitions */
/* List-1,List-2,List-3,List-4,List-5,List-6 */
/* _UIB-PREPROCESSOR-BLOCK-END */
&ANALYZE-RESUME
/* ************************ Function Prototypes ********************** */
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD ifunc_ip C-Win
FUNCTION ifunc_ip RETURNS CHARACTER
( /* parameter-definitions */ ) FORWARD.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
/* *********************** Control Definitions ********************** */
/* Define the widget handle for the window */
DEFINE VAR C-Win AS WIDGET-HANDLE NO-UNDO.
/* Definitions of handles for OCX Containers */
DEFINE VARIABLE CtrlFrame AS WIDGET-HANDLE NO-UNDO.
DEFINE VARIABLE chCtrlFrame AS COMPONENT-HANDLE NO-UNDO.
/* Definitions of the field level widgets */
DEFINE BUTTON BUTTON-SLUIT
LABEL "&Sluiten"
SIZE 25 BY 1.14.
DEFINE BUTTON BUTTON-START
LABEL "&Start Server"
SIZE 25 BY 1.14.
DEFINE VARIABLE FILL-IN-IP AS CHARACTER FORMAT "X(256)":U
VIEW-AS TEXT
SIZE 48 BY .62 NO-UNDO.
DEFINE VARIABLE FILL-IN-MSG AS CHARACTER FORMAT "X(256)":U INITIAL "Server STOPT"
VIEW-AS TEXT
SIZE 47 BY .62 NO-UNDO.
DEFINE VARIABLE SELECT-LOGON AS CHARACTER
VIEW-AS SELECTION-LIST SINGLE SCROLLBAR-VERTICAL
SIZE 48 BY 8.1 NO-UNDO.
/* ************************ Frame Definitions *********************** */
DEFINE FRAME DEFAULT-FRAME
SELECT-LOGON AT ROW 1.95 COL 2 NO-LABEL
BUTTON-START AT ROW 10.29 COL 12
BUTTON-SLUIT AT ROW 11.48 COL 12
FILL-IN-IP AT ROW 1.24 COL 2 NO-LABEL
FILL-IN-MSG AT ROW 13.14 COL 3 NO-LABEL
WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY
SIDE-LABELS NO-UNDERLINE THREE-D
AT COL 1 ROW 1
SIZE 51 BY 13.48.
DEFINE FRAME FRAME-IP
FILL-IN-IP AT ROW 1.95 COL 9 COLON-ALIGNED
LABEL "IP-Adres" FORMAT "X(256)":U
VIEW-AS FILL-IN
SIZE 21 BY 1
WITH 1 DOWN KEEP-TAB-ORDER OVERLAY
SIDE-LABELS NO-UNDERLINE THREE-D
AT COL 3 ROW 2.43
SIZE 33 BY 4.29
TITLE "IP".
/* *********************** Procedure Settings ************************ */
&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
Type: Window
Allow: Basic,Browse,DB-Fields,Window,Query
Other Settings: COMPILE
*/
&ANALYZE-RESUME _END-PROCEDURE-SETTINGS
/* ************************* Create Window ************************** */
&ANALYZE-SUSPEND _CREATE-WINDOW
IF SESSION
ISPLAY-TYPE = "GUI":U THEN
CREATE WINDOW C-Win ASSIGN
HIDDEN = YES
TITLE = "Server"
HEIGHT = 13.38
WIDTH = 51
MAX-HEIGHT = 16
MAX-WIDTH = 80
VIRTUAL-HEIGHT = 16
VIRTUAL-WIDTH = 80
RESIZE = yes
SCROLL-BARS = no
STATUS-AREA = no
BGCOLOR = ?
FGCOLOR = ?
KEEP-FRAME-Z-ORDER = yes
THREE-D = yes
MESSAGE-AREA = no
SENSITIVE = yes.
ELSE {&WINDOW-NAME} = CURRENT-WINDOW.
/* END WINDOW DEFINITION */
&ANALYZE-RESUME
/* *********** Runtime Attributes and AppBuilder Settings *********** */
&ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
/* SETTINGS FOR WINDOW C-Win
VISIBLE,,RUN-PERSISTENT */
/* REPARENT FRAME */
ASSIGN FRAME FRAME-IP:FRAME = FRAME DEFAULT-FRAME:HANDLE.
/* SETTINGS FOR FRAME DEFAULT-FRAME
*/
DEFINE VARIABLE XXTABVALXX AS LOGICAL NO-UNDO.
ASSIGN XXTABVALXX = FRAME FRAME-IP:MOVE-AFTER-TAB-ITEM (SELECT-LOGON:HANDLE IN FRAME DEFAULT-FRAME)
XXTABVALXX = FRAME FRAME-IP:MOVE-BEFORE-TAB-ITEM (BUTTON-START:HANDLE IN FRAME DEFAULT-FRAME)
/* END-ASSIGN-TABS */.
/* SETTINGS FOR FILL-IN FILL-IN-IP IN FRAME DEFAULT-FRAME
ALIGN-L */
/* SETTINGS FOR FILL-IN FILL-IN-MSG IN FRAME DEFAULT-FRAME
ALIGN-L */
/* SETTINGS FOR FRAME FRAME-IP
NOT-VISIBLE */
ASSIGN
FRAME FRAME-IP:HIDDEN = TRUE.
IF SESSIONISPLAY-TYPE = "GUI":U AND VALID-HANDLE(C-Win)
THEN C-Win:HIDDEN = no.
/* _RUN-TIME-ATTRIBUTES-END */
&ANALYZE-RESUME
/* ********************** Create OCX Containers ********************** */
&ANALYZE-SUSPEND _CREATE-DYNAMIC
&IF "{&OPSYS}" = "WIN32":U AND "{&WINDOW-SYSTEM}" NE "TTY":U &THEN
CREATE CONTROL-FRAME CtrlFrame ASSIGN
FRAME = FRAME DEFAULT-FRAME:HANDLE
ROW = 10.52
COLUMN = 44
HEIGHT = 1.33
WIDTH = 5.6
HIDDEN = yes
SENSITIVE = yes.
CtrlFrame:NAME = "CtrlFrame":U .
/* CtrlFrame OCXINFO:CREATE-CONTROL from: {F0B88A90-F5DA-11CF-B545-0020AF6ED35A} type: PSTimer */
CtrlFrame:MOVE-AFTER(BUTTON-START:HANDLE IN FRAME DEFAULT-FRAME).
&ENDIF
&ANALYZE-RESUME /* End of _CREATE-DYNAMIC */
/* ************************ Control Triggers ************************ */
&Scoped-define SELF-NAME C-Win
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL C-Win C-Win
ON END-ERROR OF C-Win /* Server */
OR ENDKEY OF {&WINDOW-NAME} ANYWHERE DO:
/* This case occurs when the user presses the "Esc" key.
In a persistently run window, just ignore this. If we did not, the
application would exit. */
IF THIS-PROCEDUREERSISTENT THEN RETURN NO-APPLY.
END.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL C-Win C-Win
ON WINDOW-CLOSE OF C-Win /* Server */
DO:
/* This event will close the window and terminate the procedure. */
APPLY "CLOSE":U TO THIS-PROCEDURE.
RETURN NO-APPLY.
END.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&Scoped-define SELF-NAME BUTTON-SLUIT
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL BUTTON-SLUIT C-Win
ON CHOOSE OF BUTTON-SLUIT IN FRAME DEFAULT-FRAME /* Sluiten */
DO:
IF VALID-HANDLE(hServerSocket) THEN
DO:
DELETE OBJECT hServerSocket NO-ERROR.
IF ERROR-STATUS:ERROR THEN
DO:
MESSAGE "Server is nog actief !" VIEW-AS ALERT-BOX.
RETURN NO-APPLY.
END.
END.
APPLY "close":U TO THIS-PROCEDURE.
END.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&Scoped-define SELF-NAME BUTTON-START
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL BUTTON-START C-Win
ON CHOOSE OF BUTTON-START IN FRAME DEFAULT-FRAME /* Start Server */
DO:
/* Creatie van Server Socket */
IF NOT VALID-HANDLE(hServerSocket) THEN
DO:
{&SELF-NAME}:LABEL = "&Stop Server".
CREATE SERVER-SOCKET hServerSocket.
fill-in-msg:SCREEN-VALUE IN FRAME {&FRAME-NAME} = "Server STARTED".
/* Instellen en activeren van connectie procedure */
hServerSocket:SET-CONNECT-PROCEDURE( "connProc":U).
aOk = hServerSocket:ENABLE-CONNECTIONS(cConnectString).
MESSAGE "Enabled connections:" aOk.
IF NOT aOk THEN
RETURN.
RUN adecomm/_statdsp.p (hstatus,1,"Wacht op Connecties ...").
END. ELSE
DO:
IF {&self-name}:LABEL = "&Stop Server" THEN
DO:
{&self-name}:LABEL = "&Start Server".
aOk = hServerSocketISABLE-CONNECTIONS().
MESSAGE "Disabled connections:" aOk.
IF NOT aOk THEN
RETURN.
ELSE
fill-in-msg:SCREEN-VALUE IN FRAME {&FRAME-NAME} = "Server STOPPED".
RUN adecomm/_statdsp.p (hstatus,1,"Wacht op Connecties INACTIEF...").
END. ELSE DO:
{&self-name}:LABEL = "&Stop Server".
aOk = hServerSocket:ENABLE-CONNECTIONS(cConnectString).
MESSAGE "Enabled connections:" aOk.
IF NOT aOk THEN
RETURN.
ELSE
fill-in-msg:SCREEN-VALUE IN FRAME {&FRAME-NAME} = "Server STARTED".
RUN adecomm/_statdsp.p (hstatus,1,"Wacht op Connecties ...").
END.
END.
END.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&Scoped-define SELF-NAME CtrlFrame
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL CtrlFrame C-Win OCX.Tick
PROCEDURE CtrlFrame.PSTimer.Tick .
/*------------------------------------------------------------------------------
Purpose:
Parameters: None required for OCX.
Notes:
------------------------------------------------------------------------------*/
RUN iproc_Logon.
END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&UNDEFINE SELF-NAME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK C-Win
/* *************************** Main Block *************************** */
/* Set CURRENT-WINDOW: this will parent dialog-boxes and frames. */
ASSIGN CURRENT-WINDOW = {&WINDOW-NAME}
THIS-PROCEDURE:CURRENT-WINDOW = {&WINDOW-NAME}.
/* The CLOSE event can be used from inside or outside the procedure to */
/* terminate it. */
ON CLOSE OF THIS-PROCEDURE
RUN disable_UI.
/* Best default for GUI applications is... */
PAUSE 0 BEFORE-HIDE.
/* Now enable the interface and wait for the exit condition. */
/* (NOTE: handle ERROR and END-KEY so cleanup code will always fire. */
MAIN-BLOCK:
DO ON ERROR UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK
ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK:
RUN enable_UI.
ON 'tab':U OF fill-in-ip IN FRAME frame-ip
DO:
HIDE FRAME frame-ip.
ENABLE ALL WITH FRAME {&FRAME-NAME}.
END.
/* Bepalen ip-adres van de server */
cIP = ifunc_ip().
IF LENGTH(TRIM(cIp)) = 0 THEN
DO:
MESSAGE "IP adres voor SERVER niet gevonden !" SKIP "Gelieve deze zelf op te geven !" VIEW-AS ALERT-BOX.
VIEW FRAME frame-ip.
DISABLE ALL WITH FRAME {&FRAME-NAME}.
ENABLE ALL WITH FRAME frame-ip.
WAIT-FOR "tab":U OF fill-in-ip IN FRAME frame-ip.
ASSIGN
cIp = fill-in-ip:SCREEN-VALUE IN FRAME frame-ip.
END.
ASSIGN
fill-in-ip:SCREEN-VALUE IN FRAME {&FRAME-NAME} = "IP-Adres : ":U + cIP + " ServicePoort : 3333":U.
cConnectString = "-H ":U + cIp + " -S 3333 -N tcp":U.
APPLY "choose":U TO button-start.
IF NOT THIS-PROCEDUREERSISTENT THEN
WAIT-FOR CLOSE OF THIS-PROCEDURE.
END.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
/* ********************** Internal Procedures *********************** */
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE connProc C-Win
PROCEDURE connProc :
/*------------------------------------------------------------------------------
Purpose:
Parameters: <none>
Notes:
------------------------------------------------------------------------------*/
/* Connection procedure for server socket */
DEFINE INPUT PARAMETER iphSocket AS HANDLE. /*Socket implicitly created*/
ASSIGN
hSocket = iphSocket.
END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE control_load C-Win _CONTROL-LOAD
PROCEDURE control_load :
/*------------------------------------------------------------------------------
Purpose: Load the OCXs
Parameters: <none>
Notes: Here we load, initialize and make visible the
OCXs in the interface.
------------------------------------------------------------------------------*/
&IF "{&OPSYS}" = "WIN32":U AND "{&WINDOW-SYSTEM}" NE "TTY":U &THEN
DEFINE VARIABLE UIB_S AS LOGICAL NO-UNDO.
DEFINE VARIABLE OCXFile AS CHARACTER NO-UNDO.
OCXFile = SEARCH( "server.wrx":U ).
IF OCXFile = ? THEN
OCXFile = SEARCH(SUBSTRING(THIS-PROCEDURE:FILE-NAME, 1,
R-INDEX(THIS-PROCEDURE:FILE-NAME, ".":U), "CHARACTER":U) + "wrx":U).
IF OCXFile <> ? THEN
DO:
ASSIGN
chCtrlFrame = CtrlFrame:COM-HANDLE
UIB_S = chCtrlFrame:LoadControls( OCXFile, "CtrlFrame":U)
.
RUN initialize-controls IN THIS-PROCEDURE NO-ERROR.
END.
ELSE MESSAGE "server.wrx":U SKIP(1)
"The binary control file could not be found. The controls cannot be loaded."
VIEW-AS ALERT-BOX TITLE "Controls Not Loaded".
&ENDIF
END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI C-Win _DEFAULT-DISABLE
PROCEDURE disable_UI :
/*------------------------------------------------------------------------------
Purpose: DISABLE the User Interface
Parameters: <none>
Notes: Here we clean-up the user-interface by deleting
dynamic widgets we have created and/or hide
frames. This procedure is usually called when
we are ready to "clean-up" after running.
------------------------------------------------------------------------------*/
/* Delete the WINDOW we created */
IF SESSIONISPLAY-TYPE = "GUI":U AND VALID-HANDLE(C-Win)
THEN DELETE WIDGET C-Win.
IF THIS-PROCEDUREERSISTENT THEN DELETE PROCEDURE THIS-PROCEDURE.
END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enable_UI C-Win _DEFAULT-ENABLE
PROCEDURE enable_UI :
/*------------------------------------------------------------------------------
Purpose: ENABLE the User Interface
Parameters: <none>
Notes: Here we display/view/enable the widgets in the
user-interface. In addition, OPEN all queries
associated with each FRAME and BROWSE.
These statements here are based on the "Other
Settings" section of the widget Property Sheets.
------------------------------------------------------------------------------*/
RUN control_load.
DISPLAY SELECT-LOGON FILL-IN-IP FILL-IN-MSG
WITH FRAME DEFAULT-FRAME IN WINDOW C-Win.
ENABLE SELECT-LOGON BUTTON-START BUTTON-SLUIT FILL-IN-IP FILL-IN-MSG
WITH FRAME DEFAULT-FRAME IN WINDOW C-Win.
{&OPEN-BROWSERS-IN-QUERY-DEFAULT-FRAME}
DISPLAY FILL-IN-IP
WITH FRAME FRAME-IP IN WINDOW C-Win.
ENABLE FILL-IN-IP
WITH FRAME FRAME-IP IN WINDOW C-Win.
{&OPEN-BROWSERS-IN-QUERY-FRAME-IP}
VIEW C-Win.
END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE iproc_Logon C-Win
PROCEDURE iproc_Logon :
/*------------------------------------------------------------------------------
Purpose:
Parameters: <none>
Notes:
------------------------------------------------------------------------------*/
IF VALID-HANDLE(hSocket) THEN
DO:
IF hSocket:GET-BYTES-AVAILABLE() > 0 THEN
DO:
/* 64 bytes reserveren voor inkomende string */
SET-SIZE(mBuffer) = 64.
hSocket:READ (mBuffer,1,hSocket:GET-BYTES-AVAILABLE()).
cString = GET-STRING(mBuffer,1). /*Unmarshal data*/
BELL.
SELECT-logon:ADD-LAST(cString) IN FRAME {&FRAME-NAME}.
END.
END.
END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
/* ************************ Function Implementations ***************** */
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION ifunc_ip C-Win
FUNCTION ifunc_ip RETURNS CHARACTER
( /* parameter-definitions */ ) :
/*------------------------------------------------------------------------------
Purpose: Bepaal ip adres server
Notes:
------------------------------------------------------------------------------*/
DEF VAR cLijn AS CHAR NO-UNDO.
DEF VAR cIp AS CHAR NO-UNDO.
DEF VAR iIndex AS INT NO-UNDO.
OS-COMMAND SILENT md C:\TEMP.
OUTPUT TO "C:\TEMP\IPCONFIG.TXT":U.
OS-COMMAND SILENT ipconfig.
OUTPUT CLOSE.
INPUT FROM "C:\TEMP\IPCONFIG.TXT":U.
lus:
REPEAT:
IMPORT UNFORMATTED cLijn.
IF INDEX(cLijn,"IP Address":U) > 0 THEN
DO:
cIp = TRIM(cLijn).
LEAVE lus.
END.
END.
IF LENGTH(cIp) > 0 THEN
DO:
iIndex = INDEX(cIp,":":U).
IF iIndex > 0 THEN
cIp = SUBSTR(cIp,iIndex + 1 ,LENGTH(cIp) - iIndex).
END.
RETURN cIp. /* Function return value. */
END FUNCTION.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
/* Contents of client.w */
&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v9r12 GUI
&ANALYZE-RESUME
&Scoped-define WINDOW-NAME C-Win
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS C-Win
/*------------------------------------------------------------------------
File:
Description:
Input Parameters:
<none>
Output Parameters:
<none>
Author:
Created:
------------------------------------------------------------------------*/
/* This .W file was created with the Progress AppBuilder. */
/*----------------------------------------------------------------------*/
/* Create an unnamed pool to store all the widgets created
by this procedure. This is a good default which assures
that this procedure's triggers and internal procedures
will execute in this procedure's storage, and that proper
cleanup will occur on deletion of the procedure. */
CREATE WIDGET-POOL.
/* *************************** Definitions ************************** */
/* Parameters Definitions --- */
/* Local Variable Definitions --- */
DEFINE VARIABLE hSocket AS HANDLE.
DEFINE VARIABLE aOk AS LOGICAL.
DEFINE VARIABLE mBuffer AS MEMPTR.
DEFINE VARIABLE cString AS CHARACTER.
DEF VAR cIP AS CHAR NO-UNDO.
DEF VAR cConnectString AS CHAR NO-UNDO.
DEF VAR cTime AS CHAR NO-UNDO.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
/* ******************** Preprocessor Definitions ******************** */
&Scoped-define PROCEDURE-TYPE Window
&Scoped-define DB-AWARE no
/* Name of first Frame and/or Browse and/or first Query */
&Scoped-define FRAME-NAME DEFAULT-FRAME
/* Standard List Definitions */
&Scoped-Define ENABLED-OBJECTS BUTTON-SLUITEN
&Scoped-Define DISPLAYED-OBJECTS FILL-IN-USER
/* Custom List Definitions */
/* List-1,List-2,List-3,List-4,List-5,List-6 */
/* _UIB-PREPROCESSOR-BLOCK-END */
&ANALYZE-RESUME
/* ************************ Function Prototypes ********************** */
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD ifunc_ip C-Win
FUNCTION ifunc_ip RETURNS CHARACTER
( /* parameter-definitions */ ) FORWARD.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
/* *********************** Control Definitions ********************** */
/* Define the widget handle for the window */
DEFINE VAR C-Win AS WIDGET-HANDLE NO-UNDO.
/* Definitions of the field level widgets */
DEFINE BUTTON BUTTON-SLUITEN
LABEL "&Sluiten"
SIZE 15 BY 1.14.
DEFINE VARIABLE FILL-IN-USER AS CHARACTER FORMAT "X(256)":U
VIEW-AS FILL-IN NATIVE
SIZE 71 BY 1.43 NO-UNDO.
DEFINE VARIABLE FILL-IN-IP AS CHARACTER FORMAT "X(256)":U
LABEL "IP-Server"
VIEW-AS FILL-IN
SIZE 14 BY 1 NO-UNDO.
DEFINE VARIABLE FILL-IN-LOGON AS CHARACTER FORMAT "X(10)":U
LABEL "User"
VIEW-AS FILL-IN
SIZE 14 BY 1 NO-UNDO.
/* ************************ Frame Definitions *********************** */
DEFINE FRAME DEFAULT-FRAME
FILL-IN-USER AT ROW 3.38 COL 3 NO-LABEL
BUTTON-SLUITEN AT ROW 5.52 COL 31
WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY
SIDE-LABELS NO-UNDERLINE THREE-D
AT COL 1.2 ROW 1
SIZE 74.2 BY 6.67.
DEFINE FRAME FRAME-LOGON
FILL-IN-IP AT ROW 1.71 COL 11 COLON-ALIGNED
FILL-IN-LOGON AT ROW 2.91 COL 11 COLON-ALIGNED
WITH 1 DOWN KEEP-TAB-ORDER OVERLAY
SIDE-LABELS NO-UNDERLINE THREE-D
AT COL 20 ROW 1
SIZE 35 BY 4.29
TITLE "LOGON".
/* *********************** Procedure Settings ************************ */
&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
Type: Window
Allow: Basic,Browse,DB-Fields,Window,Query
Other Settings: COMPILE
*/
&ANALYZE-RESUME _END-PROCEDURE-SETTINGS
/* ************************* Create Window ************************** */
&ANALYZE-SUSPEND _CREATE-WINDOW
IF SESSIONISPLAY-TYPE = "GUI":U THEN
CREATE WINDOW C-Win ASSIGN
HIDDEN = YES
TITLE = "Client"
HEIGHT = 6.43
WIDTH = 74.4
MAX-HEIGHT = 34.33
MAX-WIDTH = 204.8
VIRTUAL-HEIGHT = 34.33
VIRTUAL-WIDTH = 204.8
RESIZE = yes
SCROLL-BARS = no
STATUS-AREA = no
BGCOLOR = ?
FGCOLOR = ?
KEEP-FRAME-Z-ORDER = yes
THREE-D = yes
MESSAGE-AREA = no
SENSITIVE = yes.
ELSE {&WINDOW-NAME} = CURRENT-WINDOW.
/* END WINDOW DEFINITION */
&ANALYZE-RESUME
/* *********** Runtime Attributes and AppBuilder Settings *********** */
&ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
/* SETTINGS FOR WINDOW C-Win
VISIBLE,,RUN-PERSISTENT */
/* REPARENT FRAME */
ASSIGN FRAME FRAME-LOGON:FRAME = FRAME DEFAULT-FRAME:HANDLE.
/* SETTINGS FOR FRAME DEFAULT-FRAME
*/
DEFINE VARIABLE XXTABVALXX AS LOGICAL NO-UNDO.
ASSIGN XXTABVALXX = FRAME FRAME-LOGON:MOVE-BEFORE-TAB-ITEM (FILL-IN-USER:HANDLE IN FRAME DEFAULT-FRAME)
/* END-ASSIGN-TABS */.
/* SETTINGS FOR FILL-IN FILL-IN-USER IN FRAME DEFAULT-FRAME
NO-ENABLE ALIGN-L */
/* SETTINGS FOR FRAME FRAME-LOGON
NOT-VISIBLE */
ASSIGN
FRAME FRAME-LOGON:HIDDEN = TRUE.
IF SESSIONISPLAY-TYPE = "GUI":U AND VALID-HANDLE(C-Win)
THEN C-Win:HIDDEN = no.
/* _RUN-TIME-ATTRIBUTES-END */
&ANALYZE-RESUME
/* ************************ Control Triggers ************************ */
&Scoped-define SELF-NAME C-Win
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL C-Win C-Win
ON END-ERROR OF C-Win /* Client */
OR ENDKEY OF {&WINDOW-NAME} ANYWHERE DO:
/* This case occurs when the user presses the "Esc" key.
In a persistently run window, just ignore this. If we did not, the
application would exit. */
IF THIS-PROCEDUREERSISTENT THEN RETURN NO-APPLY.
END.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL C-Win C-Win
ON WINDOW-CLOSE OF C-Win /* Client */
DO:
/* This event will close the window and terminate the procedure. */
APPLY "CLOSE":U TO THIS-PROCEDURE.
RETURN NO-APPLY.
END.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&Scoped-define SELF-NAME BUTTON-SLUITEN
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL BUTTON-SLUITEN C-Win
ON CHOOSE OF BUTTON-SLUITEN IN FRAME DEFAULT-FRAME /* Sluiten */
DO:
RUN iproc_snd_msg(" logged off", STRING(TIME,"hh:mm:ss":U)).
hSocketISCONNECT().
APPLY "close":u TO THIS-PROCEDURE.
END.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&Scoped-define FRAME-NAME FRAME-LOGON
&Scoped-define SELF-NAME FILL-IN-IP
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL FILL-IN-IP C-Win
ON LEAVE OF FILL-IN-IP IN FRAME FRAME-LOGON /* IP-Server */
DO:
cConnectString = "-H ":U + {&self-name}:SCREEN-VALUE IN FRAME frame-logon + " -S 3333 -N tcp":U.
END.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&Scoped-define FRAME-NAME DEFAULT-FRAME
&UNDEFINE SELF-NAME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK C-Win
/* *************************** Main Block *************************** */
/* Set CURRENT-WINDOW: this will parent dialog-boxes and frames. */
ASSIGN CURRENT-WINDOW = {&WINDOW-NAME}
THIS-PROCEDURE:CURRENT-WINDOW = {&WINDOW-NAME}.
/* The CLOSE event can be used from inside or outside the procedure to */
/* terminate it. */
ON CLOSE OF THIS-PROCEDURE
RUN disable_UI.
/* Best default for GUI applications is... */
PAUSE 0 BEFORE-HIDE.
/* Now enable the interface and wait for the exit condition. */
/* (NOTE: handle ERROR and END-KEY so cleanup code will always fire. */
MAIN-BLOCK:
DO ON ERROR UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK
ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK:
ON 'tab':U OF fill-in-logon IN FRAME frame-logon
DO:
HIDE FRAME frame-logon.
RUN connProc.
RETURN.
END.
RUN enable_UI.
DISABLE ALL WITH FRAME {&FRAME-NAME}.
VIEW FRAME frame-logon.
/* Bepalen ip-adres van de server */
cIP = ifunc_ip().
IF LENGTH(TRIM(cIp)) = 0 THEN
DO:
MESSAGE "IP adres voor SERVER niet gevonden !" VIEW-AS ALERT-BOX.
APPLY "close":U TO THIS-PROCEDURE.
END.
ASSIGN
fill-in-ip:SCREEN-VALUE IN FRAME frame-logon = cIP.
ENABLE ALL WITH FRAME frame-logon.
IF NOT THIS-PROCEDUREERSISTENT THEN
WAIT-FOR CLOSE OF THIS-PROCEDURE.
END.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
/* ********************** Internal Procedures *********************** */
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE connProc C-Win
PROCEDURE connProc :
/*------------------------------------------------------------------------------
Purpose:
Parameters: <none>
Notes:
------------------------------------------------------------------------------*/
/* Connect to service at server */
CREATE SOCKET hSocket.
hSocket:CONNECT (cConnectString).
IF hSocket:CONNECTED() THEN
DO:
ASSIGN
cTime = STRING(TIME,"hh:mm:ss") /* in var, voor zelfde tijd doorsturen naar server */
fill-in-user:SCREEN-VALUE IN FRAME {&FRAME-NAME} = fill-in-logon:SCREEN-VALUE IN FRAME frame-logon + " logged on at " + cTime.
ENABLE ALL WITH FRAME {&FRAME-NAME}.
MESSAGE "Connected OK".
END.
ELSE DO:
MESSAGE "Could not connect".
APPLY "close":u TO THIS-PROCEDURE.
END.
RUN iproc_snd_msg(" logged on",cTime).
END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI C-Win _DEFAULT-DISABLE
PROCEDURE disable_UI :
/*------------------------------------------------------------------------------
Purpose: DISABLE the User Interface
Parameters: <none>
Notes: Here we clean-up the user-interface by deleting
dynamic widgets we have created and/or hide
frames. This procedure is usually called when
we are ready to "clean-up" after running.
------------------------------------------------------------------------------*/
/* Delete the WINDOW we created */
IF SESSIONISPLAY-TYPE = "GUI":U AND VALID-HANDLE(C-Win)
THEN DELETE WIDGET C-Win.
IF THIS-PROCEDUREERSISTENT THEN DELETE PROCEDURE THIS-PROCEDURE.
END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enable_UI C-Win _DEFAULT-ENABLE
PROCEDURE enable_UI :
/*------------------------------------------------------------------------------
Purpose: ENABLE the User Interface
Parameters: <none>
Notes: Here we display/view/enable the widgets in the
user-interface. In addition, OPEN all queries
associated with each FRAME and BROWSE.
These statements here are based on the "Other
Settings" section of the widget Property Sheets.
------------------------------------------------------------------------------*/
DISPLAY FILL-IN-USER
WITH FRAME DEFAULT-FRAME IN WINDOW C-Win.
ENABLE BUTTON-SLUITEN
WITH FRAME DEFAULT-FRAME IN WINDOW C-Win.
{&OPEN-BROWSERS-IN-QUERY-DEFAULT-FRAME}
DISPLAY FILL-IN-IP FILL-IN-LOGON
WITH FRAME FRAME-LOGON IN WINDOW C-Win.
ENABLE FILL-IN-IP FILL-IN-LOGON
WITH FRAME FRAME-LOGON IN WINDOW C-Win.
{&OPEN-BROWSERS-IN-QUERY-FRAME-LOGON}
VIEW C-Win.
END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE iproc_snd_msg C-Win
PROCEDURE iproc_snd_msg :
/*------------------------------------------------------------------------------
Purpose:
Parameters: <none>
Notes:
------------------------------------------------------------------------------*/
DEF INPUT PARAMETER ipcMsg AS CHAR NO-UNDO.
DEF INPUT PARAMETER ipcTime AS CHAR NO-UNDO.
SET-SIZE(mBuffer) = 64.
cString = fill-in-logon:SCREEN-VALUE IN FRAME frame-logon + " " + TRIM(ipcMsg) + " at " + ipcTime.
PUT-STRING(mBuffer,1) = cString.
hSocket:WRITE (mBuffer,1,LENGTH(cString)).
END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
/* ************************ Function Implementations ***************** */
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION ifunc_ip C-Win
FUNCTION ifunc_ip RETURNS CHARACTER
( /* parameter-definitions */ ) :
/*------------------------------------------------------------------------------
Purpose: Bepaal ip adres server
Notes:
------------------------------------------------------------------------------*/
DEF VAR cLijn AS CHAR NO-UNDO.
DEF VAR cIp AS CHAR NO-UNDO.
DEF VAR iIndex AS INT NO-UNDO.
OS-COMMAND SILENT md C:\TEMP.
OUTPUT TO "C:\TEMP\IPCONFIG.TXT":U.
OS-COMMAND SILENT ipconfig.
OUTPUT CLOSE.
INPUT FROM "C:\TEMP\IPCONFIG.TXT":U.
lus:
REPEAT:
IMPORT UNFORMATTED cLijn.
IF INDEX(cLijn,"IP Address":U) > 0 THEN
DO:
cIp = TRIM(cLijn).
LEAVE lus.
END.
END.
IF LENGTH(cIp) > 0 THEN
DO:
iIndex = INDEX(cIp,":":U).
IF iIndex > 0 THEN
cIp = SUBSTR(cIp,iIndex + 1 ,LENGTH(cIp) - iIndex).
END.
RETURN cIp. /* Function return value. */
END FUNCTION.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
A few DAYs agoo I was dooing SOME testing concering PROGRESS sockets
IN v91B. AS an example, i've made a little C/S system which does the next
thing (CODE mentioned below FOR SERVER.w AND client.w):
SERVER.W:
* CHECK IF ip-address OF SERVER IS AVAIL, IF NOT, manual INPUT ip
* Creates a SERVER SOCKET which listens FOR incoming clients
* Puts logon INFO IN a WINDOW list (username AND login TIME)
CLIENT.W
* CHECK IF ip-address OF SERVER IS AVAIL, IF NOT, manual INPUT ip
* sends logon INFO TO SERVER AT login TIME.
* sends logoff INFO TO SERVER AT logoff TIME.
Everything seems TO work smoothly, the SERVER starts UP, clients can LOG ON AND
are viewed IN the window-list OF the SERVER. But there's a slight problem
WITH the logoff PROCEDURE OF the client, only the LAST DISCONNECT fires IF
more THEN one client IS CONNECTED TO the SERVER.
Example: See attached FILE.
Have a Clue ?
Greetings,
Emmanuel Nuyttens
Analist Programmer
C&C Oudenaarde Belgium
/*
Contens OF SERVER.w
*/
&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v9r12 GUI
&ANALYZE-RESUME
&Scoped-define WINDOW-NAME C-Win
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS C-Win
/*------------------------------------------------------------------------
File: server.w
Description: Socket server voorbeeld
Input Parameters:
<none>
Output Parameters:
<none>
Author: emnu
Created: 08/01
------------------------------------------------------------------------*/
/* This .W file was created with the Progress AppBuilder. */
/*----------------------------------------------------------------------*/
/* Create an unnamed pool to store all the widgets created
by this procedure. This is a good default which assures
that this procedure's triggers and internal procedures
will execute in this procedure's storage, and that proper
cleanup will occur on deletion of the procedure. */
CREATE WIDGET-POOL.
/* *************************** Definitions ************************** */
/* Parameters Definitions --- */
/* Local Variable Definitions --- */
DEFINE VARIABLE hServerSocket AS HANDLE.
DEFINE VARIABLE aOk AS LOGICAL.
DEFINE VARIABLE mBuffer AS MEMPTR.
DEFINE VARIABLE cString AS CHAR NO-UNDO.
DEF VAR hSocket AS HANDLE NO-UNDO.
DEF VAR cIP AS CHAR NO-UNDO.
DEF VAR cConnectString AS CHAR NO-UNDO.
DEF VAR hStatus AS HANDLE NO-UNDO.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
/* ******************** Preprocessor Definitions ******************** */
&Scoped-define PROCEDURE-TYPE Window
&Scoped-define DB-AWARE no
/* Name of first Frame and/or Browse and/or first Query */
&Scoped-define FRAME-NAME DEFAULT-FRAME
/* Standard List Definitions */
&Scoped-Define ENABLED-OBJECTS SELECT-LOGON BUTTON-START BUTTON-SLUIT ~
FILL-IN-IP FILL-IN-MSG
&Scoped-Define DISPLAYED-OBJECTS SELECT-LOGON FILL-IN-IP FILL-IN-MSG
/* Custom List Definitions */
/* List-1,List-2,List-3,List-4,List-5,List-6 */
/* _UIB-PREPROCESSOR-BLOCK-END */
&ANALYZE-RESUME
/* ************************ Function Prototypes ********************** */
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD ifunc_ip C-Win
FUNCTION ifunc_ip RETURNS CHARACTER
( /* parameter-definitions */ ) FORWARD.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
/* *********************** Control Definitions ********************** */
/* Define the widget handle for the window */
DEFINE VAR C-Win AS WIDGET-HANDLE NO-UNDO.
/* Definitions of handles for OCX Containers */
DEFINE VARIABLE CtrlFrame AS WIDGET-HANDLE NO-UNDO.
DEFINE VARIABLE chCtrlFrame AS COMPONENT-HANDLE NO-UNDO.
/* Definitions of the field level widgets */
DEFINE BUTTON BUTTON-SLUIT
LABEL "&Sluiten"
SIZE 25 BY 1.14.
DEFINE BUTTON BUTTON-START
LABEL "&Start Server"
SIZE 25 BY 1.14.
DEFINE VARIABLE FILL-IN-IP AS CHARACTER FORMAT "X(256)":U
VIEW-AS TEXT
SIZE 48 BY .62 NO-UNDO.
DEFINE VARIABLE FILL-IN-MSG AS CHARACTER FORMAT "X(256)":U INITIAL "Server STOPT"
VIEW-AS TEXT
SIZE 47 BY .62 NO-UNDO.
DEFINE VARIABLE SELECT-LOGON AS CHARACTER
VIEW-AS SELECTION-LIST SINGLE SCROLLBAR-VERTICAL
SIZE 48 BY 8.1 NO-UNDO.
/* ************************ Frame Definitions *********************** */
DEFINE FRAME DEFAULT-FRAME
SELECT-LOGON AT ROW 1.95 COL 2 NO-LABEL
BUTTON-START AT ROW 10.29 COL 12
BUTTON-SLUIT AT ROW 11.48 COL 12
FILL-IN-IP AT ROW 1.24 COL 2 NO-LABEL
FILL-IN-MSG AT ROW 13.14 COL 3 NO-LABEL
WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY
SIDE-LABELS NO-UNDERLINE THREE-D
AT COL 1 ROW 1
SIZE 51 BY 13.48.
DEFINE FRAME FRAME-IP
FILL-IN-IP AT ROW 1.95 COL 9 COLON-ALIGNED
LABEL "IP-Adres" FORMAT "X(256)":U
VIEW-AS FILL-IN
SIZE 21 BY 1
WITH 1 DOWN KEEP-TAB-ORDER OVERLAY
SIDE-LABELS NO-UNDERLINE THREE-D
AT COL 3 ROW 2.43
SIZE 33 BY 4.29
TITLE "IP".
/* *********************** Procedure Settings ************************ */
&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
Type: Window
Allow: Basic,Browse,DB-Fields,Window,Query
Other Settings: COMPILE
*/
&ANALYZE-RESUME _END-PROCEDURE-SETTINGS
/* ************************* Create Window ************************** */
&ANALYZE-SUSPEND _CREATE-WINDOW
IF SESSION
ISPLAY-TYPE = "GUI":U THENCREATE WINDOW C-Win ASSIGN
HIDDEN = YES
TITLE = "Server"
HEIGHT = 13.38
WIDTH = 51
MAX-HEIGHT = 16
MAX-WIDTH = 80
VIRTUAL-HEIGHT = 16
VIRTUAL-WIDTH = 80
RESIZE = yes
SCROLL-BARS = no
STATUS-AREA = no
BGCOLOR = ?
FGCOLOR = ?
KEEP-FRAME-Z-ORDER = yes
THREE-D = yes
MESSAGE-AREA = no
SENSITIVE = yes.
ELSE {&WINDOW-NAME} = CURRENT-WINDOW.
/* END WINDOW DEFINITION */
&ANALYZE-RESUME
/* *********** Runtime Attributes and AppBuilder Settings *********** */
&ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
/* SETTINGS FOR WINDOW C-Win
VISIBLE,,RUN-PERSISTENT */
/* REPARENT FRAME */
ASSIGN FRAME FRAME-IP:FRAME = FRAME DEFAULT-FRAME:HANDLE.
/* SETTINGS FOR FRAME DEFAULT-FRAME
*/
DEFINE VARIABLE XXTABVALXX AS LOGICAL NO-UNDO.
ASSIGN XXTABVALXX = FRAME FRAME-IP:MOVE-AFTER-TAB-ITEM (SELECT-LOGON:HANDLE IN FRAME DEFAULT-FRAME)
XXTABVALXX = FRAME FRAME-IP:MOVE-BEFORE-TAB-ITEM (BUTTON-START:HANDLE IN FRAME DEFAULT-FRAME)
/* END-ASSIGN-TABS */.
/* SETTINGS FOR FILL-IN FILL-IN-IP IN FRAME DEFAULT-FRAME
ALIGN-L */
/* SETTINGS FOR FILL-IN FILL-IN-MSG IN FRAME DEFAULT-FRAME
ALIGN-L */
/* SETTINGS FOR FRAME FRAME-IP
NOT-VISIBLE */
ASSIGN
FRAME FRAME-IP:HIDDEN = TRUE.
IF SESSION
ISPLAY-TYPE = "GUI":U AND VALID-HANDLE(C-Win)THEN C-Win:HIDDEN = no.
/* _RUN-TIME-ATTRIBUTES-END */
&ANALYZE-RESUME
/* ********************** Create OCX Containers ********************** */
&ANALYZE-SUSPEND _CREATE-DYNAMIC
&IF "{&OPSYS}" = "WIN32":U AND "{&WINDOW-SYSTEM}" NE "TTY":U &THEN
CREATE CONTROL-FRAME CtrlFrame ASSIGN
FRAME = FRAME DEFAULT-FRAME:HANDLE
ROW = 10.52
COLUMN = 44
HEIGHT = 1.33
WIDTH = 5.6
HIDDEN = yes
SENSITIVE = yes.
CtrlFrame:NAME = "CtrlFrame":U .
/* CtrlFrame OCXINFO:CREATE-CONTROL from: {F0B88A90-F5DA-11CF-B545-0020AF6ED35A} type: PSTimer */
CtrlFrame:MOVE-AFTER(BUTTON-START:HANDLE IN FRAME DEFAULT-FRAME).
&ENDIF
&ANALYZE-RESUME /* End of _CREATE-DYNAMIC */
/* ************************ Control Triggers ************************ */
&Scoped-define SELF-NAME C-Win
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL C-Win C-Win
ON END-ERROR OF C-Win /* Server */
OR ENDKEY OF {&WINDOW-NAME} ANYWHERE DO:
/* This case occurs when the user presses the "Esc" key.
In a persistently run window, just ignore this. If we did not, the
application would exit. */
IF THIS-PROCEDURE
ERSISTENT THEN RETURN NO-APPLY.END.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL C-Win C-Win
ON WINDOW-CLOSE OF C-Win /* Server */
DO:
/* This event will close the window and terminate the procedure. */
APPLY "CLOSE":U TO THIS-PROCEDURE.
RETURN NO-APPLY.
END.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&Scoped-define SELF-NAME BUTTON-SLUIT
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL BUTTON-SLUIT C-Win
ON CHOOSE OF BUTTON-SLUIT IN FRAME DEFAULT-FRAME /* Sluiten */
DO:
IF VALID-HANDLE(hServerSocket) THEN
DO:
DELETE OBJECT hServerSocket NO-ERROR.
IF ERROR-STATUS:ERROR THEN
DO:
MESSAGE "Server is nog actief !" VIEW-AS ALERT-BOX.
RETURN NO-APPLY.
END.
END.
APPLY "close":U TO THIS-PROCEDURE.
END.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&Scoped-define SELF-NAME BUTTON-START
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL BUTTON-START C-Win
ON CHOOSE OF BUTTON-START IN FRAME DEFAULT-FRAME /* Start Server */
DO:
/* Creatie van Server Socket */
IF NOT VALID-HANDLE(hServerSocket) THEN
DO:
{&SELF-NAME}:LABEL = "&Stop Server".
CREATE SERVER-SOCKET hServerSocket.
fill-in-msg:SCREEN-VALUE IN FRAME {&FRAME-NAME} = "Server STARTED".
/* Instellen en activeren van connectie procedure */
hServerSocket:SET-CONNECT-PROCEDURE( "connProc":U).
aOk = hServerSocket:ENABLE-CONNECTIONS(cConnectString).
MESSAGE "Enabled connections:" aOk.
IF NOT aOk THEN
RETURN.
RUN adecomm/_statdsp.p (hstatus,1,"Wacht op Connecties ...").
END. ELSE
DO:
IF {&self-name}:LABEL = "&Stop Server" THEN
DO:
{&self-name}:LABEL = "&Start Server".
aOk = hServerSocket
ISABLE-CONNECTIONS().MESSAGE "Disabled connections:" aOk.
IF NOT aOk THEN
RETURN.
ELSE
fill-in-msg:SCREEN-VALUE IN FRAME {&FRAME-NAME} = "Server STOPPED".
RUN adecomm/_statdsp.p (hstatus,1,"Wacht op Connecties INACTIEF...").
END. ELSE DO:
{&self-name}:LABEL = "&Stop Server".
aOk = hServerSocket:ENABLE-CONNECTIONS(cConnectString).
MESSAGE "Enabled connections:" aOk.
IF NOT aOk THEN
RETURN.
ELSE
fill-in-msg:SCREEN-VALUE IN FRAME {&FRAME-NAME} = "Server STARTED".
RUN adecomm/_statdsp.p (hstatus,1,"Wacht op Connecties ...").
END.
END.
END.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&Scoped-define SELF-NAME CtrlFrame
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL CtrlFrame C-Win OCX.Tick
PROCEDURE CtrlFrame.PSTimer.Tick .
/*------------------------------------------------------------------------------
Purpose:
Parameters: None required for OCX.
Notes:
------------------------------------------------------------------------------*/
RUN iproc_Logon.
END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&UNDEFINE SELF-NAME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK C-Win
/* *************************** Main Block *************************** */
/* Set CURRENT-WINDOW: this will parent dialog-boxes and frames. */
ASSIGN CURRENT-WINDOW = {&WINDOW-NAME}
THIS-PROCEDURE:CURRENT-WINDOW = {&WINDOW-NAME}.
/* The CLOSE event can be used from inside or outside the procedure to */
/* terminate it. */
ON CLOSE OF THIS-PROCEDURE
RUN disable_UI.
/* Best default for GUI applications is... */
PAUSE 0 BEFORE-HIDE.
/* Now enable the interface and wait for the exit condition. */
/* (NOTE: handle ERROR and END-KEY so cleanup code will always fire. */
MAIN-BLOCK:
DO ON ERROR UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK
ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK:
RUN enable_UI.
ON 'tab':U OF fill-in-ip IN FRAME frame-ip
DO:
HIDE FRAME frame-ip.
ENABLE ALL WITH FRAME {&FRAME-NAME}.
END.
/* Bepalen ip-adres van de server */
cIP = ifunc_ip().
IF LENGTH(TRIM(cIp)) = 0 THEN
DO:
MESSAGE "IP adres voor SERVER niet gevonden !" SKIP "Gelieve deze zelf op te geven !" VIEW-AS ALERT-BOX.
VIEW FRAME frame-ip.
DISABLE ALL WITH FRAME {&FRAME-NAME}.
ENABLE ALL WITH FRAME frame-ip.
WAIT-FOR "tab":U OF fill-in-ip IN FRAME frame-ip.
ASSIGN
cIp = fill-in-ip:SCREEN-VALUE IN FRAME frame-ip.
END.
ASSIGN
fill-in-ip:SCREEN-VALUE IN FRAME {&FRAME-NAME} = "IP-Adres : ":U + cIP + " ServicePoort : 3333":U.
cConnectString = "-H ":U + cIp + " -S 3333 -N tcp":U.
APPLY "choose":U TO button-start.
IF NOT THIS-PROCEDURE
ERSISTENT THENWAIT-FOR CLOSE OF THIS-PROCEDURE.
END.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
/* ********************** Internal Procedures *********************** */
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE connProc C-Win
PROCEDURE connProc :
/*------------------------------------------------------------------------------
Purpose:
Parameters: <none>
Notes:
------------------------------------------------------------------------------*/
/* Connection procedure for server socket */
DEFINE INPUT PARAMETER iphSocket AS HANDLE. /*Socket implicitly created*/
ASSIGN
hSocket = iphSocket.
END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE control_load C-Win _CONTROL-LOAD
PROCEDURE control_load :
/*------------------------------------------------------------------------------
Purpose: Load the OCXs
Parameters: <none>
Notes: Here we load, initialize and make visible the
OCXs in the interface.
------------------------------------------------------------------------------*/
&IF "{&OPSYS}" = "WIN32":U AND "{&WINDOW-SYSTEM}" NE "TTY":U &THEN
DEFINE VARIABLE UIB_S AS LOGICAL NO-UNDO.
DEFINE VARIABLE OCXFile AS CHARACTER NO-UNDO.
OCXFile = SEARCH( "server.wrx":U ).
IF OCXFile = ? THEN
OCXFile = SEARCH(SUBSTRING(THIS-PROCEDURE:FILE-NAME, 1,
R-INDEX(THIS-PROCEDURE:FILE-NAME, ".":U), "CHARACTER":U) + "wrx":U).
IF OCXFile <> ? THEN
DO:
ASSIGN
chCtrlFrame = CtrlFrame:COM-HANDLE
UIB_S = chCtrlFrame:LoadControls( OCXFile, "CtrlFrame":U)
.
RUN initialize-controls IN THIS-PROCEDURE NO-ERROR.
END.
ELSE MESSAGE "server.wrx":U SKIP(1)
"The binary control file could not be found. The controls cannot be loaded."
VIEW-AS ALERT-BOX TITLE "Controls Not Loaded".
&ENDIF
END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI C-Win _DEFAULT-DISABLE
PROCEDURE disable_UI :
/*------------------------------------------------------------------------------
Purpose: DISABLE the User Interface
Parameters: <none>
Notes: Here we clean-up the user-interface by deleting
dynamic widgets we have created and/or hide
frames. This procedure is usually called when
we are ready to "clean-up" after running.
------------------------------------------------------------------------------*/
/* Delete the WINDOW we created */
IF SESSION
ISPLAY-TYPE = "GUI":U AND VALID-HANDLE(C-Win)THEN DELETE WIDGET C-Win.
IF THIS-PROCEDURE
ERSISTENT THEN DELETE PROCEDURE THIS-PROCEDURE.END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enable_UI C-Win _DEFAULT-ENABLE
PROCEDURE enable_UI :
/*------------------------------------------------------------------------------
Purpose: ENABLE the User Interface
Parameters: <none>
Notes: Here we display/view/enable the widgets in the
user-interface. In addition, OPEN all queries
associated with each FRAME and BROWSE.
These statements here are based on the "Other
Settings" section of the widget Property Sheets.
------------------------------------------------------------------------------*/
RUN control_load.
DISPLAY SELECT-LOGON FILL-IN-IP FILL-IN-MSG
WITH FRAME DEFAULT-FRAME IN WINDOW C-Win.
ENABLE SELECT-LOGON BUTTON-START BUTTON-SLUIT FILL-IN-IP FILL-IN-MSG
WITH FRAME DEFAULT-FRAME IN WINDOW C-Win.
{&OPEN-BROWSERS-IN-QUERY-DEFAULT-FRAME}
DISPLAY FILL-IN-IP
WITH FRAME FRAME-IP IN WINDOW C-Win.
ENABLE FILL-IN-IP
WITH FRAME FRAME-IP IN WINDOW C-Win.
{&OPEN-BROWSERS-IN-QUERY-FRAME-IP}
VIEW C-Win.
END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE iproc_Logon C-Win
PROCEDURE iproc_Logon :
/*------------------------------------------------------------------------------
Purpose:
Parameters: <none>
Notes:
------------------------------------------------------------------------------*/
IF VALID-HANDLE(hSocket) THEN
DO:
IF hSocket:GET-BYTES-AVAILABLE() > 0 THEN
DO:
/* 64 bytes reserveren voor inkomende string */
SET-SIZE(mBuffer) = 64.
hSocket:READ (mBuffer,1,hSocket:GET-BYTES-AVAILABLE()).
cString = GET-STRING(mBuffer,1). /*Unmarshal data*/
BELL.
SELECT-logon:ADD-LAST(cString) IN FRAME {&FRAME-NAME}.
END.
END.
END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
/* ************************ Function Implementations ***************** */
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION ifunc_ip C-Win
FUNCTION ifunc_ip RETURNS CHARACTER
( /* parameter-definitions */ ) :
/*------------------------------------------------------------------------------
Purpose: Bepaal ip adres server
Notes:
------------------------------------------------------------------------------*/
DEF VAR cLijn AS CHAR NO-UNDO.
DEF VAR cIp AS CHAR NO-UNDO.
DEF VAR iIndex AS INT NO-UNDO.
OS-COMMAND SILENT md C:\TEMP.
OUTPUT TO "C:\TEMP\IPCONFIG.TXT":U.
OS-COMMAND SILENT ipconfig.
OUTPUT CLOSE.
INPUT FROM "C:\TEMP\IPCONFIG.TXT":U.
lus:
REPEAT:
IMPORT UNFORMATTED cLijn.
IF INDEX(cLijn,"IP Address":U) > 0 THEN
DO:
cIp = TRIM(cLijn).
LEAVE lus.
END.
END.
IF LENGTH(cIp) > 0 THEN
DO:
iIndex = INDEX(cIp,":":U).
IF iIndex > 0 THEN
cIp = SUBSTR(cIp,iIndex + 1 ,LENGTH(cIp) - iIndex).
END.
RETURN cIp. /* Function return value. */
END FUNCTION.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
/* Contents of client.w */
&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v9r12 GUI
&ANALYZE-RESUME
&Scoped-define WINDOW-NAME C-Win
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS C-Win
/*------------------------------------------------------------------------
File:
Description:
Input Parameters:
<none>
Output Parameters:
<none>
Author:
Created:
------------------------------------------------------------------------*/
/* This .W file was created with the Progress AppBuilder. */
/*----------------------------------------------------------------------*/
/* Create an unnamed pool to store all the widgets created
by this procedure. This is a good default which assures
that this procedure's triggers and internal procedures
will execute in this procedure's storage, and that proper
cleanup will occur on deletion of the procedure. */
CREATE WIDGET-POOL.
/* *************************** Definitions ************************** */
/* Parameters Definitions --- */
/* Local Variable Definitions --- */
DEFINE VARIABLE hSocket AS HANDLE.
DEFINE VARIABLE aOk AS LOGICAL.
DEFINE VARIABLE mBuffer AS MEMPTR.
DEFINE VARIABLE cString AS CHARACTER.
DEF VAR cIP AS CHAR NO-UNDO.
DEF VAR cConnectString AS CHAR NO-UNDO.
DEF VAR cTime AS CHAR NO-UNDO.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
/* ******************** Preprocessor Definitions ******************** */
&Scoped-define PROCEDURE-TYPE Window
&Scoped-define DB-AWARE no
/* Name of first Frame and/or Browse and/or first Query */
&Scoped-define FRAME-NAME DEFAULT-FRAME
/* Standard List Definitions */
&Scoped-Define ENABLED-OBJECTS BUTTON-SLUITEN
&Scoped-Define DISPLAYED-OBJECTS FILL-IN-USER
/* Custom List Definitions */
/* List-1,List-2,List-3,List-4,List-5,List-6 */
/* _UIB-PREPROCESSOR-BLOCK-END */
&ANALYZE-RESUME
/* ************************ Function Prototypes ********************** */
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD ifunc_ip C-Win
FUNCTION ifunc_ip RETURNS CHARACTER
( /* parameter-definitions */ ) FORWARD.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
/* *********************** Control Definitions ********************** */
/* Define the widget handle for the window */
DEFINE VAR C-Win AS WIDGET-HANDLE NO-UNDO.
/* Definitions of the field level widgets */
DEFINE BUTTON BUTTON-SLUITEN
LABEL "&Sluiten"
SIZE 15 BY 1.14.
DEFINE VARIABLE FILL-IN-USER AS CHARACTER FORMAT "X(256)":U
VIEW-AS FILL-IN NATIVE
SIZE 71 BY 1.43 NO-UNDO.
DEFINE VARIABLE FILL-IN-IP AS CHARACTER FORMAT "X(256)":U
LABEL "IP-Server"
VIEW-AS FILL-IN
SIZE 14 BY 1 NO-UNDO.
DEFINE VARIABLE FILL-IN-LOGON AS CHARACTER FORMAT "X(10)":U
LABEL "User"
VIEW-AS FILL-IN
SIZE 14 BY 1 NO-UNDO.
/* ************************ Frame Definitions *********************** */
DEFINE FRAME DEFAULT-FRAME
FILL-IN-USER AT ROW 3.38 COL 3 NO-LABEL
BUTTON-SLUITEN AT ROW 5.52 COL 31
WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY
SIDE-LABELS NO-UNDERLINE THREE-D
AT COL 1.2 ROW 1
SIZE 74.2 BY 6.67.
DEFINE FRAME FRAME-LOGON
FILL-IN-IP AT ROW 1.71 COL 11 COLON-ALIGNED
FILL-IN-LOGON AT ROW 2.91 COL 11 COLON-ALIGNED
WITH 1 DOWN KEEP-TAB-ORDER OVERLAY
SIDE-LABELS NO-UNDERLINE THREE-D
AT COL 20 ROW 1
SIZE 35 BY 4.29
TITLE "LOGON".
/* *********************** Procedure Settings ************************ */
&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
Type: Window
Allow: Basic,Browse,DB-Fields,Window,Query
Other Settings: COMPILE
*/
&ANALYZE-RESUME _END-PROCEDURE-SETTINGS
/* ************************* Create Window ************************** */
&ANALYZE-SUSPEND _CREATE-WINDOW
IF SESSION
ISPLAY-TYPE = "GUI":U THENCREATE WINDOW C-Win ASSIGN
HIDDEN = YES
TITLE = "Client"
HEIGHT = 6.43
WIDTH = 74.4
MAX-HEIGHT = 34.33
MAX-WIDTH = 204.8
VIRTUAL-HEIGHT = 34.33
VIRTUAL-WIDTH = 204.8
RESIZE = yes
SCROLL-BARS = no
STATUS-AREA = no
BGCOLOR = ?
FGCOLOR = ?
KEEP-FRAME-Z-ORDER = yes
THREE-D = yes
MESSAGE-AREA = no
SENSITIVE = yes.
ELSE {&WINDOW-NAME} = CURRENT-WINDOW.
/* END WINDOW DEFINITION */
&ANALYZE-RESUME
/* *********** Runtime Attributes and AppBuilder Settings *********** */
&ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
/* SETTINGS FOR WINDOW C-Win
VISIBLE,,RUN-PERSISTENT */
/* REPARENT FRAME */
ASSIGN FRAME FRAME-LOGON:FRAME = FRAME DEFAULT-FRAME:HANDLE.
/* SETTINGS FOR FRAME DEFAULT-FRAME
*/
DEFINE VARIABLE XXTABVALXX AS LOGICAL NO-UNDO.
ASSIGN XXTABVALXX = FRAME FRAME-LOGON:MOVE-BEFORE-TAB-ITEM (FILL-IN-USER:HANDLE IN FRAME DEFAULT-FRAME)
/* END-ASSIGN-TABS */.
/* SETTINGS FOR FILL-IN FILL-IN-USER IN FRAME DEFAULT-FRAME
NO-ENABLE ALIGN-L */
/* SETTINGS FOR FRAME FRAME-LOGON
NOT-VISIBLE */
ASSIGN
FRAME FRAME-LOGON:HIDDEN = TRUE.
IF SESSION
ISPLAY-TYPE = "GUI":U AND VALID-HANDLE(C-Win)THEN C-Win:HIDDEN = no.
/* _RUN-TIME-ATTRIBUTES-END */
&ANALYZE-RESUME
/* ************************ Control Triggers ************************ */
&Scoped-define SELF-NAME C-Win
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL C-Win C-Win
ON END-ERROR OF C-Win /* Client */
OR ENDKEY OF {&WINDOW-NAME} ANYWHERE DO:
/* This case occurs when the user presses the "Esc" key.
In a persistently run window, just ignore this. If we did not, the
application would exit. */
IF THIS-PROCEDURE
ERSISTENT THEN RETURN NO-APPLY.END.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL C-Win C-Win
ON WINDOW-CLOSE OF C-Win /* Client */
DO:
/* This event will close the window and terminate the procedure. */
APPLY "CLOSE":U TO THIS-PROCEDURE.
RETURN NO-APPLY.
END.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&Scoped-define SELF-NAME BUTTON-SLUITEN
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL BUTTON-SLUITEN C-Win
ON CHOOSE OF BUTTON-SLUITEN IN FRAME DEFAULT-FRAME /* Sluiten */
DO:
RUN iproc_snd_msg(" logged off", STRING(TIME,"hh:mm:ss":U)).
hSocket
ISCONNECT().APPLY "close":u TO THIS-PROCEDURE.
END.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&Scoped-define FRAME-NAME FRAME-LOGON
&Scoped-define SELF-NAME FILL-IN-IP
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL FILL-IN-IP C-Win
ON LEAVE OF FILL-IN-IP IN FRAME FRAME-LOGON /* IP-Server */
DO:
cConnectString = "-H ":U + {&self-name}:SCREEN-VALUE IN FRAME frame-logon + " -S 3333 -N tcp":U.
END.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&Scoped-define FRAME-NAME DEFAULT-FRAME
&UNDEFINE SELF-NAME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK C-Win
/* *************************** Main Block *************************** */
/* Set CURRENT-WINDOW: this will parent dialog-boxes and frames. */
ASSIGN CURRENT-WINDOW = {&WINDOW-NAME}
THIS-PROCEDURE:CURRENT-WINDOW = {&WINDOW-NAME}.
/* The CLOSE event can be used from inside or outside the procedure to */
/* terminate it. */
ON CLOSE OF THIS-PROCEDURE
RUN disable_UI.
/* Best default for GUI applications is... */
PAUSE 0 BEFORE-HIDE.
/* Now enable the interface and wait for the exit condition. */
/* (NOTE: handle ERROR and END-KEY so cleanup code will always fire. */
MAIN-BLOCK:
DO ON ERROR UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK
ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK:
ON 'tab':U OF fill-in-logon IN FRAME frame-logon
DO:
HIDE FRAME frame-logon.
RUN connProc.
RETURN.
END.
RUN enable_UI.
DISABLE ALL WITH FRAME {&FRAME-NAME}.
VIEW FRAME frame-logon.
/* Bepalen ip-adres van de server */
cIP = ifunc_ip().
IF LENGTH(TRIM(cIp)) = 0 THEN
DO:
MESSAGE "IP adres voor SERVER niet gevonden !" VIEW-AS ALERT-BOX.
APPLY "close":U TO THIS-PROCEDURE.
END.
ASSIGN
fill-in-ip:SCREEN-VALUE IN FRAME frame-logon = cIP.
ENABLE ALL WITH FRAME frame-logon.
IF NOT THIS-PROCEDURE
ERSISTENT THENWAIT-FOR CLOSE OF THIS-PROCEDURE.
END.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
/* ********************** Internal Procedures *********************** */
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE connProc C-Win
PROCEDURE connProc :
/*------------------------------------------------------------------------------
Purpose:
Parameters: <none>
Notes:
------------------------------------------------------------------------------*/
/* Connect to service at server */
CREATE SOCKET hSocket.
hSocket:CONNECT (cConnectString).
IF hSocket:CONNECTED() THEN
DO:
ASSIGN
cTime = STRING(TIME,"hh:mm:ss") /* in var, voor zelfde tijd doorsturen naar server */
fill-in-user:SCREEN-VALUE IN FRAME {&FRAME-NAME} = fill-in-logon:SCREEN-VALUE IN FRAME frame-logon + " logged on at " + cTime.
ENABLE ALL WITH FRAME {&FRAME-NAME}.
MESSAGE "Connected OK".
END.
ELSE DO:
MESSAGE "Could not connect".
APPLY "close":u TO THIS-PROCEDURE.
END.
RUN iproc_snd_msg(" logged on",cTime).
END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI C-Win _DEFAULT-DISABLE
PROCEDURE disable_UI :
/*------------------------------------------------------------------------------
Purpose: DISABLE the User Interface
Parameters: <none>
Notes: Here we clean-up the user-interface by deleting
dynamic widgets we have created and/or hide
frames. This procedure is usually called when
we are ready to "clean-up" after running.
------------------------------------------------------------------------------*/
/* Delete the WINDOW we created */
IF SESSION
ISPLAY-TYPE = "GUI":U AND VALID-HANDLE(C-Win)THEN DELETE WIDGET C-Win.
IF THIS-PROCEDURE
ERSISTENT THEN DELETE PROCEDURE THIS-PROCEDURE.END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enable_UI C-Win _DEFAULT-ENABLE
PROCEDURE enable_UI :
/*------------------------------------------------------------------------------
Purpose: ENABLE the User Interface
Parameters: <none>
Notes: Here we display/view/enable the widgets in the
user-interface. In addition, OPEN all queries
associated with each FRAME and BROWSE.
These statements here are based on the "Other
Settings" section of the widget Property Sheets.
------------------------------------------------------------------------------*/
DISPLAY FILL-IN-USER
WITH FRAME DEFAULT-FRAME IN WINDOW C-Win.
ENABLE BUTTON-SLUITEN
WITH FRAME DEFAULT-FRAME IN WINDOW C-Win.
{&OPEN-BROWSERS-IN-QUERY-DEFAULT-FRAME}
DISPLAY FILL-IN-IP FILL-IN-LOGON
WITH FRAME FRAME-LOGON IN WINDOW C-Win.
ENABLE FILL-IN-IP FILL-IN-LOGON
WITH FRAME FRAME-LOGON IN WINDOW C-Win.
{&OPEN-BROWSERS-IN-QUERY-FRAME-LOGON}
VIEW C-Win.
END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE iproc_snd_msg C-Win
PROCEDURE iproc_snd_msg :
/*------------------------------------------------------------------------------
Purpose:
Parameters: <none>
Notes:
------------------------------------------------------------------------------*/
DEF INPUT PARAMETER ipcMsg AS CHAR NO-UNDO.
DEF INPUT PARAMETER ipcTime AS CHAR NO-UNDO.
SET-SIZE(mBuffer) = 64.
cString = fill-in-logon:SCREEN-VALUE IN FRAME frame-logon + " " + TRIM(ipcMsg) + " at " + ipcTime.
PUT-STRING(mBuffer,1) = cString.
hSocket:WRITE (mBuffer,1,LENGTH(cString)).
END PROCEDURE.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME
/* ************************ Function Implementations ***************** */
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION ifunc_ip C-Win
FUNCTION ifunc_ip RETURNS CHARACTER
( /* parameter-definitions */ ) :
/*------------------------------------------------------------------------------
Purpose: Bepaal ip adres server
Notes:
------------------------------------------------------------------------------*/
DEF VAR cLijn AS CHAR NO-UNDO.
DEF VAR cIp AS CHAR NO-UNDO.
DEF VAR iIndex AS INT NO-UNDO.
OS-COMMAND SILENT md C:\TEMP.
OUTPUT TO "C:\TEMP\IPCONFIG.TXT":U.
OS-COMMAND SILENT ipconfig.
OUTPUT CLOSE.
INPUT FROM "C:\TEMP\IPCONFIG.TXT":U.
lus:
REPEAT:
IMPORT UNFORMATTED cLijn.
IF INDEX(cLijn,"IP Address":U) > 0 THEN
DO:
cIp = TRIM(cLijn).
LEAVE lus.
END.
END.
IF LENGTH(cIp) > 0 THEN
DO:
iIndex = INDEX(cIp,":":U).
IF iIndex > 0 THEN
cIp = SUBSTR(cIp,iIndex + 1 ,LENGTH(cIp) - iIndex).
END.
RETURN cIp. /* Function return value. */
END FUNCTION.
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME