.CM  SCRIPT , Version - 1.1 , last edited by barbara
.pa
.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$VIN04$
.tt 2 $$$
.TT 3 $$messages$1997-01-31$
***********************************************************
.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  : messages
=========
.sp
Purpose : Real interface to SYSMSG and SYSLITERAL table.
.CM *-END-* purpose -------------------------------------
.sp
.cp 3
Define  :
 
        PROCEDURE
              i04msg1 (
                    g_area  : tin_global_in_vars;
                    msg_nr  : integer;
                    VAR msg : tin_screenline );
 
        PROCEDURE
              i04db2msg (
                    g_area    : tin_global_in_vars;
                    msg_nr    : integer;
                    VAR msg   : tin_screenline;
                    VAR msgt  : tin_msg_type );
 
        PROCEDURE
              i04crashmsg (
                    g_area  : tin_global_in_vars;
                    err     : tin_connect_status;
                    VAR msg : tin_screenline );
 
        PROCEDURE
              i04dbrequest (
                    g_area       : tin_global_in_vars;
                    VAR timeout  : boolean;
                    VAR ret      : tin_connect_status;
                    VAR sqlstate : tsp00_SqlState;
                    VAR r_code   : tsp00_Int2;
                    VAR e_pos    : tsp00_Int4);
 
        PROCEDURE
              i04init (
                    g_area : tin_global_in_vars );
 
        PROCEDURE
              i04insert_msg (
                    g_area  : tin_global_in_vars;
                    msg_nr  : integer;
                    VAR msg : tin_screenline );
 
        PROCEDURE
              i04int2msg (
                    g_area    : tin_global_in_vars;
                    msg_nr    : integer;
                    int2parms : tsp00_Int2;
                    VAR msg   : tin_screenline;
                    VAR msgt  : tin_msg_type );
 
        PROCEDURE
              i04literal (
                    g_area      : tin_global_in_vars;
                    author      : tsp00_KnlIdentifier;
                    litname     : tsp00_Name;
                    VAR literal : tin_menu_result );
 
        PROCEDURE
              i04mfetch (
                    g_area     : tin_global_in_vars;
                    VAR msgnos : tin_msgnos);
 
        PROCEDURE
              i04mfrange (
                    msgno1     : tsp00_Int2;
                    msgno2     : tsp00_Int2;
                    VAR msgnos : tin_msgnos);
 
        PROCEDURE
              i04mfset (
                    msgno      : tsp00_Int2;
                    VAR msgnos : tin_msgnos);
 
        PROCEDURE
              i04msg (
                    g_area    : tin_global_in_vars;
                    msg_nr    : integer;
                    VAR parms : tin_msg_parms;
                    VAR msg   : tin_screenline;
                    VAR msgt  : tin_msg_type );
 
        PROCEDURE
              i04negmsg (
                    g_area    : tin_global_in_vars;
                    msg_nr    : integer;
                    VAR parms : tin_msg_parms;
                    VAR msg   : tin_screenline;
                    VAR msgt  : tin_msg_type );
 
        PROCEDURE
              i04nummsg (
                    g_area    : tin_global_in_vars;
                    msg_nr    : integer;
                    VAR parms : tin_msg_parms;
                    VAR msg   : tin_screenline;
                    VAR msgt  : tin_msg_type );
 
        PROCEDURE
              i04resolve_parms (
                    VAR parms : tin_msg_parms;
                    VAR msg   : tin_screenline );
 
        PROCEDURE
              i04sqlmsg (
                    g_area  : tin_global_in_vars;
                    msg_nr  : integer;
                    VAR msg : tin_screenline );
 
        PROCEDURE
              i04check_mlanguage (
                    g_area     : tin_global_in_vars;
                    language   : tin_language_id;
                    VAR ok     : boolean);
 
        FUNCTION
              in0430 : tsp00_Int4;
 
.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :
 
        FROM
              standard_editor_functions : VIN14 ;
 
        PROCEDURE
              i14geteline (
                    VAR eform  : tin_msgpoolbuf;
                    VAR evars  : tin_eform_vars;
                    VAR line   : tin_screenline;
                    line_nr    : tin_natural;
                    VAR length : tin_natural;
                    VAR error  : boolean);
 
        PROCEDURE
              i14deleteeline (
                    VAR eform  : tin_msgpoolbuf;
                    VAR evars  : tin_eform_vars;
                    line_nr    : tin_natural;
                    line_count : tin_natural);
 
        PROCEDURE
              i14puteline (
                    VAR eform : tin_msgpoolbuf;
                    VAR evars : tin_eform_vars;
                    VAR line  : tin_screenline;
                    line_nr   : tin_natural;
                    length    : tin_natural;
                    VAR error : boolean);
 
        PROCEDURE
              i14cleareform (
                    VAR evars : tin_eform_vars);
 
      ------------------------------ 
 
        FROM
              SQLDB-command-interface : VIN21;
 
        PROCEDURE
              i21initexecute (
                    g_area  : tin_global_in_vars;
                    VAR pid : tin_parsid);
 
        PROCEDURE
              i21initparse (
                    g_area : tin_global_in_vars);
 
        PROCEDURE
              i21initadbs (
                    g_area : tin_global_in_vars);
 
        PROCEDURE
              i21alternativesegment (
                    g_area      : tin_global_in_vars;
                    switch_stat : tin_switch_type );
 
        FUNCTION
              i21dbok (
                    g_area : tin_global_in_vars ) : boolean;
 
        PROCEDURE
              i21errortext (
                    g_area  : tin_global_in_vars;
                    VAR msg : tin_screenline);
 
        PROCEDURE
              i21findpart (
                    g_area    : tin_global_in_vars;
                    part_kind : tsp1_part_kind);
 
        PROCEDURE
              i21gparsid (
                    g_area     : tin_global_in_vars;
                    VAR parsid : tin_parsid);
 
        PROCEDURE
              i21gbval (
                    g_area      : tin_global_in_vars;
                    l_val       : tin_natural;
                    b_pos       : tsp00_Int4;
                    VAR val     : tsp00_C80;
                    VAR is_null : boolean );
 
        PROCEDURE
              i21g1bval (
                    g_area      : tin_global_in_vars;
                    l_val       : tin_natural;
                    b_pos       : tsp00_Int4;
                    VAR val     : tsp00_C8;
                    VAR is_null : boolean );
 
        PROCEDURE
              i21g2bval (
                    g_area      : tin_global_in_vars;
                    l_val       : tin_natural;
                    b_pos       : tsp00_Int4;
                    VAR val     : tsp00_C12;
                    VAR is_null : boolean );
 
        PROCEDURE
              i21g3bval (
                    g_area      : tin_global_in_vars;
                    l_val       : tin_natural;
                    b_pos       : tsp00_Int4;
                    VAR val     : tsp00_C18;
                    VAR is_null : boolean );
 
        PROCEDURE
              i21grescount (
                    g_area     : tin_global_in_vars;
                    VAR known  : boolean;
                    VAR count  : tsp00_Int4);
 
        PROCEDURE
              i21gvalcount (
                    g_area    : tin_global_in_vars;
                    VAR count : integer);
 
        FUNCTION
              i21gchar (
                    g_area       : tin_global_in_vars;
                    b_pos        : tsp00_Int4) : char;
 
        PROCEDURE
              i21gval (
                    g_area      : tin_global_in_vars;
                    l_val       : tin_natural;
                    VAR pos     : tsp00_Int4;
                    VAR val     : tin_screenline;
                    VAR is_null : boolean );
 
        PROCEDURE
              i21g1val (
                    g_area      : tin_global_in_vars;
                    l_val       : tin_natural;
                    VAR pos     : tsp00_Int4;
                    VAR val     : tin_double_eline;
                    VAR is_null : boolean );
 
        PROCEDURE
              i21mfetch (
                    g_area       : tin_global_in_vars;
                    in_unicode   : boolean;
                    m_type       : tsp1_cmd_mess_type;
                    count        : tsp00_Int4;
                    dir          : tin_fetch_dir;
                    VAR res_name : tsp00_KnlIdentifier);
 
        PROCEDURE
              i21gparaminfo (
                    g_area    : tin_global_in_vars;
                    info_no   : tin_natural;
                    VAR pi    : tsp1_param_info;
                    VAR found : boolean);
 
        PROCEDURE
              i21p1barg (
                    g_area  : tin_global_in_vars;
                    VAR arg : tin_language_id;
                    b_pos   : tsp00_Int4;
                    l_arg   : tin_natural;
                    is_null : boolean );
 
        PROCEDURE
              i21p2barg (
                    g_area  : tin_global_in_vars;
                    VAR arg : tsp00_Number;
                    b_pos   : tsp00_Int4;
                    l_arg   : tin_natural;
                    is_null : boolean );
 
        PROCEDURE
              i21p3barg (
                    g_area  : tin_global_in_vars;
                    VAR arg : tsp00_Name;
                    b_pos   : tsp00_Int4;
                    l_arg   : tin_natural;
                    is_null : boolean );
 
        PROCEDURE
              i21p4barg (
                    g_area  : tin_global_in_vars;
                    VAR arg : tsp00_KnlIdentifier;
                    b_pos   : tsp00_Int4;
                    l_arg   : tin_natural;
                    is_null : boolean );
 
        PROCEDURE
              i21pcmnd (
                    g_area : tin_global_in_vars;
                    VAR s  : tsp00_KnlIdentifier;
                    l_s    : tin_natural );
 
        PROCEDURE
              i21p1cmnd (
                    g_area : tin_global_in_vars;
                    VAR s  : tsp00_C20;
                    l_s    : tin_natural );
 
        PROCEDURE
              i21p2cmnd (
                    g_area : tin_global_in_vars;
                    VAR s  : tsp00_C40;
                    l_s    : tin_natural );
 
        PROCEDURE
              i21pccmnd (
                    g_area : tin_global_in_vars;
                    c      : char );
 
        PROCEDURE
              i21request (
                    g_area        : tin_global_in_vars;
                    VAR rq_status : tin_connect_status);
 
        PROCEDURE
              i21receive (
                    g_area         : tin_global_in_vars;
                    VAR rc_status  : tin_connect_status;
                    VAR sqlstate   : tsp00_SqlState;
                    VAR returncode : tsp00_Int2;
                    VAR errorpos   : tsp00_Int4);
&       ifndef inlink
 
        PROCEDURE
              i21rebuild_session (
                    g_area     : tin_global_in_vars;
                    VAR status : tin_connect_status);
&       endif
 
      ------------------------------ 
 
        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
              s30klen (
                    VAR str : tin_screenline;
                    val     : char; cnt : integer) : integer;
 
        FUNCTION
              s30gad (
                    VAR b : char) : tsp00_MoveObjPtr;
 
      ------------------------------ 
 
        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
              GET-Conversions : VSP40;
 
        PROCEDURE
              s40gsint (
                    VAR buf  : tin_screenline;
                    pos      : tsp00_Int4;
                    len      : integer;
                    VAR dest : tsp00_Int2;
                    VAR res  : tsp00_NumError);
 
      ------------------------------ 
 
        FROM
              PUT-Conversions : VSP41;
 
        PROCEDURE
              s41psint (
                    VAR buf : tsp00_Number;
                    pos     : tsp00_Int4;
                    len     : integer;
                    frac    : integer;
                    source  : tsp00_Int2;
                    VAR res : tsp00_NumError);
 
      ------------------------------ 
 
        FROM
              Code-Translation : VIN32;
 
        PROCEDURE
              i32upstring (
                    VAR source : tin_screenline;
                    spos       : integer;
                    VAR dest   : tin_screenline;
                    dpos       : integer;
                    len        : integer);
 
.CM *-END-* use -----------------------------------------
.sp;.cp 3
Synonym :
 
        PROCEDURE
              i32upstring;
 
              tsp00_MoveObj tin_screenline
              tsp00_MoveObj tin_screenline
 
        PROCEDURE
              i21gbval;
 
              tsp00_Buf     tsp00_C80
 
        PROCEDURE
              i21g1bval;
 
              tsp00_Buf     tsp00_C8
 
        PROCEDURE
              i21g2bval;
 
              tsp00_Buf     tsp00_C12
 
        PROCEDURE
              i21g3bval;
 
              tsp00_Buf     tsp00_C18
 
        PROCEDURE
              i21p3barg;
 
              tsp00_Buf     tsp00_Name
 
        PROCEDURE
              i21p4barg;
 
              tsp00_Buf    tsp00_KnlIdentifier
 
        PROCEDURE
              i21p1barg;
 
              tsp00_Buf tin_language_id;
 
        PROCEDURE
              i21p2barg;
 
              tsp00_Buf tsp00_Number;
 
        PROCEDURE
              i21gval;
 
              tsp00_Buf tin_screenline
 
        PROCEDURE
              i21g1val;
 
              tsp00_Buf tin_double_eline
 
        PROCEDURE
              s41psint ;
 
              tsp00_MoveObj  tsp00_Number
 
        PROCEDURE
              s40gsint;
 
              tsp00_MoveObj tin_screenline
 
        PROCEDURE
              m90hostname;
 
              tsp00_VFilename tin_screenline
 
        PROCEDURE
              s30klen;
 
              tsp00_MoveObj tin_screenline
 
        FUNCTION
              s30gad;
 
              tsp00_MoveObj char
              tsp00_Addr    tsp00_MoveObjPtr
 
        PROCEDURE
              i14geteline;
 
              tin_eform_buffer tin_msgpoolbuf
              tin_eline tin_screenline
 
        PROCEDURE
              i14deleteeline;
 
              tin_eform_buffer tin_msgpoolbuf
 
        PROCEDURE
              i14puteline;
 
              tin_eform_buffer tin_msgpoolbuf
              tin_eline tin_screenline
 
        PROCEDURE
              i21pcmnd;
 
              tsp00_Buf tsp00_KnlIdentifier
 
.CM *-END-* synonym -------------------------------------
.sp;.cp 3
Author  :
.sp
.cp 3
Created : 1986-08-04
.sp
.cp 3
.sp
.cp 3
Release :  6.2.8.0       Date : 1997-01-31
.sp
***********************************************************
.sp
.cp 20
.fo
.oc _/1
Specification:
.sp;.hi +3
        PROCEDURE
              i04msg (
                    g_area    : ti_global_in_vars;
                          msg_nr    : integer;
                          VAR parms : ti_msg_parms;
                          VAR msg   : ti_screenline;
                          VAR msgt  : ti_msg_type);
 
.sp;.fo
This procedure supplies in MSG the current text for the component
COMP with the message number MSG_NR and the language determined in
SET_PARMS.
.sp;.cp 6
Current text parameters can also be supplied via the buffer PARMS.
The ith parameter in the buffer replaces &i in the text (1<=i<=9).
PARMS.BUFFER must be allocated as follows :
.br
The first byte contains the length of the first parameter ( chr (length) )
followed by the parameter, then the length byte of the second parameter
followed by the parameter, etc.
.sp;.nf;.cp 4
    Example:
    x := chr (4); y := chr (3);
    parms.buffer := 'xEXITyEND       ';
    parms.length := 9;
.sp;.fo
References that have not been deleted are ignored.
If no text_parameters are used, PARMS.LENGTH must be assigned null.
.sp;.cp 5
If the relevant message for the specified component COMP is not
currently available in I01_G.MSG_TAB, the procedure accesses the
system table SYSMSG   of the database in order to fetch the message
text.
.sp;.cp 4
The parameter MSGT reports whether it was possible to supply the message
 (LONG_MSG) or the message was not present (SHORT_MSG) or
no database access was possible (CRASH_MSG).
MSG is assigned at least one default message.
.sp 3;.cp 6;.nf
        PROCEDURE
              i04int2msg (
                    g_area    : ti_global_in_vars;
                          msg_nr    : integer;
                          int2parms : int2;
                          VAR msg   : ti_screenline;
                          VAR msgt  : ti_msg_type);
 
.sp;.fo
This procedure supplies in MSG the current text for the component
COMP with the message number MSG_NR and the language determined in
SET_PARMS.
.sp;.cp 6
If a '&' is contained in MSG, it is replaced by the character
presentation from INT2PARMS.
.sp;.cp 5
If the relevant message for the specified component COMP is not
currently available in I01_G.MSG_TAB, the procedure accesses the
system table SYSMSG   of the database in order to fetch the message
text.
.sp;.cp 4
The parameter MSGT reports whether it was possible to supply the message
 (LONG_MSG) or the message was not present (SHORT_MSG) or no database
access was possible (CRASH_MSG).
MSG is assigned at least one default message.
.sp;.cp 8;.nf
        PROCEDURE
              i04crashmsg (
                    g_area  : ti_global_in_vars;
                    err     : ti_connect_status;
                    VAR msg : ti_screenline);
.sp 2;.fo
This procedure returns the appropriate error message to ERR
in MSG.
.sp;.cp 8;.nf
        PROCEDURE
              i04fetchmessages (
                    g_area  : ti_global_in_vars;
                    msg_nos : c60);
.sp 2;.fo
This procedure can be called at the beginning of a component (or a
new branch) in order to provide the messages more quickly.  With
MFETCH, the procedure fetches the messages that belong to the
message numbers specified in MSG_NOS.
.sp;These numbers are passed in MSG_NOS in the form of a PASCAL SET
in plain text (without parentheses!!).
.sp;Example:
.sp;.nf;.cp 10
PROCEDURE
          fetch_important_messages;
 
CONST
      most_used_messages =
        '1..13,22..30,33,34,200..205                                 ';
 
BEGIN
i04fetchmessages (most_used_messages);
END; (* fetch_important_messages *)
.sp 2;.fo
This procedure checks beforehand whether the messages desired have
already been loaded by taking random samples.
 (A message number is taken from the string ]
.CM *-END-* specification -------------------------------
.sp 2.fo
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Description:
The texts for all messages are located in the VDN table PUBLIC.SYSMSG  :
.sp 2;.cp 6;.nf
 CREATE TABLE PUBLIC.SYSMSG
.sp
   (
     LANGUAGE     CHAR (3)  KEY,
     MSGNO        FIXED (5) KEY,
     MSGTEXT      CHAR (80)     )
.sp 2;.fo
The texts (MSGTEXT) are read in from the database table with the procedure
EINLESEN and stored in I01_G^.MSG_TAB.MESSAGES.
The MESSAGES are sorted according to LRU.
I01_MSG).
.sp 2;.cp 12;.nf
            I01_G^.MSG_TAB
                       FIRST    : INTEGER;
                       LAST     : INTEGER;
                       EMTY     : BOOLEAN;
                       PARSID   : STRING6;
                       BUFPOS   : ARRAY [1..4] of int2;
                       MESSAGES [1..30 ]
                               NEXT     : INTEGER;
                               PREV     : INTEGER;
                               MSG_KEY  : MSG_KEY_TYPE;
                                        LANG : LANGUAGE_ID;
                                        NR   : INTEGER;
                               MSG_TEXT : SCREENLINE;
.sp 3
i04LITERAL
----------
.br
The language-dependent literals are located in the view
PUBLIC.SYSLITERAL.  They are entered there via the data
dictionary.  The procedure i04LITERAL is also given the name of the
literal ('litname') and the name of the "owner" ('author').  The language is
determined via the SET parameter.  If the literal being searched for
is found, the value is located in 'literal' and the length in 'llen'.
If no entry is found, the name of the literal is returned in 'literal'.
Before i04LITERAL is called for the first time, the following fields
must be initialized in the data structure LITERAL_POOL:
       length with 0,
       dbpid with bi_parseid,
       accesscount with 0 and
       sysliteral_exists with TRUE.
.CM *-END-* description ---------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.nf
.oc _/1
Structure:
 
.CM *-END-* structure -----------------------------------
.sp 2
**********************************************************
.sp
.cp 10
.nf
.oc _/1
.CM -lll-
Code    :
 
 
CONST
      sysmessage_table = 'LOCALSYSDBA.MESSAGES                    ';
      mselect_resname  =
            'I04MESS_R                                                       ';
      sysmsg_len       = 80;
      sysmsg_uc_len    = 160;
      undef_msgno      = csp_minint2;
      nil_ptr          = csp_maxint2;
&     ifdef TEST
      max_messages     = 20;
      msgpool_size     = 1024;
&     else
      max_messages     = mxin_msgkeys;
      msgpool_size     = mxin_msgpoolbuf;
&     endif
      range_symbol     = csp_minint2;
      empty_char = 255;
 
TYPE
      msgkey_pointer   = tsp00_Int2;
 
 
(*------------------------------*) 
 
FUNCTION
      in0430 : tsp00_Int4;
 
BEGIN
(* linkcheck function *)
in0430 := 219020708;
END;
 
(*------------------------------*) 
 
PROCEDURE
      i04msg1 (
            g_area  : tin_global_in_vars;
            msg_nr  : integer;
            VAR msg : tin_screenline);
 
VAR
      msgt   : tin_msg_type;
 
BEGIN
IF  g_area^.msg_tab.lang <> g_area^.set_parms.language
THEN
    in04_language_switch ( g_area, g_area^.set_parms.language );
(*ENDIF*) 
in04_search_msg (g_area, msg_nr, msg, msgt);
IF  msgt <> long_msg
THEN
    in04_select_msg (g_area, msg_nr, msg, msgt);
(*ENDIF*) 
END; (* i04msg1 *)
 
(*------------------------------*) 
 
PROCEDURE
      i04db2msg (
            g_area    : tin_global_in_vars;
            msg_nr    : integer;
            VAR msg   : tin_screenline;
            VAR msgt  : tin_msg_type );
 
CONST
      db2_offset = -30000;
 
VAR
      lang : tin_language_id;
 
BEGIN
in04_search_msg (g_area, msg_nr - db2_offset, msg, msgt);
IF  msgt <> long_msg
THEN
    BEGIN
    lang := g_area^.set_parms.language;
    g_area^.set_parms.language := 'DB2';
    in04_select_msg (g_area, msg_nr - db2_offset, msg, msgt);
    g_area^.set_parms.language := lang;
    END;
(*ENDIF*) 
END; (* i04db2msg *)
 
(*------------------------------*) 
 
PROCEDURE
      i04dbrequest (
            g_area       : tin_global_in_vars;
            VAR timeout  : boolean;
            VAR ret      : tin_connect_status;
            VAR sqlstate : tsp00_SqlState;
            VAR r_code   : tsp00_Int2;
            VAR e_pos    : tsp00_Int4);
 
BEGIN
timeout := false;
r_code := - 1;
IF  i21dbok (g_area)
THEN
    BEGIN
    i21request (g_area, ret);
    IF  ret = rc_ok
    THEN
        i21receive (g_area, ret, sqlstate, r_code, e_pos);
    (*ENDIF*) 
    IF  ret in [ rc_timeout, rc_logon_required]
    THEN
        BEGIN
&       ifndef inlink
        i21rebuild_session (g_area, ret);
&       endif
        timeout := true;
        END;
    (*ENDIF*) 
    END;
(*ENDIF*) 
END; (* i04dbrequest *)
 
(*------------------------------*) 
 
PROCEDURE
      i04crashmsg (
            g_area  : tin_global_in_vars;
            err     : tin_connect_status;
            VAR msg : tin_screenline);
 
CONST (* B.M. Rel 3.0.01 15 Aug 1991 *)
      sta = 'Database &1 not started                 ';
      rst = 'Database &1 must be restarted           ';
      (* *)
      lim = 'Too many database users active          ';
      tim = 'Request timeout                         ';
      csh = 'Database system crashed                 ';
      log = 'Username/password illegal               ';
      sys = 'System error, ord (status) = &1         ';
 
VAR
      m_txt           : tsp00_C40;
      length          : integer;
      parms           : tin_msg_parms;
      int2parms       : tsp00_Int2;
      message_fetched : boolean; (* B.M. Rel 3.0 11 Mar 1991 *)
 
BEGIN
parms.length := 0;
int2parms := 0;
message_fetched := false; (* B.M. Rel 3.0 11 Mar 1991 *)
CASE err OF
    rc_ok :
        (* keine msg, leere msg bleibt erhalten *)
        length := 0;
    rc_dbms_start_required :
        BEGIN
        m_txt :=  sta;
        length := 40;
        in04_set_dbname_in_parms (g_area, parms);
        END;
    rc_too_many_users:
        BEGIN
        m_txt := lim;
        length := 40;
        END;
    rc_timeout:
        BEGIN
        m_txt := tim;
        length := 40;
        END;
    rc_crash :
        BEGIN
        m_txt := csh;
        length := 40;
        END;
    rc_restart_required :
        BEGIN
        m_txt := rst;
        length := 40;
        in04_set_dbname_in_parms (g_area, parms);
        END;
    rc_user_or_pswd_illegal, rc_logon_required :
        BEGIN
        i21errortext (g_area, msg);
        message_fetched := true; (* B.M. Rel 3.0 11 Mar 1991 *)
        length := mxin_eline;
        IF  (msg [1] = bsp_c1)
            AND (msg [2] = bsp_c1)
            AND (msg [3] = bsp_c1)
            AND (msg [4] = bsp_c1)
            AND (msg [5] = bsp_c1)
            AND (msg [6] = bsp_c1)
        THEN
            BEGIN
            m_txt := log;
            length := 40;
            END;
        (*ENDIF*) 
        END;
    OTHERWISE:
        BEGIN
        m_txt := sys;
        length := 40;
        int2parms := ord (err);
        END;
    END;
(*ENDCASE*) 
IF  length = 40
THEN
    s10mv (40,mxin_screenline,
          @m_txt,1,
          @msg,1,length);
(*ENDIF*) 
IF  length < mxin_screenline
THEN
    SAPDB_PascalForcedFill (mxin_screenline,
          @msg, length + 1, mxin_screenline - length, bsp_c1);
(*ENDIF*) 
IF  err <> rc_ok
THEN
    BEGIN
    IF  parms.length > 0
    THEN
        i04resolve_parms (parms, msg)
    ELSE
        in04_int2_to_string (int2parms, msg);
    (*ENDIF*) 
&   ifndef inlink
    IF  NOT message_fetched (* B.M. Rel 3.0 11 Mar 1991 *)
    THEN
        in04_append_rte_message ( g_area, msg);
    (*ENDIF*) 
    IF  g_area^.vt.desc.dbcs <> no_dbcs
    THEN
        i32upstring ( msg, 1, msg, 1, mxin_screenline );
&   endif
    (*ENDIF*) 
    END;
(*ENDIF*) 
END; (* i04crashmsg *)
 
(*------------------------------*) 
 
PROCEDURE
      i04init (
            g_area : tin_global_in_vars );
 
BEGIN
WITH g_area^.msg_tab DO
    BEGIN
    table_ok    := true;
    packet_free := true;
    parsid      := bin_parseid;
    lang        := '   ';
    END;
(*ENDWITH*) 
in04_init_messages (g_area);
END; (* i04init *)
 
(*------------------------------*) 
 
PROCEDURE
      i04insert_msg (
            g_area  : tin_global_in_vars;
            msg_nr  : integer;
            VAR msg : tin_screenline );
 
VAR
      ok  : boolean;
      ptr : msgkey_pointer;
 
BEGIN
WITH g_area^.msg_tab DO
    BEGIN
    lang := g_area^.set_parms.language;
    REPEAT
        ptr := in04_store_message ( g_area, msg, ok);
        IF  NOT ok
        THEN
            in04_delete_last_message ( g_area );
        (*ENDIF*) 
    UNTIL
        ok;
    (*ENDREPEAT*) 
    messages [ptr] .key := msg_nr;
    in04_insert_chain (g_area, ptr);
    END;
(*ENDWITH*) 
END; (* i04insert_msg *)
 
(*------------------------------*) 
 
PROCEDURE
      i04int2msg (
            g_area    : tin_global_in_vars;
            msg_nr    : integer;
            int2parms : tsp00_Int2;
            VAR msg   : tin_screenline;
            VAR msgt  : tin_msg_type );
 
BEGIN
IF  g_area^.msg_tab.lang <> g_area^.set_parms.language
THEN
    in04_language_switch ( g_area, g_area^.set_parms.language );
(*ENDIF*) 
in04_search_msg (g_area, msg_nr, msg, msgt);
IF  msgt <> long_msg
THEN
    in04_select_msg (g_area, msg_nr, msg, msgt);
(*ENDIF*) 
IF  msgt = long_msg
THEN
    in04_int2_to_string (int2parms, msg);
(*ENDIF*) 
END; (* i04int2msg *)
 
(*------------------------------*) 
 
PROCEDURE
      i04literal (
            g_area      : tin_global_in_vars;
            author      : tsp00_KnlIdentifier;
            litname     : tsp00_Name;
            VAR literal : tin_menu_result );
 
CONST
      c_pub =
            'PUBLIC                                                          ';
 
TYPE
      search_where_t = ( author_name, public_name, no_more );
 
VAR
      i       : integer;
      r_code  : tsp00_Int2;
      e_pos   : tsp00_Int4;
      is_null : boolean;
      found   : boolean;
      timeout : boolean;
      s_stat  : tsp00_SqlState;
      ret     : tin_connect_status;
      pi      : tsp1_param_info;
      lang    : tsp00_Name;
      search  : search_where_t;
      public  : tsp00_KnlIdentifier;
 
BEGIN
i21alternativesegment (g_area, switch_on);
WITH literal DO
    BEGIN
    s_label  := bsp_c8;
    m_label  := bsp_c12;
    l_label  := bsp_c18;
    SAPDB_PascalForcedFill (80, @xl_label, 1, 80, ' ');
    IF  tab_exists
    THEN
        BEGIN
        search := author_name;
        REPEAT
            (* until search = no_more                       *)
            (* parse failed ==> no_more        ( abort    ) *)
            (* execute rc 100 ==> succ(search) ( try next ) *)
            (* execute rc   0 ==> no_more      ( found    ) *)
            r_code := 0;
            IF  dbpid = bin_parseid
            THEN
                BEGIN
                in04_sellit_cmd (g_area);
                i04dbrequest (g_area, timeout, ret, s_stat,
                      r_code, e_pos);
                IF  r_code = 0
                THEN
                    BEGIN
                    i21gparsid (g_area, dbpid);
                    i21findpart (g_area, sp1pk_shortinfo);
                    FOR i := 1 TO 7 DO
                        BEGIN
                        i21gparaminfo (g_area, i, pi, found);
                        dbpos [i] := pi.sp1i_bufpos;
                        END;
                    (*ENDFOR*) 
                    END
                ELSE
                    IF  r_code = -4004
                    THEN
                        tab_exists := false;
                    (*ENDIF*) 
                (*ENDIF*) 
                END
            ELSE
                BEGIN
                r_code := 0;
                timeout := false;
                END;
            (*ENDIF*) 
            IF  timeout
            THEN
                BEGIN
                dbpid := bin_parseid;
                i04literal (g_area, author, litname, literal);
                END
            ELSE
                IF  r_code <> 0
                THEN
                    search := no_more;
                (*ENDIF*) 
            (*ENDIF*) 
            IF  NOT timeout AND (r_code = 0)
            THEN
                BEGIN
                FOR i := 1 TO 3 DO
                    lang [i] := g_area^.set_parms.language [i] ;
                (*ENDFOR*) 
                SAPDB_PascalForcedFill (mxsp_name, @lang, 4, mxsp_name - 3, ' ');
                i21initexecute (g_area, dbpid);
                CASE search OF
                    author_name :
                        i21p4barg (g_area, author, dbpos [5] ,
                              sizeof (tsp00_KnlIdentifier), false);
                    public_name :
                        BEGIN
                        public := c_pub;
                        i21p4barg (g_area, public, dbpos [5] ,
                              sizeof (tsp00_KnlIdentifier), false);
                        END;
                    END;
                (*ENDCASE*) 
                i21p3barg (g_area, litname, dbpos [6], mxsp_name,
                      false);
                i21p3barg (g_area, lang, dbpos [7], mxsp_name,
                      false);
                i04dbrequest (g_area, timeout, ret, s_stat,
                      r_code, e_pos);
                CASE  r_code OF
                    0 :
                        BEGIN
                        i21findpart (g_area, sp1pk_data);
                        i21g1bval (g_area,  8, dbpos [1], s_label,
                              is_null);
                        i21g2bval (g_area, 12, dbpos [2], m_label,
                              is_null);
                        i21g3bval (g_area, 18, dbpos [3], l_label,
                              is_null);
                        i21gbval  (g_area, 80, dbpos [4], xl_label,
                              is_null);
                        search := no_more;
                        END;
                    -1 :
                        BEGIN
                        dbpid := bin_parseid;
                        i04literal (g_area, author, litname, literal);
                        END;
                    100 :
                        search := succ(search);
                    OTHERWISE
                        BEGIN
                        END;
                    END;
                (*ENDCASE*) 
                END;
            (*ENDIF*) 
        UNTIL
            search = no_more;
        (*ENDREPEAT*) 
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
i21alternativesegment (g_area, switch_off);
END; (* i04literal *)
 
(*------------------------------*) 
 
PROCEDURE
      i04mfetch (
            g_area     : tin_global_in_vars;
            VAR msgnos : tin_msgnos);
 
VAR
      ok         : boolean;
      local_msgs : tin_msgnos;
 
BEGIN
local_msgs := msgnos;
IF  g_area^.msg_tab.lang <> g_area^.set_parms.language
THEN
    BEGIN
    in04_init_messages (g_area);
    g_area^.msg_tab.lang := g_area^.set_parms.language;
    END;
(*ENDIF*) 
in04_get_missing_messages ( g_area, msgnos, local_msgs);
IF  local_msgs.len > 0
THEN
    BEGIN
    i21alternativesegment (g_area, switch_on);
    IF  g_area^.session [g_area^.dbno].is_connected
        AND g_area^.msg_tab.table_ok
    THEN
        in04_build_mselect_command (g_area, local_msgs, ok)
    ELSE
        ok := false;
    (*ENDIF*) 
    IF  ok
    THEN
        in04_mfetch_messages (g_area);
    (*ENDIF*) 
    i21alternativesegment (g_area, switch_off);
    END;
(*ENDIF*) 
END; (* i04mfetch *)
 
(*------------------------------*) 
 
PROCEDURE
      i04mfrange (
            msgno1     : tsp00_Int2;
            msgno2     : tsp00_Int2;
            VAR msgnos : tin_msgnos);
 
VAR
      i : integer;
 
BEGIN
FOR i := msgno1 TO msgno2 DO
    in04store_messagenumber ( i, msgnos );
(*ENDFOR*) 
END; (* i04mfrange *)
 
(*------------------------------*) 
 
PROCEDURE
      i04mfset (
            msgno      : tsp00_Int2;
            VAR msgnos : tin_msgnos);
 
BEGIN
in04store_messagenumber ( msgno, msgnos );
END; (* i04mfset *)
 
(*------------------------------*) 
 
PROCEDURE
      i04msg (
            g_area    : tin_global_in_vars;
            msg_nr    : integer;
            VAR parms : tin_msg_parms;
            VAR msg   : tin_screenline;
            VAR msgt  : tin_msg_type );
 
VAR
      p       : integer;
      plen    : integer;
      msg_end : integer;
      s_parms : tin_parms_buffer;
 
BEGIN
IF  (g_area^.msg_tab.lang <> g_area^.set_parms.language)
    AND (g_area^.msg_tab.packet_free)
THEN
    in04_language_switch ( g_area, g_area^.set_parms.language );
(*ENDIF*) 
in04_search_msg (g_area, msg_nr, msg, msgt);
IF  msgt <> long_msg
THEN
    IF  g_area^.msg_tab.packet_free
    THEN
        in04_select_msg (g_area, msg_nr, msg, msgt)
    ELSE
        in04_default_msg (g_area, msg_nr, msg, msgt);
    (*ENDIF*) 
(*ENDIF*) 
IF  (parms.length > 0) AND (msgt <> crash_msg)
THEN
    IF  msgt = short_msg
    THEN
        (* mra 29.11.94 *)
        BEGIN
        s_parms := parms.buffer;
        p := 1;
        REPEAT
            plen := ord (s_parms [p]);
            s_parms [p] := bsp_c1;
            p := p + plen + 1;
        UNTIL
            p > parms.length;
        (*ENDREPEAT*) 
        msg_end := s30klen (msg, bsp_c1, mxin_screenline);
        IF  mxin_screenline - msg_end >= parms.length
        THEN
            plen := parms.length
        ELSE
            plen := mxin_screenline - msg_end;
        (*ENDIF*) 
        s10mv (mxin_parms_buffer,mxin_screenline,
              @s_parms,1,
              @msg,msg_end + 1,plen);
        END
    ELSE
        i04resolve_parms (parms, msg);
    (*ENDIF*) 
(*ENDIF*) 
END; (* i04msg *)
 
(*------------------------------*) 
 
PROCEDURE
      i04negmsg (
            g_area    : tin_global_in_vars;
            msg_nr    : integer;
            VAR parms : tin_msg_parms;
            VAR msg   : tin_screenline;
            VAR msgt  : tin_msg_type );
 
BEGIN
(* similar to i04nummsg, this procedure changes the msg text *)
(* by adding the msg number. Purpose: find a component message *)
(* (msg_nr >= 10000), display the error-indicating negative pendant *)
i04msg (g_area, msg_nr, parms, msg, msgt);
IF  msgt = long_msg
THEN
    in04_add_msg_nr (- msg_nr, msg);
(*ENDIF*) 
END; (* i04negmsg *)
 
(*------------------------------*) 
 
PROCEDURE
      i04nummsg (
            g_area    : tin_global_in_vars;
            msg_nr    : integer;
            VAR parms : tin_msg_parms;
            VAR msg   : tin_screenline;
            VAR msgt  : tin_msg_type );
 
BEGIN
(* only for SQL messages. the message text contains no number, *)
(* positive and negative numbers can occur and shall be displayed *)
IF  g_area^.msg_tab.lang <> g_area^.set_parms.language
THEN
    in04_language_switch ( g_area, g_area^.set_parms.language );
(*ENDIF*) 
i04msg (g_area, msg_nr, parms, msg, msgt);
IF  msgt = long_msg
THEN
    in04_add_msg_nr (msg_nr, msg);
(*ENDIF*) 
END; (* i04nummsg *)
 
(*------------------------------*) 
 
PROCEDURE
      i04resolve_parms (
            VAR parms : tin_msg_parms;
            VAR msg   : tin_screenline );
 
VAR
      m_pos     : integer;
      h_pos     : integer;
      act_param : integer;
      parm_len  : integer;
      i         : integer;
      help      : tin_screenline;
 
BEGIN
WITH parms DO
    BEGIN
    m_pos := 1;
    h_pos := 1;
    act_param := 1;
    WHILE (m_pos <= mxin_screenline)
          AND (h_pos <= mxin_screenline) DO
        BEGIN
        IF  msg [m_pos] <> '&'
        THEN
            BEGIN
            (*---------------------*)
            (* copy original text  *)
            (*---------------------*)
            help [h_pos] := msg [m_pos] ;
            m_pos := m_pos + 1;
            h_pos := h_pos + 1;
            END
        ELSE
            BEGIN
            m_pos := m_pos + 2;
            (*-----------------------------------*)
            (* replace &n by the next parameter  *)
            (*-----------------------------------*)
            IF  act_param <= length
            THEN
                BEGIN
                parm_len := ord (buffer [act_param] );
                FOR i := 1 TO parm_len DO
                    IF  h_pos <= mxin_screenline
                    THEN
                        BEGIN
                        help [h_pos] := buffer [act_param + i] ;
                        h_pos := h_pos + 1;
                        END;
                    (*ENDIF*) 
                (*ENDFOR*) 
                act_param := act_param + parm_len + 1;
                END
            ELSE
                IF  h_pos < mxin_screenline
                THEN
                    BEGIN
                    help [h_pos] := bsp_c1;
                    help [h_pos + 1] := bsp_c1;
                    h_pos := h_pos + 2;
                    END;
                (*ENDIF*) 
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        END;
    (*ENDWHILE*) 
    s10mv (mxin_screenline,mxin_screenline,
          @help,1,
          @msg,1,h_pos - 1);
    END;
(*ENDWITH*) 
END; (* i04resolve_parms *)
 
(*------------------------------*) 
 
PROCEDURE
      i04sqlmsg (
            g_area  : tin_global_in_vars;
            msg_nr  : integer;
            VAR msg : tin_screenline);
 
VAR
      msgt   : tin_msg_type;
 
BEGIN
IF  g_area^.msg_tab.lang <> g_area^.set_parms.language
THEN
    in04_language_switch ( g_area, g_area^.set_parms.language );
(*ENDIF*) 
in04_search_msg (g_area, msg_nr, msg, msgt);
IF  msgt <> long_msg
THEN
    in04_select_msg (g_area, msg_nr, msg, msgt);
(*ENDIF*) 
END; (* i04sqlmsg *)
 
(*------------------------------*) 
 
PROCEDURE
      in04_add_msg_nr (
            msg_nr   : integer;
            VAR msg  : tin_screenline);
 
VAR
      help   : tin_screenline;
      s20    : tsp00_C20;
      i      : integer;
 
BEGIN
in04_encode_int2 ( msg_nr, s20 );
i := 1;
WHILE (i <= 20) AND ( s20 [i] <> bsp_c1) DO
    BEGIN
    help [i] := s20 [i] ;
    i        := i + 1;
    END;
(*ENDWHILE*) 
help [i] := bsp_c1;
s10mv (mxin_screenline,mxin_screenline,
      @msg,1,
      @help,i + 1,mxin_screenline - i);
msg := help;
END; (* in04_add_msg_nr *)
 
(*------------------------------*) 
 
PROCEDURE
      in04_append_rte_message (
            g_area  : tin_global_in_vars;
            VAR msg : tin_screenline);
 
CONST
      errmsglen = 80;
 
VAR
      rte_msg      : tin_screenline;
      len, rte_len : integer;
 
BEGIN
i21errortext (g_area, rte_msg);
rte_len := s30klen (rte_msg, bsp_c1, mxin_screenline);
IF  rte_len > 0
THEN
    BEGIN
    len := s30klen (msg, bsp_c1,  mxin_screenline);
    len := len + 1;
    msg [len] := bsp_c1;
    len := len + 1;
    msg [len] := ':';
    len := len + 1;
    msg [len] := bsp_c1;
    IF  rte_len + len > errmsglen
    THEN
        rte_len := errmsglen - len;
    (*ENDIF*) 
    s10mv (mxin_screenline,mxin_screenline,
          @rte_msg,1,
          @msg,len+1,rte_len);
    END;
(*ENDIF*) 
END; (* in04_append_rte_message *)
 
(*------------------------------*) 
 
PROCEDURE
      in04_between_requests (
            g_area            : tin_global_in_vars;
            VAR msgnos        : tin_msgnos;
            VAR between_found : boolean);
 
VAR
      between_text : tsp00_C40;
      and_text     : tsp00_C40;
      or_text      : tsp00_C40;
      pos          : integer;
      found        : boolean;
 
BEGIN
between_found := false;
between_text  := ' MSGNO BETWEEN                          ';
and_text      := ' AND                                    ';
or_text       := ' OR                                     ';
pos := 0;
REPEAT
    in04_search_between_pair (msgnos, pos, found);
    IF  found
    THEN
        BEGIN
        IF  between_found
        THEN
            i21p2cmnd (g_area, or_text, 5);
        (*ENDIF*) 
        between_found := true;
        (* between command *)
        i21p2cmnd (g_area, between_text, 20);
        in04_int2_as_cmndpart ( g_area, msgnos.buf [pos] );
        i21p2cmnd (g_area, and_text, 5);
        pos := pos + 1;
        in04_int2_as_cmndpart ( g_area, msgnos.buf [pos] );
        END;
    (*ENDIF*) 
UNTIL
    NOT found;
(*ENDREPEAT*) 
END; (* in04_between_requests *)
 
(*------------------------------*) 
 
PROCEDURE
      in04_build_mselect_command (
            g_area     : tin_global_in_vars;
            VAR msgnos : tin_msgnos;
            VAR ok     : boolean);
 
CONST
      apostrophe = '''';
 
VAR
      i       : integer;
      ret     : tin_connect_status;
      s_stat  : tsp00_SqlState;
      r_code  : tsp00_Int2;
      e_pos   : tsp00_Int4;
      s40     : tsp00_C40;
      name    : tsp00_KnlIdentifier;
      timeout : boolean;
 
BEGIN
REPEAT
    i21initadbs (g_area);
    s40  := 'SELECT                                  ';
    i21p2cmnd (g_area, s40, 7);
    name := mselect_resname;
    i21pcmnd (g_area, name, sizeof(name));
    s40  := ' (MSGNO, MSGTEXT) FROM                  ';
    i21p2cmnd (g_area, s40, 25);
    s40 := sysmessage_table;
    i21p2cmnd (g_area, s40, 40);
    s40  := ' WHERE LANGUAGE =                       ';
    i21p2cmnd (g_area, s40, 40);
    i21pccmnd (g_area, apostrophe);
    WITH g_area^.set_parms DO
        FOR i := 1 TO 3 DO
            i21pccmnd (g_area, language [i] );
        (*ENDFOR*) 
    (*ENDWITH*) 
    i21pccmnd (g_area, apostrophe);
    in04_messagenumbers (g_area, msgnos);
    i04dbrequest (g_area, timeout, ret, s_stat, r_code, e_pos);
UNTIL
    NOT timeout;
(*ENDREPEAT*) 
IF  r_code = -4004
THEN
    g_area^.msg_tab.table_ok := false;
(*ENDIF*) 
ok := ( (ret = rc_ok) AND (r_code = 0) );
END; (* in04_build_mselect_command *)
 
(*------------------------------*) 
 
PROCEDURE
      i04check_mlanguage (
            g_area     : tin_global_in_vars;
            language   : tin_language_id;
            VAR ok     : boolean);
 
CONST
      apostrophe = '''';
 
VAR
      i       : integer;
      ret     : tin_connect_status;
      s_stat  : tsp00_SqlState;
      r_code  : tsp00_Int2;
      e_pos   : tsp00_Int4;
      s40     : tsp00_C40;
      timeout : boolean;
 
BEGIN
REPEAT
    i21initadbs (g_area);
    s40  := 'SELECT FIRST (LANGUAGE) FROM            ';
    i21p2cmnd (g_area, s40, 29);
    s40 := sysmessage_table;
    i21p2cmnd (g_area, s40, 40);
    s40  := ' WHERE LANGUAGE =                       ';
    i21p2cmnd (g_area, s40, 40);
    i21pccmnd (g_area, apostrophe);
    FOR i := 1 TO 3 DO
        i21pccmnd (g_area, language [i] );
    (*ENDFOR*) 
    i21pccmnd (g_area, apostrophe);
    i04dbrequest (g_area, timeout, ret, s_stat, r_code, e_pos);
UNTIL
    NOT timeout;
(*ENDREPEAT*) 
ok := ( (ret = rc_ok) AND (r_code = 0) );
END; (* i04check_mlanguage *)
 
(*------------------------------*) 
 
PROCEDURE
      in04_default_msg (
            g_area   : tin_global_in_vars;
            msg_nr   : integer;
            VAR msg  : tin_screenline;
            VAR msgt : tin_msg_type);
 
VAR
      j   : integer;
      s40 : tsp00_C40;
      s20 : tsp00_C20;
 
BEGIN
SAPDB_PascalForcedFill (mxin_screenline, @msg, 1, mxin_screenline, ' ');
in04_encode_int2 ( msg_nr, s20 );
j := 1;
WHILE (j <= 10) AND (s20 [j] <> bsp_c1) DO
    BEGIN
    msg [j] := s20 [j] ;
    j := j + 1;
    END;
(*ENDWHILE*) 
IF  msgt = short_msg
THEN
    s40 := 'message not available                   '
ELSE
    s40 := 'database access not available           ';
(*ENDIF*) 
s10mv (40,mxin_screenline,
      @s40,1,
      @msg,10,40);
&ifndef inlink
IF  g_area^.vt.desc.dbcs <> no_dbcs
THEN
    i32upstring ( msg, 1, msg, 1, mxin_screenline );
&endif
(*ENDIF*) 
END; (* in04_default_msg *)
 
(*------------------------------*) 
 
PROCEDURE
      in04_delete_last_message (
            g_area : tin_global_in_vars);
 
VAR
      act : msgkey_pointer;
      lno : tsp00_Int2;
 
BEGIN
WITH g_area^.msg_tab DO
    BEGIN
    act := last;
    lno := messages [act] .index;
    WITH msgpool DO
        i14deleteeline (buf, evars, lno, 1);
    (*ENDWITH*) 
    END;
(*ENDWITH*) 
in04_remove_from_chain ( g_area, act );
in04_free_msg_key ( g_area, act);
in04_renumber_msgindex ( g_area, lno);
END; (* in04_delete_last_message *)
 
(*------------------------------*) 
 
PROCEDURE
      in04_encode_int2 (
            nr      : tsp00_Int2;
            VAR s20 : tsp00_C20);
 
VAR
      j   : integer;
      neg : boolean;
 
BEGIN
s20 := bsp_c20;
neg := (nr < 0);
IF  neg
THEN
    nr := -nr;
(*ENDIF*) 
IF  nr = 0
THEN
    s20 [1] := '0'
ELSE
    BEGIN
    IF  nr < 10
    THEN
        j := 1
    ELSE
        IF  nr < 100
        THEN
            j := 2
        ELSE
            IF  nr < 1000
            THEN
                j := 3
            ELSE
                IF  nr < 10000
                THEN
                    j := 4
                ELSE
                    j := 5;
                (*ENDIF*) 
            (*ENDIF*) 
        (*ENDIF*) 
    (*ENDIF*) 
    IF  neg
    THEN
        j := j + 1;
    (*ENDIF*) 
    WHILE (j > 0 ) AND (nr > 0) DO
        BEGIN
        s20 [j] := chr (ord ('0') + (nr MOD 10));
        nr := nr DIV 10;
        j := j - 1;
        END;
    (*ENDWHILE*) 
    IF  neg
    THEN
        s20 [j] := '-';
    (*ENDIF*) 
    END;
(*ENDIF*) 
END; (* in04_encode_int2 *)
 
(*------------------------------*) 
 
PROCEDURE
      in04_free_msg_key (
            g_area : tin_global_in_vars;
            ptr    : msgkey_pointer);
 
BEGIN
WITH g_area^.msg_tab DO
    BEGIN
    IF  empty = nil_ptr
    THEN
        BEGIN
        empty := ptr;
        messages [ptr] .next := nil_ptr;
        END
    ELSE
        BEGIN
        messages [ptr] .next := empty;
        empty := ptr;
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END; (* in04_free_msg_key *)
 
(*------------------------------*) 
 
FUNCTION
      in04_get_free_msg_key (
            g_area : tin_global_in_vars;
            VAR ok : boolean) : msgkey_pointer;
 
VAR
      free : msgkey_pointer;
 
BEGIN
WITH g_area^.msg_tab DO
    BEGIN
    free := empty;
    ok := (free <> nil_ptr);
    IF  ok
    THEN
        empty := messages [free] .next;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
in04_get_free_msg_key := free;
END; (* in04_get_free_msg_key *)
 
(*------------------------------*) 
 
PROCEDURE
      in04_get_missing_messages (
            g_area       : tin_global_in_vars;
            VAR msgnos   : tin_msgnos;
            VAR new_msgs : tin_msgnos);
 
VAR
      sample : integer;
      ptr    : msgkey_pointer;
      pos    : integer;
 
BEGIN
IF  g_area^.msg_tab.first = nil_ptr
THEN
    new_msgs := msgnos
ELSE
    BEGIN
    pos := 0;
    new_msgs.len := 0;
    WHILE (pos < msgnos.len) DO
        BEGIN
        in04_get_next_msgno (msgnos, sample, pos);
        IF  NOT in04_message_exists (g_area, sample, ptr)
        THEN
            in04store_messagenumber ( sample, new_msgs );
        (*ENDIF*) 
        END;
    (*ENDWHILE*) 
    END;
(*ENDIF*) 
END; (* in04_get_missing_messages *)
 
(*------------------------------*) 
 
PROCEDURE
      in04_get_msg (
            g_area        : tin_global_in_vars;
            msg_nr        : integer;
            VAR msg       : tin_screenline;
            VAR ret       : tin_connect_status;
            VAR parsagain : boolean;
            VAR ok        : boolean);
 
VAR
      s_stat    : tsp00_SqlState;
      r_code    : tsp00_Int2;
      e_pos     : tsp00_Int4;
      is_null   : boolean;
      known     : boolean;
      count     : tsp00_Int4;
      help      : tsp00_Int2;
      partpos   : tsp00_Int4;
      num       : tsp00_Number;
      res       : tsp00_NumError;
 
BEGIN
is_null := false;
help := msg_nr;
WITH g_area^.msg_tab DO
    BEGIN
    i21initexecute (g_area, parsid);
    i21p1barg (g_area, g_area^.set_parms.language, bufpos [2] , 3,
          is_null);
    s41psint (num, 1, sizeof(num), 0, help, res);
    i21p2barg (g_area, num, bufpos [3] , 5, is_null);
    i21request (g_area, ret);
    IF  ret = rc_ok
    THEN
        BEGIN
        i21receive (g_area, ret, s_stat, r_code, e_pos);
        IF  (ret = rc_ok) AND (r_code = 0)
        THEN
            BEGIN
            i21findpart (g_area, sp1pk_resultcount);
            i21grescount (g_area, known, count);
            i21findpart (g_area, sp1pk_data);
            partpos := 1;
            in04_trans_msg (g_area, partpos, msg);
            END;
        (*ENDIF*) 
        IF  (ret = rc_ok) AND (r_code <> 0)
        THEN
            BEGIN
            CASE r_code OF
                0  :
                    ok := true;
                -8 :
                    parsagain := true;
                -4004 :
                    table_ok := false;
                OTHERWISE:
                    ok := false;
                END;
            (*ENDCASE*) 
            END;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  (ret = rc_dbms_start_required) OR (ret = rc_too_many_users)
    THEN
        ok := false;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END; (* in04_get_msg *)
 
(*------------------------------*) 
 
PROCEDURE
      in04_get_next_msgno (
            VAR msgnos : tin_msgnos;
            VAR nr     : integer;
            VAR pos    : integer);
 
VAR
      is_range : boolean;
 
BEGIN
is_range := pos > 0;
IF  is_range
THEN
    is_range := (msgnos.buf [pos] = range_symbol);
(*ENDIF*) 
IF  is_range
THEN
    BEGIN
    nr := nr + 1;
    IF  nr = msgnos.buf [pos+2  ]
    THEN
        (* end of range *)
        pos := pos + 2;
    (*ENDIF*) 
    END
ELSE
    BEGIN
    pos := pos + 1;
    nr := msgnos.buf [pos] ;
    IF  nr = range_symbol
    THEN
        (* start of range *)
        nr := msgnos.buf [pos+1] ;
    (*ENDIF*) 
    END;
(*ENDIF*) 
END; (* in04_get_next_msgno *)
 
(*------------------------------*) 
 
PROCEDURE
      in04_get_one_result (
            g_area      : tin_global_in_vars;
            VAR partpos : tsp00_Int4;
            VAR msgno   : integer;
            VAR message : tin_screenline);
 
CONST
      msgno_len = 5;
 
VAR
      num_text : tin_screenline;
      is_null  : boolean;
      dest     : tsp00_Int2;
      res      : tsp00_NumError;
      io_len   : integer;
 
BEGIN
io_len := ( (msgno_len + 1) DIV 2 ) + 1;
i21gval (g_area, io_len, partpos, num_text, is_null);
s40gsint (num_text, 1, msgno_len, dest, res);
msgno := dest;
in04_trans_msg (g_area, partpos, message);
END; (* in04_get_one_result *)
 
(*------------------------------*) 
 
PROCEDURE
      in04_get_resident_msgnos (
            g_area     : tin_global_in_vars;
            VAR msgnos : tin_msgnos);
 
VAR
      ptr  : msgkey_pointer ;
      stop : boolean;
 
BEGIN
(**)
msgnos.len := 0;
WITH g_area^.msg_tab DO
    BEGIN
    ptr := first;
    stop := false;
    IF  ptr <> nil_ptr
    THEN
        REPEAT
            stop := messages [ptr] .key = undef_msgno;
            IF  NOT stop
            THEN
                BEGIN
                in04store_messagenumber ( messages [ptr] .key, msgnos );
                ptr := messages [ptr] .next;
                stop := (ptr = first);
                END;
            (*ENDIF*) 
        UNTIL
            stop;
        (*ENDREPEAT*) 
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END; (* in04_get_resident_msgnos *)
 
(*------------------------------*) 
 
PROCEDURE
      in04_in_request (
            g_area        : tin_global_in_vars;
            between_found : boolean;
            VAR msgnos    : tin_msgnos);
 
VAR
      s40     : tsp00_C40;
      or_text : tsp00_C40;
      pos     : integer;
      first   : boolean;
 
BEGIN
pos := 0;
first := true ;
WHILE ( pos < msgnos.len) DO
    BEGIN
    pos := pos + 1;
    IF  msgnos.buf [pos] = range_symbol
    THEN
        pos := pos + 2
    ELSE
        BEGIN
        IF  first
        THEN
            BEGIN
            IF  between_found
            THEN
                BEGIN
                or_text := ' OR                                     ';
                i21p2cmnd (g_area, or_text, 5);
                END;
            (*ENDIF*) 
            s40  := ' MSGNO IN (                             ';
            i21p2cmnd (g_area, s40, 12);
            first := false;
            END
        ELSE
            i21pccmnd (g_area, ',');
        (*ENDIF*) 
        in04_int2_as_cmndpart ( g_area, msgnos.buf [pos] );
        END;
    (*ENDIF*) 
    END;
(*ENDWHILE*) 
IF  NOT first
THEN
    i21pccmnd (g_area, ')');
(*ENDIF*) 
END; (* in04_in_request *)
 
(*------------------------------*) 
 
PROCEDURE
      in04_init_messages (
            g_area : tin_global_in_vars );
 
VAR
      i : integer;
 
BEGIN
WITH g_area^.msg_tab DO
    BEGIN
    WITH msgpool DO
        BEGIN
        evars.size := msgpool_size;
        i14cleareform (evars);
        END;
    (*ENDWITH*) 
    empty := 1;
    FOR i := 1 TO max_messages  DO
        BEGIN
        messages [i] .next := i + 1;
        messages [i] .key := undef_msgno;
        END;
    (*ENDFOR*) 
    messages [max_messages] .next := nil_ptr;
    first := nil_ptr;
    last :=  nil_ptr;
    END;
(*ENDWITH*) 
END; (* in04_init_messages *)
 
(*------------------------------*) 
 
PROCEDURE
      in04_insert_chain (
            g_area : tin_global_in_vars;
            ptr    : msgkey_pointer);
 
VAR
      next : msgkey_pointer;
 
BEGIN
WITH g_area^.msg_tab DO
    BEGIN
    IF  first = nil_ptr
    THEN
        BEGIN
        first := ptr;
        last := ptr;
        END;
    (*ENDIF*) 
    next := first;
    first := ptr;
    messages [first] .next := next;
    messages [first] .prev := last;
    messages [next] .prev := first;
    messages [last] .next := first;
    END;
(*ENDWITH*) 
END; (* in04_insert_chain *)
 
(*------------------------------*) 
 
PROCEDURE
      in04_int2_as_cmndpart (
            g_area : tin_global_in_vars;
            nr     : tsp00_Int2);
 
VAR
      s20 : tsp00_C20;
 
BEGIN
in04_encode_int2 ( nr, s20 );
i21p1cmnd ( g_area, s20, 10 );
END; (* in04_int2_as_cmndpart *)
 
(*------------------------------*) 
 
PROCEDURE
      in04_int2_to_string (
            int2parms : tsp00_Int2;
            VAR msg   : tin_screenline);
 
VAR
      i      : integer;
      j      : integer;
      k      : integer;
      help   : tin_screenline;
      s20    : tsp00_C20;
 
BEGIN
i := 1;
j := 1;
WHILE (i <= sysmsg_len) AND (j <= mxin_screenline) DO
    BEGIN
    IF  msg [i] <> '&'
    THEN
        BEGIN
        help [j] := msg [i] ;
        i := i + 1;
        j := j + 1;
        END
    ELSE
        BEGIN
        i := i + 1;
        in04_encode_int2 ( int2parms, s20 );
        k := 0;
        WHILE (j <= mxin_screenline) AND (k < 20) DO
            BEGIN
            k := k + 1;
            help [j] := s20 [k] ;
            j := j + 1;
            END;
        (*ENDWHILE*) 
        END;
    (*ENDIF*) 
    END;
(*ENDWHILE*) 
FOR i := j TO mxin_screenline DO
    help [i] := bsp_c1;
(*ENDFOR*) 
msg := help;
END; (* in04_int2_to_string *)
 
(*------------------------------*) 
 
PROCEDURE
      in04_language_switch (
            g_area   : tin_global_in_vars;
            VAR lang : tin_language_id );
 
VAR
      msgnos : tin_msgnos;
 
BEGIN
in04_get_resident_msgnos ( g_area, msgnos );
in04_init_messages (g_area);
g_area^.msg_tab.lang := lang;
i04mfetch ( g_area, msgnos );
END; (* in04_language_switch *)
 
(*------------------------------*) 
 
FUNCTION
      in04_message_exists (
            g_area  : tin_global_in_vars;
            msg_nr  : integer;
            VAR ptr : msgkey_pointer ) : boolean;
 
VAR
      stop  : boolean;
      found : boolean;
 
BEGIN
found := false;
WITH g_area^.msg_tab DO
    BEGIN
    ptr := first;
    stop := false;
    IF  ptr <> nil_ptr
    THEN
        REPEAT
            stop := messages [ptr] .key = undef_msgno;
            IF  NOT stop
            THEN
                IF  (messages [ptr] .key = msg_nr)
                THEN
                    found := true
                ELSE
                    BEGIN
                    ptr := messages [ptr] .next;
                    stop := (ptr = first);
                    END;
                (*ENDIF*) 
            (*ENDIF*) 
        UNTIL
            stop OR found;
        (*ENDREPEAT*) 
    (*ENDIF*) 
    END;
(*ENDWITH*) 
in04_message_exists := found;
END; (* in04_message_exists *)
 
(*------------------------------*) 
 
PROCEDURE
      in04_messagenumbers (
            g_area     : tin_global_in_vars;
            VAR msgnos : tin_msgnos);
 
VAR
      between_set : boolean;
      s40         : tsp00_C40;
 
BEGIN
s40  := ' AND (                                  ';
i21p2cmnd (g_area, s40, 7);
in04_between_requests (g_area, msgnos, between_set);
in04_in_request (g_area, between_set, msgnos );
i21pccmnd (g_area, ')');
END; (* in04_messagenumbers *)
 
(*------------------------------*) 
 
PROCEDURE
      in04_mfetch_messages (
            g_area : tin_global_in_vars);
 
VAR
      res_name : tsp00_KnlIdentifier;
      ret      : tin_connect_status;
      s_stat   : tsp00_SqlState;
      r_code   : tsp00_Int2;
      e_pos    : tsp00_Int4;
      partpos  : tsp00_Int4;
      ok       : boolean;
      timeout  : boolean;
      count    : integer;
      i        : integer;
      msgno    : integer;
      message  : tin_screenline;
      ptr      : msgkey_pointer;
 
BEGIN
res_name := mselect_resname;
REPEAT
    i21mfetch (g_area, false, sp1m_dbs, max_messages, mf_first, res_name);
    i04dbrequest (g_area, timeout, ret, s_stat, r_code, e_pos);
UNTIL
    NOT timeout;
(*ENDREPEAT*) 
ok := ( (ret = rc_ok) AND (r_code = 0) );
IF  ok
THEN
    BEGIN
    i21findpart (g_area, sp1pk_data);
    i21gvalcount (g_area, count);
    partpos := 1;
    FOR i := 1 TO count DO
        BEGIN
        in04_get_one_result (g_area, partpos, msgno, message);
        IF  NOT in04_message_exists (g_area, msgno, ptr)
        THEN
            i04insert_msg (g_area, msgno, message);
        (*ENDIF*) 
        END;
    (*ENDFOR*) 
    END;
(*ENDIF*) 
END; (* in04_mfetch_messages *)
 
(*------------------------------*) 
 
PROCEDURE
      in04_pars_info (
            g_area : tin_global_in_vars );
 
VAR
      pi    : tsp1_param_info;
      i     : integer;
      found : boolean;
 
BEGIN
WITH g_area^.msg_tab DO
    BEGIN
    i21gparsid (g_area, parsid);
    i21findpart (g_area, sp1pk_shortinfo);
    FOR i := 1 TO 3 DO
        BEGIN
        i21gparaminfo (g_area, i, pi, found);
        bufpos [i] := pi.sp1i_bufpos;
        END;
    (*ENDFOR*) 
    END;
(*ENDWITH*) 
END; (* in04_pars_info *)
 
(*------------------------------*) 
 
PROCEDURE
      in04_parse_msg_select (
            g_area  : tin_global_in_vars;
            VAR ret : tin_connect_status;
            VAR ok  : boolean );
 
VAR
      timeout  : boolean;
      s_stat   : tsp00_SqlState;
      r_code   : tsp00_Int2;
      e_pos    : tsp00_Int4;
      s40      : tsp00_C40;
 
BEGIN
WITH g_area^.msg_tab DO
    BEGIN
    REPEAT
        i21initparse (g_area);
        s40  := 'SELECT DIRECT MSGTEXT  INTO :MSG_TEXT   ';
        i21p2cmnd (g_area, s40, 40);
        s40  := 'FROM                                    ';
        i21p2cmnd (g_area, s40, 5);
        s40  := sysmessage_table;
        i21p2cmnd (g_area, s40, 40);
        s40  := 'KEY LANGUAGE = :L  ,  MSGNO = :MSG_NR   ';
        i21p2cmnd (g_area, s40, 40);
        i04dbrequest (g_area, timeout, ret, s_stat, r_code, e_pos);
    UNTIL
        NOT timeout;
    (*ENDREPEAT*) 
    IF  ret <> rc_ok
    THEN
        ok := false;
    (*ENDIF*) 
    IF  (ret = rc_ok) AND (r_code = 0)
    THEN
        in04_pars_info (g_area)
    ELSE
        BEGIN
        IF  r_code = -4004
        THEN
            table_ok := false;
        (*ENDIF*) 
        parsid := bin_parseid;
        ok := false;
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END; (* in04_parse_msg_select *)
 
(*------------------------------*) 
 
PROCEDURE
      in04_remove_from_chain (
            g_area : tin_global_in_vars;
            ptr    : msgkey_pointer);
 
VAR
      next : msgkey_pointer;
      prev : msgkey_pointer;
 
BEGIN
WITH g_area^.msg_tab DO
    BEGIN
    next := messages [ptr] .next;
    prev := messages [ptr] .prev;
    messages [prev] .next := next;
    messages [next] .prev := prev;
    IF  ptr = first
    THEN
        first := next;
    (*ENDIF*) 
    IF  ptr = last
    THEN
        last := prev;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END; (* in04_remove_from_chain *)
 
(*------------------------------*) 
 
PROCEDURE
      in04_renumber_msgindex (
            g_area : tin_global_in_vars;
            lno    : tsp00_Int2);
 
VAR
      act : msgkey_pointer;
 
BEGIN
WITH g_area^.msg_tab DO
    BEGIN
    act := first;
    IF  act <> nil_ptr
    THEN
        REPEAT
            IF  messages [act] .index > lno
            THEN
                messages [act] .index := messages [act] .index - 1;
            (*ENDIF*) 
            act := messages [act] .next;
        UNTIL
            act = first;
        (*ENDREPEAT*) 
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END; (* in04_renumber_msgindex *)
 
(*------------------------------*) 
 
PROCEDURE
      in04_reorder_messages (
            g_area : tin_global_in_vars;
            act    : integer);
 
BEGIN
IF  act <> g_area^.msg_tab.first
THEN
    BEGIN
    in04_remove_from_chain ( g_area, act);
    in04_insert_chain ( g_area, act);
    END;
(*ENDIF*) 
END; (* in04_reorder_messages *)
 
(*------------------------------*) 
 
PROCEDURE
      in04_search_between_pair (
            VAR msgnos : tin_msgnos;
            VAR pos    : integer;
            VAR found  : boolean);
 
BEGIN
found := false;
WHILE (NOT found) AND ( pos < msgnos.len) DO
    BEGIN
    pos := pos + 1;
    found := (msgnos.buf [pos] = range_symbol);
    END;
(*ENDWHILE*) 
IF  found
THEN
    pos := pos + 1;
(*ENDIF*) 
END; (* in04_search_between_pair *)
 
(*------------------------------*) 
 
PROCEDURE
      in04_search_msg (
            g_area   : tin_global_in_vars;
            msg_nr   : integer;
            VAR msg  : tin_screenline;
            VAR msgt : tin_msg_type );
 
VAR
      ptr    : msgkey_pointer;
      length : tin_natural;
      error  : boolean;
 
BEGIN
length := 0;
IF  in04_message_exists (g_area, msg_nr, ptr)
THEN
    BEGIN
    WITH g_area^.msg_tab, msgpool DO
        i14geteline (buf, evars, msg,
              messages [ptr] .index, length, error);
    (*ENDWITH*) 
    IF  error
    THEN
        msgt := short_msg
    ELSE
        BEGIN
        IF  length = 1
        THEN
            IF  msg [1] = chr(empty_char)
            THEN
                length := 0;
            (*ENDIF*) 
        (*ENDIF*) 
        msgt := long_msg;
        in04_reorder_messages (g_area, ptr);
        END
    (*ENDIF*) 
    END
ELSE
    msgt := short_msg;
(*ENDIF*) 
SAPDB_PascalForcedFill (mxin_screenline, @msg, length+1, mxin_screenline-length, bsp_c1);
END; (* in04_search_msg *)
 
(*------------------------------*) 
 
PROCEDURE
      in04_select_msg (
            g_area   : tin_global_in_vars;
            msg_nr   : integer;
            VAR msg  : tin_screenline;
            VAR msgt : tin_msg_type);
 
VAR
      ret       : tin_connect_status;
      parsagain : boolean;
      ok        : boolean;
 
BEGIN
msgt := long_msg;
ok := g_area^.msg_tab.table_ok;
parsagain := false;
ret := rc_ok;
WITH g_area^.msg_tab DO
    BEGIN
    i21alternativesegment (g_area, switch_on);
    IF  i21dbok (g_area)
        AND table_ok
        AND g_area^.session [g_area^.dbno].is_connected
    THEN
        BEGIN
        IF  parsid = bin_parseid
        THEN
            in04_parse_msg_select (g_area, ret, ok);
        (*ENDIF*) 
        IF  ok
        THEN
            BEGIN
            in04_get_msg (g_area, msg_nr, msg, ret, parsagain, ok);
&           ifndef inlink
            IF  ret in [rc_timeout, rc_logon_required ]
            THEN
                BEGIN
                parsid := bin_parseid;
                i21rebuild_session (g_area, ret);
                IF  ret <> rc_ok
                THEN
                    ok := false
                ELSE
                    BEGIN
                    in04_parse_msg_select (g_area, ret, ok);
                    IF  ok
                    THEN
                        in04_get_msg (g_area, msg_nr, msg, ret,
                              parsagain, ok);
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
                END;
&           endif
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        IF  (ret = rc_ok) AND parsagain
        THEN
            BEGIN
            parsid := bin_parseid;
            in04_parse_msg_select (g_area, ret, ok);
            IF  ok
            THEN
                in04_get_msg (g_area, msg_nr, msg, ret,
                      parsagain, ok);
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        IF  (ret = rc_ok) AND NOT ok
        THEN
            BEGIN
            msgt := short_msg;
            in04_default_msg (g_area, msg_nr, msg, msgt);
            END;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  NOT i21dbok (g_area)
    THEN
        BEGIN
        ok := false;
        msgt := crash_msg;
        in04_default_msg (g_area, msg_nr, msg, msgt);
        END;
    (*ENDIF*) 
    IF  NOT g_area^.session [g_area^.dbno].is_connected OR NOT table_ok
    THEN
        BEGIN
        ok := false;
        msgt := short_msg;
        in04_default_msg (g_area, msg_nr, msg, msgt);
        END;
    (*ENDIF*) 
    IF  ok
    THEN
        i04insert_msg (g_area, msg_nr, msg);
    (*ENDIF*) 
    i21alternativesegment (g_area, switch_off);
    END;
(*ENDWITH*) 
END; (* in04_select_msg *)
 
(*------------------------------*) 
 
PROCEDURE
      in04_set_dbname_in_parms (
            g_area    : tin_global_in_vars;
            VAR parms : tin_msg_parms );
 
VAR
      i : integer;
 
BEGIN
i := 1;
WITH g_area^, session [dbno] DO
    WHILE (i <= DBNAME_MXSP00) DO
        IF   serverdb [i] <> bsp_c1
        THEN
            BEGIN
            parms.buffer [i + 1] := serverdb [i] ;
            parms.length := i;
            i := i + 1;
            END
        ELSE
            i := DBNAME_MXSP00 + 1;
        (*ENDIF*) 
    (*ENDWHILE*) 
(*ENDWITH*) 
(* 26.04.1994 h.b. if serverdb = '    ' *)
IF  parms.length = 0
THEN
    BEGIN
    parms.length := 1;
    parms.buffer [1] := chr (parms.length);
    parms.buffer [2] := bsp_c1;
    END;
(*ENDIF*) 
parms.buffer [1] := chr (parms.length);
END; (* in04_set_dbname_in_parms *)
 
(*------------------------------*) 
 
PROCEDURE
      in04_sellit_cmd (
            g_area : tin_global_in_vars );
 
VAR
      c : tsp00_C40;
 
BEGIN
i21initparse (g_area);
c := 'SELECT S_LABEL, M_LABEL,                ';
i21p2cmnd (g_area, c, 25);
c := 'L_LABEL, XL_LABEL                       ';
i21p2cmnd (g_area, c, 20);
c := 'INTO  :s, :m, :l, :x                    ';
i21p2cmnd (g_area, c, 21);
c := 'FROM "DOMAIN".LITERALS                  ';
i21p2cmnd (g_area, c, 28);
c := 'WHERE OWNER = :auth                     ';
i21p2cmnd (g_area, c, 25);
c := 'AND LITERALNAME = :name                 ';
(*        Literalname *)
i21p2cmnd (g_area, c, 25);
c := 'AND LANGUAGE = :lang                    ';
(*        Language    *)
i21p2cmnd (g_area, c, 20);
END; (* in04_sellit_cmd *)
 
(*------------------------------*) 
 
FUNCTION
      in04_store_message (
            g_area  : tin_global_in_vars;
            VAR msg : tin_screenline;
            VAR ok  : boolean) : msgkey_pointer;
 
VAR
      line_nr  : tin_natural;
      length   : tin_natural;
      error    : boolean;
      act      : msgkey_pointer;
      is_empty : boolean;
 
BEGIN
act := in04_get_free_msg_key ( g_area, ok);
IF  ok
THEN
    BEGIN
    length := s30klen (msg, bsp_c1,  mxin_screenline );
    WITH g_area^.msg_tab DO
        BEGIN
        WITH msgpool DO
            BEGIN
            line_nr := evars.lines + 1;
            is_empty := (length = 0);
            IF  is_empty
            THEN
                BEGIN
                length := 1;
                msg [1] := chr( empty_char);
                END;
            (*ENDIF*) 
            i14puteline (buf, evars, msg, line_nr, length, error);
            ok := NOT error;
            IF  ok
            THEN
                BEGIN
                messages [act] .index := line_nr;
                IF  is_empty
                THEN
                    msg [1] := bsp_c1;
                (*ENDIF*) 
                END
            ELSE
                BEGIN
                in04_free_msg_key ( g_area, act);
                END;
            (*ENDIF*) 
            END;
        (*ENDWITH*) 
        END;
    (*ENDWITH*) 
    END;
(*ENDIF*) 
IF  ok
THEN
    in04_store_message := act
ELSE
    in04_store_message := nil_ptr;
(*ENDIF*) 
END; (* in04_store_message *)
 
(*------------------------------*) 
 
PROCEDURE
      in04store_messagenumber (
            nr         : integer;
            VAR msgnos : tin_msgnos);
 
VAR
      is_range : boolean;
 
BEGIN
is_range := (msgnos.len > 0);
IF  is_range
THEN
    is_range := (msgnos.buf [msgnos.len] = nr - 1);
(*ENDIF*) 
IF  is_range
THEN
    BEGIN
    is_range := msgnos.len > 2;
    IF  is_range
    THEN
        is_range := (msgnos.buf [msgnos.len - 2] = range_symbol);
    (*ENDIF*) 
    IF  NOT is_range
    THEN
        IF  msgnos.len + 1 < mxin_msgnos
        THEN
            BEGIN
            msgnos.buf [msgnos.len] := range_symbol;
            msgnos.len := msgnos.len + 1;
            msgnos.buf [msgnos.len] := nr - 1;
            msgnos.len := msgnos.len + 1;
            END;
        (*ENDIF*) 
    (*ENDIF*) 
    msgnos.buf [msgnos.len] := nr;
    END
ELSE
    IF  msgnos.len < mxin_msgnos
    THEN
        BEGIN
        msgnos.len := msgnos.len + 1;
        msgnos.buf [msgnos.len] := nr;
        END;
    (*ENDIF*) 
(*ENDIF*) 
END; (* in04store_messagenumber *)
 
(*------------------------------*) 
 
PROCEDURE
      in04_trans_msg (
            g_area      : tin_global_in_vars;
            VAR partpos : tsp00_Int4;
            VAR msg     : tin_screenline);
 
VAR
      is_null   : boolean;
      trans_ret : tsp8_uni_error;
      errpos    : tsp00_Int4;
      res_len   : tsp00_Int4;
      uc_msg    : tin_double_eline;
 
BEGIN
IF  i21gchar (g_area, partpos) = csp_unicode_def_byte
THEN
    BEGIN
    i21g1val (g_area, sysmsg_uc_len, partpos, uc_msg, is_null);
    res_len := sizeof (msg);
    WITH g_area^.multibyte DO
        IF  g_area^.i20.swap = sw_normal
        THEN
            s80uni_trans (s30gad (uc_msg [1]), sysmsg_uc_len, csp_unicode,
                  s30gad (msg [1]), res_len, dblang_idx,
                  [ ], trans_ret, errpos)
        ELSE
            s80uni_trans (s30gad (uc_msg [1]), sysmsg_uc_len, csp_unicode_swap,
                  s30gad (msg [1]), res_len, dblang_idx,
                  [ ], trans_ret, errpos);
        (*ENDIF*) 
    (*ENDWITH*) 
    END
ELSE
    BEGIN
    i21gval (g_area, sysmsg_len, partpos, msg, is_null);
    (* Kernel does not distinguish ASCII and UNICODE messages, *)
    (* SQL messages are expected to consist of 160 Bytes regardless *)
    (* of the type. Therfore DOMAIN definition for MSGTEXT either *)
    (* CHAR (160) ASCII or CHAR (80) UNICODE. The trailing 80 ASCII *)
    (* bytes are blank and must be skipped *)
    partpos := partpos + sysmsg_len;
    res_len := sysmsg_len;
    END;
(*ENDIF*) 
SAPDB_PascalForcedFill (sizeof (msg), @msg, res_len + 1, sizeof (msg) - res_len, bsp_c1);
END; (* in04_trans_msg *)
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
.PA 
