cobol42

COBOL TIPS #35

Shawn Gordon

We are back to some interesting tips this month. I have run into a number of situations over the years where I wanted to programmatically do file transfers through terminal emulator. there are a number of emulators out there, so I finally decided to support the two major ones, MS92 from MiniSoft, and Reflection from WRQ.

What our program is going to do essentially is, auto sense which emulator is running, and if it's on a terminal, abort. FOPEN stdin so we can easily use some time out routines, ask for a PC path and file name, then request a file name for the host. We are defaulting to an UPLOAD group so that the user can't mess with production files.

We are going to use a call to the FLABELINFO intrinsic as a quick way to see if the file exists, the call will fail if no file exists. If one does exist, then ask the user if they want to overwrite it. They only get one chance on the file name, so we abort if they don't want to overwrite. Then depending on which emulator they are using we are going to create the transfer program (which was returned in the status request that told us what emulator was being used) as a son process, and pass it all the script commands it requires to perform the transfer.

There is a fundamental problem with trying to get any decent error information back from these things. They just fail with no description of the problem. You will notice the REFCOM macro that handles the communication with Reflection, this is were we have the timer on the ACCEPT verb, that is the call to FCONTROL to enable a 7 second timer. The variable RETURN-STRING will contain an F in the first character if there was a problem.

You will also notice a string of DISPLAY verbs that are doing UP-LINE, CLEAR-LINE and such. These are standard terminal escape sequences that will move the cursor around and manipulate the display. The purpose to these is to keep the screen relativily clean and hide the unnecessary status information that will get returned by the emulators. I'm not going to get into the specific syntax of the two emulators, you can consult your owners manual for what each parameter does.

Finally at the end of the program we make another call to FLABELINFO to retrieve some statistics on the file that was uploaded, and display them to the user so that they have some positive feedback. One important thing to remember is to LINK the program with PH capability. PH grants you Process Handeling ability, and is what allows you to CREATE the file transfer programs as a son process. It seems I always forget to get this right, and if you do your program will abort, and you won't know why. See Figure 2 for an example of the compile and link statements. Figure 3 has an example of the program output, with a LISTF afterwards to verify.

This code is based on sample code that is included with both emulator products. I cleaned it up, made it more generic, and added the auto sensing as well as various other bits and pieces. Hopefully you will find this sample enlightening into various possibilities, as well as a decent description of some of the more esoteric intrinsics. This can also be easily adapted to do uploads and downloads, but size constraints limit me to what we have here. Next month I may show an example of how and why to use long pointers with COBOL (it requires some C as well).

FIGURE 1

$CONTROL USLINIT,BOUNDS

IDENTIFICATION DIVISION.

PROGRAM-ID. SMGULOAD.

AUTHOR. SHAWN GORDON.

INSTALLATION. S.M.GORDON & ASSOCIATES.

DATE-WRITTEN. FRI, JUN 21, 1996.

DATE-COMPILED.

**************************************************

* This program will prompt the user for a PC file

* path name, and a host name (no group), it will

* check to see if the file exists, ask for confirmation,

* and then upload it to the DATA group. At the end

* some feedback is given as to what was uploaded.

* Shawn M. Gordon.

**************************************************

ENVIRONMENT DIVISION.

CONFIGURATION SECTION.

SOURCE-COMPUTER. HP-3000.

OBJECT-COMPUTER. HP-3000.

SPECIAL-NAMES.

CONDITION-CODE IS CC.

DATA DIVISION.

WORKING-STORAGE SECTION.

01 HOST-FILE PIC X(08) VALUE SPACES.

01 HOST-GRP PIC X(18) VALUE SPACES.

01 GET-OUT PIC X.

01 WS-ERROR PIC X.

01 TERM-ID PIC X(09) VALUE SPACES.

01 DISP-BUFF PIC X(70) VALUE SPACES.

01 EDIT-EOF PIC ZZ,ZZ9.

01 FOPEN-STUFF.

03 STDIN PIC S9(4) COMP VALUE 0.

03 TIMEOUT PIC S9(4) COMP VALUE 7.

03 ERR PIC S9(4) COMP VALUE 0.

03 ERR-LEN PIC S9(4) COMP VALUE 0.

03 ERR-MSG PIC X(76) VALUE SPACES.

03 FILE-NAME PIC X(66) VALUE SPACES.

01 CLEAR-LINE.

03 PIC X VALUE %33.

03 PIC X VALUE 'K'.

01 UP-LINE.

03 PIC X VALUE %33.

03 PIC X VALUE 'A'.

01 ITEMNUM.

03 PIC S9(4) COMP VALUE 19.

03 PIC S9(4) COMP VALUE 9.

03 PIC S9(4) COMP VALUE 0.

01 ITEM.

05 EOF PIC S9(9) COMP VALUE 0.

05 FCODE PIC S9(4) COMP VALUE 0.

01 ITEMERR.

05 PIC S9(4) COMP VALUE 0.

* Reflection stuff

01 RETURN-STRING.

03 PIC X(80) VALUE SPACES.

01 REFLECT-PROG PIC X(25) VALUE SPACES.

01 REFLECT-PIN PIC S9(4) COMP VALUE 0.

01 REFLECT-COMMAND.

03 PIC X VALUE %33.

03 PIC X(03) VALUE '&oC'.

03 REF-COMMAND PIC X(74).

03 PIC X VALUE %15.

* MINISOFT commands

01 PCFT-CMD.

03 PIC X VALUE %33.

03 PIC X(03) VALUE '&oC'.

03 CMD-LINE PIC X(40).

01 RUN-STATEMENT PIC X(44) VALUE SPACES.

01 DUMMY PIC X(04) VALUE SPACES.

01 PROGRAM-NAME PIC X(40) VALUE SPACES.

01 PARM-OPTION PIC X(10) VALUE SPACES.

01 PARM-VALUE PIC 999.

01 DC1 PIC X VALUE %21.

01 DEV-COMP-CODE PIC X(05) VALUE SPACES.

01 CP-ERROR PIC S9(9) COMP VALUE 0.

01 CP-ITEM-ARRAYS.

03 ITEMNUMS-C.

05 ITEMNUMS PIC S9(9) COMP OCCURS 3.

03 ITEMS-C.

05 ITEMS PIC 9(9) COMP OCCURS 3.

01 MS92LINK-PIN PIC S9(4) COMP VALUE 0.

01 SUSPEND PIC 9(4) COMP VALUE 0.

PROCEDURE DIVISION.

A0000-MACROS.

$DEFINE %REFCOM=

MOVE SPACES TO RETURN-STRING

DISPLAY UP-LINE CLEAR-LINE NO ADVANCING

DISPLAY REFLECT-COMMAND

DISPLAY UP-LINE CLEAR-LINE NO ADVANCING

CALL INTRINSIC "FCONTROL" USING STDIN, 4, TIMEOUT

ACCEPT RETURN-STRING FREE

ON INPUT ERROR DISPLAY 'TIMEOUT ON READ'

END-ACCEPT

IF RETURN-STRING(1:1) = "F"

DISPLAY CLEAR-LINE

"(" !1 ") Failed on: " REF-COMMAND

GO TO !2

END-IF#

A1000-INIT.

* FOPEN the terminal for a timed read in case they try to do a

* PC file transfer but are running from a dumb terminal.

CALL INTRINSIC "FOPEN" USING \\, %45 GIVING STDIN.

DISPLAY "Enter path and filename of PC file: "

NO ADVANCING.

ACCEPT FILE-NAME FREE.

IF FILE-NAME = SPACES

GO TO C9000-EOJ.

DISPLAY "Enter Host filename: " NO ADVANCING.

ACCEPT HOST-FILE FREE.

IF HOST-FILE = SPACES

GO TO C9000-EOJ.

MOVE SPACES TO HOST-GRP.

STRING HOST-FILE DELIMITED BY SPACES

".UPLOAD" DELIMITED BY SIZE

INTO HOST-GRP.

CALL INTRINSIC 'FLABELINFO' USING HOST-GRP, 2, ERR,

ITEMNUM, ITEM, ITEMERR.

IF ERR = 0

DISPLAY 'That file already exists - Overwrite (Y/N)? '

NO ADVANCING

ACCEPT WS-ERROR FREE

IF WS-ERROR <> 'Y' AND 'y'

GO TO C9000-EOJ.

DISPLAY %33 '*s12347^'.

ACCEPT TERM-ID FREE.

DISPLAY UP-LINE CLEAR-LINE NO ADVANCING.

IF TERM-ID(1:3) = 'WRQ'

PERFORM C1000-REFLECT THRU C1000-EXIT

ELSE IF TERM-ID = 'MS92 BEST'

PERFORM C2000-MS92 THRU C2000-EXIT.

GO TO C9000-EOJ.

*******************

C1000-REFLECT.

MOVE "SET DISABLE-COMP-CODES NO" TO REF-COMMAND.

%REFCOM(1#,C1000-EXIT#).

MOVE "CONTINUE ON" TO REF-COMMAND.

%REFCOM(2#,C1000-EXIT#).

STRING "SEND " DELIMITED BY SIZE

FILE-NAME DELIMITED BY SPACES

" TO " DELIMITED BY SIZE

HOST-GRP DELIMITED BY SPACES

";P ASCII" DELIMITED BY SIZE

INTO REF-COMMAND.

%REFCOM(3#,C1000-EXIT#).

IF RETURN-STRING(1:3) = "RUN"

MOVE RETURN-STRING(5:30) TO REFLECT-PROG

ELSE

DISPLAY "Failure in return"

GO TO C1000-EXIT.

* Create PCLINK2 as son process and transfer file

CALL INTRINSIC "CREATE" USING REFLECT-PROG \\ REFLECT-PIN,

\1\, \1\.

IF CC <> 0

DISPLAY 'Failure to CREATE: ' REFLECT-PROG

GO TO C1000-EXIT.

CALL INTRINSIC "ACTIVATE" USING REFLECT-PIN, \2\.

IF CC <> 0

DISPLAY 'Failure to ACTIVATE: ' REFLECT-PROG

GO TO C1000-EXIT.

MOVE "LET V3 = ERROR-CODE" TO REF-COMMAND.

%REFCOM(5#,C1000-EXIT#).

MOVE "TRANSMIT V3" TO REF-COMMAND.

MOVE SPACES TO RETURN-STRING.

DISPLAY UP-LINE CLEAR-LINE NO ADVANCING.

DISPLAY REFLECT-COMMAND.

DISPLAY UP-LINE CLEAR-LINE NO ADVANCING.

ACCEPT RETURN-STRING.

IF RETURN-STRING(1:2) = "0S" OR RETURN-STRING(1:1) = "S"

CONTINUE

ELSE

DISPLAY CLEAR-LINE "FILE TRANSFER FAILED".

C1000-EXIT. EXIT.

C2000-MS92.

MOVE SPACES TO CMD-LINE.

STRING "LOCF " FILE-NAME DELIMITED BY SIZE

INTO CMD-LINE.

DISPLAY PCFT-CMD.

ACCEPT DEV-COMP-CODE.

DISPLAY UP-LINE UP-LINE CLEAR-LINE NO ADVANCING.

MOVE SPACES TO CMD-LINE.

STRING "HOSTF " HOST-GRP DELIMITED BY SIZE

INTO CMD-LINE.

DISPLAY PCFT-CMD.

ACCEPT DEV-COMP-CODE.

DISPLAY UP-LINE UP-LINE CLEAR-LINE NO ADVANCING.

MOVE 'ASCII' TO CMD-LINE.

DISPLAY PCFT-CMD.

ACCEPT DEV-COMP-CODE.

DISPLAY UP-LINE UP-LINE CLEAR-LINE NO ADVANCING.

MOVE 'RECSIZE 256' TO CMD-LINE.

DISPLAY PCFT-CMD.

ACCEPT DEV-COMP-CODE.

DISPLAY UP-LINE UP-LINE CLEAR-LINE NO ADVANCING.

MOVE 'UPLOAD' TO CMD-LINE.

DISPLAY PCFT-CMD.

ACCEPT RUN-STATEMENT.

IF RUN-STATEMENT(1:1) = 'F'

DISPLAY UP-LINE 'Failure in transfer'

GO TO C2000-EXIT.

DISPLAY UP-LINE UP-LINE CLEAR-LINE NO ADVANCING.

UNSTRING RUN-STATEMENT DELIMITED BY ALL SPACE OR ";"

INTO DUMMY, PROGRAM-NAME, PARM-OPTION.

IF PARM-OPTION <> SPACES

UNSTRING PARM-OPTION DELIMITED BY ALL SPACE OR "="

INTO DUMMY, PARM-VALUE.

MOVE 2 TO ITEMNUMS(1).

* MOVE PARM-VALUE TO ITEMS(1).

MOVE 0 TO ITEMS(1).

MOVE 3 TO ITEMNUMS(2).

MOVE 1 TO ITEMS(2).

MOVE 0 TO ITEMNUMS(3) ITEMS(3).

MOVE 2 TO SUSPEND.

CALL INTRINSIC "CREATEPROCESS" USING CP-ERROR,

MS92LINK-PIN, @PROGRAM-NAME,

ITEMNUMS-C, ITEMS-C.

IF CC <> 0

DISPLAY 'FAILED IN CREATEPROCESS ' CP-ERROR

DISPLAY 'Failed to CREATE: ' PROGRAM-NAME

GO TO C2000-EXIT

ELSE

CALL INTRINSIC "ACTIVATE" USING \MS92LINK-PIN\, \SUSPEND\

IF CC <> 0

DISPLAY 'Failed to ACTIVATE: ' PROGRAM-NAME

GO TO C2000-EXIT.

ACCEPT DEV-COMP-CODE.

DISPLAY UP-LINE CLEAR-LINE NO ADVANCING.

C2000-EXIT. EXIT.

C9000-EOJ.

CALL INTRINSIC 'FCLOSE' USING STDIN, 0, 0.

CALL INTRINSIC 'FLABELINFO' USING HOST-GRP, 2, ERR,

ITEMNUM, ITEM, ITEMERR.

IF ERR = 0

MOVE EOF TO EDIT-EOF

STRING 'Uploaded ' DELIMITED BY SIZE

FILE-NAME DELIMITED BY SPACES

' to ' DELIMITED BY SIZE

HOST-GRP DELIMITED BY SPACES

' with ' DELIMITED BY SIZE

EDIT-EOF ' records' DELIMITED BY SIZE

INTO DISP-BUFF.

DISPLAY UP-LINE DISP-BUFF.

DISPLAY "Press RETURN to continue: "

NO ADVANCING.

ACCEPT GET-OUT FREE.

STOP RUN.

FIGURE 2

COB85XL SMGULOAD.SOURCE,,$NULL

LINK $OLDPASS,SMGULOAD.PROG;CAP=IA,BA,PH

FIGURE 3

run smguload.prog

Enter path and filename of PC file: c:\autoexec.bat

Enter Host filename: autoexec

Uploaded C:\AUTOEXEC.BAT to AUTOEXEC with 45 records

Press RETURN to continue:

SMGA.PUB: listf a@,2

ACCOUNT= SMGA GROUP= PUB

FILENAME CODE ------------LOGICAL RECORD-----------
----SPACE----

SIZE TYP EOF LIMIT R/B SECTORS
#X MX

AUTOEXEC 80B FA 45 45 3 16
1 2