--openmail-part-009d10a7-00000001
Content-Type: text/plain; charset=US-ASCII; name="RE: Image/SQL (COBOL Program)"
Content-Transfer-Encoding: 7bit
there r examples in sampledb.sys. if u don't have the group anymore,
the attached is an example program. it also contains the udc from
sql.sys which u will need for the pre-processor.
good luck.
wayne.
----------
From: HP3000-L; jgeiser
To: HP3000-L
Subject: Image/SQL (COBOL Program)
Date: Friday, 16 August 1996 4:33
OK, now all don't laugh at once...
I can handle Image/SQL quite nicely from a PC client, however...
I have a need to write a subroutine on the 3000 which needs SQL (the friendly
'DB' calls just won't cut it for this app - it's a QBE, better handled
with SQL),
and for life of me, I cannot remember the steps to do this in COBOL.
I can handle the SQL, and I know that EXEC steps are needed...What I need
is the requirements for Working-Storage, and the Compile steps.
(Damned memory is always the first to go when you clear 35 :-)
Oh yeah - and we just rearrange the office here - and guess which manual
is missing - hence my appeal to the generous folks here :-)
TIA,
Joe Geiser
--openmail-part-009d10a7-00000001
Content-Type: text/plain; charset=US-ASCII; name="COBSQL.TXT"
Content-Transfer-Encoding: 7bit
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* Program COBEX5: *
* This program is the same as program COBEX2, except this *
* program handles deadlocks differently. *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
IDENTIFICATION DIVISION.
PROGRAM-ID. COBEX5.
AUTHOR. HP TRAINING
INSTALLATION. HP.
DATE-WRITTEN. 23 JULY 1987.
DATE-COMPILED. 23 JULY 1987.
REMARKS. SQL'S SELECT WITH WHENEVER COMMAND.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. HP-3000.
OBJECT-COMPUTER. HP-3000.
SPECIAL-NAMES. CONSOLE IS TERMINAL-INPUT.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT CRT ASSIGN TO "$STDLIST".
DATA DIVISION.
FILE SECTION.
FD CRT.
01 PROMPT PIC X(34).
$PAGE
WORKING-STORAGE SECTION.
EXEC SQL INCLUDE SQLCA END-EXEC.
* * * * * * BEGIN HOST VARIABLE DECLARATIONS * * * * * * *
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
01 PARTNUMBER PIC X(16).
01 PARTNAME PIC X(30).
01 SALESPRICE PIC S9(8)V99 COMP-3.
01 SALESPRICEIND SQLIND.
01 SQLMESSAGE PIC X(132).
EXEC SQL END DECLARE SECTION END-EXEC.
* * * * * * END OF HOST VARIABLE DECLARATIONS * * * * * * *
77 DONE-FLAG PIC X(01) VALUE 'N'.
88 NOT-DONE VALUE 'N'.
88 DONE VALUE 'Y'.
77 ABORT-FLAG PIC X(01) VALUE 'N'.
88 NOT-STOP VALUE 'N'.
88 ABORT VALUE 'Y'.
77 SQL-COMMAND-DONE-FLAG PIC X(01) VALUE 'N'.
88 NOT-SQL-CMD-DONE VALUE 'N'.
88 SQL-COMMAND-DONE VALUE 'Y'.
01 NOMEMORY PIC S9(9) COMP VALUE -4008.
01 DEADLOCK PIC S9(9) COMP VALUE -14024.
01 TRY-COUNTER PIC S9(4) COMP VALUE 0.
01 TRY-LIMIT PIC S9(4) COMP VALUE 3.
01 RESPONSE.
05 RESPONSE-PREFIX PIC X(01) VALUE SPACE.
05 FILLER PIC X(15) VALUE SPACES.
01 DOLLARS PIC $$$,$$$,$$$.99.
$PAGE
PROCEDURE DIVISION.
A100-MAIN.
DISPLAY "Program to SELECT specified rows from "
"the Parts Table - COBEX5".
DISPLAY " ".
DISPLAY "Event List:".
DISPLAY " Connect to PartsDBE".
DISPLAY " Begin Work".
DISPLAY " SELECT specified Part Number from the "
"Parts Table until user enters '/' ".
DISPLAY " Commit Work".
DISPLAY " Disconnect from PartsDBE".
DISPLAY " ".
OPEN OUTPUT CRT.
PERFORM A200-CONNECT-DBENVIRONMENT THRU A200-EXIT.
PERFORM B100-SELECT-DATA THRU B100-EXIT
UNTIL DONE.
PERFORM A500-TERMINATE-PROGRAM THRU A500-EXIT.
A100-EXIT.
EXIT.
A200-CONNECT-DBENVIRONMENT.
EXEC SQL
WHENEVER SQLERROR
GO TO S300-SERIOUS-ERROR
END-EXEC.
DISPLAY "Connect to PartsDBE".
EXEC SQL CONNECT TO 'PartsDBE' END-EXEC.
A200-EXIT.
EXIT.
A300-BEGIN-TRANSACTION.
DISPLAY "Begin Work".
EXEC SQL
BEGIN WORK
END-EXEC.
A300-EXIT.
EXIT.
A400-END-TRANSACTION.
DISPLAY "Commit Work".
EXEC SQL
COMMIT WORK
END-EXEC.
A400-EXIT.
EXIT.
A500-TERMINATE-PROGRAM.
EXEC SQL
RELEASE
END-EXEC.
STOP RUN.
A500-EXIT.
EXIT.
$PAGE
B100-SELECT-DATA.
MOVE SPACES TO RESPONSE.
MOVE "Enter Part Number or '/' to STOP> "
TO PROMPT.
WRITE PROMPT AFTER ADVANCING 1 LINE.
ACCEPT RESPONSE.
IF RESPONSE-PREFIX = "/"
MOVE "Y" TO DONE-FLAG
GO TO B100-EXIT
ELSE
MOVE RESPONSE TO PARTNUMBER.
EXEC SQL
WHENEVER SQLERROR
GO TO S100-SQL-ERROR
END-EXEC.
EXEC SQL
WHENEVER SQLWARNING
GO TO S500-SQL-WARNING
END-EXEC.
EXEC SQL
WHENEVER NOT FOUND
GO TO S600-NOT-FOUND
END-EXEC.
MOVE 'N' TO SQL-COMMAND-DONE-FLAG.
MOVE 0 TO TRY-COUNTER.
PERFORM B110-SQL-SELECT THRU B110-EXIT
UNTIL SQL-COMMAND-DONE.
B100-EXIT.
EXIT.
B110-SQL-SELECT.
ADD 1 TO TRY-COUNTER.
DISPLAY "SELECT PartNumber, PartName and SalesPrice".
PERFORM A300-BEGIN-TRANSACTION THRU A300-EXIT.
EXEC SQL
SELECT PARTNUMBER, PARTNAME, SALESPRICE
INTO :PARTNUMBER,
:PARTNAME,
:SALESPRICE :SALESPRICEIND
FROM PURCHDB.PARTS
WHERE PARTNUMBER = :PARTNUMBER
END-EXEC.
IF SQL-COMMAND-DONE
GO TO B110-EXIT.
PERFORM A400-END-TRANSACTION THRU A400-EXIT
PERFORM B200-DISPLAY-ROW THRU B200-EXIT.
MOVE 'Y' TO SQL-COMMAND-DONE-FLAG.
B110-EXIT.
EXIT.
B200-DISPLAY-ROW.
DISPLAY " ".
DISPLAY " Part Number: " PARTNUMBER.
DISPLAY " Part Name: " PARTNAME.
IF SALESPRICEIND < 0
DISPLAY " Sales Price is NULL"
ELSE
MOVE SALESPRICE TO DOLLARS
DISPLAY " Sales Price: " DOLLARS.
B200-EXIT.
EXIT.
$PAGE
S100-SQL-ERROR.
IF SQLCODE < DEADLOCK
PERFORM S200-SQL-EXPLAIN THRU S200-EXIT
UNTIL SQLCODE = 0
PERFORM A500-TERMINATE-PROGRAM.
IF SQLCODE = DEADLOCK
OR SQLCODE = NOMEMORY
IF TRY-COUNTER = TRY-LIMIT
MOVE 'Y' TO SQL-COMMAND-DONE-FLAG
DISPLAY "Deadlock occurred, or not enough shared "
"memory. You may want to try again."
GO TO B110-EXIT
ELSE
GO TO B110-EXIT
ELSE
PERFORM S200-SQL-EXPLAIN THRU S200-EXIT
PERFORM A500-TERMINATE-PROGRAM.
S100-EXIT.
EXIT.
S200-SQL-EXPLAIN.
EXEC SQL
SQLEXPLAIN :SQLMESSAGE
END-EXEC.
DISPLAY SQLMESSAGE.
S200-EXIT.
EXIT.
S300-SERIOUS-ERROR.
PERFORM S200-SQL-EXPLAIN THRU S200-EXIT.
PERFORM A500-TERMINATE-PROGRAM THRU A500-EXIT.
S300-EXIT.
EXIT.
S500-SQL-WARNING.
DISPLAY "SQL WARNING has occurred. The following row "
"of data may not be valid:".
PERFORM B200-DISPLAY-ROW THRU B200-EXIT.
IF SQLWARN6 NOT = 'W'
PERFORM A400-END-TRANSACTION THRU A400-EXIT.
MOVE 'Y' TO SQL-COMMAND-DONE-FLAG
GO TO B110-EXIT.
S500-EXIT.
EXIT.
S600-NOT-FOUND.
DISPLAY " ".
DISPLAY "Part Number not found!".
PERFORM A400-END-TRANSACTION THRU A400-EXIT.
MOVE 'Y' TO SQL-COMMAND-DONE-FLAG
GO TO B110-EXIT.
S600-EXIT.
EXIT.
hpsqludc.sql.sys
ISQL profile="isqlpro",synfile="isqlsyn"
file isqlpro = !profile
file isqlsyn = !synfile
run isql.pub.sys
reset isqlpro
reset isqlsyn
************************************************************
SQLUTIL
run sqlutil.pub.sys
************************************************************
SQLGEN
run sqlgen.pub.sys
************************************************************
PPAS srcfile,dbefile,msgfile=$stdlist
continue
setvar _savefence hpmsgfence
setvar hpmsgfence 2
continue
purge !msgfile
purge sqlout
purge sqlmod
purge sqlvar
purge sqlconst
purge sqltype
purge sqlextn
setvar hpmsgfence _savefence
deletevar _savefence
file sqlin = !srcfile
file sqlmsg = !msgfile;rec=-80,16,f,ascii
file sqlout; disc=10000,32;rec=-80,16,f,ascii
file sqlmod; disc=1023,10,1;rec=250,,f,binary
file sqlvar; disc=2048,32;rec=-80,16,f,ascii
file sqlconst; disc=2048;rec=-80,16,f,ascii
file sqltype; disc=2048,32;rec=-80,16,f,ascii
file sqlextn; disc=2048,32;rec=-80,16,f,ascii
continue
run psqlpas.pub.sys;info="!dbefile (drop)"
reset sqlin
reset sqlmsg
reset sqlout
reset sqlmod
reset sqlvar
reset sqlconst
reset sqltype
reset sqlextn
************************************************************
PPPAS srcfile,dbefile,pgmfile,msgfile=$stdlist
continue
setvar _savefence hpmsgfence
setvar hpmsgfence 2
continue
purge !msgfile
purge sqlout
purge sqlmod
purge sqlvar
purge sqlconst
purge sqltype
purge sqlextn
setvar hpmsgfence _savefence
deletevar _savefence
file sqlin = !srcfile
file sqlmsg = !msgfile;rec=-80,16,f,ascii
file sqlout; disc=10000,32;rec=-80,16,f,ascii
file sqlmod; disc=1023,10,1;rec=250,,f,binary
file sqlvar; disc=2048,32;rec=-80,16,f,ascii
file sqlconst; disc=2048;rec=-80,16,f,ascii
file sqltype; disc=2048,32;rec=-80,16,f,ascii
file sqlextn; disc=2048,32;rec=-80,16,f,ascii
continue
run psqlpas.pub.sys;info="!dbefile (drop)"
if jcw <= warn then
continue
pasxllk sqlout,!pgmfile,$null
endif
reset sqlin
reset sqlmsg
reset sqlout
reset sqlmod
reset sqlvar
reset sqlconst
************************************************************
PCOB srcfile,dbefile,msgfile=$stdlist
continue
setvar _savefence hpmsgfence
setvar hpmsgfence 2
continue
purge !msgfile
purge sqlout
purge sqlmod
purge sqlvar
purge sqlconst
setvar hpmsgfence _savefence
deletevar _savefence
file sqlin = !srcfile
file sqlmsg = !msgfile;rec=-80,16,f,ascii
file sqlout; disc=10000,10,1; rec=-80,,f,ascii
file sqlmod; disc=1023,10,1; rec=250,,f,binary
file sqlvar; disc=2048,10,1; rec=-80,,f,ascii
file sqlconst; disc=2048,10,1; rec=-80,,f,ascii
continue
run psqlcob.pub.sys;info="!dbefile (drop)"
reset sqlin
reset sqlmsg
reset sqlout
reset sqlmod
reset sqlvar
reset sqlconst
************************************************************
PPCOB srcfile,dbefile,pgmfile,msgfile=$stdlist
continue
setvar _savefence hpmsgfence
setvar hpmsgfence 2
continue
purge !msgfile
purge sqlout
purge sqlmod
purge sqlvar
purge sqlconst
setvar hpmsgfence _savefence
deletevar _savefence
file sqlin = !srcfile
file sqlmsg = !msgfile;rec=-80,16,f,ascii
file sqlout; disc=10000,32; rec=-80,16,f,ascii
file sqlmod; disc=1023,10,1; rec=250,,f,binary
file sqlvar; disc=2048,32; rec=-80,16,f,ascii
file sqlconst; disc=2048; rec=-80,16,f,ascii
continue
run psqlcob.pub.sys;info="!dbefile (drop)"
if jcw <= warn then
continue
cob85xlk sqlout,!pgmfile,$null
endif
reset sqlin
reset sqlmsg
reset sqlout
reset sqlmod
reset sqlvar
reset sqlconst
************************************************************
PFOR srcfile,dbefile,pgmfile,msgfile=$stdlist
continue
setvar _savefence hpmsgfence
setvar hpmsgfence 2
continue
purge !msgfile
purge sqlout
purge sqlmod
purge sqlvar
setvar hpmsgfence _savefence
deletevar _savefence
file sqlin = !srcfile
file sqlmsg = !msgfile;rec=-80,16,f,ascii
file sqlout; disc=10000,32; rec=-80,16,f,ascii;save
file sqlmod; disc=1023,10,1; rec=250,,f,binary
file sqlvar; disc=2048,32; rec=-80,16,f,ascii;save
continue
run psqlfor.pub.sys;info="!dbefile (drop)"
reset sqlin
reset sqlmsg
reset sqlout
reset sqlmod
reset sqlvar
************************************************************
PPFOR srcfile,dbefile,pgmfile,msgfile=$stdlist
continue
setvar _savefence hpmsgfence
setvar hpmsgfence 2
continue
purge !msgfile
purge sqlout
purge sqlmod
purge sqlvar
setvar hpmsgfence _savefence
deletevar _savefence
file sqlin = !srcfile
file sqlmsg = !msgfile;rec=-80,16,f,ascii
file sqlout; disc=10000,32; rec=-80,16,f,ascii;save
file sqlmod; disc=1023,10,1; rec=250,,f,binary
file sqlvar; disc=2048,32; rec=-80,16,f,ascii;save
continue
run psqlfor.pub.sys;info="!dbefile (drop)"
if jcw <= warn then
continue
ftnxllk sqlout,!pgmfile,$null
endif
reset sqlin
reset sqlmsg
purge sqlout
reset sqlmod
purge sqlvar
************************************************************
PC srcfile,dbefile,msgfile=$stdlist
continue
setvar _savefence hpmsgfence
setvar hpmsgfence 2
continue
purge !msgfile
purge sqlout
purge sqlmod
purge sqlvar
purge sqltype
purge sqlextn
setvar hpmsgfence _savefence
deletevar _savefence
file sqlin = !srcfile
file sqlmsg = !msgfile;rec=-80,16,f,ascii
file sqlout; disc=10000,32;rec=-80,16,f,ascii
file sqlmod; disc=1023,10,1;rec=250,,f,binary
file sqlvar; disc=2048,32;rec=-80,16,f,ascii
file sqltype; disc=2048,32;rec=-80,16,f,ascii
file sqlextn; disc=2048,32;rec=-80,16,f,ascii
continue
run psqlc.pub.sys;info="!dbefile (drop)"
reset sqlin
reset sqlmsg
reset sqlout
reset sqlmod
reset sqlvar
reset sqltype
reset sqlextn
************************************************************
PPC srcfile,dbefile,pgmfile,msgfile=$stdlist
continue
setvar _savefence hpmsgfence
setvar hpmsgfence 2
continue
purge !msgfile
purge sqlout
purge sqlmod
purge sqlvar
purge sqltype
purge sqlextn
setvar hpmsgfence _savefence
deletevar _savefence
file sqlin = !srcfile
file sqlmsg = !msgfile;rec=-80,16,f,ascii
file sqlout; disc=10000,32;rec=-80,16,f,ascii
file sqlmod; disc=1023,10,1;rec=250,,f,binary
file sqlvar; disc=2048,32;rec=-80,16,f,ascii
file sqltype; disc=2048,32;rec=-80,16,f,ascii
file sqlextn; disc=2048,32;rec=-80,16,f,ascii
continue
run psqlc.pub.sys;info="!dbefile (drop)"
if jcw <= warn then
continue
ccxllk sqlout,!pgmfile,$null
endif
reset sqlin
reset sqlmsg
reset sqlout
reset sqlmod
reset sqlvar
reset sqltype
reset sqlextn
************************************************************
--openmail-part-009d10a7-00000001
Content-Type: application/x-openmail-1734; name="WINMAIL.DAT"
Content-Transfer-Encoding: base64
eJ8+IikMAQuAAQAnAAAAMDFCQjhBQTUuRjFCQUFBQzAoYSlqZ2Vpc2VyLmlkcG5ldC5jb20A
qws=
--openmail-part-009d10a7-00000001--
|
