RPGIV @ Work

A unique site for RPG and System i Lovers

Welcome!

Hi, this site will provide all what you need in System i and RPG developments.

My Name is Chamara Withanachchi, System i Expert and RPG Developer. And in the field for last 11 years.

I hope you will find lot of valuable information from this site

ODBC Exit Program Print E-mail
User Rating: / 1
PoorBest 
Written by Chamara Withanachchi   
       **********************************************************************
       *  SET COMPILER OPTIONS
       **********************************************************************
      HOPTION(*NODEBUGIO:*SRCSTMT)
       **********************************************************************
       *  PROGRAM NAME: ODBCEXITR
       *  CREATION DATE: 07/23/08
       *  PURPOSE OF PROGRAM: ODBC EXIT PROGAM TO PREVENT FILE UPDATES.
       **********************************************************************
       * FILES USED BY PROGRAM.
       **********************************************************************
      FODBCEXITPFIF A E           K DISK
       **********************************************************************
       *  ENTRY PARMS.
       **********************************************************************
      D  ENTRYPARMS     PR                  ExtPgm('ODBCEXITR')
      D  REQUEST_STATUS...
      D                                1
      D  REQUEST_STRING...
      D                             1024
 
      D  ENTRYPARMS     PI
      D  REQUEST_STATUS...
      D                                1
      D  REQUEST_STRING...
      D                             1024
 
       **********************************************************************
       *  FIELD DEFINITIONS.
       **********************************************************************
      D  USER_PROFILE   S             10    INZ(*BLANKS)
      D  SERVER_ID      S             10    INZ(*BLANKS)
      D  FORMAT_NAME    S              8    INZ(*BLANKS)
      D  FUNCTION       S              4    INZ(*BLANKS)
      D  CODETYPE       S              4    INZ(*BLANKS)
      D  FILE_CHANGE    S              6    INZ(*BLANKS)
      D  CODE0000       C                   CONST(X'00000000')
      D  CODE1800       C                   CONST(X'00001800')
      D  CODE1801       C                   CONST(X'00001801')
      D  CODE1802       C                   CONST(X'00001802')
      D  CODE1803       C                   CONST(X'00001803')
      D  CODE1804       C                   CONST(X'00001804')
      D  CODE1805       C                   CONST(X'00001805')
      D  CODE1806       C                   CONST(X'00001806')
      D  CODE1807       C                   CONST(X'00001807')
      D  CODE1808       C                   CONST(X'00001808')
      D  CODE1809       C                   CONST(X'00001809')
      D  CODE180A       C                   CONST(X'0000180A')
      D  CODE180B       C                   CONST(X'0000180B')
      D  CODE180C       C                   CONST(X'0000180C')
      D  CODE180D       C                   CONST(X'0000180D')
      D  CODE180E       C                   CONST(X'0000180E')
      D  CODE180F       C                   CONST(X'0000180F')
      D  CODE1810       C                   CONST(X'00001810')
      D  CODE1811       C                   CONST(X'00001811')
      D  CODE1812       C                   CONST(X'00001812')
      D  CODE1815       C                   CONST(X'00001815')
       **********************************************************************
       *  DATA STRUCTURE FOR REQUEST STRING
       **********************************************************************
      D                 DS                  INZ
      D REQUEST                 1    364
      D  USER                   1     10
      D  SRVID                 11     20
      D  FORMAT                21     28
      D  FUNC                  29     32
      D  FILNAME               33    161
      D  LIBNAME              162    171
      D  MEMBERNAME           172    181
      D  AUTHORITY            182    191
      D  Based_on_file_name...
      D                       192    319
      D  Based_on_library_name...
      D                       320    329
      D  Override_file_name...
      D                       330    339
      D  Override_library_name...
      D                       340    349
      D  Override_member_name...
      D                       350    364
 
         // ******************************************************************
         // *  START FREE FORM CALCS.
         // ******************************************************************
 
       /FREE
 
 
         // ******************************************************************
         // * WRITE REQUEST TO FILE.
         // ******************************************************************
 
         REQUEST_STATUS = '1';
 
         ODBSTATUS = REQUEST_STATUS;
         ODBREQUEST = REQUEST_STRING;
         REQUEST = REQUEST_STRING;
         ODBUSER = USER;
         ODBSRVID = SRVID;
         ODBFORMAT= FORMAT;
         ODBFUNC = FUNC;
         CODETYPE = FUNC;
         ODBDATE = %DATE();
         ODBTIME = %TIME();
 
         // ******************************************************************
         // * IF THE REQUEST IS FROM ANYONE EXCEPT FAST FAX OR B&L'S MPC.
         // ******************************************************************
 
         IF ODBUSER <> 'FFXSYS' AND
            ODBUSER <> 'MPC';
 
         // ******************************************************************
         // * CHECK THE REQUEST STATUS.
         // * IF THIS IS AN UPDATE OR INSERT (ADD A RECORD) REQUEST, CHANGE
         // * THE STATUS TO 0. THIS WILL DENY THE REQUEST.
         // *
         // * WHEN THE ODBC DRIVER SEES THAT THE REQUEST IS DENIED, IT WILL
         // * KILL THE JOB.
         // ******************************************************************
 
            FILE_CHANGE = %SUBST(ODBREQUEST : 240 : 6);
 
            IF FILE_CHANGE = 'UPDATE' OR
               FILE_CHANGE = 'INSERT';
 
               REQUEST_STATUS = '0';
 
            ENDIF;
 
 
            SELECT;
 
         // ******************************************************************
         // *  CODES FOR FORMAT ZDAI0100.
         // ******************************************************************
 
              WHEN CODETYPE = CODE0000 AND ODBFORMAT = 'ZDAI0100';
                ODBFUNCNM = 'Requesting Function';
 
         // ******************************************************************
         // *  CODES FOR FORMAT ZDAQ0200.
         // ******************************************************************
 
              WHEN CODETYPE = CODE1800 AND ODBFORMAT = 'ZDAQ0200';
                ODBFUNCNM = 'Prepare';
 
              WHEN CODETYPE = CODE1803 AND ODBFORMAT = 'ZDAQ0200';
                ODBFUNCNM = 'Prepare and describe';
 
              WHEN CODETYPE = CODE1804 AND ODBFORMAT = 'ZDAQ0200';
                ODBFUNCNM = 'Open/describe';
 
              WHEN CODETYPE = CODE1805 AND ODBFORMAT = 'ZDAQ0200';
                ODBFUNCNM = 'Execute';
 
              WHEN CODETYPE = CODE1806 AND ODBFORMAT = 'ZDAQ0200';
                ODBFUNCNM = 'Execute immediate';
 
              WHEN CODETYPE = CODE1809 AND ODBFORMAT = 'ZDAQ0200';
                ODBFUNCNM = 'Connect';
 
              WHEN CODETYPE = CODE180C AND ODBFORMAT = 'ZDAQ0200';
                ODBFUNCNM = 'Stream fetch';
 
              WHEN CODETYPE = CODE180D AND ODBFORMAT = 'ZDAQ0200';
                ODBFUNCNM = 'Prepare and execute';
 
              WHEN CODETYPE = CODE180E AND ODBFORMAT = 'ZDAQ0200';
                ODBFUNCNM = 'Open and fetch';
 
              WHEN CODETYPE = CODE180F AND ODBFORMAT = 'ZDAQ0200';
                ODBFUNCNM = 'Create package';
 
              WHEN CODETYPE = CODE1810 AND ODBFORMAT = 'ZDAQ0200';
                ODBFUNCNM = 'Clear package';
 
              WHEN CODETYPE = CODE1811 AND ODBFORMAT = 'ZDAQ0200';
                ODBFUNCNM = 'Delete package';
 
              WHEN CODETYPE = CODE1812 AND ODBFORMAT = 'ZDAQ0200';
                ODBFUNCNM = 'Execute or open';
 
              WHEN CODETYPE = CODE1815 AND ODBFORMAT = 'ZDAQ0200';
                ODBFUNCNM = 'Return package';
 
         // ******************************************************************
         // *  CODES FOR FORMAT ZDAD0100.
         // ******************************************************************
 
              WHEN CODETYPE = CODE1800 AND ODBFORMAT = 'ZDAD0100';
                ODBFUNCNM = 'Create source physical file';
                REQUEST_STATUS = '0';
 
              WHEN CODETYPE = CODE1801 AND ODBFORMAT = 'ZDAD0100';
                ODBFUNCNM = 'Create database file, based on existing file';
                REQUEST_STATUS = '0';
 
              WHEN CODETYPE = CODE1802 AND ODBFORMAT = 'ZDAD0100';
                ODBFUNCNM = 'Add database file member';
                REQUEST_STATUS = '0';
 
              WHEN CODETYPE = CODE1803 AND ODBFORMAT = 'ZDAD0100';
                ODBFUNCNM = 'Clear database file member';
                REQUEST_STATUS = '0';
 
              WHEN CODETYPE = CODE1804 AND ODBFORMAT = 'ZDAD0100';
                ODBFUNCNM = 'Delete database file member';
                REQUEST_STATUS = '0';
 
              WHEN CODETYPE = CODE1805 AND ODBFORMAT = 'ZDAD0100';
                ODBFUNCNM = 'Override database file';
 
              WHEN CODETYPE = CODE1806 AND ODBFORMAT = 'ZDAD0100';
                ODBFUNCNM = 'Delete database file override';
 
              WHEN CODETYPE = CODE1807 AND ODBFORMAT = 'ZDAD0100';
                ODBFUNCNM = 'Create save file';
                REQUEST_STATUS = '0';
 
              WHEN CODETYPE = CODE1808 AND ODBFORMAT = 'ZDAD0100';
                ODBFUNCNM = 'Clear save file';
                REQUEST_STATUS = '0';
 
              WHEN CODETYPE = CODE1809 AND ODBFORMAT = 'ZDAD0100';
                ODBFUNCNM = 'Delete file';
                REQUEST_STATUS = '0';
 
         // ******************************************************************
         // *  CODES FOR FORMAT ZDAD0200.
         // ******************************************************************
 
              WHEN CODETYPE = CODE180C AND ODBFORMAT = 'ZDAD0200';
                ODBFUNCNM = 'Add library list';
 
         // ******************************************************************
         // *  CODES FOR FORMAT ZDAQ0100.
         // ******************************************************************
 
              WHEN CODETYPE = CODE1800 AND ODBFORMAT = 'ZDAQ0100';
                ODBFUNCNM = 'Prepare';
 
              WHEN CODETYPE=  CODE1803 AND ODBFORMAT = 'ZDAQ0100';
                ODBFUNCNM = 'Prepare and describe';
 
              WHEN CODETYPE = CODE1804 AND ODBFORMAT = 'ZDAQ0100';
                ODBFUNCNM = 'Open/describe';
 
              WHEN CODETYPE = CODE1805 AND ODBFORMAT = 'ZDAQ0100';
                ODBFUNCNM = 'Execute';
 
              WHEN CODETYPE = CODE1806 AND ODBFORMAT = 'ZDAQ0100';
                ODBFUNCNM = 'Execute immediate';
 
              WHEN CODETYPE = CODE1809 AND ODBFORMAT = 'ZDAQ0100';
                ODBFUNCNM = 'Connect';
 
              WHEN CODETYPE = CODE180D AND ODBFORMAT = 'ZDAQ0100';
                ODBFUNCNM = 'Prepare and execute';
 
              WHEN CODETYPE = CODE180E AND ODBFORMAT = 'ZDAQ0100';
                ODBFUNCNM = 'Open and fetch';
 
              WHEN CODETYPE = CODE180F AND ODBFORMAT = 'ZDAQ0100';
                ODBFUNCNM = 'Create package';
 
              WHEN CODETYPE = CODE1810 AND ODBFORMAT = 'ZDAQ0100';
                ODBFUNCNM = 'Clear package';
 
              WHEN CODETYPE = CODE1811 AND ODBFORMAT = 'ZDAQ0100';
                ODBFUNCNM = 'Delete package';
 
              WHEN CODETYPE = CODE1812 AND ODBFORMAT = 'ZDAQ0100';
                ODBFUNCNM = 'Execute or open';
 
              WHEN CODETYPE = CODE1815 AND ODBFORMAT = 'ZDAQ0100';
                ODBFUNCNM = 'Return package information';
 
         // ******************************************************************
         // *  CODES FOR FORMAT ZDAR0100.
         // ******************************************************************
 
              WHEN CODETYPE = CODE1800 AND ODBFORMAT = 'ZDAR0100';
                ODBFUNCNM = 'Retrieve library information';
 
              WHEN CODETYPE = CODE1801 AND ODBFORMAT = 'ZDAR0100';
                ODBFUNCNM = 'Retrieve relationaldatabase information';
 
              WHEN CODETYPE = CODE1802 AND ODBFORMAT = 'ZDAR0100';
                ODBFUNCNM = 'Retrieve SQL package information';
 
              WHEN CODETYPE = CODE1803 AND ODBFORMAT = 'ZDAR0100';
                ODBFUNCNM = 'Retrieve SQL package statement information';
 
              WHEN CODETYPE = CODE1804 AND ODBFORMAT = 'ZDAR0100';
                ODBFUNCNM = 'Retrieve file information';
 
              WHEN CODETYPE = CODE1805 AND ODBFORMAT = 'ZDAR0100';
                ODBFUNCNM = 'Retrieve file member information';
 
              WHEN CODETYPE = CODE1806 AND ODBFORMAT = 'ZDAR0100';
                ODBFUNCNM = 'Retrieve record format information';
 
              WHEN CODETYPE = CODE1807 AND ODBFORMAT = 'ZDAR0100';
                ODBFUNCNM = 'Retrieve field information';
 
              WHEN CODETYPE = CODE1808 AND ODBFORMAT = 'ZDAR0100';
                ODBFUNCNM = 'Retrieve index information';
 
              WHEN CODETYPE = CODE180B AND ODBFORMAT = 'ZDAR0100';
                ODBFUNCNM = 'Retrieve special column information';
 
         // ******************************************************************
         // *  CODES FOR FORMAT ZDAR0200.
         // ******************************************************************
 
              WHEN CODETYPE = CODE1809 AND ODBFORMAT = 'ZDAR0200';
                ODBFUNCNM = 'Retrieve foreign key information';
 
              WHEN CODETYPE = CODE180A AND ODBFORMAT = 'ZDAR0200';
                ODBFUNCNM = ' Retrieve primary key formation';
 
            other;
 
              ODBFUNCNM = 'Function code unknown ' + CODETYPE;
 
            endsl;
 
          ENDIF;
 
          WRITE ODBCEXIT;
          CLEAR ODBCEXIT;
 
 
          *INLR = *ON;
          RETURN;
 
        /END-FREE
 

User Comments

Please login or register to add comments

<Previous   Next>