.CM  SCRIPT , Version - 1.1 , last edited by holger
.ad 8
.bm 8
.fm 4
.bt $Copyright (c) 2000-2005 SAP AG$$Page %$
.tm 12
.hm 6
.hs 3
.TT 1 $SQL$Project Distributed Database System$VIN19$
.tt 2 $$$
.TT 3 $HolgerB$Long-Columns$1998-06-19$
***********************************************************
.nf
 
.nf
 
 .nf

    ========== licence begin  GPL
    Copyright (c) 2000-2005 SAP AG

    This program is free software; you can redistribute it and/or
    modify it under the terms of the GNU General Public License
    as published by the Free Software Foundation; either version 2
    of the License, or (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
    ========== licence end
.fo

 
.fo
 
 
.fo
.nf
.sp
MODULE  : Long-Columns-II
=========
.sp
Purpose : Handles Long-Columns
.CM *-END-* purpose -------------------------------------
.sp
.cp 3
Define  :
 
        PROCEDURE
              i19viewlongcolumn (
                    descriptor   : tin_long_desc_type;
                    component    : tsp00_C8;
                    release_id   : tsp00_C8;
                    ascii        : boolean;
                    VAR exit_all : boolean;
                    VAR ok       : boolean );
 
        PROCEDURE
              i19putlong (
                    descriptor : tin_long_desc_type;
                    filename   : tsp00_VFilename;
                    VAR ok     : boolean );
 
.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :
 
        FROM
              global_variable      : VIN01;
 
        VAR
              i01g : tin_global_in_vars;
 
      ------------------------------ 
 
        FROM
              messages: VIN03;
 
        PROCEDURE
              i03msg (
                    msg_nr    : integer;
                    VAR parms : tin_msg_parms;
                    VAR msg   : tin_screenline;
                    VAR msgt  : tin_msg_type);
 
      ------------------------------ 
 
        FROM
              SQLDB-command-interface : VIN20;
 
        PROCEDURE
              i20rebuild_session (
                    VAR status : tin_connect_status);
 
        PROCEDURE
              i20receive (
                    VAR rc_status  : tin_connect_status;
                    VAR sqlstate   : tsp00_SqlState;
                    VAR returncode : tsp00_Int2;
                    VAR errorpos   : tsp00_Int4);
 
        PROCEDURE
              i20request (
                    VAR rq_status : tin_connect_status );
 
      ------------------------------ 
 
        FROM
              logical_screen : VIN50;
 
        PROCEDURE
              i50getfield (
                    VAR vt_input    : tin_ls_input_field;
                    VAR field_found : boolean);
 
        PROCEDURE
              i50getwindow (
                    first_pos          : tin_ls_position;
                    window_len         : tin_natural;
                    window_width       : tin_natural;
                    VAR window_changed : boolean);
 
        PROCEDURE
              i50clear (
                    part : tin_ls_part );
 
        PROCEDURE
              i50put1field (
                    VAR field  : tsp00_C8;
                    length     : tin_natural;
                    field_pos  : tin_ls_position;
                    field_type : tin_ls_fieldtype );
 
        PROCEDURE
              i50put2field (
                    VAR field  : tsp00_C48;
                    length     : tin_natural;
                    field_pos  : tin_ls_position;
                    field_type : tin_ls_fieldtype );
 
        PROCEDURE
              i50put3field (
                    VAR field  : tsp00_C16;
                    length     : tin_natural;
                    field_pos  : tin_ls_position;
                    field_type : tin_ls_fieldtype );
 
        PROCEDURE
              i50put4field (
                    VAR field  : tsp00_C10;
                    length     : tin_natural;
                    field_pos  : tin_ls_position;
                    field_type : tin_ls_fieldtype );
 
        PROCEDURE
              i50put5field (
                    VAR field  : tsp00_C64;
                    length     : tin_natural;
                    field_pos  : tin_ls_position;
                    field_type : tin_ls_fieldtype );
 
        PROCEDURE
              i50put6field (
                    VAR field  : tin_screenline;
                    length     : tin_natural;
                    field_pos  : tin_ls_position;
                    field_type : tin_ls_fieldtype );
 
      ------------------------------ 
 
        FROM
              logical_screen_layout : VIN51;
 
        PROCEDURE
              i51ownlayout (
                    defined_part : tin_ls_part;
                    first_pos    : tin_ls_position;
                    lines,cols   : tin_natural);
 
        PROCEDURE
              i51onwindow (
                    defined_part : tin_ls_part;
                    VAR win      : tin_screen_window;
                    VAR ok       : boolean );
 
        PROCEDURE
              i51offwindow (
                    VAR restore : boolean );
 
        PROCEDURE
              i51layout (
                    functionmenu_length : tin_natural;
                    inputarea_length    : tin_natural;
                    msglines            : tin_natural );
 
        PROCEDURE
              i51size (
                    screen_part    : tin_ls_part;
                    VAR partlength : tin_natural;
                    VAR partwidth  : tin_natural );
 
      ------------------------------ 
 
        FROM
              logical_screen_modules : VIN56;
 
        PROCEDURE
              i56title (
                    blinking_modefield : boolean;
                    screen_nr          : integer;
                    VAR title          : tsp00_OnlineHeader);
 
        PROCEDURE
              i56putframe (
                    with_name   :  boolean;
                    with_parms  :  boolean );
 
        PROCEDURE
              i56putlabels (
                    fct_cursorpos       : tin_ls_releasemode;
                    functionline_label  : boolean );
 
      ------------------------------ 
 
        FROM
              logical_screen_IO : VIN57 ;
 
        PROCEDURE
              i57ioscreen (
                    VAR csr_pos        : tin_ls_position;
                    VAR rf             : tin_ls_releasemode;
                    VAR screen_changed : boolean );
 
      ------------------------------ 
 
        FROM
              Kernel_move_and_fill : VGG101;
 
        PROCEDURE
              SAPDB_PascalForcedFill (
                    size        : tsp00_Int4;
                    m           : tsp00_MoveObjPtr;
                    pos         : tsp00_Int4;
                    len         : tsp00_Int4;
                    fillchar    : char);
 
        PROCEDURE
              SAPDB_PascalForcedMove (
                    source_upb  : tsp00_Int4;
                    destin_upb  : tsp00_Int4;
                    source      : tsp00_MoveObjPtr;
                    source_pos  : tsp00_Int4;
                    destin      : tsp00_MoveObjPtr;
                    destin_pos  : tsp00_Int4;
                    length      : tsp00_Int4);
 
        PROCEDURE
              s10mv (
                    source_upb  : tsp00_Int4;       
                    destin_upb  : tsp00_Int4;
                    source      : tsp00_MoveObjPtr;    
                    source_pos  : tsp00_Int4;
                    destin      : tsp00_MoveObjPtr;    
                    destin_pos  : tsp00_Int4;
                    length      : tsp00_Int4);
 
      ------------------------------ 
 
        FROM
              RTE-Extension-30 : VSP30;
 
        FUNCTION
              s30gad (VAR b : tsp00_Buf8K) : tsp_vf_bufaddr;
 
      ------------------------------ 
 
        FROM
              RTE-Extension-80: VSP80;
 
        PROCEDURE
              s80uni_trans
                    (src_ptr        : tsp00_MoveObjPtr;
                    src_len         : tsp00_Int4;
                    src_codeset     : tsp00_Int2;
                    dest_ptr        : tsp00_MoveObjPtr;
                    VAR dest_len    : tsp00_Int4;
                    dest_codeset    : tsp00_Int2;
                    trans_options   : tsp8_uni_opt_set;
                    VAR rc          : tsp8_uni_error;
                    VAR err_char_no : tsp00_Int4);
 
      ------------------------------ 
 
        FROM
              RTE_driver : VEN102;
 
        PROCEDURE
              sqlfopen (
                    VAR hostfile   : tsp00_VFilename;
                    direction      : tsp00_VFileOpCodes;
                    resource       : tsp00_VfResource;
                    VAR hostfileno : tsp00_Int4;
                    VAR format     : tsp00_VfFormat;
                    VAR rec_len    : tsp00_Int4;
                    poolptr        : tsp00_Int4;
                    buf_count      : tsp00_Int2;
                    VAR block      : tsp_vf_bufaddr;
                    VAR error      : tsp00_VfReturn;
                    VAR errtext    : tsp00_ErrText);
 
        PROCEDURE
              sqlfwrite (
                    VAR hostfileno  : tsp00_Int4;
                    block           : tsp_vf_bufaddr;
                    length          : tsp00_Int4;
                    VAR error       : tsp00_VfReturn;
                    VAR errtext     : tsp00_ErrText);
 
        PROCEDURE
              sqlfclose (
                    VAR hostfileno : tsp00_Int4;
                    erase          : boolean;
                    poolptr        : tsp00_Int4;
                    buf_count      : tsp00_Int2;
                    block          : tsp_vf_bufaddr;
                    VAR error      : tsp00_VfReturn;
                    VAR errtext    : tsp00_ErrText);
 
      ------------------------------ 
 
        FROM
              SQLDB-long-support: VIN22;
 
        PROCEDURE
              i22nglong (
                    g_area        : tin_global_in_vars;
                    VAR long_desc : tin_long_desc_type;
                    VAR buf       : tsp00_Buf8K;
                    VAR bufpos    : tsp00_Int4;
                    buflen        : tsp00_Int4 );
 
        PROCEDURE
              i22ngldesc (
                    g_area        : tin_global_in_vars;
                    VAR long_desc : tin_long_desc_type;
                    idx           : integer );
 
        PROCEDURE
              i22npldesc (
                    g_area        : tin_global_in_vars;
                    VAR long_desc : tin_long_desc_type;
                    max_read      : tsp00_Int4 );
 
        PROCEDURE
              i22igetval (
                    g_area : tin_global_in_vars;
                    cnt    : tsp00_Int2 );
 
.CM *-END-* use -----------------------------------------
.sp;.cp 3
Synonym :
 
        PROCEDURE
              i50put1field;
 
              tsp00_MoveObj tsp00_C8;
 
        PROCEDURE
              i50put2field;
 
              tsp00_MoveObj tsp00_C48;
 
        PROCEDURE
              i50put3field;
 
              tsp00_MoveObj tsp00_C16;
 
        PROCEDURE
              i50put4field;
 
              tsp00_MoveObj tsp00_C10;
 
        PROCEDURE
              i50put5field;
 
              tsp00_MoveObj tsp00_C64;
 
        PROCEDURE
              i50put6field;
 
              tsp00_MoveObj tin_screenline;
 
        PROCEDURE
              s30gad;
 
              tsp00_MoveObj tsp00_Buf8K
              tsp00_Addr    tsp_vf_bufaddr
 
        PROCEDURE
              i22nglong;
 
              tsp00_AnyPackedChar tsp00_Buf8K
 
        PROCEDURE
              sqlfopen;
 
              tsp00_VFilename    tsp00_VFilename
              tsp00_VFileOpCodes tsp00_VFileOpCodes
              tsp00_VfResource   tsp00_VfResource
              tsp00_Int4         tsp00_Int4
              tsp00_VfFormat     tsp00_VfFormat
              tsp00_Int4         tsp00_Int4
              tsp00_Int4         tsp00_Int4
              tsp00_Int2         tsp00_Int2
              tsp00_VfBufaddr    tsp_vf_bufaddr
              tsp00_VfReturn     tsp00_VfReturn
              tsp00_ErrText      tsp00_ErrText
 
        PROCEDURE
              sqlfwrite;
 
              tsp00_Int4      tsp00_Int4
              tsp00_VfBufaddr tsp_vf_bufaddr
              tsp00_Int4      tsp00_Int4
              tsp00_VfReturn  tsp00_VfReturn
              tsp00_ErrText   tsp00_ErrText
 
        PROCEDURE
              sqlfclose;
 
              tsp00_Int4      tsp00_Int4
              tsp00_Int4      tsp00_Int4
              tsp00_Int2      tsp00_Int2
              tsp00_VfBufaddr tsp_vf_bufaddr
              tsp00_VfReturn  tsp00_VfReturn
              tsp00_ErrText   tsp00_ErrText
 
        PROCEDURE
              m90buf;
 
              tsp00_Buf tsp00_C10
 
        PROCEDURE
              m90buf1;
 
              tsp00_Buf tsp00_C64
 
        PROCEDURE
              m90buf2;
 
              tsp00_Buf tsp00_Buf8K
 
.CM *-END-* synonym -------------------------------------
.sp;.cp 3
Author  : MartinR
.sp
.cp 3
Created : 1993-08-04
.sp
.cp 3
.sp
.cp 3
Release :      Date : 1998-06-19
.sp
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Specification:
.sp
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Description:
.nf
.sp
***********************************************************
.sp
.cp 10
.nf
.oc _/1
Structure:
 
.CM *-END-* specification -------------------------------
**********************************************************
.sp
.cp 10
.nf
.oc _/1
.CM -lll-
 
Code    :
 
 
CONST
      cin19_db_ok                    = 0;
      cin19_db_sys_error             = 1;
      cin19_timeout                  = 2;
      maxlongbuf                     = BUF8K_MXSP00;
      cin19_header                   = 14901;
      cin19_keys                     = 14902;
      cin19_more_text                = 14903;
      cin19_bottom_text              = 14904;
      cin19_top_text                 = 14905;
      cin19_file_text                = 14906;
      cin19_file_ok                  = 14907;
      cin19_file_error               = 14908;
 
TYPE
 
      t_fkeyline     = RECORD
            CASE boolean OF
                true :
                    (line : tsp00_C80);
                false :
                    (endend  : tin_ls_sk_label;
                    help    : tin_ls_sk_label;
                    up      : tin_ls_sk_label;
                    down    : tin_ls_sk_label;
                    mode    : tin_ls_sk_label;
                    quit    : tin_ls_sk_label;
                    outfile : tin_ls_sk_label;
                    top     : tin_ls_sk_label;
                    bottom  : tin_ls_sk_label;
                    infile  : tin_ls_sk_label;
                    );
                END;
            (*ENDCASE*) 
 
      t_disp_mode = ( unicode_dump_mode,
            codeset_dump_mode,
            text_mode );
 
      lc_global = RECORD
            component       :  tsp00_C8;
            release_id      :  tsp00_C8;
            cols_on_screen  :  tin_natural;
            lines_on_screen :  tin_natural;
            mode            :  tsp00_C12;
            lcpos           :  tsp00_Int4;
            realpos         :  tsp00_Int4;
            lcmaxlen        :  tsp00_Int4;
            lcbuf           :  tsp00_Buf8K;
            disp_mode       :  t_disp_mode;
            exit_key        :  boolean;
            offset          :  tin_natural;
            digiset         :  SET OF Char;
            uletters        :  SET OF Char;
            lletters        :  SET OF Char;
            specsigns       :  SET OF Char;
            desc            :  tin_long_desc_type;
            lcgok           :  boolean;
            lcisunicode     :  boolean;
            lcgfiller       :  tsp00_C2;
      END;
 
 
 
(*------------------------------*) 
 
PROCEDURE
      i19putlong (
            descriptor : tin_long_desc_type;
            filename   : tsp00_VFilename;
            VAR ok     : boolean );
 
VAR
      lcg             : lc_global;
      file_error      : tsp00_VfReturn;
      file_errtext    : tsp00_ErrText;
      format          : tsp00_VfFormat;
      rec_len         : tsp00_Int4;
      fno             : tsp00_Int4;
      outblockaddress : tsp_vf_bufaddr;
      direction       : tsp00_VFileOpCodes;
      error           : boolean;
 
BEGIN
IF  filename[1] <> ' '
THEN
    BEGIN
    lcg.desc := descriptor;
    lcg.lcisunicode := (ld_unicode in descriptor.lt_old.ld_infoset);
    IF  lcg.desc.lt_newlong
    THEN
        BEGIN
        lcg.desc.lt_new.ldb_infoset := lcg.desc.lt_new.ldb_infoset
              + [ldb_no_close];
        lcg.desc.lt_new.ldb_intern_pos := 1;
        get_max_len_19 (lcg);
        lcg.lcpos := 1;
        lcg.realpos := 1;
        lcg.desc.lt_new.ldb_intern_pos := 1;
        END
    ELSE
        BEGIN
        lcg.desc.lt_old.ld_infoset := lcg.desc.lt_old.ld_infoset
              + [ld_no_close];
        lcg.desc.lt_old.ld_intern_pos := 1;
        get_max_len_19 (lcg);
        lcg.lcpos := 1;
        lcg.realpos := 1;
        lcg.desc.lt_old.ld_intern_pos := 1;
        END;
    (*ENDIF*) 
    direction := voverwrite;
    format := vf_stream; (*vf_plaintext;*)
    rec_len := 0;
    file_error := vf_ok;
    sqlfopen (filename, direction, vf_stack, fno, format, rec_len,
          i01g^.vf_pool_ptr, 1, outblockaddress,
          file_error, file_errtext);
    IF  file_error = vf_ok
    THEN
        BEGIN
        write_long_to_file_19 (lcg, fno, error);
        IF  error
        THEN
            ok := false;
        (*ENDIF*) 
        sqlfclose (fno, false, i01g^.vf_pool_ptr, 0,
              outblockaddress, file_error, file_errtext);
        END
    ELSE
        ok := false;
    (*ENDIF*) 
    (**)
    close_long_19 (lcg);
    END
ELSE
    ok := false;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      i19viewlongcolumn (
            descriptor   : tin_long_desc_type;
            component    : tsp00_C8;
            release_id   : tsp00_C8;
            ascii        : boolean;
            VAR exit_all : boolean;
            VAR ok       : boolean );
 
VAR
      lcg              : lc_global;
      current_key_type : tin_ls_key_type;
      current_ls       : tin_ls_record;
      current_vt       : tin_vt_record;
 
BEGIN
current_key_type := i01g^.key_type;
current_ls := i01g^.ls;
current_vt := i01g^.vt;
i01g^.i50.with_windowframe := false;
(**)
lcg.desc := descriptor;
lcg.component   := component;
lcg.release_id  := release_id;
lcg.lcisunicode := (ld_unicode in descriptor.lt_old.ld_infoset);
IF  ascii
THEN
    BEGIN
    lcg.disp_mode := text_mode;
    IF  lcg.lcisunicode
    THEN
        lcg.offset := 16
    ELSE
        lcg.offset := 64;
    (*ENDIF*) 
    END
ELSE
    BEGIN
    IF  lcg.lcisunicode
    THEN
        lcg.disp_mode := unicode_dump_mode
    ELSE
        lcg.disp_mode := codeset_dump_mode;
    (*ENDIF*) 
    lcg.offset := 16;
    END;
(*ENDIF*) 
(**)
init_lc_19 (lcg);
IF  lcg.lcgok
THEN
    do_view_19 (lcg);
(*ENDIF*) 
IF  lcg.lcgok
THEN
    close_long_19 (lcg);
(**)
(*ENDIF*) 
i01g^.key_type := current_key_type;
i01g^.ls := current_ls;
i01g^.vt := current_vt;
(**)
exit_all := lcg.exit_key;
ok := lcg.lcgok;
END;
 
(*------------------------------*) 
 
PROCEDURE
      init_lc_19 (
            VAR lcg : lc_global );
 
CONST
      cin19_header = 14901;
      no_cmd_lines = 0;
      msglines     = 1;
      keylines     = 1;
 
VAR
      msg_p  : tin_msg_parms;
      msg_t  : tin_msg_type;
      sl     : tin_screenline;
 
BEGIN
(**)
init_char_set_19 (lcg);
(**)
(* get headline*)
(**)
msg_p.length := 0;
i03msg (cin19_header, msg_p, sl, msg_t);
IF  msg_t = long_msg
THEN
    s10mv (mxin_screenline,mxsp_c12,
          @sl,1,
          @lcg.mode,1,mxsp_c12);
(**)
(* set terminal *)
(**)
(*ENDIF*) 
WITH i01g^.vt.opt DO
    BEGIN
    wait_for_input  := true;
    usage_mode      := vt_form;
    return_on_last  := false;
    return_on_first := false;
    returnkeys      := [  ] ;
    reject_keys     := [  ] ;
    bell            := false;
    END;
(*ENDWITH*) 
(**)
(* get screensize *)
(**)
i51layout (keylines, no_cmd_lines, msglines);
i51size (cin_ls_workarea, lcg.lines_on_screen, lcg.cols_on_screen);
i50clear (cin_ls_basic_window);
(**)
IF  lcg.desc.lt_newlong
THEN
    BEGIN
    lcg.lcgok := true;
    lcg.desc.lt_new.ldb_infoset := lcg.desc.lt_new.ldb_infoset
          + [ldb_no_close];
    lcg.desc.lt_new.ldb_intern_pos := 1;
    (**)
    get_max_len_19 (lcg);
    lcg.lcpos := 1;
    lcg.realpos := 1;
    lcg.desc.lt_new.ldb_intern_pos := 1;
    END
ELSE
    BEGIN
    lcg.lcgok := true;
    lcg.desc.lt_old.ld_infoset := lcg.desc.lt_old.ld_infoset +
          [ld_no_close];
    lcg.desc.lt_old.ld_intern_pos := 1;
    (**)
    get_max_len_19 (lcg);
    lcg.lcpos := 1;
    lcg.realpos := 1;
    lcg.desc.lt_old.ld_intern_pos := 1;
    END;
(*ENDIF*) 
(**)
lcg.exit_key := false;
lcg.lcgfiller := '\0\0';
(**)
END; (* init_lc_19 *)
 
(*------------------------------*) 
 
PROCEDURE
      do_view_19 (
            VAR lcg : lc_global);
 
VAR
      func  : tin_ls_releasemode;
      msgno : integer;
      exit  : boolean;
 
BEGIN
init_keys_19;
exit := false;
read_long_column_19 (lcg);
msgno := 0;
WHILE NOT exit AND lcg.lcgok DO
    BEGIN
    IF  msgno = 0
    THEN
        i50clear (cin_ls_sysline);
    (*ENDIF*) 
    get_screen_19 (lcg, msgno);
    show_screen_19 (func);
    command_19 (lcg, func, msgno, exit);
    END;
(*ENDWHILE*) 
END; (* do_view_19 *)
 
(*------------------------------*) 
 
PROCEDURE
      init_keys_19;
 
VAR
      msg    : tin_screenline;
      fkey   : t_fkeyline;
      msg_p  : tin_msg_parms;
      msg_t  : tin_msg_type;
 
BEGIN
msg_p.length := 0;
i03msg (cin19_keys, msg_p, msg, msg_t);
IF  msg_t = long_msg
THEN
    s10mv (mxin_screenline,mxsp_c80,
          @msg,1,
          @fkey.line,1,80)
ELSE
    BEGIN
    fkey.outfile := 'FILE    ';
    fkey.infile  := 'GET     ';
    fkey.endend  := 'END     ';
    fkey.help    := 'HELP    ';
    fkey.up      := 'UP      ';
    fkey.down    := 'DOWN    ';
    fkey.mode    := 'MODE    ';
    fkey.quit    := 'QUIT    ';
    fkey.top     := 'TOP     ';
    fkey.bottom  := 'BOTTOM  ';
    END;
(*ENDIF*) 
fkey.mode    := 'MODE    ';
WITH i01g^.key_type DO
    BEGIN
    key_labels  [f9]   := fkey.endend;
    key_labels  [f7]   := fkey.outfile;
    key_labels  [f2]   := fkey.mode;
    key_labels  [f4]   := fkey.top;
    key_labels  [f5]   := fkey.bottom;
    END;
(*ENDWITH*) 
END; (* init_keys_19 *)
 
(*------------------------------*) 
 
PROCEDURE
      set_keys_19;
 
BEGIN
WITH i01g^.key_type DO
    BEGIN
    activated := [ f2, f4, f5, f7, f9, f_up, f_down, f_exit, f_end ];
    END;
(*ENDWITH*) 
i56putlabels (f_enter,false);
END; (* set_keys_19 *)
 
(*------------------------------*) 
 
PROCEDURE
      get_screen_19 (
            VAR lcg   : lc_global;
            VAR msgno : integer);
 
CONST
      cmdlines = 0;
      msglines = 1;
      keylines = 1;
      num_pos = 2;
      hexvalues_pos = 13;
      asc16values_pos = 63;
      asc64values_pos = 15;
 
VAR
      lpos : tsp00_Int4;
      bpos : tsp00_Int4;
      len  : tin_natural;
      line : tin_natural;
      s16  : tsp00_C16;
      s64  : tsp00_C64;
 
BEGIN
i51layout (keylines, cmdlines, msglines);
i50clear (cin_ls_workarea);
put_header_19 (lcg);
i56putframe (true, true);
(**)
put_msg_19 (msgno);
(**)
lpos := lcg.lcpos;
bpos := (lcg.realpos) + lcg.lcpos - 2;
line := 1;
WHILE (line <= lcg.lines_on_screen) AND
      (bpos < lcg.lcmaxlen ) DO
    BEGIN
    CASE  lcg.disp_mode OF
        unicode_dump_mode :
            BEGIN
            IF  lcg.lcmaxlen - bpos < 16
            THEN
                len := lcg.lcmaxlen - bpos
            ELSE
                len := 16;
            (*ENDIF*) 
            get_s16_from_buf_19 (lcg, s16, lpos, len);
            put_hexlongpos_19 (bpos, line, num_pos);
            put_hexvalues_19 (s16, line, hexvalues_pos, len);
            lpos := lpos + 16;
            bpos := bpos + 16;
            END;
        codeset_dump_mode :
            BEGIN
            IF  lcg.lcmaxlen - bpos < 16
            THEN
                len := lcg.lcmaxlen - bpos
            ELSE
                len := 16;
            (*ENDIF*) 
            get_s16_from_buf_19 (lcg, s16, lpos, len);
            put_hexlongpos_19 (bpos, line, num_pos);
            IF  lcg.lcisunicode
            THEN
                put_unihexvalues_19 (s16, line, hexvalues_pos, len)
            ELSE
                put_hexvalues_19 (s16, line, hexvalues_pos, len);
            (*ENDIF*) 
            IF  NOT lcg.lcisunicode
            THEN
                put_asc16values_19 (lcg, s16, line, asc16values_pos, len);
            (*ENDIF*) 
            lpos := lpos + 16;
            bpos := bpos + 16;
            END;
        text_mode :
            BEGIN
            IF  lcg.lcisunicode
            THEN
                BEGIN
                IF  lcg.lcmaxlen - bpos < 16
                THEN
                    len := lcg.lcmaxlen - bpos
                ELSE
                    len := 16;
                (*ENDIF*) 
                get_s16_from_buf_19 (lcg, s16, lpos, len);
                put_hexlongpos_19 (bpos, line, num_pos);
                put_uni16values_19 (s16, line, asc64values_pos, len);
                lpos := lpos + 16;
                bpos := bpos + 16;
                END
            ELSE
                BEGIN
                IF  lcg.lcmaxlen - bpos < 64
                THEN
                    len := lcg.lcmaxlen - bpos
                ELSE
                    len := 64;
                (*ENDIF*) 
                get_s64_from_buf_19 (lcg, s64, lpos, len);
                put_declongpos_19 (bpos, line, num_pos);
                put_asc64values_19 (lcg, s64, line, asc64values_pos, len);
                lpos := lpos + 64;
                bpos := bpos + 64;
                END;
            (*ENDIF*) 
            END;
        END;
    (*ENDCASE*) 
    line := line + 1;
    END;
(*ENDWHILE*) 
set_keys_19;
END; (* get_screen_19 *)
 
(*------------------------------*) 
 
PROCEDURE
      set_msg_more_19 (
            VAR lcg   : lc_global;
            msgno     : integer );
 
CONST
      cin19_more_text = 14903;
 
BEGIN
WITH lcg DO
    BEGIN
    IF  (lcpos + lines_on_screen * offset) < lcmaxlen
    THEN
        msgno := cin19_more_text;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END; (* set_msg_more *)
 
(*------------------------------*) 
 
PROCEDURE
      get_s16_from_buf_19 (
            VAR lcg   : lc_global;
            VAR s16 : tsp00_C16;
            pos     : tin_natural;
            len     : tin_natural);
 
BEGIN
s10mv (BUF8K_MXSP00,mxsp_c16,
      @lcg.lcbuf,pos,
      @s16,1,len);
END; (* get_s16_from_buf *)
 
(*------------------------------*) 
 
PROCEDURE
      get_s64_from_buf_19 (
            VAR lcg   : lc_global;
            VAR s64 : tsp00_C64;
            pos     : tin_natural;
            len     : tin_natural);
 
BEGIN
s10mv (BUF8K_MXSP00,mxsp_c64,
      @lcg.lcbuf,pos,
      @s64,1,len);
END; (* get_s64_from_buf *)
 
(*------------------------------*) 
 
PROCEDURE
      put_hexlongpos_19 (
            longpos : tsp00_Int4;
            sline   : tin_natural;
            scol    : tin_natural);
 
VAR
      p  : tin_ls_position;
      t  : tin_ls_fieldtype;
      s8 : tsp00_C8;
 
BEGIN
p.screen_nr := 1;
p.screen_part := cin_ls_workarea;
p.scol := scol;
p.sline := sline;
t.field_att  := cin_attr1;
t.fieldmode  := [ ];
int4_to_hex_19 (longpos, s8);
i50put1field (s8, 8, p, t);
END; (* put_hexlongpos *)
 
(*------------------------------*) 
 
PROCEDURE
      put_declongpos_19 (
            longpos : tsp00_Int4;
            sline   : tin_natural;
            scol    : tin_natural);
 
VAR
      p  : tin_ls_position;
      t  : tin_ls_fieldtype;
      s10 : tsp00_C10;
 
BEGIN
p.screen_nr := 1;
p.screen_part := cin_ls_workarea;
p.scol := scol;
p.sline := sline;
t.field_att  := cin_attr1;
t.fieldmode  := [ ];
int4_to_dec_19 (longpos, s10);
i50put4field (s10, 10, p, t);
END; (* put_declongpos *)
 
(*------------------------------*) 
 
PROCEDURE
      put_hexvalues_19 (
            VAR s16 : tsp00_C16;
            sline   : tin_natural;
            scol    : tin_natural;
            len     : tin_natural);
 
VAR
      p  : tin_ls_position;
      t  : tin_ls_fieldtype;
      s48 : tsp00_C48;
      trunc : boolean;
 
BEGIN
p.screen_nr := 1;
p.screen_part := cin_ls_workarea;
p.scol := scol;
p.sline := sline;
t.field_att  := cin_attr1;
t.fieldmode  := [ ];
s48 := bsp_c48;
buf_to_hex_19 (@s16, 1, len, @s48, 1, 48, trunc);
i50put2field (s48, 48, p, t);
END; (* put_hexvalues *)
 
(*------------------------------*) 
 
PROCEDURE
      put_unihexvalues_19 (
            VAR s16 : tsp00_C16;
            sline   : tin_natural;
            scol    : tin_natural;
            len     : tin_natural);
 
VAR
      p           : tin_ls_position;
      t           : tin_ls_fieldtype;
      s24         : tsp00_C24;
      line        : tin_screenline;
      trunc       : boolean;
      uni_outlen  : integer;
      uni_ret     : tsp8_uni_error;
      uni_errpos  : tsp00_Int4;
      src_code    : tsp00_Int2;
 
BEGIN
IF  i01g^.i20.swap = sw_normal
THEN
    src_code := csp_unicode
ELSE
    src_code := csp_unicode_swap;
(*ENDIF*) 
uni_outlen := mxsp_c24;
s80uni_trans (@s16, len, src_code,
      @s24, uni_outlen,
      i01g^.multibyte.dblang_idx,
      [], uni_ret, uni_errpos);
p.screen_nr := 1;
p.screen_part := cin_ls_workarea;
p.scol := scol;
p.sline := sline;
t.field_att  := cin_attr1;
t.fieldmode  := [ ];
SAPDB_PascalForcedFill (mxin_screenline, @line, 1, mxin_screenline, ' ');
buf_to_hex_19 (@s24, 1, uni_outlen, @line, 1, mxin_screenline, trunc);
i50put6field (line, 72, p, t);
END; (* put_hexvalues *)
 
(*------------------------------*) 
 
PROCEDURE
      put_asc16values_19 (
            VAR lcg : lc_global;
            VAR s16 : tsp00_C16;
            sline   : tin_natural;
            scol    : tin_natural;
            len     : tin_natural);
 
VAR
      p  : tin_ls_position;
      t  : tin_ls_fieldtype;
      i  : integer;
 
BEGIN
FOR i := 1 TO 16 DO
    IF  i <= len
    THEN
        BEGIN
        IF  NOT is_printable_19 (lcg, s16 [i])
        THEN
            s16 [i] := '.';
        (*ENDIF*) 
        END
    ELSE
        s16 [i] := bsp_c1;
    (*ENDIF*) 
(*ENDFOR*) 
p.screen_nr := 1;
p.screen_part := cin_ls_workarea;
p.scol := scol;
p.sline := sline;
t.field_att  := cin_attr1;
t.fieldmode  := [ ];
i50put3field (s16, 16, p, t);
END; (* put_asc16_values *)
 
(*------------------------------*) 
 
PROCEDURE
      put_asc64values_19 (
            VAR lcg : lc_global;
            VAR s64 : tsp00_C64;
            sline   : tin_natural;
            scol    : tin_natural;
            len     : tin_natural);
 
VAR
      p  : tin_ls_position;
      t  : tin_ls_fieldtype;
      i  : integer;
 
BEGIN
FOR i := 1 TO 64 DO
    IF  i <= len
    THEN
        BEGIN
        IF  NOT is_printable_19 (lcg, s64 [i])
        THEN
            s64 [i] := '.';
        (*ENDIF*) 
        END
    ELSE
        s64 [i] := bsp_c1;
    (*ENDIF*) 
(*ENDFOR*) 
p.screen_nr := 1;
p.screen_part := cin_ls_workarea;
p.scol := scol;
p.sline := sline;
t.field_att  := cin_attr1;
t.fieldmode  := [ ];
i50put5field (s64, 64, p, t);
END; (* put_asc64_values *)
 
(*------------------------------*) 
 
PROCEDURE
      put_uni16values_19 (
            VAR s16 : tsp00_C16;
            sline   : tin_natural;
            scol    : tin_natural;
            len     : tin_natural);
 
VAR
      p           : tin_ls_position;
      t           : tin_ls_fieldtype;
      s64         : tsp00_C64;
      uni_outlen  : integer;
      uni_ret     : tsp8_uni_error;
      uni_errpos  : tsp00_Int4;
      src_code    : tsp00_Int2;
 
BEGIN
IF  i01g^.i20.swap = sw_normal
THEN
    src_code := csp_unicode
ELSE
    src_code := csp_unicode_swap;
(*ENDIF*) 
uni_outlen := mxsp_c64;
s80uni_trans (@s16, len, src_code,
      @s64, uni_outlen,
      i01g^.multibyte.dblang_idx,
      [uni_fillup_field], uni_ret, uni_errpos);
p.screen_nr := 1;
p.screen_part := cin_ls_workarea;
p.scol := scol;
p.sline := sline;
t.field_att  := cin_attr1;
t.fieldmode  := [ ];
i50put5field (s64, mxsp_c24, p, t);
END; (* put_asc16_values *)
 
(*------------------------------*) 
 
PROCEDURE
      show_screen_19 (
            VAR func : tin_ls_releasemode );
 
VAR
      altered    : boolean;
      rk         : tin_ls_releasemode;
      cursor_pos : tin_ls_position;
 
BEGIN
WITH cursor_pos DO
    BEGIN
    screen_nr := 1;
    screen_part := cin_ls_workarea;
    scol := 2;
    sline := 1;
    END;
(*ENDWITH*) 
i57ioscreen (cursor_pos, rk, altered);
func := rk;
END; (* show_screen_19 *)
 
(*------------------------------*) 
 
PROCEDURE
      command_19 (
            VAR lcg   : lc_global;
            VAR func  : tin_ls_releasemode;
            VAR msgno : integer;
            VAR exit  : boolean);
 
BEGIN
WITH lcg DO
    CASE func OF
        f_down :
            page_down_19 (lcg, msgno);
        f_up :
            page_up_19 (lcg, msgno);
        f2 : (* *** hex/asc *** *)
            BEGIN
            IF  disp_mode = unicode_dump_mode
            THEN
                disp_mode := codeset_dump_mode
            ELSE
                IF  disp_mode = codeset_dump_mode
                THEN
                    disp_mode := text_mode
                ELSE
                    IF  lcg.lcisunicode
                    THEN
                        disp_mode := unicode_dump_mode
                    ELSE
                        disp_mode := codeset_dump_mode;
                    (*ENDIF*) 
                (*ENDIF*) 
            (*ENDIF*) 
            IF  (disp_mode = text_mode) AND NOT lcg.lcisunicode
            THEN
                offset := 64
            ELSE
                offset := 16;
            (*ENDIF*) 
            END;
        f7 :
            putfile_19 (lcg, msgno);
        f_exit : (* *** exit *** *)
            BEGIN
            exit := true;
            exit_key := true;
            END;
        f_end,
        f9 : (* *** end *** *)
            exit := true;
        f4 : (* *** top *** *)
            top_19 (lcg);
        f5 : (* *** bottom *** *)
            bottom_19 (lcg);
        OTHERWISE:
            BEGIN
            END;
        END;
    (*ENDCASE*) 
(*ENDWITH*) 
END; (* command_19 *)
 
(*------------------------------*) 
 
PROCEDURE
      page_down_19 (
            VAR lcg   : lc_global;
            VAR msgno : integer);
 
CONST
      cin19_bottom_text = 14904;
 
VAR
      width    : tsp00_Int4;
 
BEGIN
WITH lcg DO
    BEGIN
    width := (lines_on_screen - 1) * offset;
    IF  lcmaxlen > (realpos + lcpos + width)
    THEN
        BEGIN
        IF  lcpos + (2 * width) > maxlongbuf
        THEN
            BEGIN
            realpos := realpos + lcpos + width -1;
            lcpos := 1;
            read_long_column_19 (lcg);
            END
        ELSE
            lcpos := lcpos + width;
        (*ENDIF*) 
        END
    ELSE
        msgno := cin19_bottom_text;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END; (* page_down *)
 
(*------------------------------*) 
 
PROCEDURE
      page_up_19 (
            VAR lcg   : lc_global;
            VAR msgno : integer);
 
CONST
      cin19_top_text = 14905;
 
VAR
      width       : tsp00_Int4;
 
BEGIN
WITH lcg DO
    BEGIN
    IF  (lcpos > 1) OR (realpos > 1)
    THEN
        BEGIN
        width := (lines_on_screen - 1) * offset;
        IF  lcpos - width < 1
        THEN
            BEGIN
            IF  realpos > 1
            THEN
                BEGIN
                realpos := realpos + (lcpos - width)
                      + width - maxlongbuf + offset;
                lcpos := maxlongbuf - width - offset;
                IF  realpos < 1
                THEN
                    BEGIN
                    lcpos := lcpos + realpos - 1;
                    realpos := 1;
                    END;
                (*ENDIF*) 
                read_long_column_19 (lcg);
                END
            ELSE
                lcpos := 1;
            (*ENDIF*) 
            END
        ELSE
            lcpos := lcpos - width;
        (*ENDIF*) 
        END
    ELSE
        msgno := cin19_top_text;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END; (* page_up *)
 
(*------------------------------*) 
 
PROCEDURE
      top_19 (
            VAR lcg   : lc_global);
 
BEGIN
WITH lcg DO
    BEGIN
    realpos := 1;
    lcpos := 1;
    read_long_column_19 (lcg);
    END;
(*ENDWITH*) 
END; (* top *)
 
(*------------------------------*) 
 
PROCEDURE
      bottom_19 (
            VAR lcg   : lc_global);
 
VAR
      width  : tsp00_Int4;
 
BEGIN
WITH lcg DO
    BEGIN
    width := (lines_on_screen-1) * offset;
    realpos := (lcmaxlen DIV maxlongbuf) * maxlongbuf;
    IF  realpos = lcmaxlen
    THEN
        realpos := lcmaxlen - maxlongbuf + 1;
    (*ENDIF*) 
    IF  realpos = 0
    THEN
        realpos := 1;
    (*ENDIF*) 
    lcpos := ((lcmaxlen - realpos) DIV  width) * width ;
    IF  lcpos = (lcmaxlen - realpos)
    THEN
        lcpos := (lcmaxlen - realpos) - width + 1;
    (*ENDIF*) 
    IF  lcpos = 0
    THEN
        lcpos := 1;
    (*ENDIF*) 
    read_long_column_19 (lcg);
    END;
(*ENDWITH*) 
END; (* bottom *)
 
(*------------------------------*) 
 
PROCEDURE
      set_pos_19 (
            VAR pos : tin_ls_position;
            area    : tin_ls_part;
            line    : tin_natural;
            col     : tin_natural );
 
BEGIN
WITH pos DO
    BEGIN
    scol := col;
    sline := line;
    screen_part := area;
    screen_nr := 1;
    END;
(*ENDWITH*) 
END; (* set_pos_19 *)
 
(*------------------------------*) 
 
PROCEDURE
      execute_command_19 (
            VAR rc : tsp00_Int2);
 
VAR
      dbstate   : tin_connect_status;
      sqlstate  : tsp00_SqlState;
      errorpos  : tsp00_Int4;
 
BEGIN
rc := cin19_db_ok;
i20request (dbstate);
IF  dbstate = rc_ok
THEN
    i20receive (dbstate, sqlstate, rc, errorpos);
(*ENDIF*) 
IF  dbstate = rc_timeout
THEN
    BEGIN
    i20rebuild_session (dbstate);
    IF  dbstate = rc_ok
    THEN
        rc := cin19_timeout;
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  dbstate <> rc_ok
THEN
    rc := cin19_db_sys_error;
(*ENDIF*) 
END; (* execute_command_19 *)
 
(*------------------------------*) 
 
PROCEDURE
      put_header_19 (
            VAR lcg : lc_global  );
 
VAR
      header : tsp00_OnlineHeader;
 
BEGIN
WITH header DO
    BEGIN
    id_field := lcg.component;
    relno_field := lcg.release_id;
    mode_field := lcg.mode;
    text_field := '                                        ';
    END;
(*ENDWITH*) 
i56title (false, 1, header);
END; (* put_header_19 *)
 
(*------------------------------*) 
 
PROCEDURE
      get_msg_19 (
            msgno   : integer;
            VAR msg : tin_screenline);
 
VAR
      msg_p : tin_msg_parms;
      msg_t : tin_msg_type;
 
BEGIN
msg_p.length := 0;
i03msg (msgno, msg_p, msg, msg_t);
END; (* get_msg_19 *)
 
(*------------------------------*) 
 
PROCEDURE
      put_msg_19 (
            VAR msgno : integer) ;
 
VAR
      p   : tin_ls_position;
      t   : tin_ls_fieldtype;
      msg : tin_screenline;
 
BEGIN
IF  msgno <> 0
THEN
    BEGIN
    get_msg_19 (msgno, msg);
    t.field_att := cin_attr5;
    t.fieldmode := [  ] ;
    p.screen_part := cin_ls_sysline;
    p.sline := 1;
    p.scol  := 1;
    i50put6field (msg, i01g^.vt.desc.num_of_cols, p, t);
    msgno := 0;
    END;
(*ENDIF*) 
END; (* put_msg *)
 
(*------------------------------*) 
 
PROCEDURE
      read_long_column_19 (
            VAR lcg    : lc_global );
 
CONST
      one_descriptor    = 1;
      get_first_desc    = 1;
 
VAR
      rc               : tsp00_Int2;
      pos              : tsp00_Int4;
      end_reached      : boolean;
      helpbuf          : tsp00_Buf8K;
      uni_outlen       : integer;
      uni_ret          : tsp8_uni_error;
      uni_errpos       : tsp00_Int4;
      src_code         : tsp00_Int2;
 
BEGIN
WITH lcg, desc DO
    BEGIN
    IF  lt_newlong
    THEN
        BEGIN
        lt_new.ldb_valmode := vm_datapart;
        lt_new.ldb_intern_pos := realpos;
        END
    ELSE
        BEGIN
        lt_old.ld_valmode := vm_datapart;
        lt_old.ld_intern_pos := realpos;
        END;
    (*ENDIF*) 
    pos := 1;
    end_reached := false;
    REPEAT
        i22igetval (i01g, one_descriptor);
        i22npldesc (i01g, desc, maxlongbuf);
        execute_command_19 (rc);
        IF  rc = cin19_timeout
        THEN
            BEGIN
            i22igetval (i01g, one_descriptor);
            i22npldesc (i01g, desc, maxlongbuf);
            execute_command_19 (rc);
            END;
        (*ENDIF*) 
        IF  (rc = cin19_db_ok)
        THEN
            BEGIN
            i22ngldesc (i01g, desc, get_first_desc);
            i22nglong (i01g, desc, helpbuf,
                  pos, maxlongbuf);
            IF  lt_newlong
            THEN
                end_reached := lt_new.ldb_valmode
                      in [vm_alldata, vm_lastdata, vm_data_trunc]
            ELSE
                end_reached := lt_old.ld_valmode
                      in [vm_alldata, vm_lastdata, vm_data_trunc];
            (*ENDIF*) 
            END;
        (*ENDIF*) 
    UNTIL
        ((rc <> cin19_db_ok) OR (pos >= maxlongbuf)
        OR end_reached OR NOT lcgok);
    (*ENDREPEAT*) 
    IF  false (* lcg.lcisunicode *)
    THEN
        BEGIN
        IF  i01g^.i20.swap = sw_normal
        THEN
            src_code := csp_unicode
        ELSE
            src_code := csp_unicode_swap;
        (*ENDIF*) 
        uni_outlen := maxlongbuf;
        s80uni_trans (@helpbuf, pos, src_code,
              @lcg.lcbuf, uni_outlen,
              i01g^.multibyte.dblang_idx,
              [], uni_ret, uni_errpos);
        END
    ELSE
        lcg.lcbuf := helpbuf;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END; (* read_long_column_19 *)
 
(*------------------------------*) 
 
PROCEDURE
      get_max_len_19 (
            VAR lcg    : lc_global );
 
CONST
      one_descriptor    = 1;
      get_first_desc    = 1;
      get_no_data       = 2;
 
VAR
      rc      : tsp00_Int2;
 
BEGIN
WITH lcg, desc DO
    BEGIN
    IF  lt_newlong
    THEN
        lt_new.ldb_valmode := vm_data_trunc
    ELSE
        lt_old.ld_valmode := vm_data_trunc;
    (*ENDIF*) 
    i22igetval (i01g, one_descriptor);
    i22npldesc (i01g, desc, get_no_data);
    execute_command_19 (rc);
    IF  rc = cin19_timeout
    THEN
        BEGIN
        i22igetval (i01g, one_descriptor);
        i22npldesc (i01g, desc, maxlongbuf);
        execute_command_19 (rc);
        END;
    (*ENDIF*) 
    IF  rc = cin19_db_ok
    THEN
        i22ngldesc (i01g, desc, get_first_desc);
    (*ENDIF*) 
    IF  lt_newlong
    THEN
        lcmaxlen := lt_new.ldb_intern_pos - 1
    ELSE
        lcmaxlen := lt_old.ld_intern_pos - 1;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END; (* get_max_len_19 *)
 
(*------------------------------*) 
 
PROCEDURE
      close_long_19 (
            VAR lcg    : lc_global );
 
CONST
      one_descriptor    = 1;
      get_no_data       = 1;
 
VAR
      rc      : tsp00_Int2;
 
BEGIN
WITH lcg, desc DO
    BEGIN
    IF  lt_newlong
    THEN
        BEGIN
        lt_new.ldb_infoset := lt_new.ldb_infoset - [ldb_no_close];
        lt_new.ldb_valmode := vm_close;
        END
    ELSE
        BEGIN
        lt_old.ld_infoset := lt_old.ld_infoset - [ld_no_close];
        lt_old.ld_valmode := vm_close;
        END;
    (*ENDIF*) 
    i22igetval (i01g, one_descriptor);
    i22npldesc (i01g, desc, get_no_data);
    execute_command_19 (rc);
    IF  rc = cin19_timeout
    THEN
        BEGIN
        i22igetval (i01g, one_descriptor);
        i22npldesc (i01g, desc, get_no_data);
        execute_command_19 (rc);
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END; (* close_long_19 *)
 
(*------------------------------*) 
 
FUNCTION
      iolen_19 (
            dlen : tsp00_Int2 ) : tsp00_Int2;
 
BEGIN
iolen_19 := ((dlen + 1) DIV 2 ) + 1;
END; (* iolen_19 *)
 
(*------------------------------*) 
 
PROCEDURE
      buf_to_hex_19 (
            buf            : tsp00_MoveObjPtr;
            pos            : integer;
            len            : integer;
            dest           : tsp00_MoveObjPtr;
            dpos           : integer;
            dlen           : integer;
            VAR truncated  : boolean);
 
VAR
      di     : integer;
      si     : integer;
      lo_dig : integer;
      hi_dig : integer;
 
BEGIN
truncated := false;
di := 0;
si := 0;
WHILE NOT truncated AND (si < len) DO
    IF  dlen < di + 2
    THEN
        truncated := true
    ELSE
        BEGIN
        si := si + 1;
        hi_dig := ord (buf^ [ pos + si - 1 ] ) DIV 16;
        lo_dig := ord (buf^ [ pos + si - 1 ] ) MOD 16;
        di := di + 1;
        IF  hi_dig <= 9
        THEN
            dest^ [ dpos + di - 1 ] := chr (hi_dig + ord ('0'))
        ELSE
            dest^ [ dpos + di - 1 ] := chr (hi_dig - 10 + ord ('A'));
        (*ENDIF*) 
        di := di  + 1;
        IF  lo_dig <= 9
        THEN
            dest^ [ dpos + di - 1 ] := chr (lo_dig + ord ('0'))
        ELSE
            dest^ [ dpos + di - 1 ] := chr (lo_dig - 10 + ord ('A'));
        (*ENDIF*) 
        di := di + 1;
        dest^ [ dpos + di -  1] := bsp_c1;
        END;
    (*ENDIF*) 
(*ENDWHILE*) 
END; (* buf_to_hex_19 *)
 
(*------------------------------*) 
 
PROCEDURE
      int4_to_hex_19 (
            i4      : tsp00_Int4;
            VAR hex : tsp00_C8);
 
VAR
      i  : integer;
      ig,ir : tsp00_Int4;
 
BEGIN
hex := '00000000';
FOR i := 8 DOWNTO 1 DO
    BEGIN
    ig := i4 DIV 16;
    ir := i4 MOD 16;
    IF  ir <= 9
    THEN
        hex[i] := chr (ir + ord ('0'))
    ELSE
        hex[i] := chr (ir - 10 + ord ('A'));
    (*ENDIF*) 
    i4 := ig;
    END;
(*ENDFOR*) 
END; (* int4_to_hex *)
 
(*------------------------------*) 
 
PROCEDURE
      int4_to_dec_19 (
            i4      : tsp00_Int4;
            VAR dec : tsp00_C10);
 
VAR
      i  : integer;
      ig,ir : tsp00_Int4;
 
BEGIN
dec := '0000000000';
FOR i := 10 DOWNTO 1 DO
    BEGIN
    ig := i4 DIV 10;
    ir := i4 MOD 10;
    dec[i] := chr (ir + ord ('0'));
    i4 := ig;
    END;
(*ENDFOR*) 
END; (* int4_to_dec *)
 
(*------------------------------*) 
 
PROCEDURE
      dec_to_int4_19 (
            dec     : tsp00_C10;
            VAR i4  : tsp00_Int4;
            VAR ok  : boolean);
 
VAR
      i      : integer;
      m      : tsp00_Int4;
      digits : SET OF Char;
      num_ok : boolean;
 
BEGIN
digits := [ '0','1','2','3','4','5','6','7','8','9' ] ;
(**)
ok := false;
i4 := 0;
(**)
i := 1;
num_ok := true;
WHILE (num_ok) AND (i < 10) DO
    BEGIN
    IF  (dec [i] IN digits) OR (dec [i] = bsp_c1)
    THEN
        i := i + 1
    ELSE
        num_ok := false;
    (*ENDIF*) 
    END;
(*ENDWHILE*) 
IF  num_ok
THEN
    BEGIN
    m := 1;
    FOR i := 10 DOWNTO 1 DO
        BEGIN
        IF  dec [i] IN digits
        THEN
            BEGIN
            i4 := i4 + (ord (dec [i]) - ord ('0')) * m;
            m := m * 10;
            END;
        (*ENDIF*) 
        END;
    (*ENDFOR*) 
    END;
(*ENDIF*) 
ok := num_ok;
END; (* dec_to_int4 *)
 
(*------------------------------*) 
 
PROCEDURE
      init_char_set_19 (
            VAR lcg : lc_global );
 
BEGIN
lcg.digiset   := [ '0','1','2','3','4','5','6','7','8','9' ] ;
lcg.uletters  := [ ' ','A','B','C','D','E','F','G','H','I','J','K',
      'L','M','N','O','P','Q','R','S','T','U','V','W','X','Y','Z'] ;
lcg.lletters  := [ 'a','b','c','d','e','f','g','h','i','j','k',
      'l','m','n','o','p','q','r','s','t','u','v','w','x','y','z'] ;
(* Sonderzeichen, die in EBCDIC und ASCII vorhanden sind *)
lcg.specsigns := [ '.','<','(','+','&','!','$','*',')',';',
      '-','/',',','%','_','>','?',':','#','@','''','=', '"'] ;
END; (* init_char_set *)
 
(*------------------------------*) 
 
FUNCTION
      is_printable_19 (
            VAR lcg : lc_global;
            c       : Char) : Boolean;
 
BEGIN
&ifndef NOCHECK
WITH lcg DO
    IF  c IN ( digiset + lletters + uletters + specsigns )
    THEN
        is_printable_19 := true
    ELSE
        is_printable_19 := false;
    (*ENDIF*) 
(*ENDWITH*) 
&else
is_printable_19 := true;
&endif
END; (* is_printable *)
 
(*------------------------------*) 
 
PROCEDURE
      putfile_19 (
            VAR lcg   : lc_global;
            VAR msgno : integer);
 
CONST
      cin19_file_ok      = 14907;
      cin19_file_error   = 14908;
 
VAR
      filename        : tsp00_VFilename;
      file_error      : tsp00_VfReturn;
      file_errtext    : tsp00_ErrText;
      format          : tsp00_VfFormat;
      rec_len         : tsp00_Int4;
      fno             : tsp00_Int4;
      outblockaddress : tsp_vf_bufaddr;
      direction       : tsp00_VFileOpCodes;
      error           : boolean;
 
BEGIN
error := false;
get_filename_19 (filename);
IF  filename[1] <> ' '
THEN
    BEGIN
    direction := voverwrite;
    format := vf_stream; (*vf_plaintext;*)
    rec_len := 0;
    file_error := vf_ok;
    sqlfopen (filename, direction, vf_stack, fno, format, rec_len,
          i01g^.vf_pool_ptr, 1, outblockaddress,
          file_error, file_errtext);
    IF  file_error = vf_ok
    THEN
        BEGIN
        write_long_to_file_19 (lcg, fno, error);
        IF  error
        THEN
            msgno := cin19_file_error;
        (*ENDIF*) 
        sqlfclose (fno, false, i01g^.vf_pool_ptr, 0,
              outblockaddress, file_error, file_errtext);
        IF  msgno = 0
        THEN
            msgno := cin19_file_ok;
        (*ENDIF*) 
        END
    ELSE
        msgno := cin19_file_error;
    (*ENDIF*) 
    END;
(*ENDIF*) 
END; (* putfile_19 *)
 
(*------------------------------*) 
 
PROCEDURE
      write_long_to_file_19 (
            VAR lcg   : lc_global;
            fno       : tsp00_Int4;
            VAR error : boolean );
 
CONST
      one_descriptor    = 1;
      get_first_desc    = 1;
 
VAR
      rc              : tsp00_Int2;
      buf             : tsp00_Buf8K;
      buflen          : tsp00_Int4;
      actpos          : tsp00_Int4;
      end_of_buf      : boolean;
      end_of_col      : boolean;
      file_error      : tsp00_VfReturn;
      file_errtext    : tsp00_ErrText;
      ubuf            : tsp00_Buf8K;
      ubuflen         : integer;
      uni_ret         : tsp8_uni_error;
      uni_errpos      : tsp00_Int4;
      src_code        : tsp00_Int2;
 
BEGIN
WITH lcg, desc DO
    BEGIN
    IF  lt_newlong
    THEN
        lt_new.ldb_intern_pos := 1
    ELSE
        lt_old.ld_intern_pos  := 1;
    (*ENDIF*) 
    actpos := 1;
    error := false;
    REPEAT
        IF  lt_newlong
        THEN
            BEGIN
            lt_new.ldb_valmode := vm_nodata;
            lt_new.ldb_intern_pos := actpos;
            END
        ELSE
            BEGIN
            lt_old.ld_valmode := vm_nodata;
            lt_old.ld_intern_pos := actpos;
            END;
        (*ENDIF*) 
        buflen := 1;
        REPEAT
            i22igetval (i01g, one_descriptor);
            i22npldesc (i01g, desc, 4000);
            execute_command_19 (rc);
            IF  rc = cin19_timeout
            THEN
                BEGIN
                i22igetval (i01g, one_descriptor);
                i22npldesc (i01g, desc, maxlongbuf);
                execute_command_19 (rc);
                END;
            (*ENDIF*) 
            IF  rc = cin19_db_ok
            THEN
                BEGIN
                i22ngldesc (i01g, desc, get_first_desc);
                i22nglong (i01g, desc, buf, buflen, 4000);
                IF  lt_newlong
                THEN
                    BEGIN
                    end_of_buf := lt_new.ldb_valmode = vm_data_trunc;
                    end_of_col := lt_new.ldb_valmode in
                          [vm_alldata, vm_lastdata];
                    END
                ELSE
                    BEGIN
                    end_of_buf := lt_old.ld_valmode = vm_data_trunc;
                    end_of_col := lt_old.ld_valmode in
                          [vm_alldata, vm_lastdata];
                    END;
                (*ENDIF*) 
                END;
            (*ENDIF*) 
        UNTIL
            ((rc <> cin19_db_ok) OR (buflen >= 4000) OR end_of_col
            OR end_of_buf);
        (*ENDREPEAT*) 
        IF  end_of_col OR end_of_buf
        THEN
            buflen := buflen - 1;
        (*ENDIF*) 
        IF  lcg.lcisunicode
        THEN
            BEGIN
            IF  i01g^.i20.swap = sw_normal
            THEN
                src_code := csp_unicode
            ELSE
                src_code := csp_unicode_swap;
            (*ENDIF*) 
            ubuflen := sizeof(ubuf);
            s80uni_trans (@buf, buflen, src_code,
                  @ubuf, ubuflen,
                  i01g^.multibyte.dblang_idx,
                  [], uni_ret, uni_errpos);
            sqlfwrite (fno, s30gad (ubuf), ubuflen, file_error, file_errtext);
            END
        ELSE
            sqlfwrite (fno, s30gad (buf), buflen, file_error, file_errtext);
        (*ENDIF*) 
        IF  file_error <> vf_ok
        THEN
            error := true;
        (*ENDIF*) 
        actpos := actpos + buflen;
    UNTIL
        ( error OR (rc <> cin19_db_ok) OR end_of_col );
    (*ENDREPEAT*) 
    END;
(*ENDWITH*) 
END; (* write_long_to_file_19 *)
 
(*------------------------------*) 
 
PROCEDURE
      get_filename_19 (
            VAR filename  : tsp00_VFilename);
 
VAR
      cursor_pos     : tin_ls_position;
      rf             : tin_ls_releasemode;
      screen_changed : boolean;
      restore        : boolean;
 
BEGIN
filename[1] := ' ';
i50clear (cin_ls_functionmenu);
filename_box_19;
set_filename_keys_19;
fill_filename_box_19;
WITH cursor_pos DO
    BEGIN
    screen_nr := 1;
    screen_part := cin_ls_basic_window;
    scol :=  1;
    sline := 2;
    END;
(*ENDWITH*) 
out_filename_19 (cursor_pos, rf, screen_changed);
WITH cursor_pos DO
    BEGIN
    screen_nr := 1;
    screen_part := cin_ls_basic_window;
    scol :=  1;
    sline := 2;
    END;
(*ENDWITH*) 
in_filename_19 (filename, cursor_pos, screen_changed);
i51offwindow (restore);
END; (* get_filename_19 *)
 
(*------------------------------*) 
 
PROCEDURE
      filename_box_19;
 
VAR
      win_pos : tin_ls_position;
      win     : tin_screen_window;
      s_len   : tin_natural;
      s_wid   : tin_natural;
      restore : boolean;
      ok      : boolean;
 
BEGIN
ok := true;
restore := false;
WITH win DO
    BEGIN
    lines := 4;
    cols := VFILENAME_MXSP00 + 2;
    first_pos.screen_nr := 1;
    first_pos.screen_part := cin_ls_whole_screen;
    i51size (cin_ls_whole_screen, s_len, s_wid);
    first_pos.scol := (s_wid - cols) DIV 2 + 1;
    first_pos.sline := (s_len - lines) DIV 2;
    WITH win_pos DO
        BEGIN
        screen_nr   := 1;
        screen_part := cin_ls_whole_screen;
        scol        := 2;
        sline       := 1;
        END;
    (*ENDWITH*) 
    i51ownlayout ( cin_ls_inputarea, win_pos, 0, 0 );
    i51ownlayout ( cin_ls_workarea, win_pos, 0, 0 );
    i51ownlayout ( cin_ls_header, win_pos, 0, 0 );
    i51ownlayout ( cin_ls_sysline, win_pos, 0, 0 );
    i51ownlayout ( cin_ls_functionmenu, win_pos, 0, 0 );
    WITH i01g^.vt.wopt DO
        BEGIN
        with_frame := true;
        WITH frame_ft DO
            BEGIN
            field_att := cin_attr7;
            fieldmode := [  ] ;
            END;
        (*ENDWITH*) 
        background_part := cin_ls_whole_screen;
        background_ft.field_att := cin_attr1;
        background_ft.fieldmode := [ ] ;
        END;
    (*ENDWITH*) 
    i51onwindow (cin_ls_basic_window, win, ok);
    IF  ok
    THEN
        i50clear (cin_ls_basic_window);
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END; (* filename_box *)
 
(*------------------------------*) 
 
PROCEDURE
      set_filename_keys_19;
 
BEGIN
WITH i01g^.key_type DO
    activated := [ f_enter, f_clear ];
(*ENDWITH*) 
i56putlabels (f_clear, false);
END; (* set_file_keys_19 *)
 
(*------------------------------*) 
 
PROCEDURE
      fill_filename_box_19;
 
CONST
      cin19_file_text = 14906;
 
VAR
      p    : tin_ls_position;
      t    : tin_ls_fieldtype;
      l    : tin_screenline;
 
BEGIN
(**)
get_msg_19 (cin19_file_text, l);
p.screen_nr := 1;
p.screen_part := cin_ls_basic_window;
p.scol := 1;
p.sline := 1;
t.field_att  := cin_attr1;
t.fieldmode  := [ ];
i50put6field (l, mxsp_c64, p, t);
(**)
SAPDB_PascalForcedFill (mxin_screenline, @l, 1, mxin_screenline, ' ');
p.scol := 1;
t.field_att  := cin_attr1;
t.fieldmode  := [ ls_input ];
p.sline := 2;
i50put6field (l, VFILENAME_MXSP00, p, t);
END; (* fill_filename_box_19 *)
 
(*------------------------------*) 
 
PROCEDURE
      out_filename_19 (
            VAR cursor_pos     : tin_ls_position;
            VAR rf             : tin_ls_releasemode;
            VAR screen_changed : boolean );
 
BEGIN
WITH i01g^.vt.opt DO
    BEGIN
    wait_for_input := true;
    usage_mode := vt_form;
    return_on_last  := false;
    return_on_first := false;
    returnkeys      := [  ] ;
    reject_keys     := [  ] ;
    bell := false;
    END;
(*ENDWITH*) 
i57ioscreen (cursor_pos, rf, screen_changed);
END;
 
(*------------------------------*) 
 
PROCEDURE
      in_filename_19 (
            VAR filename       : tsp00_VFilename;
            VAR cursor_pos     : tin_ls_position;
            VAR screen_changed : boolean);
 
VAR
      input        : tin_ls_input_field;
      field_found  : boolean;
 
BEGIN
i50getwindow (cursor_pos, 999, 999, screen_changed);
i50getfield (input, field_found);
IF  field_found
THEN
    s10mv (mxin_screenline,mxsp_c64,
          @input.buf,1,
          @filename,1,input.len);
(*ENDIF*) 
END;
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
.PA 
