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 * 04/01/2005 3.50 Updates v4 * 03/16/2011 4.50 Update for GET COLUMNS and GET TABLES v5 * GET DIAGNOSTICS COLUMN COUNT * Allow CONNECT DEFAULT and USER v6 * Allow several optiosn for * GET TABLES/COLUMNS v7 * * * 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. * Under UNIX usually you edit an odbcini file. * * Second, use Connect (F1/sF1/cF1) to connect to a dataset. * F1 connect using the name only, sF1 connect using a Username/password * cF1 connect using DEFAULT and environment variables. * This will connect thru ODBC to the appropriate driver and database. * csF1 will DisConnect. * * 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. * * Using Get Tables and Get Columns (sF12 or cF12) can provide * information on the dataset, tables available and the columns in * the tables. csF12 will show TABLE/COLUMN help. * * Statements (1-3) 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. * * Use F2 to Prepare a statement, sF2 changes the id used * F3 to Execute that statement, sF3 changes the id used, cF3 set # of parms * If there were NO errors then use * F4 to Fetch values from the result set, sF5 sets the number of columns * to retrieve. * * csF1 will Disconnect from a DSN, and cF2 will DeAllocate a statement. * * 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! * * Again F12 Get Diagnostics provides information on the most recent * operation. * * After a GET TABLES, GET COLUMNS, or EXECUTE statement the new * GET DIAGNOSTICS x = COLUMN COUNT call is made to initialize the * number of FETCH arguments to show. * * Note: For GET TABLES and GET COLUMNS the per-cent "%" is the template * character for CATALOG, SCHEMA, TABLES and COLUMNS. TYPE is a list * of table types (like TABLE, SYSTEM TABLE, VIEW, ... * * ENVIRONMENT DIVISION. CONFIGURATION SECTION. INPUT-OUTPUT SECTION. DATA DIVISION. FILE SECTION. WORKING-STORAGE SECTION. 01 DATASOURCENAME PIC X(60). 01 DATASOURCE-USER PIC X(20). 01 DATASOURCE-PWD PIC X(20). 01 CAT-NAME CHAR VARYING (20) VALUE "%". 01 SCH-NAME CHAR VARYING (20) VALUE "%". 01 TAB-NAME CHAR VARYING (20) VALUE "%". 01 TYP-NAME CHAR VARYING (30) VALUE "TABLE". 01 COL-NAME CHAR VARYING (20) VALUE "". 01 FKEY PIC 99. 01 pFKEY PIC 99. 01 FKEY2 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). 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-PARMS PIC 9 VALUE 0. 01 EXECUTE-IMM-STATEMENT PIC X(200). 01 FETCH-ARGS PIC 99 VALUE 18. 01 FETCH-ARGUMENTS. 02 VSTR OCCURS 100 TIMES CHAR VARYING (100). 01 FETCH-INDICATORS. 02 IND OCCURS 100 TIMES USAGE IS INDICATOR. *01 SQLSTATExx PIC x(5). 77 i pic 99. 77 i-col pic 99. 77 i-line pic 99. * Get Diagnostics 01 GD-COL-COUNT PIC 9(10). 01 hold-GD-COL-COUNT PIC 9(10). 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 v7". 02 LINE 1 COL 60 "SQLSTATE: ". 02 BOLD PIC X(5) FROM SQLSTATE. 02 GET-DSN. 03 LINE 2 COL 1 "DataSource Name: ". 03 PIC X(60) USING DataSourceName. 02 LINE 3 COL 1 "Statements(below)". 02 GET-IDS. 03 GET-ID-PREPARE. 04 COL 41 "ID to prepare: ". 04 PIC 9 USING PREPARE-ID. 03 GET-ID-EXECUTE. 04 " to execute: ". 04 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 GET-PARMS. 04 LINE 7 COL 1 "Parms: a=". 04 PIC X(30) USING PARM-A1. 04 " b=". 04 PIC X(30) USING PARM-A2. 04 LINE 8 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 9 COL 1 "ExeIMM: ". 03 PIC X(70) USING EXECUTE-IMM-STATEMENT. * 00000000011111111112222222222333333333344444444445555555555666666666677777777778 01 MAIN-FUNCTIONS. 02 LINE 10 COL 1 BOLD "Functions:". 02 " F12 GET DIAGNOSTICS, sF12 GET TABLES, cF12 GET COLUMNS, csF12 HELP". 02 LINE 11 COL 1 "F1/sF1/cF1/csF1 Connect DSN/+UID/DEFAULT/DisConn, F2/sF2/cF2 Prepare/ID/Dealloc". 02 LINE 12 COL 1 "F3 Execute with: ". 02 GET-EXECUTE-PARMS. 03 PIC 9 USING EXECUTE-PARMS. 02 " params, sF3 ID, cF3 # of parms, csF3 Execute-Imm". 02 LINE 13 COL 1 "F4 Fetch with: ". 02 GET-FETCH-ARGS. 03 PIC 99 USING FETCH-ARGS. 02 " args, sF4 # of args, F10/sF10 Commit/Rollback". 01 MAIN-SCREEN2. 02 GET-DSN-UID. 03 LINE 2 COL 1 "DataSource Name: ". 03 PIC X(60) USING DataSourceName. 03 LINE 16 COL 1 "User: ". 03 PIC X(20) USING DATASOURCE-USER. 03 " Pwd: ". 03 PIC X(20) USING DATASOURCE-PWD. 01 MAIN-SCREEN-TAB. 02 GET-TABLE. 03 LINE 16 COL 1 "Catalog: ". 03 PIC X(20) USING CAT-NAME. 03 " Schema: ". 03 PIC X(20) USING SCH-NAME. 03 LINE 17 COL 1 "Table: ". 03 PIC X(20) USING TAB-NAME. 03 " Type: ". 03 PIC X(30) USING TYP-NAME. 03 LINE 18 "F1 None of the above, F2 Use ONLY TABLE, F3 Use Only TABLE and TYPE". 01 CL-LINE16. 02 LINE 16 BLANK LINE. 01 CL-LINE17-30. 02 LINE 17 COL 30 BLANK LINE. 01 MAIN-SCREEN-COL. 02 GET-COLUMN. 03 LINE 16 COL 1 "Catalog: ". 03 PIC X(20) USING CAT-NAME. 03 " Schema: ". 03 PIC X(20) USING SCH-NAME. 03 LINE 17 COL 1 "Table: ". 03 PIC X(20) USING TAB-NAME. 03 " Column: ". 03 PIC X(20) USING COL-NAME. 03 LINE 18 "F1 Do not use Catalog/Schema/Table/Column". 01 OUTPUT-LOC. 02 LINE 14 COL 1. 01 OUTPUT-LOC-ERASE. 02 LINE 14 COL 1 ERASE EOS. 01 GD-SCREEN-START. 02 LINE 15 COL 1 "ColCount: ". 02 BOLD PIC Z(3)9 FROM GD-COL-COUNT. 02 " RowCount: ". 02 BOLD PIC Z(5)9 FROM GD-ROW-COUNT. 02 " Number: ". 02 BOLD PIC Z(5)9 FROM GD-NUMBER. 02 " Cmd: ". 02 BOLD PIC X(30) FROM GD-COMMAND-FUNC. 02 LINE 16 "Dyn: ". 02 BOLD PIC X(35) FROM GD-DYNAMIC-FUNC. 01 GD-SCREEN-LOOP. 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 PLUS 1. 02 COL 1 "Msg: ". 02 BOLD PIC X(75) FROM GD-MESSAGE-TEXT (1:75). 02 LINE PLUS 1. 02 BOLD PIC X(80) FROM GD-MESSAGE-TEXT (76:80). 01 HELP-TABLE. 02 LINE 15 "Get Tables columns: TABLE_CAT, TABLE_SCHEM, TABLE_NAME, TABLE_TYPE, REMARKS". 02 LINE 16 "Get Columns columns: TABLE_CAT, TABLE_SCHEM, TABLE_NAME, COLUMN_NAME, DATA_TYPE,". 02 LINE 17 "TYPE_NAME, COLUMN_SIZE, BUFFER_LENGTH, DECINAL_DIGITS, NUM_PREC_RADIX, NULLABLE,". 02 LINE 18 "REMARKS, COLUMN_DEF, SQL_DATA_TYPE, DATETIME_SUB, CHAR_OCTET_LENGTH,". 02 LINE 19 "ORDINAL_POSITION, IS_NULLABLE". PROCEDURE DIVISION. MAIN-LOGIC SECTION. ML-BEGIN. * set fma-ndx to 1. DISPLAY BLANK-SCREEN. RECYCLE. * MOVE SQLSTATE TO SQLSTATExx. DISPLAY MAIN-SCREEN. DISPLAY MAIN-FUNCTIONS. MOVE FKEY TO PFKEY. ACCEPT GET-STATEMENTS. ACCEPT FKEY FROM ESCAPE. * 2-Escapes IF FKEY = 1 AND PFKEY = 1 GO TO ML-END-PROGRAM. * 1-Escape, clear screen, recycle IF FKEY = 1 DISPLAY BLANK-SCREEN GO TO RECYCLE. * Clear output area DISPLAY OUTPUT-LOC-ERASE. * F1(2), sF1(10), cF1(18), csF1(26) Open/Close DSN (database) IF FKEY = 2 OR FKEY = 10 OR FKEY = 18 IF FKEY = 2 ACCEPT GET-DSN END-IF IF FKEY = 10 DISPLAY GET-DSN-UID ACCEPT GET-DSN-UID END-IF DISPLAY OUTPUT-LOC PERFORM CONNECT-IT END-IF. IF FKEY = 26 PERFORM DISCONNECT-IT. * F2(3) sF2(11) cF2(19)Prepare or Deallocate ids IF FKEY = 3 PERFORM PREPARE-IT. If FKEY = 11 ACCEPT GET-ID-PREPARE GO TO RECYCLE. IF FKEY = 19 PERFORM DEALLOCATE-IT. * F3(6) sF3(14) id cF3(22) EXECUTE, csF3(28) Exec Imm IF FKEY = 4 PERFORM EXECUTE-IT. IF FKEY = 12 ACCEPT GET-ID-EXECUTE GO TO RECYCLE. IF FKEY = 20 ACCEPT GET-EXECUTE-PARMS GO TO RECYCLE. IF FKEY = 28 ACCEPT GET-IMM DISPLAY OUTPUT-LOC PERFORM EXECUTE-IMM-IT. *F4(5), sF6(13), Fetch, set fetch count IF FKEY = 5 PERFORM FETCH-IT. IF FKEY = 13 ACCEPT GET-FETCH-ARGS GO TO RECYCLE. * F10/sF10 IF FKEY = 35 PERFORM COMMIT-IT. IF FKEY = 42 PERFORM ROLLBACK-IT. * F12 - Diagnostics IF FKEY = 37 PERFORM GD-STUFF. * sF12(44)/cF12(51) GET TABLES/GET COLUMNS IF FKEY = 44 PERFORM GETTAB. IF FKEY = 51 PERFORM GETCOL. *csF12 - Help IF FKEY = 58 DISPLAY HELP-TABLE. GO TO RECYCLE. COMMIT-IT. COMMIT on sqlerror display "commit error=" sqlstate not on sqlerror display "commit OK " sqlstate end-commit. COMMIT-IT-ALL. COMMIT ALL on sqlerror display "commit all error=" sqlstate not on sqlerror display "commit all OK " sqlstate end-commit. ROLLBACK-IT. ROLLBACK on sqlerror display "rollback error=" sqlstate not on sqlerror display "rollback OK " sqlstate end-rollback. ROLLBACK-IT-ALL. ROLLBACK ALL on sqlerror display "rollback all error=" sqlstate not on sqlerror display "rollback all OK " sqlstate end-rollback. CONNECT-IT. IF FKEY = 2 connect DataSourceName on sqlerror display "connect error=" sqlstate IF SQLSTATE = "28001" DISPLAY "Authorization Failure: probably no ICSQL license is available" END-IF not on sqlerror display "connect OK " sqlstate end-connect END-IF. IF FKEY = 10 connect DataSourceName USER DATASOURCE-USER DATASOURCE-PWD on sqlerror display "connect UID error=" sqlstate IF SQLSTATE = "28001" DISPLAY "Authorization Failure: probably no ICSQL license is available" END-IF not on sqlerror display "connect UID OK " sqlstate end-connect END-IF. IF FKEY = 18 * Uses ICSQLDSN, ICSQLUSER, ICSQLPWD environment variables connect DEFAULT on sqlerror display "connect DEFAULT error=" sqlstate IF SQLSTATE = "28001" DISPLAY "Authorization Failure: probably no ICSQL license is available" END-IF not on sqlerror display "connect DEFAULT OK " sqlstate end-connect END-IF. DISCONNECT-IT. * disconnect current disconnect DataSourceName on sqlerror display "disconnect error=" sqlstate not on sqlerror display "disconnect OK " sqlstate end-disconnect. GETCOL. DISPLAY GET-COLUMN. ACCEPT GET-COLUMN. ACCEPT FKEY2 FROM ESCAPE. DISPLAY OUTPUT-LOC. IF FKEY2 = 2 DISPLAY OUTPUT-LOC-ERASE GET COLUMNS Prepare-id on sqlerror display "get columns error=" sqlstate not on sqlerror display "get columns OK " sqlstate END-GET ELSE DISPLAY OUTPUT-LOC GET COLUMNS Prepare-id CATALOG CAT-NAME SCHEMA SCH-NAME TABLE TAB-NAME COLUMN COL-NAME on sqlerror display "get columns error=" sqlstate not on sqlerror display "get columns OK " sqlstate END-GET END-IF. GET DIAGNOSTICS hold-GD-COL-COUNT = COLUMN COUNT NOT ON EXCEPTION IF hold-GD-COL-COUNT > 0 MOVE hold-GD-COL-COUNT TO FETCH-ARGS; END-IF END-GET. GETTAB. DISPLAY GET-TABLE. ACCEPT GET-TABLE. ACCEPT FKEY2 FROM ESCAPE. DISPLAY OUTPUT-LOC. IF FKEY2 = 2 OR FKEY2 = 3 OR FKEY2 = 4 * second F1 DISPLAY CL-LINE16 DISPLAY OUTPUT-LOC * Some drivers do not support CATALOG or SCHEMA IF FKEY2 = 2 DISPLAY OUTPUT-LOC-ERASE GET TABLES Prepare-id on sqlerror display "get tables error=" sqlstate not on sqlerror display "get tables OK " sqlstate END-GET END-IF IF FKEY2 = 3 * second F2, use TABLE DISPLAY CL-LINE17-30 DISPLAY OUTPUT-LOC GET TABLES Prepare-id TABLE TAB-NAME on sqlerror display "get tables error=" sqlstate not on sqlerror display "get tables OK " sqlstate END-GET END-IF IF FKEY2 = 4 * second F4, use TABLE and TYPE GET TABLES Prepare-id TABLE TAB-NAME TYPE TYP-NAME * type does not support % must use list of tables, TABLE, SYSTEM TABLE, VIEW. ,,, on sqlerror display "get tables error=" sqlstate not on sqlerror display "get tables OK " sqlstate END-GET END-IF ELSE DISPLAY OUTPUT-LOC GET TABLES Prepare-id CATALOG CAT-NAME SCHEMA SCH-NAME TABLE TAB-NAME TYPE TYP-NAME on sqlerror display "get tables error=" sqlstate not on sqlerror display "get tables OK " sqlstate END-GET END-IF. GET DIAGNOSTICS hold-GD-COL-COUNT = COLUMN COUNT NOT ON EXCEPTION IF hold-GD-COL-COUNT > 0 MOVE hold-GD-COL-COUNT TO FETCH-ARGS; END-IF END-GET. 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 " sqlstate end-prepare. DEALLOCATE-IT. deallocate prepare PREPARE-ID on sqlerror display "deallocate error=" sqlstate not on sqlerror display "deallocate OK " sqlstate end-deallocate. EXECUTE-IT. IF EXECUTE-PARMS = 0 execute EXECUTE-ID on sqlerror display "execute0 error=" sqlstate not on sqlerror display "execute0 OK " sqlstate end-execute END-IF. IF EXECUTE-PARMS = 1 execute EXECUTE-ID using Parm-A1 on sqlerror display "execute1 error=" sqlstate not on sqlerror display "execute1 OK " sqlstate end-execute END-IF. IF EXECUTE-PARMS = 2 execute EXECUTE-ID using Parm-A1 Parm-A2 on sqlerror display "execute2 error=" sqlstate not on sqlerror display "execute2 OK " sqlstate end-execute END-IF. IF EXECUTE-PARMS = 3 execute EXECUTE-ID using Parm-A1 Parm-A2 Parm-A3 on sqlerror display "execute3 error=" sqlstate not on sqlerror display "execute3 OK " sqlstate end-execute END-IF. IF EXECUTE-PARMS >= 4 execute EXECUTE-ID using Parm-A1 Parm-A2 Parm-A3 Parm-A4 on sqlerror display "execute4 error=" sqlstate not on sqlerror display "execute4 OK " sqlstate end-execute END-IF. GET DIAGNOSTICS hold-GD-COL-COUNT = COLUMN COUNT NOT ON EXCEPTION IF hold-GD-COL-COUNT > 0 MOVE hold-GD-COL-COUNT TO FETCH-ARGS; END-IF END-GET. EXECUTE-IMM-IT. execute immediate EXECUTE-IMM-STATEMENT on sqlerror display "execute imm error=" sqlstate not on sqlerror display "execute imm OK " sqlstate end-execute. FETCH-IT. INITIALIZE FETCH-ARGUMENTS. INITIALIZE FETCH-INDICATORS. fetch for EXECUTE-ID into vstr(1) INDICATOR ind(1), vstr(2) INDICATOR ind(2), vstr(3) INDICATOR ind(3), vstr(4) INDICATOR ind(4), vstr(5) INDICATOR ind(5), vstr(6) INDICATOR ind(6), vstr(7) INDICATOR ind(7), vstr(8) INDICATOR ind(8), vstr(9) INDICATOR ind(9), vstr(10) INDICATOR ind(10), vstr(11) INDICATOR ind(11) vstr(12) INDICATOR ind(12), vstr(13) INDICATOR ind(13), vstr(14) INDICATOR ind(14), vstr(15) INDICATOR ind(15), vstr(16) INDICATOR ind(16), vstr(17) INDICATOR ind(17), vstr(18) INDICATOR ind(18), vstr(19) INDICATOR ind(19), vstr(20) INDICATOR ind(20), vstr(21) INDICATOR ind(21) on sqlerror display "fetch error=" sqlstate not on sqlerror display "fetch OK " sqlstate end-fetch. MOVE 1 TO I, I-COL MOVE 15 to i-line PERFORM FETCH-ARGS TIMES evaluate TRUE when ind(I) is null display i line i-line col i-col " ind is null" when ind(I) is overflow display i line i-line col i-col "*" QUOTE vstr(I) QUOTE when ind(I) is valid display i line i-line col i-col " " QUOTE vstr(I) QUOTE end-evaluate ADD 1 TO I IF I-COL = 1 THEN MOVE 41 TO I-COL ELSE MOVE 1 TO I-COL ADD 1 TO I-LINE END-IF END-PERFORM. GD-STUFF. GET DIAGNOSTICS GD-COL-COUNT = COLUMN COUNT GD-ROW-COUNT = ROW COUNT GD-NUMBER = NUMBER GD-COMMAND-FUNC = COMMAND FUNCTION GD-DYNAMIC-FUNC = DYNAMIC FUNCTION ON EXCEPTION DISPLAY "GD Diagnostics error, sqlstate=", SQLSTATE IF SQLSTATE = "28001" DISPLAY "Authorization Failure: probably no ICSQL license is available" END-IF NOT ON EXCEPTION DISPLAY GD-SCREEN-START; * Use below for non-screen case * DISPLAY "Rowcount: ", GD-ROW-COUNT, " Number: ", GD-NUMBER; * DISPLAY "Cmd: ", GD-COMMAND-LINE; * DISPLAY "Dyn: ", GD-DYNAMIC-FUNC; END-GET. MOVE SPACES TO GD-SQLSTATE, GD-MESSAGE-TEXT. MOVE 0 TO GD-MESSAGE-LEN, GD-NATIVE-ERROR. IF GD-NUMBER > 0 MOVE 1 TO I; * Loop and get all the exceptions PERFORM UNTIL I > GD-NUMBER GET DIAGNOSTICS EXCEPTION I GD-SQLSTATE = SQLSTATE GD-MESSAGE-TEXT = MESSAGE TEXT GD-MESSAGE-LEN = MESSAGE LENGTH GD-NATIVE-ERROR = NATIVE ERROR ON EXCEPTION DISPLAY "GD Exception error, number =", I, " sqlstate=", SQLSTATE; NOT ON EXCEPTION DISPLAY "SQLSTATE: ", GD-SQLSTATE, " Native Err: ", GD-NATIVE-ERROR; DISPLAY "Msg: ", GD-MESSAGE-TEXT (1:GD-MESSAGE-LEN), "."; END-GET ADD 1 TO I END-PERFORM. ML-END-PROGRAM. EXIT PROGRAM. STOP RUN.