home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
o22516d1.zip
/
DSDEMO.@IP
/
DSSERVER.CBL
< prev
next >
Wrap
Text File
|
1992-07-29
|
8KB
|
212 lines
$SET MF
IDENTIFICATION DIVISION.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SPECIAL-NAMES.
CALL-CONVENTION 3 IS API.
WORKING-STORAGE SECTION.
01 LOCALS.
05 INFO1 PIC X(80).
05 MAX-LENGTH PIC X(4) COMP-5.
05 WS-LENGTH PIC X(4) COMP-5.
05 SERVER-NAME PIC X(8) VALUE "CCIECI".
05 SESSION-ID PIC X(4) COMP-5 VALUE 0.
05 HANDLE1 PIC X(4) COMP-5 VALUE 0.
COPY CCISIGNA.
COPY 'FAAECIW.CBL'.
01 CICS-ENTRY-POINT PROCEDURE-POINTER.
01 ECI-ERR-MSG-LINE.
05 ECI-ERR-MSG-CODE PIC 9(4).
05 ECI-ERR-MSG-DATA PIC X(30).
COPY COMMAREA.
LINKAGE SECTION.
COPY CCITABLE.
PROCEDURE DIVISION.
PERFORM 100-START
PERFORM 200-CALL-ECI UNTIL COMM-REQUEST EQUAL 4
PERFORM 300-CLOSE
PERFORM MAIN-EXIT
.
****************************************************************
100-START SECTION.
INITIALIZE COMM-AREA
ECI-PARMS
ECI-ERROR-ID
* THE FOLLOWING LINE
* CAUSES THE DLL FILE FAACICS.DLL TO BE PRELOADED BY THE
* COBOL RUNTIME SYSTEM. IF THIS IS NOT DONE THEN THE
* FOLLOWING CALL TO '_FAAECI' WILL GENERATE A FILE NOT FOUND
* MESSAGE, DURING ANIMATION. THIS ERROR WILL NOT OCCUR IF
* THE PROGRAM IS COMPILED TO OBJ THEN LINKED AS AN EXE.
*
SET CICS-ENTRY-POINT TO ENTRY "FAACICS.DLL".
*
* JUST CALLING THIS TO PRE-LOAD CUSTIO SINCE YOU WILL PROBABLY
* MARK IT AS RESIDENT IN THE PPT AND ALSO TO MAKE SURE CICS OS/2
* IS FUNCTIONAL.
*
MOVE 'CUSTIO' TO ECI-PROGRAM-NAME
MOVE 'SYSAD' TO ECI-USERID
MOVE 'SYSAD' TO ECI-PASSWORD
SET ECI-COMMAREA TO ADDRESS OF COMM-AREA
MOVE LENGTH OF COMM-AREA TO ECI-COMMAREA-LENGTH
WS-LENGTH
MAX-LENGTH
CALL '_FAAECI' USING ECI-PARMS
END-CALL
PERFORM CHECK-ECI-RETURN
CALL API "CCINAMP" USING BY REFERENCE SIGNATURE-BLOCK
IF CCITYPE NOT = "NAMP"
DISPLAY 'ERROR IN CCI SIGNATURE'
GO TO MAIN-EXIT
END-IF
SET ADDRESS OF CALTAB TO CCICALTAB
CALL API CCI-INITSERVER USING BY REFERENCE SERVER-NAME
BY REFERENCE HANDLE1
BY VALUE 0 SIZE 4
IF RETURN-CODE NOT = 0
PERFORM GET-CCI-ERROR
DISPLAY INFO1 AT LINE NUMBER 15 COLUMN 1
DISPLAY "Error on return from CCI-INITSERVER"
AT LINE NUMBER 15 COLUMN 1
GO TO MAIN-EXIT
END-IF
.
****************************************************************
200-CALL-ECI SECTION.
CALL API CCI-RECEIVEALL USING BY VALUE HANDLE1
BY REFERENCE SESSION-ID
BY REFERENCE COMM-AREA
BY VALUE MAX-LENGTH
BY REFERENCE WS-LENGTH
BY VALUE 0 SIZE 4
BY VALUE 0 SIZE 4
IF RETURN-CODE NOT = 0
PERFORM GET-CCI-ERROR
DISPLAY INFO1 AT LINE NUMBER 15 COLUMN 1
DISPLAY "Error on return from CCI-RECEIVEALL"
AT LINE NUMBER 15 COLUMN 1
END-IF
IF COMM-REQUEST EQUAL 2
MOVE LENGTH OF COMM-AREA TO ECI-COMMAREA-LENGTH
CALL '_FAAECI' USING ECI-PARMS
END-CALL
PERFORM CHECK-ECI-RETURN
END-IF
CALL API CCI-SEND USING BY VALUE SESSION-ID
BY REFERENCE COMM-AREA
BY VALUE WS-LENGTH
BY VALUE 0 SIZE 4
BY VALUE 0 SIZE 4
CALL API CCI-SUSPENDSERVER USING BY VALUE SESSION-ID
IF RETURN-CODE NOT = 0
PERFORM GET-CCI-ERROR
DISPLAY INFO1 AT LINE NUMBER 15 COLUMN 1
DISPLAY "Error on return from CCI-SUSPENDSERVER"
AT LINE NUMBER 15 COLUMN 1
GO TO MAIN-EXIT
END-IF
IF COMM-REQUEST EQUAL 3 OR 4
CALL API CCI-HANGUP USING BY VALUE SESSION-ID
IF RETURN-CODE NOT = 0
PERFORM GET-CCI-ERROR
DISPLAY INFO1 AT LINE NUMBER 15 COLUMN 1
DISPLAY "Error on return from CCI-HANGUP"
AT LINE NUMBER 15 COLUMN 1
GO TO MAIN-EXIT
END-IF
END-IF
.
*---------------------------------------------------------------*
CHECK-ECI-RETURN SECTION.
EVALUATE TRUE
WHEN ECI-NO-ERROR
NEXT SENTENCE
WHEN ECI-ERR-INVALID-DATA-LENGTH
MOVE ' ECI-ERR-INVALID-DATA-LENGTH' TO
ECI-ERR-MSG-DATA
WHEN ECI-ERR-INVALID-EXTEND-MODE
MOVE ' ECI-ERR-INVALID-EXTEND-MODE' TO
ECI-ERR-MSG-DATA
WHEN ECI-ERR-NO-CICS
MOVE ' ECI-ERR-NO-CICS' TO
ECI-ERR-MSG-DATA
WHEN ECI-ERR-CICS-DIED
MOVE ' ECI-ERR-CICS-DIED' TO
ECI-ERR-MSG-DATA
WHEN ECI-ERR-REQUEST-TIMEOUT
MOVE ' ECI-ERR-REQUEST-TIMEOUT' TO
ECI-ERR-MSG-DATA
WHEN ECI-ERR-RESPONSE-TIMEOUT
MOVE ' ECI-ERR-RESPONSE-TIMEOUT' TO
ECI-ERR-MSG-DATA
WHEN ECI-ERR-TRANSACTION-ABEND
MOVE ' ECI-ERR-TRANSACTION-ABEND' TO
ECI-ERR-MSG-DATA
WHEN ECI-ERR-EXEC-NOT-RESIDENT
MOVE ' ECI-ERR-EXEC-NOT-RESIDENT' TO
ECI-ERR-MSG-DATA
WHEN ECI-ERR-SYSTEM-ERROR
MOVE ' ECI-ERR-SYSTEM-ERROR' TO
ECI-ERR-MSG-DATA
WHEN ECI-ERR-NULL-WIN-HANDLE
MOVE ' ECI-ERR-NULL-WIN-HANDLE' TO
ECI-ERR-MSG-DATA
WHEN ECI-ERR-NULL-MESSAGE-ID
MOVE ' ECI-ERR-NULL-MESSAGE-ID' TO
ECI-ERR-MSG-DATA
WHEN ECI-ERR-THREAD-CREATE-ERROR
MOVE ' ECI-ERR-THREAD-CREATE-ERROR' TO
ECI-ERR-MSG-DATA
END-EVALUATE
IF ECI-ERROR-ID NOT = 0
MOVE ECI-ERROR-ID TO ECI-ERR-MSG-CODE
DISPLAY SPACES
DISPLAY 'CICS/OS2 E.C.I. failed with an error code of;'
DISPLAY ECI-ERR-MSG-LINE
GO TO MAIN-EXIT
END-IF
.
300-CLOSE SECTION.
DISPLAY "Closing down server"
CALL API CCI-CLOSESERVER USING BY VALUE HANDLE1
IF RETURN-CODE NOT = 0
PERFORM GET-CCI-ERROR
DISPLAY INFO1
DISPLAY "Error on return from CCI-CLOSESERVER"
END-IF
.
MAIN-EXIT SECTION.
EXIT PROGRAM
GOBACK
.
****************************************************************
GET-CCI-ERROR SECTION.
MOVE LENGTH OF INFO1 TO MAX-LENGTH
CALL API CCI-GETERROR USING BY REFERENCE INFO1
BY VALUE MAX-LENGTH
BY REFERENCE WS-LENGTH
.