This opens the empty sqlbook.cbl file in the file editor.
********************************************************************************************************
*
* Copyright (C) Micro Focus IP Development Limited 2010-2011. All rights reserved.
*
* This sample code is supplied for demonstration purposes only on an "as is" basis and "is for use at
* your own risk".
*
********************************************************************************************************
$set sql(dbman=jdbc, behavior=mainframe)
$set SQL(JNDIENC=java:/comp/env)
program-id. BookLegacy.
working-storage section.
exec sql include sqlca end-exec.
01 record-count pic 99.
linkage section.
01 lnk-function pic x.
88 read-record value "1".
88 add-record value "2".
88 delete-record value "3".
88 next-record value "4".
01 lnk-sqlstate pic x(5).
01 lnk-sqlmessage pic x(80).
copy "book-rec.cpy" replacing ==(prefix)== by ==lnk-b==.
procedure division using by value lnk-function
by reference lnk-b-details
by reference lnk-sqlstate
by reference lnk-sqlmessage.
main section.
exec sql connect to PUBS end-exec
if sqlcode not >= 0
move sqlstate to lnk-sqlstate
move sqlerrmc(1:sqlerrml) to lnk-sqlmessage
move 'Connection error' to lnk-b-title
move sqlstate to lnk-b-author
move '00000' to lnk-sqlstate
move sqlerrmc(1:sqlerrml) to lnk-sqlmessage
goback
end-if
evaluate true
when read-record
perform do-read-record
when add-record
perform do-add-record
when delete-record
perform do-delete-record
when next-record
perform do-next-record
end-evaluate
move sqlstate to lnk-sqlstate
move sqlerrmc(1:sqlerrml) to lnk-sqlmessage
exec sql disconnect end-exec
exit program
stop run
.
do-read-record section.
evaluate true
when lnk-b-stockno <> spaces
exec sql
select TITLE, TYPE, AUTHOR, STOCKNO, ISBN, RETAIL, ONHAND, SOLD
into :lnk-b-title, :lnk-b-type, :lnk-b-author, :lnk-b-stockno, :lnk-b-isbn, :lnk-b-retail, :lnk-b-onhand, :lnk-b-sold
from BOOKS where STOCKNO = :lnk-b-stockno
end-exec
when lnk-b-title <> spaces
exec sql
select TITLE, TYPE, AUTHOR, STOCKNO, ISBN, RETAIL, ONHAND, SOLD
into :lnk-b-title, :lnk-b-type, :lnk-b-author, :lnk-b-stockno, :lnk-b-isbn, :lnk-b-retail, :lnk-b-onhand, :lnk-b-sold
from BOOKS where TITLE = :lnk-b-title
end-exec
when lnk-b-author <> spaces
exec sql
select TITLE, TYPE, AUTHOR, STOCKNO, ISBN, RETAIL, ONHAND, SOLD
into :lnk-b-title, :lnk-b-type, :lnk-b-author, :lnk-b-stockno, :lnk-b-isbn, :lnk-b-retail, :lnk-b-onhand, :lnk-b-sold
from BOOKS where AUTHOR = :lnk-b-author
end-exec
when other
*>------------No key specified - return unsuccessful read
move "02000" to sqlstate
move "Record not found" to sqlerrmc
move 15 to sqlerrml
end-evaluate
if sqlcode not = 0
initialize lnk-b-details
*>move all '*' to lnk-b-title lnk-b-author lnk-b-type
end-if
.
do-next-record section.
exec sql
select TITLE, TYPE, AUTHOR, STOCKNO, ISBN, RETAIL, ONHAND, SOLD
into :lnk-b-title, :lnk-b-type, :lnk-b-author, :lnk-b-stockno, :lnk-b-isbn, :lnk-b-retail, :lnk-b-onhand, :lnk-b-sold
from BOOKS where STOCKNO > :lnk-b-stockno
end-exec
if sqlcode <> 0 AND sqlcode NOT EQUAL 1
initialize lnk-b-details
*>move all '*' to lnk-b-title lnk-b-author lnk-b-type
end-if
.
do-add-record section.
exec sql
insert into BOOKS (TITLE, TYPE, AUTHOR, STOCKNO, ISBN, RETAIL, ONHAND, SOLD)
values (:lnk-b-title, :lnk-b-type, :lnk-b-author, :lnk-b-stockno, :lnk-b-isbn, :lnk-b-retail, :lnk-b-onhand, :lnk-b-sold)
end-exec
if sqlcode = 0
exec sql commit end-exec
end-if
.
do-delete-record section.
evaluate true
when lnk-b-stockno <> spaces
exec sql delete from BOOKS where STOCKNO = :lnk-b-stockno end-exec
when lnk-b-title <> spaces
exec sql delete from BOOKS where TITLE = :lnk-b-title end-exec
when lnk-b-author <> spaces
exec sql delete from BOOKS where AUTHOR = :lnk-b-author end-exec
when other
*>------------No key specified - return unsuccessful read
move "02000" to sqlstate
move "Record not found" to sqlerrmc
move 15 to sqlerrml
end-evaluate
if sqlcode = 0
exec sql commit end-exec
end-if
03 (prefix)-sold pic s9(5) comp-3.