IDENTIFICATION DIVISION. PROGRAM-ID. ISQLTEST. * Sample program that provides a screen interface to the * new ISQL statements available in 3.40 * Compile with the -G q switch to enable SQL support * Revision History * 06/30/2004 3.44 First release * * * Documentation: * * All the ISQL functions are driven via a Function Key interface. * * First a database must be available via ODBC. Under Windows use * the ODBC Administrator to add an ODBC UserDSN or SystemDSN. * That allows the appropriate driver (ACCESS, ICISAM, ORACLE, * MySQL, etc.) and the corresponding database to be setup. * * Second, use Connect (F1) and enter the ODBC dataset name. * This will connect thru ODBC to the appropriate driver and database. * * If at this point an SQL error of SQLSTATE = "28001" is received then * that is an "Authorization Failure: an ICSQL license cannot be found." * Make sure that you have an ICSQL license in your .lic file that * ICPERMIT is using. * * If any other error is received, then hitting F12 will provide more * information about that error. F12 can be done at any time to get * additional information about the SQLSTATE. * For example if a connect error=IM002 is received, then * doing F12 will show something like: * [Microsoft][ODBC Driver Manager] Data souce name not found * in the Msg part of the display. * * Statements (1-4) and Parameters (a-d) can be entered at any time * they will be used as indicated by Prepare and Execute. * * After a Connect SQL statements can be entered. For example under 1) * enter "select * from " where
is replaced with a valid * tablename from the database specified. * Hit F3 to Prepare that statement, and then F5 to Execute that statement. * If there were NO errors then one of the Fetch functions can be used to * get rows of data. * * Shift-F6 will Fetch the first column of the row, * Shift-F7 will Fetch the first and second columns of the row, * Shift-F8, Shift-F9 will Fetch first/second/third or first/second/third/fourth. * * To use other statements (2,3,4) use F2 to change the PrepareID/ExecuteIDs * and enter valid statements. They can then be Prepared and Executed * as needed. * * Shift-F1 and Shift-F3 will Disconnect, and DeAllocate respectively. * * Remember this is just a very simple generic program that allows you * to get a taste for using ISQL. There is much more capability here that * is not shown! * * * * * * ENVIRONMENT DIVISION. CONFIGURATION SECTION. INPUT-OUTPUT SECTION. DATA DIVISION. FILE SECTION. WORKING-STORAGE SECTION. 01 tvstr0 USAGE CHAR. 01 tvstr1 USAGE CHAR VARYING. 01 tvstr2 USAGE DATE. 01 tvstr3 USAGE INT. 01 tvstr4 USAGE INTEGER. 01 tvstr5 USAGE NUMERIC (5). 01 tvstr6 USAGE NUMERIC (5 2). 01 tvstr7 USAGE SMALLINT. 01 tvstr8 USAGE TIME. 01 tvstr9 USAGE TIMESTAMP. 01 tvstr10 USAGE INTERVAL SECOND. 77 str1 PIC X(100). 77 str2 PIC X(100). 77 vstr1 USAGE IS CHAR VARYING (100). 77 vstr2 USAGE IS CHAR VARYING (100). 77 vstr3 USAGE IS CHAR VARYING (100). 77 vstr4 USAGE IS CHAR VARYING (100). 77 vstr5 USAGE IS CHAR VARYING (100). 77 ind1 usage is indicator value is overflow. 77 ind2 usage is indicator value is overflow. 77 ind3 usage is indicator value is overflow. 77 ind4 usage is indicator value is overflow. 77 ind5 usage is indicator value is overflow. 77 ind6 usage is indicator value is overflow. 01 DataBaseName PIC x(60). 01 FKEY PIC 99. 01 PREPARE-ID PIC X VALUE "1". 01 PREPARE-STATEMENT PIC X(200). 01 SQL-STUFF. 02 SQL-STATEMENT OCCURS 10 TIMES PIC x(100). * Sample update statement with parameters * update-address *01 SAMPLE-UPDATE-ADDRESS PIC X(200) VALUE "update addresses set FirstName = ? where LastName = ?". *01 SAMPLE-PARM-A1 PIC X(30) VALUE "David". *01 SAMPLE-PARM-A2 PIC X(30) VALUE "Prins". 01 PARM-A1 PIC X(30) VALUE SPACES. 01 PARM-A2 PIC X(30) VALUE SPACES. 01 PARM-A3 PIC X(30) VALUE SPACES. 01 PARM-A4 PIC X(30) VALUE SPACES. 01 EXECUTE-ID PIC X VALUE "1". 01 EXECUTE-IMM-STATEMENT PIC X(200). *01 SQLSTATExx PIC x(5). 77 i pic 99. * Get Diagnostics 01 GD-ROW-COUNT PIC 9(10). 01 GD-NUMBER PIC 9(10). 01 GD-COMMAND-FUNC PIC X(50). 01 GD-DYNAMIC-FUNC PIC X(50). 01 GD-NATIVE-ERROR PIC 9(10). 01 GD-MESSAGE-LEN PIC 9(5). 01 GD-SQLSTATE PIC X(5). 01 GD-MESSAGE-TEXT PIC X(240). SCREEN SECTION. 01 BLANK-SCREEN. 02 BLANK SCREEN. 01 MAIN-SCREEN. 02 LINE 1 COL 10 BOLD "ISQLTest v1". 02 LINE 1 COL 60 "SQLSTATE: ". 02 BOLD PIC X(5) FROM SQLSTATE. 02 GET-DATABASE. 03 LINE 2 COL 1 "Database name: ". 03 PIC X(65) USING DataBaseName. 02 LINE 3 COL 1 "Statements(below)". 02 GET-IDS. 03 COL 41 "ID to prepare: ". 03 PIC 9 USING PREPARE-ID. 03 " to execute: ". 03 PIC 9 USING EXECUTE-ID. 02 GET-STATEMENTS. 03 LINE 4 COL 1 "1: ". 03 PIC X(77) USING SQL-STATEMENT (1). 03 LINE 5 COL 1 "2: ". 03 PIC X(77) USING SQL-STATEMENT (2). 03 LINE 6 COL 1 "3: ". 03 PIC X(77) USING SQL-STATEMENT (3). 03 LINE 7 COL 1 "4: ". 03 PIC X(77) USING SQL-STATEMENT (4). 03 GET-PARMS. 04 LINE 8 COL 1 "Parms: a=". 04 PIC X(30) USING PARM-A1. 04 " b=". 04 PIC X(30) USING PARM-A2. 04 LINE 9 COL 1 "Parms: c=". 04 PIC X(30) USING PARM-A3. 04 " d=". 04 PIC X(30) USING PARM-A4. 02 GET-IMM. 03 LINE 10 COL 1 "ExeIMM: ". 03 PIC X(70) USING EXECUTE-IMM-STATEMENT. * 00000000011111111112222222222333333333344444444445555555555666666666677777777778 01 MAIN-FUNCTIONS. 02 LINE 11 COL 1 BOLD "Functions:". 02 LINE 12 COL 1 "F1/sF1 Connect/Dis-Connect, F2 IDs, F3/sF3 Prepare/Deallocate F4 Execute-Imm". 02 LINE 13 COL 1 "Execute with 0 parameters-F5, 1-F6, 2-F7, 3-F8, 4-F9, F10/sF10 Commit/Rollback". 02 LINE 14 COL 1 "Fetch with 1 argument-sF6, 2-sF7 3-sF8, 4-sF9, F12 Get Diagnostics". 01 OUTPUT-LOC. 02 LINE 15 COL 1 ERASE EOS. 01 GD-SCREEN. 02 LINE 19. 02 COL 1 "RowCount: ". 02 BOLD PIC Z(7)9 FROM GD-ROW-COUNT. 02 " Number: ". 02 BOLD PIC Z(7)9 FROM GD-NUMBER. 02 " Cmd: ". 02 BOLD PIC X(30) FROM GD-COMMAND-FUNC. 02 LINE 20 "Dyn: ". 02 BOLD PIC X(35) FROM GD-DYNAMIC-FUNC. 02 LINE 21. 02 "SQLSTATE: ". 02 BOLD PIC X(5) FROM GD-SQLSTATE. 02 " Native Err: ". 02 BOLD PIC Z(7)9 FROM GD-NATIVE-ERROR. 02 " MsLen: ". 02 BOLD PIC Z(4)9 FROM GD-MESSAGE-LEN. 02 LINE 22. 02 COL 1 "Msg: ". 02 BOLD PIC X(75) FROM GD-MESSAGE-TEXT (1:75). 02 LINE 23. 02 BOLD PIC X(80) FROM GD-MESSAGE-TEXT (76:80). PROCEDURE DIVISION. MAIN-LOGIC SECTION. ML-BEGIN. * set fma-ndx to 1. DISPLAY BLANK-SCREEN. * MOVE LOW-VALUES TO tvstr0, tvstr1, tvstr3, tvstr4. ACCEPT tvstr2 FROM DATE YYYYMMDD. * tvstr5, tvstr6, *tvstr7, tvstr8, tvstr9, tvstr10. RECYCLE. * MOVE SQLSTATE TO SQLSTATExx. DISPLAY MAIN-SCREEN. DISPLAY MAIN-FUNCTIONS. ACCEPT GET-STATEMENTS. ACCEPT FKEY FROM ESCAPE. * Escape IF FKEY = 1 STOP RUN. DISPLAY OUTPUT-LOC. * F1 sF1 Open/Close database IF FKEY = 2 ACCEPT GET-DATABASE DISPLAY OUTPUT-LOC PERFORM CONNECT-IT. IF FKEY = 10 PERFORM DISCONNECT-IT. * F2 Get statement ids IF FKEY = 3 ACCEPT GET-IDS. * F3 sF3 Prepare or Deallocate ids IF FKEY = 4 PERFORM PREPARE-IT. IF FKEY = 12 PERFORM DEALLOCATE-IT. * F4 Get and execite immediate IF FKEY = 5 ACCEPT GET-IMM DISPLAY OUTPUT-LOC PERFORM EXECUTE-IMM-IT. * F5-F9 EXECUTE with 0 - 4 parameters IF FKEY = 6 PERFORM EXECUTE-IT0. IF FKEY = 7 PERFORM EXECUTE-IT1. IF FKEY = 8 PERFORM EXECUTE-IT2. IF FKEY = 9 PERFORM EXECUTE-IT3. IF FKEY = 34 PERFORM EXECUTE-IT4. *sF6-sF9 Get data from rowset 1 to 4 values IF FKEY = 15 PERFORM FETCH-IT1 evaluate TRUE when ind1 is null display "ind1 is now null" when ind1 is overflow display "ind1 is now overflow" when ind1 is valid display "ind1 is now valid" end-evaluate. IF FKEY = 16 PERFORM FETCH-IT2 evaluate TRUE when ind1 is null display "ind1 is now null" when ind1 is overflow display "ind1 is now overflow" when ind1 is valid display "ind1 is now valid" end-evaluate evaluate TRUE when ind2 is null display "ind2 is now null" when ind2 is overflow display "ind2 is now overflow" when ind2 is valid display "ind2 is now valid" end-evaluate. IF FKEY = 17 PERFORM FETCH-IT3 evaluate TRUE when ind1 is null display "ind1 is now null" when ind1 is overflow display "ind1 is now overflow" when ind1 is valid display "ind1 is now valid" end-evaluate evaluate TRUE when ind2 is null display "ind2 is now null" when ind2 is overflow display "ind2 is now overflow" when ind2 is valid display "ind2 is now valid" end-evaluate evaluate TRUE when ind3 is null display "ind3 is now null" when ind3 is overflow display "ind3 is now overflow" when ind3 is valid display "ind3 is now valid" end-evaluate. IF FKEY = 41 PERFORM FETCH-IT4 evaluate TRUE when ind1 is null display "ind1 is now null" when ind1 is overflow display "ind1 is now overflow" when ind1 is valid display "ind1 is now valid" end-evaluate evaluate TRUE when ind2 is null display "ind2 is now null" when ind2 is overflow display "ind2 is now overflow" when ind2 is valid display "ind2 is now valid" end-evaluate evaluate TRUE when ind3 is null display "ind3 is now null" when ind3 is overflow display "ind3 is now overflow" when ind3 is valid display "ind3 is now valid" end-evaluate evaluate TRUE when ind4 is null display "ind4 is now null" when ind4 is overflow display "ind4 is now overflow" when ind4 is valid display "ind4 is now valid" end-evaluate. * F10/sF10 IF FKEY = 35 PERFORM COMMIT-IT. IF FKEY = 42 PERFORM ROLLBACK-IT. * F12 IF FKEY = 37 PERFORM GD-STUFF. GO TO RECYCLE. COMMIT-IT. COMMIT on sqlerror display "commit error=" sqlstate not on sqlerror display "commit OK" end-commit. COMMIT-IT-ALL. COMMIT ALL on sqlerror display "commit all error=" sqlstate not on sqlerror display "commit all OK" end-commit. ROLLBACK-IT. ROLLBACK on sqlerror display "rollback error=" sqlstate not on sqlerror display "rollback OK" end-rollback. ROLLBACK-IT-ALL. ROLLBACK ALL on sqlerror display "rollback all error=" sqlstate not on sqlerror display "rollback all OK" end-rollback. CONNECT-IT. connect DataBaseName on sqlerror display "connect error=" BOLD sqlstate not on sqlerror display "connect OK" end-connect. DISCONNECT-IT. * disconnect current disconnect DataBaseName on sqlerror display "disconnect error=" sqlstate not on sqlerror display "disconnect OK" end-disconnect. PREPARE-IT. move prepare-id to i. if i = 0 move 1 to i. if i > 9 move 1 to i. prepare PREPARE-ID from SQL-STATEMENT (i) on sqlerror display "prepare error=" sqlstate not on sqlerror display "prepare OK" end-prepare. DEALLOCATE-IT. deallocate prepare PREPARE-ID on sqlerror display "deallocate error=" sqlstate not on sqlerror display "deallocate OK" end-deallocate. EXECUTE-IT0. execute EXECUTE-ID on sqlerror display "execute0 error=" sqlstate not on sqlerror display "execute0 OK" end-execute. EXECUTE-IT1. execute EXECUTE-ID using Parm-A1 on sqlerror display "execute1 error=" sqlstate not on sqlerror display "execute1 OK" end-execute. EXECUTE-IT2. execute EXECUTE-ID using Parm-A1 Parm-A2 on sqlerror display "execute2 error=" sqlstate not on sqlerror display "execute2 OK" end-execute. EXECUTE-IT3. execute EXECUTE-ID using Parm-A1 Parm-A2 Parm-A3 on sqlerror display "execute3 error=" sqlstate not on sqlerror display "execute3 OK" end-execute. EXECUTE-IT4. execute EXECUTE-ID using Parm-A1 Parm-A2 Parm-A3 Parm-A4 on sqlerror display "execute4 error=" sqlstate not on sqlerror display "execute4 OK" end-execute. EXECUTE-IMM-IT. execute immediate EXECUTE-IMM-STATEMENT on sqlerror display "execute imm error=" sqlstate not on sqlerror display "execute imm OK" end-execute. FETCH-IT1. fetch for EXECUTE-ID into vstr1 INDICATOR ind1 on sqlerror display "fetch1 error=" sqlstate if sqlstate = 01501 display "val = " QUOTE vstr1 QUOTE end-if not on sqlerror display "fetch1 OK" display "val = " QUOTE vstr1 QUOTE end-fetch. FETCH-IT2. fetch for EXECUTE-ID into vstr1 INDICATOR ind1 vstr2 INDICATOR ind2 on sqlerror display "fetch2 error=" sqlstate not on sqlerror display "fetch2 OK" display "val1= " QUOTE vstr1 QUOTE display "val2= " QUOTE vstr2 QUOTE end-fetch. FETCH-IT3. fetch for EXECUTE-ID into vstr1 INDICATOR ind1, vstr2 INDICATOR ind2, vstr3 INDICATOR ind3 on sqlerror display "fetch3 error=" sqlstate not on sqlerror display "fetch3 OK" display "val1= " QUOTE vstr1 QUOTE display "val2= " QUOTE vstr2 QUOTE display "val3= " QUOTE vstr3 QUOTE end-fetch. FETCH-IT4. fetch for EXECUTE-ID into vstr1 INDICATOR ind1, vstr2 INDICATOR ind2, vstr3 INDICATOR ind3, vstr4 INDICATOR ind4 on sqlerror display "fetch4 error=" sqlstate not on sqlerror display "fetch4 OK" display "val1= " QUOTE vstr1 QUOTE display "val2= " QUOTE vstr2 QUOTE display "val3= " QUOTE vstr3 QUOTE if ind4 is valid display "val4= " QUOTE vstr4 QUOTE end-if end-fetch. * evaluate TRUE * when ind4 is null display "ind4 is now null" * when ind4 is overflow display "ind4 is now overflow" * when ind4 is valid display "ind4 is now valid" * end-evaluate. * Sample using sample update data *UPDATE-A. ** prepare "update-stmt" from "update addresses set FirstName = ? where LastName = ?" * prepare "update-stmt" from UPDATE-ADDRESS * on sqlerror * display "prepare error=" sqlstate * not on sqlerror * display "prepare OK" * end-prepare. *xxEXECUTE-IT. ** execute "update-stmt" using "David" "Prins" * execute PREPARE-ID using Sample-Parm-A1 Sample-Parm-A2 * on sqlerror * display "execute error=" sqlstate * not on sqlerror * display "execute OK" * end-execute. *UPDATE-B. * execute immediate "update addresses set FirstName = 'Dan' where FirstName = 'David'" * on sqlerror * display "execute imm error=" sqlstate * not on sqlerror * display "execute imm OK" * end-execute. *SELECT-A. * prepare "select-stmt" from "select distinct FirstName from addresses" * on sqlerror * display "prepare error=" sqlstate * not on sqlerror * display "prepare OK" * end-prepare * execute "select-stmt" * on sqlerror * display "execute error=" sqlstate * not on sqlerror * display "execute OK" * end-execute. FETCH-A. perform with test after until sqlstate not = zeros fetch for "select-stmt" into vstr1 on sqlerror display "fetch error=" sqlstate not on sqlerror display "fetch OK" display "val = " QUOTE vstr1 QUOTE end-fetch end-perform deallocate prepare "select-stmt". GD-STUFF. GET DIAGNOSTICS GD-ROW-COUNT = ROW COUNT GD-NUMBER = NUMBER GD-COMMAND-FUNC = COMMAND FUNCTION GD-DYNAMIC-FUNC = DYNAMIC FUNCTION ON EXCEPTION DISPLAY "GD Diagnostics error". MOVE SPACES TO GD-SQLSTATE, GD-MESSAGE-TEXT. MOVE 0 TO GD-MESSAGE-LEN, GD-NATIVE-ERROR. IF GD-NUMBER > 0 GET DIAGNOSTICS EXCEPTION 1 GD-SQLSTATE = SQLSTATE GD-MESSAGE-TEXT = MESSAGE TEXT GD-MESSAGE-LEN = MESSAGE LENGTH GD-NATIVE-ERROR = NATIVE ERROR ON EXCEPTION DISPLAY "GD Exception error". DISPLAY GD-SCREEN. ML-END-PROGRAM. EXIT PROGRAM. STOP RUN.