home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue47 / IntBase / frs_ibase_object.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-05-03  |  38.5 KB  |  1,052 lines
  1. unit frs_ibase_object;
  2.  
  3. {*************************************************************************
  4.                                                                           
  5.   UNIT:           frs_Ibase_object.pas                                    
  6.   DESCRIPTION:      This unit allows calls to gds32 via an                  
  7.                   object-oriented interface. This technique               
  8.                   works well with Delphi's code insight/code              
  9.                   completion. It also allows simplified error              
  10.                   checking.                                               
  11.                                                                           
  12.   AUTHOR:         Paul Reeves                                              
  13.                   Fleet River Software                                    
  14.                   http://www.fleetriver.demon.co.uk                       
  15. **************************************************************************}
  16.  
  17. interface
  18.  
  19. uses frs_ibase, windows, sysutils;
  20.  
  21. //Most of the functions have been declared herre - but not all!
  22. type
  23.  
  24.            Tisc_array_get_slice = function(
  25.                   status_vector : PSTATUS_VECTOR;
  26.                       db_handle : pisc_db_handle;
  27.                    trans_handle : pisc_tr_handle;
  28.                        array_id : PISC_QUAD;
  29.                               desc : PISC_ARRAY_DESC;
  30.                           dest_array : Pointer;
  31.                         slice_length : PISC_LONG
  32.                               ) : ISC_STATUS; stdcall;
  33.  
  34.           Tisc_array_lookup_bounds = function (
  35.                        status_vector : PSTATUS_VECTOR;
  36.                            db_handle : pisc_db_handle;
  37.                          trans_handle: pisc_tr_handle;
  38.                            table_name: PChar;
  39.                         column_name : PChar;
  40.                                  desc: PISC_ARRAY_DESC
  41.                                   ): ISC_STATUS; stdcall;
  42.  
  43.          Tisc_array_lookup_desc = function (
  44.                        status_vector : PSTATUS_VECTOR;
  45.                         db_handle : pisc_db_handle;
  46.                     trans_handle: pisc_tr_handle;
  47.                         table_name: PChar;
  48.                         column_name : PChar;
  49.                            desc : PISC_ARRAY_DESC
  50.                               ) : ISC_STATUS; stdcall;
  51.  
  52.     Tisc_array_put_slice = function (
  53.                       status_vector : PSTATUS_VECTOR;
  54.                           db_handle : pisc_db_handle;
  55.                         trans_handle: pisc_tr_handle;
  56.                             array_id: PISC_QUAD;
  57.                                 desc: PISC_ARRAY_DESC;
  58.                         source_array: Pointer;
  59.                         slice_length: PISC_LONG
  60.                               ) : ISC_STATUS; stdcall;
  61.  
  62.               Tisc_array_set_desc = function (
  63.                       status_vector : PSTATUS_VECTOR;
  64.                           table_name: PChar;
  65.                          column_name : PChar;
  66.                           sql_dtype : PSmallint;
  67.                            sql_length: PSmallint;
  68.                           dimensions: PSmallint;
  69.                                 desc: PISC_ARRAY_DESC
  70.                                  ) : ISC_STATUS; stdcall;
  71.  
  72.            Tisc_attach_database = function (
  73.                        status_vector : PSTATUS_VECTOR;
  74.                       db_name_length: Short;
  75.                             db_name : PChar;
  76.                           db_handle : pisc_db_handle;
  77.                   parm_buffer_length: Short;
  78.                         parm_buffer : PChar
  79.                                 ) : ISC_STATUS; stdcall;
  80.  
  81.          Tisc_blob_default_desc = procedure (
  82.                            desc : ISC_BLOB_DESC;
  83.                          table_name : PChar;
  84.                         column_name : PChar
  85.                                ); stdcall;
  86.  
  87.                 Tisc_blob_gen_bpb = function (
  88.                       status_vector : PSTATUS_VECTOR;
  89.                             to_desc : PISC_BLOB_DESC;
  90.                           from_desc : PISC_BLOB_DESC;
  91.                 bpb_buffer_length : Byte;
  92.                        bpb_buffer : Pointer;
  93.                          bpb_length : PByte
  94.                                 ) : ISC_STATUS; stdcall;
  95.  
  96.                  Tisc_blob_info = function (
  97.                       status_vector : PSTATUS_VECTOR;
  98.                         blob_handle : pisc_blob_handle;
  99.             item_list_buffer_length : Smallint;
  100.                    item_list_buffer : Pointer;
  101.                result_buffer_length : Smallint;
  102.                       result_buffer : Pointer
  103.                                 ) : ISC_STATUS; stdcall;
  104.  
  105.             Tisc_blob_lookup_desc = function (
  106.                       status_vector : PSTATUS_VECTOR;
  107.                         db_handle : pisc_db_handle;
  108.                        trans_handle : pisc_tr_handle;
  109.                           tablename : PChar;
  110.                             colname : PChar;
  111.                            blobdesc : ISC_BLOB_DESC;
  112.                              global : PChar
  113.                                 ) : ISC_STATUS; stdcall;
  114.  
  115.              Tisc_blob_set_desc = function (
  116.                       status_vector : PSTATUS_VECTOR;
  117.                        table_name : PChar;
  118.                         column_name : PChar;
  119.                             subtype : Smallint;
  120.                             charset : Smallint;
  121.                        segment_size : Smallint;
  122.                                desc : PISC_BLOB_DESC
  123.                                 ) : ISC_STATUS; stdcall;
  124.  
  125.                  Tisc_cancel_blob = function (
  126.                       status_vector : PSTATUS_VECTOR;
  127.                         blob_handle : pisc_blob_handle
  128.                                 ) : ISC_STATUS; stdcall;
  129.  
  130.              Tisc_cancel_events = function (
  131.                       status_vector : PSTATUS_VECTOR;
  132.                           db_handle : pisc_db_handle;
  133.                            event_id : pisc_long
  134.                                 ) : ISC_STATUS; stdcall;
  135.  
  136.                   Tisc_close_blob = function (
  137.                       status_vector : PSTATUS_VECTOR;
  138.                         blob_handle : pisc_blob_handle
  139.                                 ) : ISC_STATUS; stdcall;
  140.  
  141.             Tisc_commit_retaining = function (
  142.                      status_vector : PSTATUS_VECTOR;
  143.                        trans_handle : pisc_tr_handle
  144.                                   ) : ISC_STATUS; stdcall;
  145.  
  146.           Tisc_commit_transaction = function (
  147.                       status_vector : PSTATUS_VECTOR;
  148.                        trans_handle : pisc_tr_handle
  149.                                 ) : ISC_STATUS; stdcall;
  150.  
  151.   {This function is not in on-line help}
  152.                Tisc_create_blob = function (
  153.                                 status_vector : PSTATUS_VECTOR;
  154.                                         db_handle : pisc_db_handle;
  155.                                      trans_handle : pisc_tr_handle;
  156.                                      blob_handle    : pisc_blob_handle;
  157.                        pblob_id : PISC_QUAD
  158.                                 ) : ISC_STATUS; stdcall;
  159.  
  160.                 Tisc_create_blob2 = function (
  161.                   status_vector : PSTATUS_VECTOR;
  162.                       db_handle : pisc_db_handle;
  163.                    trans_handle : pisc_tr_handle;
  164.                     blob_handle : pisc_blob_handle;
  165.                        pblob_id : PISC_QUAD;
  166.                      bpb_length : Smallint;
  167.                     bpb_address : PChar
  168.                                 ) : ISC_STATUS; stdcall;
  169.  
  170.                Tisc_database_info = function (
  171.                               status_vector : PSTATUS_VECTOR;
  172.                                         db_handle    : pisc_db_handle;
  173.                 item_list_buffer_length    : Smallint;
  174.                              item_list_buffer : Pointer;
  175.                      result_buffer_length : Smallint;
  176.                                   result_buffer    : Pointer
  177.                               ) : ISC_STATUS;stdcall;
  178.  
  179.                Tisc_decode_date = procedure (
  180.                                       ib_date : PISC_QUAD;
  181.                                                 tm_date    : PTM
  182.                                 ) ; stdcall;
  183.  
  184.            Tisc_detach_database = function (
  185.                                    status_vector    : PSTATUS_VECTOR;
  186.                                            db_handle    : pisc_db_handle
  187.                               ) : ISC_STATUS; stdcall;
  188.  
  189.              Tisc_drop_database = function (
  190.                                    status_vector    : PSTATUS_VECTOR;
  191.                                         db_handle    : pisc_db_handle
  192.                                 ) : ISC_STATUS; stdcall;
  193.  
  194.    Tisc_dsql_allocate_statement = function (
  195.                        status_vector : PSTATUS_VECTOR;
  196.                            db_handle : pisc_db_handle;
  197.                          stmt_handle : pisc_stmt_handle
  198.                                  ) : ISC_STATUS;  stdcall; 
  199.  
  200.     Tisc_dsql_allocate_statement2 = function (
  201.                       status_vector : PSTATUS_VECTOR;
  202.                           db_handle : pisc_db_handle;
  203.                         stmt_handle : pisc_stmt_handle
  204.                                 ) : ISC_STATUS; stdcall;
  205.  
  206.                 Tisc_dsql_describe = function (
  207.                       status_vector : PSTATUS_VECTOR;
  208.                         stmt_handle : pisc_stmt_handle;
  209.                             dialect : Word;
  210.                            xsqlda : PXSQLDA
  211.                                  ) : ISC_STATUS; stdcall;
  212.  
  213.           Tisc_dsql_describe_bind = function (
  214.                       status_vector : PSTATUS_VECTOR;
  215.                         stmt_handle : pisc_stmt_handle;
  216.                             dialect : Word;
  217.                            xsqlda : PXSQLDA
  218.                                 ) : ISC_STATUS; stdcall;
  219.  
  220.               Tisc_dsql_execute = function (
  221.                   status_vector : PSTATUS_VECTOR;
  222.                    trans_handle : pisc_tr_handle;
  223.                     stmt_handle : pisc_stmt_handle;
  224.                         dialect : Word;
  225.                          xsqlda : PXSQLDA
  226.                               ) : ISC_STATUS; stdcall;
  227.  
  228.              Tisc_dsql_execute2 = function (
  229.                   status_vector : PSTATUS_VECTOR;
  230.                    trans_handle : pisc_tr_handle;
  231.                     stmt_handle : pisc_stmt_handle;
  232.                         dialect : Word;
  233.                       in_xsqlda : PXSQLDA;
  234.                      out_xsqlda : PXSQLDA
  235.                               ) : ISC_STATUS; stdcall;
  236.                               
  237.     Tisc_dsql_execute_immediate = function (
  238.                   status_vector : PSTATUS_VECTOR;
  239.                       db_handle : pisc_db_handle;
  240.                    trans_handle : pisc_tr_handle;
  241.                          length : Word;
  242.                       statement : PChar;
  243.                         dialect : Word;
  244.                          xsqlda : PXSQLDA
  245.                               ) : ISC_STATUS; stdcall;
  246.  
  247.           Tisc_dsql_exec_immed2 = function (
  248.                   status_vector : PSTATUS_VECTOR;
  249.                       db_handle : pisc_db_handle;
  250.                    trans_handle : pisc_tr_handle;
  251.                          length : Word;
  252.                       statement : PChar;
  253.                         dialect : Word;
  254.                       in_xsqlda : PXSQLDA;
  255.                      out_xsqlda : PXSQLDA
  256.                               ) : ISC_STATUS; stdcall;
  257.  
  258.                 Tisc_dsql_fetch = function (
  259.                   status_vector : PSTATUS_VECTOR;
  260.                     stmt_handle : pisc_stmt_handle;
  261.                         dialect : Word;
  262.                          xsqlda : PXSQLDA
  263.                               ) : ISC_STATUS; stdcall;
  264.  
  265.        Tisc_dsql_free_statement = function (
  266.                   status_vector : PSTATUS_VECTOR;
  267.                     stmt_handle : pisc_stmt_handle;
  268.                          option : Word
  269.                               ) : ISC_STATUS; stdcall;
  270.  
  271.               Tisc_dsql_prepare = function (
  272.                   status_vector : PSTATUS_VECTOR;
  273.                    trans_handle : pisc_tr_handle;
  274.                     stmt_handle : pisc_stmt_handle;
  275.                          length : Word;
  276.                       statement : PChar;
  277.                         dialect : Word;
  278.                          xsqlda : PXSQLDA
  279.                               ) : ISC_STATUS; stdcall;
  280.  
  281.       Tisc_dsql_set_cursor_name = function (
  282.                   status_vector : PSTATUS_VECTOR;
  283.                     stmt_handle : pisc_stmt_handle;
  284.                     cursor_name : PChar;
  285.                     cursor_type : Word
  286.                               ) : ISC_STATUS; stdcall;
  287.  
  288.              Tisc_dsql_sql_info = function (
  289.                   status_vector : PSTATUS_VECTOR;
  290.                     stmt_handle : pisc_stmt_handle;
  291.                     item_length : Word;
  292.                           items : PChar;
  293.                   buffer_length : Word;
  294.                          buffer : PChar
  295.                               ) : ISC_STATUS; stdcall;
  296.  
  297.                Tisc_encode_date = procedure (
  298.                         tm_date : PTM;
  299.                         ib_date : PISC_QUAD
  300.                                ); stdcall;
  301.  
  302.                Tisc_event_block = function (
  303.                    event_buffer : Pointer;
  304.                   result_buffer : Pointer;
  305.                           count : short;
  306.                           name1 : PChar
  307.                               ) : Longint; stdcall;
  308.  
  309.               Tisc_event_counts = procedure (
  310.                   status_vector : PSTATUS_VECTOR;
  311.                   buffer_length : Word;
  312.                    event_buffer : PChar;
  313.                   result_buffer : PChar
  314.                                ); stdcall;
  315.  
  316.                Tisc_get_segment = function (
  317.                   status_vector : PSTATUS_VECTOR;
  318.                     blob_handle : pisc_blob_handle;
  319.              actual_seg_length  : PWord;
  320.              seg_buffer_length  : Word;
  321.                     seg_buffer  : Pointer
  322.                               ) : ISC_STATUS; stdcall;
  323.  
  324.                 Tisc_interprete = function (
  325.                          buffer : PChar;
  326.               status_vector_ptr : PPSTATUS_VECTOR
  327.                               ) : ISC_STATUS; stdcall;
  328.  
  329.                   Tisc_open_blob2 = function (
  330.                   status_vector : PSTATUS_VECTOR;
  331.                       db_handle : pisc_db_handle;
  332.                    trans_handle : pisc_tr_handle;
  333.                     blob_handle : pisc_blob_handle;
  334.                        blob_id  : PISC_QUAD;
  335.                     bpb_length  : Word;
  336.                    bpb_address  : Pointer
  337.                               ) : ISC_STATUS; stdcall;
  338.  
  339.        Tisc_prepare_transaction = function (
  340.                   status_vector : PSTATUS_VECTOR;
  341.                    trans_handle : pisc_tr_handle
  342.                               ) : ISC_STATUS; stdcall;
  343.  
  344.       Tisc_prepare_transaction2 = function (
  345.                   status_vector : PSTATUS_VECTOR;
  346.                    trans_handle : pisc_tr_handle;
  347.                      msg_length : Word;
  348.                             msg : PChar
  349.                               ) : ISC_STATUS; stdcall;
  350.  
  351.               Tisc_print_status = procedure (
  352.               status_vector_ptr : PSTATUS_VECTOR
  353.                                );  stdcall;
  354.  
  355.             Tisc_print_sqlerror = procedure (
  356.                         SQLCODE : ISC_LONG;
  357.               status_vector_ptr : PSTATUS_VECTOR
  358.                                );  stdcall;
  359.  
  360.                Tisc_put_segment = function (
  361.                   status_vector : PSTATUS_VECTOR;
  362.                     blob_handle : pisc_blob_handle;
  363.              seg_buffer_length  : Word;
  364.             seg_buffer_address  : Pointer
  365.                               ) : ISC_STATUS; stdcall;
  366.  
  367.                 Tisc_que_events = function (
  368.                   status_vector : PSTATUS_VECTOR;
  369.                       db_handle : pisc_db_handle;
  370.                        event_id : PISC_LONG;
  371.                          length : Word;
  372.                    event_buffer : PChar;
  373.                  event_function : Tisc_callback;
  374.              event_function_arg : Pointer
  375.                               ) : ISC_STATUS; stdcall;
  376.  
  377.       Tisc_rollback_transaction = function (
  378.                   status_vector : PSTATUS_VECTOR;
  379.                    trans_handle : pisc_tr_handle
  380.                               ) : ISC_STATUS; stdcall;
  381.  
  382.                       Tisc_sqlcode = function (
  383.                       status_vector : PSTATUS_VECTOR
  384.                                 ) : ISC_LONG; stdcall;
  385.  
  386.             Tisc_sql_interprete = procedure (
  387.                             sqlcode : ISC_LONG;
  388.                               buffer : PChar;
  389.                       buffer_length : short
  390.                                ); stdcall;
  391.  
  392.             Tisc_start_multiple = function (
  393.                       status_vector : PSTATUS_VECTOR;
  394.                         trans_handle : pisc_tr_handle;
  395.                     db_handle_count : short;
  396.                  teb_vector_address : PISC_TEB
  397.                               ) : ISC_STATUS; stdcall;
  398.  
  399.          Tisc_start_transaction = function (
  400.                       status_vector : PSTATUS_VECTOR;
  401.                        trans_handle : pisc_tr_handle;
  402.                     db_handle_count : short;
  403.                           db_handle : pisc_db_handle;
  404.                           tpb_length : Word;
  405.                            tpb_addr : PChar
  406.                               ) : ISC_STATUS; stdcall;
  407.  
  408.           Tisc_transaction_info = function (
  409.                       status_vector : PSTATUS_VECTOR;
  410.                        trans_handle : pisc_tr_handle;
  411.             item_list_buffer_length : Smallint;
  412.                    item_list_buffer : Pointer;
  413.                result_buffer_length : Smallint;
  414.                      result_buffer : Pointer
  415.                               ) : ISC_STATUS; stdcall;
  416.  
  417.                Tisc_vax_integer = function (
  418.                   result_buffer : PChar;
  419.                   result_length : SmallInt
  420.                               ) : ISC_LONG; stdcall;
  421.  
  422.                    Tisc_version = function (
  423.                           db_handle : pisc_db_handle;
  424.                       function_name : Tisc_callback;
  425.                        user_arg : Pointer
  426.                               ) : Integer; stdcall;
  427.  
  428.             Tisc_wait_for_event = function (
  429.                   status_vector : PSTATUS_VECTOR;
  430.                           db_handle : pisc_db_handle;
  431.                              length : short;
  432.                        event_buffer : PChar;
  433.                       result_buffer : PChar
  434.                               ) : ISC_STATUS; stdcall;
  435.  
  436.  
  437. {---------------------------------------------------------------------------------------------}
  438. {                                 DYNAMIC LIBRARY LOADING                                     }
  439. {---------------------------------------------------------------------------------------------}
  440. type
  441.   TGDSFunctionNames = array[0..35] of PChar;
  442.  
  443. const
  444.   GDSFunctionName : TGDSFunctionNames = (
  445.     'isc_attach_database',
  446.     'isc_blob_info',
  447.     'isc_commit_retaining',
  448.     'isc_commit_transaction',
  449.     'isc_database_info',
  450.     'isc_decode_date',
  451.     'isc_detach_database',
  452.     'isc_drop_database',
  453.     'isc_dsql_allocate_statement',
  454.     'isc_dsql_allocate_statement2',
  455.     'isc_dsql_describe',
  456.     'isc_dsql_describe_bind',
  457.     'isc_dsql_execute',
  458.     'isc_dsql_execute2',
  459.     'isc_dsql_execute_immediate',
  460.     'isc_dsql_exec_immed2',
  461.     'isc_dsql_fetch',
  462.     'isc_dsql_free_statement',
  463.     'isc_dsql_prepare',
  464.     'isc_dsql_set_cursor_name',
  465.     'isc_dsql_sql_info',
  466.     'isc_encode_date',
  467.     'isc_get_segment',
  468.     'isc_interprete',
  469.     'isc_open_blob2',
  470.     'isc_prepare_transaction',
  471.     'isc_prepare_transaction2',
  472.     'isc_print_status',
  473.     'isc_print_sqlerror',
  474.     'isc_put_segment',
  475.     'isc_rollback_transaction',
  476.     'isc_sqlcode',
  477.     'isc_sql_interprete',
  478.     'isc_start_multiple',
  479.     'isc_transaction_info',
  480.     'isc_vax_integer'
  481.   );
  482. const
  483.   KILOBYTE=1024;
  484.                               
  485. type
  486.   Tfrs_IBErrorEvent = procedure(Status: ISC_STATUS_VECTOR; ErrorMessage: String; Var RaiseException:Boolean) of object;
  487.  
  488.   TParamBlock     = array [0..KILOBYTE-1] of Char;
  489.   TLargePB        = array [0..(4*KILOBYTE)-1] of Char;
  490.   TSmallPB        = array [0..(KILOBYTE div 4)-1] of Char;
  491.  
  492.   TFetchStatus  = ( fsUnFetchable, fsFetchable, fsFetching, fsFetched);
  493.   
  494.   Tfrs_GDS = class(TObject)
  495.   private
  496.     FErrorCode: ISC_STATUS;   
  497.     FErrorMessages: String;   //concatenation of error messages.
  498.     FDBName: String;
  499.     FFetchCode: ISC_STATUS;   //
  500.     FFetchStatus: TFetchStatus;
  501.     FLibHandle: THandle;
  502.     FOnIBErrorEvent : Tfrs_IBErrorEvent;
  503.     FRaiseException:   Boolean;
  504.     FTEB: ISC_TEB;
  505.     
  506.     FDBHandle: Tisc_db_handle;
  507.     FStatusVector: ISC_STATUS_VECTOR;
  508.     FStmtHandle: Tisc_stmt_handle;
  509.     FTxnHandle: Tisc_tr_handle;
  510.     
  511.     procedure SetFetchCode(const Value: ISC_STATUS);
  512.   protected  
  513.     Procedure DoIBErrorEvent(Status: ISC_STATUS_VECTOR; ErrorMessage: String; Var RaiseExcept: Boolean); virtual;
  514.     function GetErrorCode: ISC_STATUS;      
  515.     Procedure HandleIBErrors; Virtual;
  516.     Procedure SetErrorCode(AErrorCode:ISC_STATUS); virtual;
  517.   public
  518.   //NOTE!!! - Only the most regularly used functions are declared here. 
  519.     isc_attach_database           : Tisc_attach_database;
  520.     isc_blob_info                 : Tisc_blob_info;
  521.     isc_close_blob                : Tisc_close_blob;
  522.     isc_commit_retaining          : Tisc_commit_retaining;
  523.     isc_commit_transaction        : Tisc_commit_transaction;
  524.     isc_create_blob2              : Tisc_create_blob2;
  525.     isc_database_info             : Tisc_database_info;
  526.     isc_decode_date               : Tisc_decode_date;
  527.     isc_detach_database           : Tisc_detach_database;
  528.     isc_drop_database             : Tisc_drop_database;
  529.     isc_dsql_allocate_statement   : Tisc_dsql_allocate_statement;
  530.     isc_dsql_allocate_statement2  : Tisc_dsql_allocate_statement2;
  531.     isc_dsql_describe             : Tisc_dsql_describe;
  532.     isc_dsql_describe_bind        : Tisc_dsql_describe_bind;
  533.     isc_dsql_execute              : Tisc_dsql_execute;
  534.     isc_dsql_execute2             : Tisc_dsql_execute2;
  535.     isc_dsql_execute_immediate    : Tisc_dsql_execute_immediate;
  536.     isc_dsql_exec_immed2          : Tisc_dsql_exec_immed2;
  537.     isc_dsql_fetch                : Tisc_dsql_fetch;
  538.     isc_dsql_free_statement       : Tisc_dsql_free_statement;
  539.     isc_dsql_prepare              : Tisc_dsql_prepare;
  540.     isc_dsql_set_cursor_name      : Tisc_dsql_set_cursor_name;
  541.     isc_dsql_sql_info             : Tisc_dsql_sql_info;
  542.     isc_encode_date               : Tisc_encode_date;
  543.     isc_get_segment               : Tisc_get_segment;
  544.     isc_interprete                : Tisc_interprete;
  545.     isc_open_blob2                : Tisc_open_blob2;
  546.     isc_prepare_transaction       : Tisc_prepare_transaction;
  547.     isc_prepare_transaction2      : Tisc_prepare_transaction2;
  548.     isc_print_status              : Tisc_print_status;
  549.     isc_print_sqlerror            : Tisc_print_sqlerror;
  550.     isc_put_segment               : Tisc_put_segment;
  551.     isc_rollback_transaction      : Tisc_rollback_transaction;
  552.     isc_sqlcode                   : Tisc_sqlcode;
  553.     isc_sql_interprete            : Tisc_sql_interprete;
  554.     isc_start_multiple            : Tisc_start_multiple;
  555.     isc_transaction_info          : Tisc_transaction_info;
  556.     isc_vax_integer               : Tisc_vax_integer;
  557.  
  558.  
  559.     //These variables need to be public - so they can be directly referenced
  560.     FDPB: TParamBlock;        //parameter block for database connection
  561.     FDPBLen: Integer;         //length of Paramblock
  562.     FTPB: TParamBlock;        //parameter block for transaction
  563.     FTPBLen: Integer;         //length of Paramblock
  564.     InPutDataArea      : PXSQLDA;//Input XSQLDA
  565.     OutPutDataArea    : PXSQLDA;//Output XSQLDA
  566.  
  567.     Constructor create;
  568.     Destructor destroy; override;
  569.     
  570. //    procedure MemAlloc(var P; OldSize, NewSize: Integer);
  571.     function XSQLDA_LENGTH(n: Word): Longint;
  572.     procedure AllocateSQLData(var AXSQLDA: PXSQLDA);
  573.     procedure FreeSQLData(var AXSQLDA: PXSQLDA);
  574.     procedure InitSQLDA(var AXSQLDA: PXSQLDA; Columns: Integer);
  575.  
  576.     procedure BuildPBString( var PB: array of char; var PBLen: Integer; item: byte; contents: string);
  577.     procedure BuildPBInteger( var PB: array of char; var PBLen: Integer; item: byte; contents: Integer);
  578.     procedure BuildPBBoolean( var PB: array of char; var PBLen: Integer; item: byte; contents: Boolean);
  579.     procedure BuildPBAddConstant(var PB: array of char; var PBLen: Integer; item: byte);
  580.  
  581.     procedure DatabaseOpen; virtual;
  582.     procedure DatabaseClose; virtual;
  583.     
  584.     procedure TransactionStart; virtual;
  585.     procedure TransactionCommit; virtual;
  586.     procedure TransactionRetain; virtual;
  587.     procedure TransactionRollback; virtual;
  588.  
  589.     Function IBDateStrToDateTime(DateTimeStr: String): TDateTime;
  590.     
  591.     Property DBHandle: Tisc_db_handle read FDBHandle write FDBHandle;
  592.     Property DBName: String read FDBName write FDBName;
  593.     Property ErrorCode: ISC_STATUS read GetErrorCode write SetErrorCode;
  594.     Property ErrorMessages: String read FErrorMessages;
  595.     Property FetchCode: ISC_STATUS read FFetchCode write SetFetchCode;
  596.     property FetchStatus: TFetchStatus read FFetchStatus;
  597.     Property OnIBError : Tfrs_IBErrorEvent read FOnIBErrorEvent write FonIBErrorEvent;
  598.     property StatusVector: ISC_STATUS_VECTOR read FStatusVector;
  599.     Property StmtHandle: Tisc_stmt_handle read FStmtHandle write FStmtHandle;
  600.     Property TEB: ISC_TEB read FTEB write FTEB;
  601.     Property TxnHandle: Tisc_tr_handle read FTxnHandle write FTxnHandle;
  602.   end;
  603.  
  604.   Tfrs_GDSClass = class(Tfrs_GDS);
  605.  
  606.  
  607.   {Exception Classes}
  608.   EIBError = class(Exception);
  609.  
  610. var
  611.   frs_GDS: Tfrs_GDS;
  612.  
  613. implementation
  614.  
  615. function LoadProcAddress(LibraryHandle: THandle;FunctionName: PChar): pointer;
  616. begin
  617.   result:=GetProcAddress(LibraryHandle, FunctionName);
  618.   if @result = nil then 
  619.     raise EIBError.Create('Failed to load '+FunctionName+' from '+IBASE_DLL);
  620. end;
  621.  
  622.  
  623. {======= Tfrs_GDS =============}
  624. Constructor Tfrs_GDS.Create;
  625. var i: integer;
  626.  
  627. const   LOADFAIL = 'Failed to lookup ';
  628. {Note: This constructor automatically loads every function it knows about. 
  629. It is called in the initialization section. (See below.) 
  630. However, the design is intended to allow dynamic loading by making 
  631. simple modifications. }
  632. begin
  633.  
  634. FLibHandle := LoadLibrary(IBASE_DLL);
  635. if FLibHandle < 32 then  raise EIBError.Create('Unable to load '+IBASE_DLL);
  636.  
  637. i:=0;
  638. @Isc_Attach_Database:=LoadProcAddress(FLibHandle,GDSFunctionName[i]);           inc(i);
  639. @Isc_Blob_Info:=LoadProcAddress(FLibHandle,GDSFunctionName[i]);                 inc(i);
  640. @isc_commit_retaining:=LoadProcAddress(FLibHandle,GDSFunctionName[i]);          inc(i);
  641. @isc_commit_transaction:=LoadProcAddress(FLibHandle,GDSFunctionName[i]);        inc(i);
  642. @isc_database_info:=LoadProcAddress(FLibHandle,GDSFunctionName[i]);             inc(i);
  643. @isc_decode_date:=LoadProcAddress(FLibHandle,GDSFunctionName[i]);               inc(i);
  644. @isc_detach_database:=LoadProcAddress(FLibHandle,GDSFunctionName[i]);           inc(i);
  645. @isc_drop_database:=LoadProcAddress(FLibHandle,GDSFunctionName[i]);             inc(i);
  646. @isc_dsql_allocate_statement:=LoadProcAddress(FLibHandle,GDSFunctionName[i]);   inc(i);
  647. @isc_dsql_allocate_statement2:=LoadProcAddress(FLibHandle,GDSFunctionName[i]);  inc(i);
  648. @isc_dsql_describe:=LoadProcAddress(FLibHandle,GDSFunctionName[i]);             inc(i);
  649. @isc_dsql_describe_bind:=LoadProcAddress(FLibHandle,GDSFunctionName[i]);        inc(i);
  650. @isc_dsql_execute:=LoadProcAddress(FLibHandle,GDSFunctionName[i]);              inc(i);
  651. @isc_dsql_execute2:=LoadProcAddress(FLibHandle,GDSFunctionName[i]);             inc(i);
  652. @isc_dsql_execute_immediate:=LoadProcAddress(FLibHandle,GDSFunctionName[i]);    inc(i);
  653. @isc_dsql_exec_immed2:=LoadProcAddress(FLibHandle,GDSFunctionName[i]);          inc(i);
  654. @isc_dsql_fetch:=LoadProcAddress(FLibHandle,GDSFunctionName[i]);                inc(i);
  655. @isc_dsql_free_statement:=LoadProcAddress(FLibHandle,GDSFunctionName[i]);       inc(i);
  656. @isc_dsql_prepare:=LoadProcAddress(FLibHandle,GDSFunctionName[i]);              inc(i);
  657. @isc_dsql_set_cursor_name:=LoadProcAddress(FLibHandle,GDSFunctionName[i]);      inc(i);
  658. @isc_dsql_sql_info:=LoadProcAddress(FLibHandle,GDSFunctionName[i]);             inc(i);
  659. @isc_encode_date:=LoadProcAddress(FLibHandle,GDSFunctionName[i]);               inc(i);
  660. @isc_get_segment:=LoadProcAddress(FLibHandle,GDSFunctionName[i]);               inc(i);
  661. @isc_interprete:=LoadProcAddress(FLibHandle,GDSFunctionName[i]);                inc(i);
  662. @isc_open_blob2:=LoadProcAddress(FLibHandle,GDSFunctionName[i]);                inc(i);
  663. @isc_prepare_transaction:=LoadProcAddress(FLibHandle,GDSFunctionName[i]);       inc(i);
  664. @isc_prepare_transaction2:=LoadProcAddress(FLibHandle,GDSFunctionName[i]);      inc(i);
  665. @isc_print_status:=LoadProcAddress(FLibHandle,GDSFunctionName[i]);              inc(i);
  666. @isc_print_sqlerror:=LoadProcAddress(FLibHandle,GDSFunctionName[i]);            inc(i);
  667. @isc_put_segment:=LoadProcAddress(FLibHandle,GDSFunctionName[i]);               inc(i);
  668. @isc_rollback_transaction:=LoadProcAddress(FLibHandle,GDSFunctionName[i]);      inc(i);
  669. @isc_sqlcode:=LoadProcAddress(FLibHandle,GDSFunctionName[i]);                   inc(i);
  670. @isc_sql_interprete:=LoadProcAddress(FLibHandle,GDSFunctionName[i]);            inc(i);
  671. @isc_start_multiple:=LoadProcAddress(FLibHandle,GDSFunctionName[i]);            inc(i);
  672. @isc_transaction_info:=LoadProcAddress(FLibHandle,GDSFunctionName[i]);          inc(i);
  673. @isc_vax_integer:=LoadProcAddress(FLibHandle,GDSFunctionName[i]);               //inc(i);
  674.  
  675. //init statusvector
  676. for i:=low(FStatusVector) to high(FStatusVector) do
  677.   FstatusVector[i]:=0;
  678.  
  679. FDBHandle:=Nil;
  680. FTxnHandle:=Nil;
  681. FStmtHandle:=Nil;
  682.  
  683. //init DPB
  684. fillchar(FDPB,sizeof(FDPB),#0);
  685. FDPB[0] := char(isc_dpb_version1);
  686. inc(FDPBLen);
  687.  
  688. //init TPB
  689. fillchar(FTPB,sizeof(FTPB),#0);
  690. FTPB[0] := char(isc_tpb_version3);
  691. inc(FTPBLen);
  692.  
  693. //init TEB
  694. with FTEB do begin
  695.   db_ptr  := @FDBhandle;
  696.   tpb_len := 0;
  697.   tpb_ptr := nil;
  698. end;
  699.  
  700.  
  701. InputDataArea:=Nil;
  702. OutputDataArea:=Nil;
  703. InitSQLDA(InPutDataArea,1);
  704. InitSQLDA(OutPutDataArea,1);
  705.  
  706. end;
  707.  
  708. Destructor Tfrs_GDS.Destroy;
  709. begin
  710.   FreeLibrary(FLibHandle);
  711.   inherited destroy;
  712. end;
  713.  
  714. procedure Tfrs_GDS.DoIBErrorEvent(Status: ISC_STATUS_VECTOR;  ErrorMessage: String; 
  715.   var RaiseExcept: Boolean);
  716. begin
  717. //By assigning code to the event it is possible 
  718. //to check the error and handle it or raise it.
  719.   if (assigned(FOnIBErrorEvent)) then
  720.     FOnIbErrorEvent(FStatusVector,FErrorMessages,RaiseExcept);
  721. end;
  722.  
  723. function Tfrs_GDS.GetErrorCode: ISC_STATUS;
  724. begin
  725.   result:=FErrorCode;
  726. end;
  727.  
  728. procedure Tfrs_GDS.HandleIBErrors;
  729. var
  730.   buffer: array[0..511] of char;
  731.   lastMsg: string;
  732.   pStatus: PSTATUS_VECTOR;
  733. begin
  734.   fillchar(buffer,512,#0);
  735.   pStatus:=@FStatusVector;
  736.   FRaiseException := True;
  737.   begin
  738.     FErrorMessages:='';//clear the old errors;
  739.     repeat
  740.       FErrorCode := isc_interprete( @buffer, @pstatus);
  741.       if lastMsg <> strPas( buffer) then begin
  742.         lastMsg := strPas( buffer);
  743.         if length( FErrorMessages) <> 0 then FErrorMessages := FErrorMessages+#13#10;
  744.         FErrorMessages := FErrorMessages+lastMsg;
  745.         end;
  746.     until
  747.       FErrorCode = 0;
  748.     //If an event method has been assigned then it can test the error and decide whether to 
  749.     //raise it or not. The default is to raise it.  
  750.     DoIBErrorEvent(FStatusVector,FErrorMessages,FRaiseException);
  751.     if FRaiseException then raise EIBError.Create(FErrorMessages);
  752.   end;
  753. end;
  754.  
  755. procedure Tfrs_GDS.AllocateSQLData(var AXSQLDA: PXSQLDA);
  756. var
  757.     i: integer;
  758.   datatype: smallint;
  759. begin
  760.     for i := 0 to AXSQLDA^.sqld -1 do begin
  761.       datatype:= AXSQLDA.sqlvar[i].sqltype and (not SQL_NULL);
  762.       if datatype=SQL_VARYING then begin
  763.         getmem(AXSQLDA.sqlvar[i].sqlData,AXSQLDA.sqlvar[i].sqllen +2 );
  764.         FillChar(AXSQLDA.sqlvar[i].sqlData^, AXSQLDA.sqlvar[i].sqllen+2, #0);
  765.         end
  766.       else
  767.         if datatype = SQL_BLOB then begin
  768.           AXSQLDA.sqlvar[i].sqllen:=sizeof(ISC_QUAD);
  769.           getmem(AXSQLDA.sqlvar[i].sqlData,AXSQLDA.sqlvar[i].sqllen);
  770.           FillChar(AXSQLDA.sqlvar[i].sqlData^, AXSQLDA.sqlvar[i].sqllen, #0);
  771.           end
  772.         else begin
  773.           getmem(AXSQLDA.sqlvar[i].sqlData,AXSQLDA.sqlvar[i].sqllen);
  774.           FillChar(AXSQLDA.sqlvar[i].sqlData^, AXSQLDA.sqlvar[i].sqllen, #0);
  775.           end;
  776.     getmem(AXSQLDA.sqlvar[i].sqlind,sizeof(smallint)); //allocate var to hold null status
  777.     FillChar(AXSQLDA.sqlvar[i].sqlind^, sizeof(smallint), #0);
  778.   end;
  779.   AXSQLDA^.sqln:=AXSQLDA^.sqld;
  780. end;
  781.  
  782. procedure Tfrs_GDS.FreeSQLData(var AXSQLDA: PXSQLDA);
  783. var
  784.     i,columns: integer;
  785. begin
  786. if assigned(AXSQLDA) then begin
  787.   columns:=AXSQLDA^.sqln; //sqln is set when allocation is completed
  788.   for i := 0 to columns -1 do begin
  789.   if (AXSQLDA.sqlvar[i].sqltype and (not SQL_NULL)) = SQL_VARYING then
  790.     reallocmem(AXSQLDA^.sqlvar[i].sqlData,0)
  791.      else
  792.     reallocmem(AXSQLDA^.sqlvar[i].sqlData,0);
  793.   reallocmem(AXSQLDA^.sqlvar[i].sqlind,0);
  794.   end;
  795.   ReallocMem(AXSQLDA,0);
  796. end;
  797. AXSQLDA:=Nil;
  798. end;
  799.  
  800. procedure Tfrs_GDS.InitSQLDA(var AXSQLDA: PXSQLDA; Columns: Integer);
  801. begin
  802.   ReallocMem(AXSQLDA, XSQLDA_LENGTH(Columns));
  803.   FillChar(AXSQLDA^, XSQLDA_LENGTH(Columns), #0);
  804.   AXSQLDA^.SQLn := Columns;   //this is critical - we allocate SQLVAR memory on the basis if this!
  805.   AXSQLDA^.version:=SQLDA_VERSION1;
  806. end;
  807.  
  808. {procedure Tfrs_GDS.MemAlloc(var P; OldSize, NewSize: Integer);
  809. var
  810.   i: Integer;
  811. begin
  812.   ReallocMem(Pointer(P), NewSize);
  813.   for i := OldSize to NewSize - 1 do PChar(P)[i] := #0;
  814. end;
  815. }
  816. function Tfrs_GDS.XSQLDA_LENGTH(n: Word): Longint;
  817. begin
  818.     XSQLDA_LENGTH := (SizeOf(XSQLDA) + (n - 1) * SizeOf(XSQLVAR));
  819. end;
  820.  
  821. procedure Tfrs_GDS.BuildPBString( var PB: array of char; var PBLen: Integer; item: byte; contents: string);
  822. //Add a string value to a parameter block
  823. var
  824.   len: Integer; 
  825. begin
  826.   {PBLen is the current size of the populated array, as well as the indicator}
  827.   PB[PBLen] := char(item);
  828.   inc(PBLen);
  829.   len:=Length(Contents);
  830.   PB[PBLen] := char(len);
  831.   inc(PBLen);
  832.   StrPCopy(@PB[PBLen],Contents);
  833.   inc(PBLen,len);
  834. end;
  835.  
  836. procedure Tfrs_GDS.BuildPBInteger( var PB: array of char; var PBLen: Integer; item: byte; contents: Integer);
  837. //Add an integer value to a parameter block
  838. var
  839.   s: string;
  840.   j: integer;
  841.   len: Integer;
  842. begin
  843.   PB[PBLen] := char(item);
  844.   inc(PBLen);
  845.   len:=sizeof(Integer);
  846.   PB[PBLen] := char(len);
  847.   inc(PBLen);
  848.   s:=IntToStr(contents);
  849.   j:=lo(contents);
  850.   PB[PBLen] := Char(j);
  851.   j:=hi(contents);
  852.   PB[PBLen+1]:=Char(j);
  853.   inc(PBLen,len);
  854. end;
  855.  
  856. procedure Tfrs_GDS.BuildPBBoolean( var PB: array of char; var PBLen: Integer; item: byte; contents: Boolean);
  857. //Add a boolean value to a parameter block
  858. var
  859.   len: Integer;
  860. begin
  861.   PB[PBLen] := char(item);
  862.   inc(PBLen);
  863.   len:=sizeof(Boolean);
  864.   PB[PBLen] := char(len);
  865.   inc(PBLen);
  866.   PB[PBLen] := Char(Contents);
  867.   inc(PBLen,len);
  868. end;
  869.  
  870. procedure Tfrs_GDS.BuildPBAddConstant(var PB: array of char; var PBLen: Integer; item: byte);
  871. //Add a Constant value to a parameter block
  872. begin
  873.   PB[PBLen] := char(item);
  874.   inc(PBLen);
  875. end;
  876.  
  877. procedure Tfrs_GDS.SetErrorCode(AErrorCode: ISC_STATUS);
  878. begin
  879. FErrorCode:=AErrorCode;
  880. if FErrorCode <> 0 then
  881.     HandleIBErrors
  882. else //clear old errormessage stack
  883.   FErrorMessages:='';
  884. if FStatusVector[0]=1 then begin
  885.   FStatusVector[0]:=0;
  886. end;
  887. end;
  888.  
  889. procedure Tfrs_GDS.DatabaseClose;
  890. begin
  891. if assigned(FDBHandle) then 
  892.   if assigned(FTxnHandle) then 
  893.     raise EIBError.create('Transaction active. Cannot close database connection.')
  894.   else begin
  895.     ErrorCode := isc_detach_database( @FStatusVector, @FDbHandle);
  896.     FDBHandle:=Nil;
  897.   end;
  898.  
  899. end;
  900.  
  901. procedure Tfrs_GDS.DatabaseOpen;
  902. begin
  903.   ErrorCode:=isc_attach_database(@FStatusVector,Length(FDBName),PChar(FDBName),@FDBHandle,FDPBLen,@FDPB);
  904. end;
  905.  
  906. procedure Tfrs_GDS.TransactionCommit;
  907. begin
  908.   if assigned(FTxnHandle) then begin
  909.     errorcode:=isc_commit_transaction(@FStatusVector, @FTXnHandle);
  910.     FTxnHandle:=Nil;
  911.   end;
  912.  
  913.   // Tidy up statement handle resources
  914.   try
  915.     if assigned(FStmtHandle) then try
  916.       isc_dsql_free_statement(@FStatusVector, @FStmtHandle, DSQL_Drop);
  917.     except
  918.       //do nothing 
  919.     end;
  920.   finally
  921.     FStmtHandle:=nil;
  922.   end;
  923.   
  924.   //Clear OutputdataArea, but save InputDataArea
  925.   try
  926.     FreeSQLData(OutputDataArea);
  927.   except
  928.     //if there is an error, don't tell us about it - it is not critical
  929.     //
  930.   end;
  931.  
  932. end;
  933.  
  934. procedure Tfrs_GDS.TransactionRetain;
  935. begin
  936.   //here, we want to see the error if the commit retaining fails
  937.   if assigned(FTxnHandle) then
  938.     ErrorCode:=isc_commit_retaining(@FStatusVector, @FTxnHandle)
  939. end;
  940.  
  941. procedure Tfrs_GDS.TransactionRollback;
  942. begin
  943.   //if this raises an error then ignore it - as it means that
  944.   //we have probably lost our connection, and the txn will be rolled back anyway.
  945.   if assigned(FTxnHandle) then begin
  946.       isc_rollback_transaction(@FStatusVector, @FTxnHandle);
  947.     FTxnHandle:=Nil;
  948.   end;
  949.  
  950.   // Tidy up statement handle resources
  951.   try
  952.     if assigned(FStmtHandle) then try
  953.       isc_dsql_free_statement(@FStatusVector, @FStmtHandle, DSQL_Drop);
  954.     except
  955.       //do nothing 
  956.     end;
  957.   finally
  958.     FStmtHandle:=nil;
  959.   end;
  960.   
  961.   //Clear OutputdataArea, but save InputDataArea
  962.   try
  963.     FreeSQLData(OutputDataArea);
  964.   except
  965.     //if there is an error, don't tell us about it - it is not critical
  966.     //
  967.   end;
  968.  
  969. end;
  970.  
  971. procedure Tfrs_GDS.TransactionStart;
  972. begin
  973.   if not assigned(FTxnHandle) then begin
  974.  
  975.     //Set up TEB
  976.     with FTEB do begin
  977.       db_ptr  := @FDBhandle;
  978.       tpb_len := 0;
  979.       tpb_ptr := Nil
  980.     end;
  981.  
  982.     //code here for tpb, if necessary
  983.     //if FTPB[1]<>char(0) then
  984.  
  985.     errorcode:=isc_start_multiple(@FStatusVector, @FTxnHandle, 1, @FTEB);
  986.  
  987.   end;
  988. end;
  989.  
  990. procedure Tfrs_GDS.SetFetchCode(const Value: ISC_STATUS);
  991. begin
  992.   FFetchCode:=Value;
  993.   case FFetchCode of
  994.     0   :   FFetchStatus:=fsFetching{success};
  995.     100 :   begin
  996.               FFetchStatus:=fsFetched;
  997.               ErrorCode:=isc_dsql_free_statement(@FStatusVector, @FStmtHandle, DSQL_close);
  998.             end;
  999.   else
  1000.     errorcode:=FFetchCode;
  1001.   end;
  1002.  
  1003. end;
  1004.  
  1005. Function Tfrs_GDS.IBDateStrToDateTime(DateTimeStr: String): TDateTime;
  1006. {IBDateStr must be in the format of mm/dd/yyyy hh:nn:ss}
  1007. var
  1008.   DT: TDateTime;
  1009.   Yr, Mn, Dy, Hr, Mt, Sc, Ms: Word;
  1010.   OldShortDateFormat: string;
  1011. const
  1012.   MidnightStr: string =' 00:00:00:000';
  1013. begin
  1014. OldShortDateFormat:=ShortDateFormat;
  1015. ShortDateFormat:='mm/dd/yyyy';
  1016. try
  1017.   If uppercase(DateTimeStr)='TODAY' then
  1018.     DateTimeStr:=DateTimeToStr(Date)+MidnightStr
  1019.   else
  1020.     if uppercase(DateTimeStr)='YESTERDAY' then
  1021.       DateTimeStr:=DateTimeToStr(Date-1)+MidnightStr
  1022.     else
  1023.       if uppercase(DateTimeStr)='TOMORROW' then
  1024.         DateTimeStr:=DateTimeToStr(Date+1)+MidnightStr
  1025.       else
  1026.         if uppercase(DateTimeStr)='NOW' then
  1027.           DateTimeStr:=DateTimeToStr(Now)+':000';
  1028. finally
  1029.   ShortDateFormat:=OldShortDateFormat;
  1030. end;
  1031.  
  1032. //Time24Hour:=True;
  1033. Mn:=StrToInt(copy(DateTimeStr,1,2));
  1034. Dy:=StrToInt(copy(DateTimeStr,4,2));
  1035. Yr:=StrToInt(copy(DateTimeStr,7,4));
  1036. Hr:=StrToInt(copy(DateTimeStr,12,2));
  1037. Mt:=StrToInt(copy(DateTimeStr,15,2));
  1038. Sc:=StrToInt(copy(DateTimeStr,18,2));
  1039. Ms:=StrToInt(copy(DateTimeStr,21,3));
  1040. DT:=EncodeDate(Yr,Mn,Dy);
  1041. Result:=DT;
  1042. DT:=EncodeTime(Hr,Mt,Sc,Ms);
  1043. Result:=Result+DT;
  1044. end;
  1045.  
  1046. initialization
  1047.   frs_GDS:=Tfrs_GDS.create;
  1048. finalization
  1049.   frs_GDS.free;
  1050.  
  1051. end.
  1052.