Inside COBOL #35
by
Shawn Gordon
President
S.M.Gordon & Associates
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.
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