The mfclient and mfserver modules pass information to each other via a parameter block described in the mfclisrv.cpy copyfile. The modules use the same parameter block, LNK-PARAM-BLOCK, to pass information to user programs.
You must add code to your program, as in the example below, to enable it to pass parameters to mfclient.
$SET ANS85
WORKING-STORAGE SECTION. ......
*--- mfclisrv.cpy must be included in the working storage
*--- section of the client program and in the linkage
*--- section of the server program.
COPY "MFCLISRV.CPY".
LINKAGE SECTION. ......
*--- Input-Rec is the area used for transfering data
*--- between the user client and the server programs.
*--- The size of this data area is defined by the user
*--- in the Client/Server Binding configuration file
*--- which is read by the mfclient module. mfclient
*--- sets up the required memory for this area and
*--- returns a pointer to this area back to the user
*--- client program (see below).
01 INPUT-REC PIC X(32767)
PROCEDURE DIVISION.
CLIENT-CONTROL SECTION.
PERFORM UNTIL END-CONNECTION
*--- lnk-client holds the name "mfclient".
*--- The first time through we initialize mfclient and
*--- establish contact with the server.
CALL LNK-CLIENT USING LNK-PARAM-BLOCK
EVALUATE TRUE
*--- Make the user data area (Input-Rec) accessible by
*--- assigning the address returned by mfclient.
WHEN START-CONNECTION
SET ADDRESS OF INPUT-REC TO LNK-DBLOCK-PTR
WHEN END-CONNECTION
EXIT PERFORM
WHEN OTHER
*--- Perform your application client logic. For example,
*--- display and accept user interface data.
......
END-EVALUATE
*--- Set a user defined flag (eg. EXIT-FLG-TRUE) to indicate
*--- that client processing has terminated. For example, you
*--- may have clicked on the EXIT push button on your
*--- application interface.
IF EXIT-FLG-TRUE
SET CLIENT-ENDING TO TRUE
END-IF
END-PERFORM.
CLIENT-CONTROL-END.
STOP RUN.
If you want to control the number of clients running an application, or you choose to handle error message displays yourself, you will need to add code similar to the following to your program's initial EVALUATE statement:
WHEN TOO-MANY-CLIENTS
PERFORM OVER-CLIENT-LIMIT
WHEN COMMS-ERROR
PERFORM SHOW-ERROR
......
OVER-CLIENT-LIMIT SECTION.
DISPLAY SPACES AT 0101 WITH BACKGROUND-COLOR 7
"MAXIMUM NUMBER OF CLIENTS EXCEEDED - SESSION ENDED"
AT 1012 WITH FOREGROUND-COLOR 4
SET EXIT-FLG-TRUE
SET CLIENT-ENDING TO TRUE
EXIT.
SHOW-ERROR SECTION.
DISPLAY LNK-ERROR-LOC AT 2201
DISPLAY LNK-ERROR-MSG AT 2301
WITH SIZE LNK-ERROR-MSG-LEN.
EXIT.
If asynchronous requests are to be handled, you must add to the EVALUATE statement additional code similar to the following:
WHEN START-CONNECTION
PERFORM GET-USER-INPUT
IF MAKE-ASYNC-REQUEST <* user asynchronous option
SET ASYNC-REQUEST TO TRUE
END-IF
WHEN ASYNC-OK
SET TEST-ASYNC-RESULT TO TRUE
PERFORM DELAY-LOOP
WHEN ASYNC-INCOMPLETE
DISPLAY "REQUEST STILL BEING PROCESSED" AT 1010
PERFORM DELAY-LOOP
SET TEST-ASYNC-RESULT TO TRUE
WHEN RESULT-OK
DISPLAY "REQUEST-COMPLETED " AT 1010
PERFORM GET-USER-INPUT
WHEN ASYNC-NOT-STARTED
WHEN ASYNC-FAILED
DISPLAY "ASYNCHRONOUS REQUEST FAILURE " AT 1010
PERFORM SHOW-ERROR
PERFORM GET-USER-INPUT
WHEN COMMS-ERROR
PERFORM SHOW-ERROR