.CM  SCRIPT , Version - 1.1 , last edited by barbara
.ad 8
.bm 8
.fm 4
.bt $Copyright by   SAP AG, 2001$$Page %$
.tm 12
.hm 6
.hs 3
.TT 1 $SQL$Project Distributed Database System$VIN85$
.tt 2 $$$
.TT 3 $$XUSER$2001-03-13$
***********************************************************
.nf
 
 
    ========== licence begin LGPL
    Copyright (C) 2000 SAP AG
 
    This library is free software; you can redistribute it and/or
    modify it under the terms of the GNU Lesser General Public
    License as published by the Free Software Foundation; either
    version 2.1 of the License, or (at your option) any later version.
 
    This library 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
    Lesser General Public License for more details.
 
    You should have received a copy of the GNU Lesser General Public
    License along with this library; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
    ========== licence end
 
.fo
.nf
.sp
MODULE  : XUSER
=========
.sp
Purpose : Show and change of connect parameters
.CM *-END-* purpose -------------------------------------
.sp
.cp 3
Define  :
 
        PROCEDURE
              in85main;
 
.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :
 
        FROM
              global_variable : VIN01;
 
        VAR
              i01g : tin_global_in_vars;
 
      ------------------------------ 
 
        FROM
              global_init : VIN02;
 
        PROCEDURE
              i02init (
                    VAR g_area : tin_global_in_vars );
 
      ------------------------------ 
 
        FROM
              logical_screen : VIN50;
 
        PROCEDURE
              i50clear (
                    part : tin_ls_part);
 
        PROCEDURE
              i50off (
                    VAR msg : tin_screenline);
 
        PROCEDURE
              i50put1field (
                    VAR field  : tsp4_xuserkey;
                    length     : tin_natural;
                    field_pos  : tin_ls_position;
                    field_type : tin_ls_fieldtype);
 
        PROCEDURE
              i50put2field (
                    VAR field  : tsp_c30;
                    length     : tin_natural;
                    field_pos  : tin_ls_position;
                    field_type : tin_ls_fieldtype);
 
        PROCEDURE
              i50put3field (
                    VAR field  : tsp_dbname;
                    length     : tin_natural;
                    field_pos  : tin_ls_position;
                    field_type : tin_ls_fieldtype);
 
        PROCEDURE
              i50put4field (
                    VAR field  : tsp_c20;
                    length     : tin_natural;
                    field_pos  : tin_ls_position;
                    field_type : tin_ls_fieldtype);
 
        PROCEDURE
              i50put5field (
                    VAR field  : tsp_nodeid;
                    length     : tin_natural;
                    field_pos  : tin_ls_position;
                    field_type : tin_ls_fieldtype);
 
        PROCEDURE
              i50put6field (
                    VAR field  : tsp4_sqlmode_name;
                    length     : tin_natural;
                    field_pos  : tin_ls_position;
                    field_type : tin_ls_fieldtype);
 
        PROCEDURE
              i50put7field (
                    VAR field  : tsp_c10;
                    length     : tin_natural;
                    field_pos  : tin_ls_position;
                    field_type : tin_ls_fieldtype);
 
        PROCEDURE
              i50put8field (
                    VAR field  : tsp_c40;
                    length     : tin_natural;
                    field_pos  : tin_ls_position;
                    field_type : tin_ls_fieldtype);
 
        PROCEDURE
              i50getfield (
                    VAR vt_input    : tin_ls_input_field;
                    VAR field_found : boolean);
 
      ------------------------------ 
 
        FROM
              logical_screen_layout : VIN51;
 
        PROCEDURE
              i51layout (
                    functionmenu_length : tin_natural;
                    inputarea_length    : tin_natural;
                    msglines            : tin_natural);
 
      ------------------------------ 
 
        FROM
              logical_screen_modules : VIN56;
 
        PROCEDURE
              i56putlabels (
                    fct_cursorpos      : tin_ls_releasemode;
                    functionline_label : boolean);
 
        PROCEDURE
              i56putframe (
                    with_name   :  boolean;
                    with_parms  :  boolean );
 
        PROCEDURE
              i56title (
                    blinking_modefield : boolean;
                    screen_nr          : integer;
                    VAR title          : tsp_online_header);
 
      ------------------------------ 
 
        FROM
              logical_screen_IO : VIN57 ;
 
        PROCEDURE
              i57ioscreen (
                    VAR csr_pos        : tin_ls_position;
                    VAR rf             : tin_ls_releasemode;
                    VAR screen_changed : boolean);
 
      ------------------------------ 
 
        FROM
              XUSER_Logon : VIN86 ;
 
        PROCEDURE
              i86onscreen (
                    VAR ok : boolean);
 
        PROCEDURE
              i86logon (
                    wanted_uname    : tsp_knl_identifier;
                    wanted_password : tsp_cryptpw;
                    VAR given_uname : tsp_knl_identifier;
                    VAR errmsg      : tin_screenline;
                    VAR connect_ok  : boolean);
 
      ------------------------------ 
 
        FROM
              XUSER_GET : VIN87 ;
 
        PROCEDURE
              i87kgetuserkey (
                    VAR buf     : tin_screenline;
                    len         : tin_natural;
                    VAR userkey : tsp4_xuserkey);
 
        PROCEDURE
              i87ngetusername  (
                    VAR buf      : tin_screenline;
                    len          : tin_natural;
                    VAR username : tsp_knl_identifier);
 
        PROCEDURE
              i87pgetpassword (
                    VAR buf      : tin_screenline;
                    len          : tin_natural;
                    VAR password : tsp_cryptpw);
 
        PROCEDURE
              i87dgetserverdb (
                    VAR buf      : tin_screenline;
                    len          : tin_natural;
                    VAR serverdb : tsp_dbname);
 
        PROCEDURE
              i87ngetservernode (
                    VAR buf        : tin_screenline;
                    len            : tin_natural;
                    VAR servernode : tsp_nodeid);
 
        PROCEDURE
              i87mgetsqlmode (
                    VAR buf        : tin_screenline;
                    len            : tin_natural;
                    VAR sqlmode    : tsp4_sqlmode_name);
 
        PROCEDURE
              i87cgetcachelimit (
                    VAR buf        : tin_screenline;
                    len            : tin_natural;
                    VAR cachelimit : tsp_int4);
 
        PROCEDURE
              i87tgettimeout (
                    VAR buf        : tin_screenline;
                    len            : tin_natural;
                    VAR timeout    : tsp_int2);
 
        PROCEDURE
              i87igetisolation (
                    VAR buf        : tin_screenline;
                    len            : tin_natural;
                    VAR isolation  : tsp_int2);
 
        PROCEDURE
              i87lgetdblang  (
                    VAR buf      : tin_screenline;
                    len          : tin_natural;
                    VAR dblang   : tsp_knl_identifier);
 
      ------------------------------ 
 
        FROM
              RTE_driver : VEN102;
 
        PROCEDURE
              sqlinit (
                    VAR component : tsp_compname;
                    canceladdr    : tsp_booladdr);
 
        PROCEDURE
              sqlfinit (
                    buffer_pool_size : tsp_int2;
                    VAR poolptr      : tsp_int4;
                    VAR ok           : boolean);
 
        PROCEDURE
              sqlfopen (
                    VAR hostfile   : tsp00_VFilename;
                    direction      : tsp_opcodes;
                    resource       : tsp_vf_resource;
                    VAR hostfileno : tsp_int4;
                    VAR format     : tsp_vf_format;
                    VAR rec_len    : tsp_int4;
                    poolptr        : tsp_int4;
                    buf_count      : tsp_int2;
                    VAR block      : tsp_vf_bufaddr;
                    VAR error      : tsp_vf_return;
                    VAR errtext    : tsp_errtext);
 
        PROCEDURE
              sqlfclose (
                    VAR hostfileno : tsp_int4;
                    erase          : boolean;
                    poolptr        : tsp_int4;
                    buf_count      : tsp_int2;
                    block          : tsp_vf_bufaddr;
                    VAR error      : tsp_vf_return;
                    VAR errtext    : tsp_errtext);
 
        PROCEDURE
              sqlfread (
                    VAR hostfileno : tsp_int4;
                    block          : tsp_vf_bufaddr;
                    VAR length     : tsp_int4;
                    VAR error      : tsp_vf_return;
                    VAR errtext    : tsp_errtext);
 
        PROCEDURE
              sqlfinish (
                    terminate : boolean);
 
        PROCEDURE
              sqlarg3 (
                    VAR user_params : tsp4_xuser_record;
                    VAR password    : tsp_pw;
                    VAR options     : tsp4_args_options;
                    VAR xusertype   : tsp4_xuserset;
                    VAR errtext     : tsp_errtext;
                    VAR ok          : boolean);
 
        PROCEDURE
              sqlxuopenuser (
                    VAR errtext    : tsp_errtext;
                    VAR ok          : boolean);
 
        PROCEDURE
              sqlindexuser (
                    userindex       : tsp_int2;
                    VAR user_params : tsp4_xuser_record;
                    VAR errtext     : tsp_errtext;
                    VAR ok          : boolean);
 
        PROCEDURE
              sqlputuser (
                    VAR user_params : tsp4_xuser_record;
                    VAR errtext     : tsp_errtext;
                    VAR ok          : boolean);
 
        PROCEDURE
              sqlclearuser;
 
        PROCEDURE
              sqlxucloseuser (
                    VAR errtext    : tsp_errtext;
                    VAR ok          : boolean);
 
        PROCEDURE
              sqlresult (
                    result : tsp_int1);
 
      ------------------------------ 
 
        FROM
              Encrypting: VSP02;
 
        PROCEDURE
              s02applencrypt (
                    pw_clear     : tsp_pw;
                    VAR pw_crypt : tsp_cryptpw);
 
      ------------------------------ 
 
        FROM
              RTE-Extension-10 : VSP10;
 
        PROCEDURE
              s10mv1 (
                    size1    : tsp_int4; size2 : tsp_int4;
                    VAR val1 : tsp_errtext; p1 : tsp_int4;
                    VAR val2 : tin_screenline; p2  :tsp_int4;
                    anz      : tsp_int4);
 
        PROCEDURE
              s10mv2 (
                    size1    : tsp_int4; size2 : tsp_int4;
                    VAR val1 : tsp_vfilename; p1 : tsp_int4;
                    VAR val2 : tin_screenline; p2  :tsp_int4;
                    anz      : tsp_int4);
 
        PROCEDURE
              s10fil (
                    size     : tsp_int4;
                    VAR m    : tin_screenline;
                    pos      : tsp_int4;
                    len      : tsp_int4;
                    fillchar : char);
 
      ------------------------------ 
 
        FROM
              RTE-Extension-30 : VSP30;
 
        FUNCTION
              s30gad (
                    VAR b : tin_screenline) : tsp_vf_bufaddr;
 
        FUNCTION
              s30gad1(VAR b : boolean) : tsp_booladdr;
&       ifdef TRACE
 
      ------------------------------ 
 
        FROM
              Test_Procedures : VMT90;
 
        PROCEDURE
              m90maxbuflength;
 
        PROCEDURE
              m90xtinit (
                    VAR term_ref  : tsp_int4;
                    VAR term_desc : tsp_terminal_description );
 
        PROCEDURE
              m90init;
 
        PROCEDURE
              m90switch;
 
        PROCEDURE
              m90end;
 
        PROCEDURE
              m90bool (
                    layer     : tsp_layer;
                    nam       : tsp_sname;
                    curr_bool : boolean );
 
        PROCEDURE
              m90int (
                    layer : tsp_layer;
                    nam   : tsp_sname;
                    int   : integer);
 
        PROCEDURE
              m90sname (
                    layer : tsp_layer;
                    nam   : tsp_sname);
 
        PROCEDURE
              m90name (
                    layer : tsp_layer;
                    nam   : tsp_name);
 
        PROCEDURE
              m90identifier (
                    layer : tsp_layer;
                    nam   : tsp_knl_identifier);
 
        PROCEDURE
              m90c40 (
                    layer : tsp_layer;
                    nam   : tsp_c40);
 
        PROCEDURE
              m90buf (
                    layer   : tsp_layer;
                    VAR buf : tsp_cryptpw;
                    pos_anf : integer;
                    pos_end : integer);
&       endif
 
      ------------------------------ 
 
        FROM
              Binary_String_Conversions: VIN35;
 
        PROCEDURE
              i35intlj_into_str (
                    source_num     : tsp_int4;
                    VAR result_str : tsp_c10;
                    VAR res_len    : integer);
 
.CM *-END-* use -----------------------------------------
.sp;.cp 3
Synonym :
 
        PROCEDURE
              sqlinit;
 
              tsp_c64 tsp_compname
 
        PROCEDURE
              i50put1field;
 
              tsp_moveobj tsp4_xuserkey
 
        PROCEDURE
              i50put2field;
 
              tsp_moveobj tsp_c30
 
        PROCEDURE
              i50put3field;
 
              tsp_moveobj tsp_dbname
 
        PROCEDURE
              i50put4field;
 
              tsp_moveobj tsp_c20
 
        PROCEDURE
              i50put5field;
 
              tsp_moveobj tsp_nodeid
 
        PROCEDURE
              i50put6field;
 
              tsp_moveobj tsp4_sqlmode_name
 
        PROCEDURE
              i50put7field;
 
              tsp_moveobj tsp_c10
 
        PROCEDURE
              i50put8field;
 
              tsp_moveobj tsp_c40
 
        PROCEDURE
              s02applencrypt;
 
              tsp_name tsp_pw
 
        PROCEDURE
              s10mv1;
 
              tsp_moveobj tsp_errtext
              tsp_moveobj tin_screenline
 
        PROCEDURE
              s10mv2;
 
              tsp_moveobj tsp_vfilename
              tsp_moveobj tin_screenline
 
        PROCEDURE
              s10fil;
 
              tsp_moveobj tin_screenline
 
        FUNCTION
              s30gad;
 
              tsp_moveobj tin_screenline
              tsp_addr    tsp_vf_bufaddr
 
        PROCEDURE
              m90buf;
 
              tsp_buf tsp_cryptpw
 
        PROCEDURE
              s30gad1;
 
              tsp_moveobj boolean
              tsp_addr tsp_booladdr
 
        PROCEDURE
              sqlinit;
 
              tsp00_CompName tsp_compname
              tsp00_BoolAddr tsp_booladdr
 
        PROCEDURE
              sqlresult;
 
              tsp00_Uint1 tsp_int1
 
        PROCEDURE
              sqlfinit;
 
              tsp00_Int2 tsp_int2
              tsp00_Int4 tsp_int4
 
        PROCEDURE
              sqlfopen;
 
              tsp00_VFileOpCodes tsp_opcodes
              tsp00_VfResource   tsp_vf_resource
              tsp00_Int4         tsp_int4
              tsp00_VfFormat     tsp_vf_format
              tsp00_Int4         tsp_int4
              tsp00_Int4         tsp_int4
              tsp00_Int2         tsp_int2
              tsp00_VfBufaddr    tsp_vf_bufaddr
              tsp00_VfReturn     tsp_vf_return
              tsp00_ErrText      tsp_errtext
 
        PROCEDURE
              sqlfread;
 
              tsp00_Int4       tsp_int4
              tsp00_VfBufaddr  tsp_vf_bufaddr
              tsp00_Int4       tsp_int4
              tsp00_VfReturn   tsp_vf_return
              tsp00_ErrText    tsp_errtext
 
        PROCEDURE
              sqlfclose;
 
              tsp00_Int4      tsp_int4
              tsp00_Int4      tsp_int4
              tsp00_Int2      tsp_int2
              tsp00_VfBufaddr tsp_vf_bufaddr
              tsp00_VfReturn  tsp_vf_return
              tsp00_ErrText   tsp_errtext
 
        PROCEDURE
              sqlarg3;
 
              tsp00_Pw      tsp_pw
              tsp00_ErrText tsp_errtext
 
        PROCEDURE
              sqlxuopenuser;
 
              tsp00_ErrText tsp_errtext
 
        PROCEDURE
              sqlindexuser;
 
              tsp00_Int2    tsp_int2
              tsp00_ErrText tsp_errtext
 
        PROCEDURE
              sqlputuser;
 
              tsp00_ErrText tsp_errtext
 
        PROCEDURE
              sqlxucloseuser;
 
              tsp00_ErrText tsp_errtext
 
.CM *-END-* synonym -------------------------------------
.sp;.cp 3
Author  :
.sp
.cp 3
Created : 1985-08-23
.sp
.cp 3
Version : 2001-03-13
.sp
.cp 3
Release :      Date : 2001-03-13
.sp
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Specification:
This module contains the main program of the dialog mini-component
XUSER. Its task is to enter the values specified by the user for
'user', 'password' and 'locationname' in the file 'XUSER REFLEX A1'.
The password is stored in an encoded form.
.sp
The values stored in this file are used for the implicit logon
of the dialog components (see sqluser in ven12 and i04_connect).
.sp
Call: XUSER
.br
If the file 'XUSER REFLEX A1' does not exist, a screen mask for
inputting values is immediately displayed.
.br
Otherwise, inputs can be entered following a successful logon via
a logon screen with only these values for 'username' and
'password' that are stored in the file.
.CM *-END-* specification -------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Description:
.sp 2
PROCEDURE
      in85_outscreen_userparms (
            VAR username : sql_user_name;
            VAR password : name;
            VAR locname  : sql_dbname);
.sp;.fo
Bildschirmausgabe von username, password (unsichtbar) und locname,
Einlesen der eventuell ge?anderten Werte und abspeichern in der
Datei 'XUSER REFLEX A1'.
Eingabeparameter:
.br;.nf
username, password , locationname
Ausgabeparameter:
keine
.sp 2;.oc _/1;Enhancements to MS-WINDOWS
.sp;This module has been changed to comply MS-Windows conventions;
Especially, the Callback function SQLINCALLBACK has been
implemented with input checks (see VIN86).
.sp 3;B.M. Rel 3.0.01 27 Jan 1992
.CM *-END-* description ---------------------------------
***********************************************************
.sp
.cp 10
.nf
.oc _/1
Structure:
 
.CM *-END-* structure -----------------------------------
.sp 2
**********************************************************
.sp
.cp 10
.nf
.oc _/1
.CM -lll-
Code    :
 
 
CONST
      cin85_userkey_line    = 6;
      cin85_userid_line     = 7;
      cin85_password_line   = 9;
      cin85_serverdb_line   = 10;
      cin85_servernode_line = 11;
      cin85_sqlmode_line    = 12;
      cin85_cachelimit_line = 13;
      cin85_timeout_line    = 14;
      cin85_isolev_line     = 15;
      cin85_dblang_line     = 16;
      cin85_asterisk10      = '**********';
      cin85_default_num     = '-1        ';
      cin85_max_entries     = 32;
 
TYPE
      tin85_sqluserset = ARRAY [ 0..cin85_max_entries ]
            OF tsp4_xuser_record;
 
 
(*------------------------------*) 
 
PROCEDURE
      set_copyright;
 
VAR
      cpr1, cpr2 : tsp_copyright;
 
BEGIN
cpr1:= csp_cop1;
cpr2:= csp_cop2;
END; (* set_copyright *)
 
(*------------------------------*) 
 
PROCEDURE
      i85_main_program;
 
VAR
      init_dummy  : tsp_int4;
      main_dummy  : tsp_int2;
      cancel      : boolean;
      cancelb_ptr : tsp_booladdr;
 
BEGIN
cancelb_ptr := s30gad1 (cancel);
init_dummy := sqlininit ( cancelb_ptr );
sqlinmain ( main_dummy );
END;
 
(*------------------------------*) 
 
FUNCTION
      sqlininit (cancel_bool_ptr : tsp_booladdr) : tsp_int4;
 
CONST
      cin85_dummy_alloc = 4;
 
VAR
      comp_name  : tsp_compname;
      ok         : boolean;
 
BEGIN
comp_name := bsp_c64;
comp_name [1] := 'X';
comp_name [2] := 'U';
comp_name [3] := 'S';
comp_name [4] := 'E';
comp_name [5] := 'R';
sqlinit (comp_name, cancel_bool_ptr);
i02init (i01g);
i01g^.cancelb_ptr := cancel_bool_ptr;
i01g^.is_batch := false;
i01g^.session [ i01g^.dbno].serverdb := 'DATABASE          ';
i01g^.session [ i01g^.dbno].user_ident := bsp_c64;
sqlfinit (0, i01g^.vf_pool_ptr, ok);
sqlininit := cin85_dummy_alloc;
END; (* sqlininit *)
 
(*------------------------------*) 
 
PROCEDURE
      sqlinterminate (
            VAR dummy : tsp_int2);
 
BEGIN
END;
 
(*------------------------------*) 
 
PROCEDURE
      sqlinmain (
            VAR dummy : tsp_int2);
 
VAR
      i          : integer;
      count      : integer;
      first      : integer;
      ok         : boolean;
      connect_ok : boolean;
      testname   : tsp_c10;
      msg        : tin_screenline;
      options    : tsp4_args_options;
      help_pass  : tsp_pw;
      logon_kind : tsp4_xuserset;
      errtext    : tsp_errtext;
      userset    : tin85_sqluserset;
      result     : tsp_int1;
 
BEGIN
result := 0;
options.opt_component := sp4co_sql_userx;
sqlarg3 (userset [0], help_pass, options, logon_kind,
      errtext, connect_ok);
IF  help_pass = bsp_c18
THEN
    (* don't show XUSER file's username in logon mask *)
    userset [0].xu_user := bsp_c64;
(*ENDIF*) 
s02applencrypt (help_pass, userset [0].xu_password);
s10fil (mxin_screenline, msg, 1, mxin_screenline, bsp_c1);
FOR i := 1 TO 10 DO
    testname [i] := options.opt_runfile [i];
(*ENDFOR*) 
ok := false;
IF  (    testname <> '          ')
    AND (testname <> 'STDIN     ')
    AND (testname <> 'stdin     ')
THEN
    BEGIN
    IF  options.opt_ux_comm_mode = sp4cm_sql_run
    THEN
        in85_no_replace_check (msg, result)
    ELSE
        in85_infile_userparms (options.opt_ux_runfile, msg, result);
    (*ENDIF*) 
    END
ELSE
    i86onscreen (ok);
(*ENDIF*) 
IF  ok (* ok is false if RUN or BATCH was specified *)
THEN
    IF  options.opt_comm_mode = sp4cm_sql_comp_vers
    THEN
        in85_version (msg)
    ELSE
        BEGIN
&       ifdef TRACE
        IF  NOT i01g^.is_batch AND i01g^.vt.ok
        THEN
            m90xtinit (i01g^.vt.vt_ref, i01g^.vt.desc)
        ELSE
            m90init;
        (*ENDIF*) 
        m90switch;
        m90maxbuflength;
&       endif
        in85_sqluser (userset, count, msg, ok);
        IF  NOT ok
        THEN
            result := 1;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
(*ENDIF*) 
IF  ok
THEN
    BEGIN
    first := 1;
    i := 1;
    WHILE i < count DO
        IF  userset [i].xu_user = bsp_c64
        THEN
            BEGIN
            first := first + 1;
            i := i + 1;
            END
        ELSE
            i := count;
        (*ENDIF*) 
    (*ENDWHILE*) 
    connect_ok := (userset [0].xu_user = userset [first].xu_user)
          AND (userset [0].xu_password = userset [first].xu_password);
    IF  NOT connect_ok
    THEN
        i86logon (userset [first].xu_user, userset [first].xu_password,
              userset [0].xu_user, msg, connect_ok);
    (*ENDIF*) 
    IF  connect_ok
    THEN
        (* B.M. Rel 3.0.0C 2 May 1991 *)
        in85_outscreen_userparms (userset, count, result)
    ELSE
        result := 4;
    (*ENDIF*) 
    END;
(*ENDIF*) 
sqlresult (result);
i50off (msg);
&ifdef TRACE
m90end;
&endif
sqlfinish (true);
END; (* sqlinmain *)
 
(*------------------------------*) 
 
PROCEDURE
      in85_version (
            VAR version_line : tin_screenline);
 
CONST
      version     = 'USER   Version 6.2.8.5   Date 1997-09-10';
 
VAR
      vtext : tsp_errtext;
 
BEGIN
vtext := version;
s10mv1 (mxsp_errtext, mxin_screenline,
      vtext, 1, version_line, 1, mxsp_errtext);
END; (* in85_version *)
 
(*------------------------------*) 
 
PROCEDURE
      in85_sqluser (
            VAR userset : tin85_sqluserset;
            VAR count   : integer;
            VAR msg     : tin_screenline;
            VAR ok      : boolean);
 
VAR
      i, k    : integer;
      errtext : tsp_errtext;
 
BEGIN
count := 1;
ok := true;
sqlxuopenuser (errtext, ok);
&ifdef trace
m90bool (vin, 'sqlxuopen ok', ok);
m90c40 (vin, errtext);
&endif
IF  ok
THEN
    BEGIN
    REPEAT
        sqlindexuser (count, userset [count], errtext, ok);
&       ifdef trace
        m90bool (vin, 'sqlindexu ok', ok);
        m90c40 (vin, errtext);
&       endif
        IF  ok
        THEN
            count := count + 1;
        (*ENDIF*) 
    UNTIL
        NOT ok OR (count > cin85_max_entries);
    (*ENDREPEAT*) 
    ok := true;
    sqlxucloseuser (errtext, ok);
&   ifdef trace
    m90bool (vin, 'sqlxuclos ok', ok);
    m90c40 (vin, errtext);
&   endif
    END;
(*ENDIF*) 
IF  NOT ok
THEN
    s10mv1 (mxsp_errtext, mxin_screenline,
          errtext, 1, msg, 1, mxsp_errtext);
(*ENDIF*) 
count := count - 1;
IF  ok
THEN
    FOR i := count + 1 TO cin85_max_entries DO
        in85_reset (userset [i]);
    (*ENDFOR*) 
(*ENDIF*) 
IF  count = 0
THEN
    in85_copy_userset (userset, 1, 0);
(*ENDIF*) 
END; (* in85_sqluser *)
 
(*------------------------------*) 
 
PROCEDURE
      in85_reset (
            VAR userset : tsp4_xuser_record);
 
BEGIN
userset.xu_key  := bsp_c18;
userset.xu_user := bsp_c64;
s02applencrypt (bsp_c18, userset.xu_password);
userset.xu_serverdb   := bsp_c18;
userset.xu_servernode := bsp_c64;
userset.xu_sqlmode    := bsp_c8;
userset.xu_cachelimit := -1;
userset.xu_isolation  := -1;
userset.xu_timeout    := -1;
userset.xu_dblang     := bsp_c64;
END; (* in85_reset *)
 
(*------------------------------*) 
 
PROCEDURE
      in85_outscreen_userparms (
            VAR userset : tin85_sqluserset;
            VAR count   : integer;
            VAR result  : tsp_int1);
 
CONST
      inputarea_length    = 1;
      functionmenu_length = 1;
      message_lines       = 1;
 
VAR
      csr_pos        : tin_ls_position;
      rf             : tin_ls_releasemode;
      screen_changed : boolean;
      again          : boolean;
      end_again      : boolean;
      ok             : boolean;
      pw_ok          : boolean;
      mode_ok        : boolean;
      isolev_ok      : boolean;
      current        : integer;
      cursorline     : integer;
      msg            : tsp_c40;
 
BEGIN
current := 1;
IF  count = 0
THEN
    count := 1;
(*ENDIF*) 
ok := true;
pw_ok := true;
mode_ok := true;
isolev_ok := true;
again := true;
end_again := false;
msg := bsp_c40;
i51layout (functionmenu_length, inputarea_length, message_lines);
i50clear (cin_ls_basic_window);
in85ih_init_header;
i01g^.key_type.key_labels   [f1]  := 'SAVE    ';
i01g^.key_type.key_labels   [f9]  := 'QUIT    ';
i01g^.key_type.key_labels   [f6]  := 'DELETE  ';
&if $OS IN [ UNIX,MSDOS,OS2,WIN32 ]
i01g^.key_type.key_labels   [f7]  := 'PREVIOUS';
i01g^.key_type.key_labels   [f8]  := 'NEXT    ';
i01g^.key_type.activated :=  [  f1, f9, f6, f7, f8, f_exit, f_end,
      f_up, f_down] ;
&else
i01g^.key_type.key_labels  [ f_up ] := 'PREVIOUS';
i01g^.key_type.key_labels  [ f_down ] := 'NEXT    ';
i01g^.key_type.activated :=  [  f1, f9, f6, f_up, f_down,
      f_end, f_exit ] ;
&endif
cursorline := 6;
WHILE again DO
    BEGIN
    in85ib_init_body (userset, current, msg);
    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*) 
    WITH csr_pos DO
        BEGIN
        screen_nr := 1;
        screen_part := cin_ls_workarea;
        sline := cursorline;
        scol := 16;
        END;
    (*ENDWITH*) 
    IF  current > 1
    THEN
        i01g^.key_type.activated := i01g^.key_type.activated
              + [ f7, f_up  ]
    ELSE
        i01g^.key_type.activated := i01g^.key_type.activated
              - [ f7, f_up ] ;
    (*ENDIF*) 
    IF  current < cin85_max_entries
    THEN
        i01g^.key_type.activated := i01g^.key_type.activated
              + [  f8, f_down  ]
    ELSE
        i01g^.key_type.activated := i01g^.key_type.activated
              - [  f8, f_down  ] ;
    (*ENDIF*) 
    i56putlabels  (f_clear, false);
    i57ioscreen  (csr_pos, rf, screen_changed);
    msg := '                                        ';
    cursorline := cin85_userkey_line;
&   ifdef trace
    m90bool (vin, 'pw_ok       ', pw_ok);
    m90bool (vin, 'mode_ok     ', mode_ok);
    m90bool (vin, 'isolev_ok   ', isolev_ok);
&   endif
    IF  screen_changed
    THEN
        in85_inscreen_userparms (userset, count, current,
              pw_ok, mode_ok, isolev_ok);
    (*ENDIF*) 
    IF  NOT pw_ok
    THEN
        BEGIN
        msg := 'Reenter password                        ';
        cursorline := cin85_password_line;
        END
    ELSE
        IF  NOT mode_ok
        THEN
            BEGIN
            msg := 'Only INTERNAL,ANSI,DB2, ORACLE OR SAPR3 ';
            cursorline := cin85_sqlmode_line;
            END
        ELSE
            IF  NOT isolev_ok
            THEN
                BEGIN
                msg := 'isolation level: 0, 1[0], 15, 2[0], 3[0]';
                cursorline := cin85_isolev_line;
                END;
            (*ENDIF*) 
        (*ENDIF*) 
    (*ENDIF*) 
    ok := pw_ok AND mode_ok AND isolev_ok;
    CASE rf OF
        f1:
            IF  ok
            THEN
                BEGIN
                in85_store_userparms  (userset, count, msg, result, ok);
                IF  ok
                THEN
                    again := false
                ELSE
                    cursorline := cin85_userkey_line;
                (*ENDIF*) 
                END;
            (*ENDIF*) 
        f8, f_down :
            IF  ok AND (current < cin85_max_entries)
            THEN
                current := current + 1;
            (*ENDIF*) 
        f7, f_up :
            IF  ok AND (current > 1)
            THEN
                current := current - 1;
            (*ENDIF*) 
        f6:
            BEGIN
            in85_delete (userset, current, count);
&           ifdef trace
            m90name (vin, 'nach in85_delete  ');
            m90int (vin, 'current     ', current);
            m90int (vin, 'count       ', count  );
&           endif
            END;
        f9, f_end, f_exit:
            IF  end_again
            THEN
                again := false
            ELSE
                msg := 'Restrike the QUIT key                   ';
            (*ENDIF*) 
        OTHERWISE:
            ;
        END;
    (*ENDCASE*) 
    end_again := rf in [f9, f_end, f_exit];
    END;
(*ENDWHILE*) 
END; (* in85_outscreen_userparms *)
 
(*------------------------------*) 
 
PROCEDURE
      in85ih_init_header;
 
VAR
      title : tsp_online_header;
 
BEGIN
(* ======================== *)
(* put id field in top line *)
(* ======================== *)
WITH title DO
    BEGIN
    id_field    := 'XUSER   ';
    relno_field := '6.2     ';
    mode_field  := 'INPUT       ';
    text_field  :=  bsp_c40;
    END;
(*ENDWITH*) 
i56putframe (true, true);
i56title ( false, 1, title );
END; (* in85ih_init_header *)
 
(*------------------------------*) 
 
PROCEDURE
      in85ib_init_body (
            VAR userset : tin85_sqluserset;
            current     : integer;
            VAR msg     : tsp_c40);
 
VAR
      t30          : tsp_c30;
      t10          : tsp_c10;
      p_local      : tsp_c20;
      fieldpos     : tin_ls_position;
      fieldtype    : tin_ls_fieldtype;
      l            : integer;
 
BEGIN
WITH fieldpos DO
    BEGIN
    screen_nr := 1;
    screen_part := cin_ls_workarea;
    sline := 2;
    scol := 25;
    END;
(*ENDWITH*) 
WITH fieldtype DO
    BEGIN
    field_att := cin_ls_normal;
    fieldmode := [  ] ;
    END;
(*ENDWITH*) 
t30 := 'USER PARAMETER NO             ';
IF  current >= 10
THEN
    t30 [19] := chr (ord ('0') + current DIV 10);
(*ENDIF*) 
t30 [20] := chr (ord ('0') + current MOD 10);
i50put2field (t30, 30, fieldpos, fieldtype);
WITH fieldpos DO
    BEGIN
    t30 := '====================          ';
    sline := 3;
    i50put2field (t30, 30, fieldpos, fieldtype);
    END;
(*ENDWITH*) 
WITH fieldpos, fieldtype DO
    BEGIN
    t30:='USERKEY      :                ';
    sline := cin85_userkey_line;
    scol  := 1;
    field_att := cin_ls_enhanced;
    i50put2field (t30, 14, fieldpos, fieldtype);
    scol  := 16;
    fieldmode := [ ls_input] ;
    IF  current = 1
    THEN
        userset [ current] .xu_key := 'DEFAULT           ';
    (* at least VM RTE does that anyway *)
    (*ENDIF*) 
    IF  userset [ current ].xu_key [1] = csp_defined_byte
    THEN
        userset [ current ].xu_key [1] := '.';
    (*ENDIF*) 
    i50put1field (userset [ current] .xu_key, sizeof(tsp4_xuserkey),
          fieldpos, fieldtype);
&   ifdef trace
    m90sname (vin, 'xu_key out  ');
    m90name (vin, userset [current].xu_key);
&   endif
    END;
(*ENDWITH*) 
WITH fieldpos, fieldtype DO
    BEGIN
    t30 := 'USERID       :                ';
    sline := cin85_userid_line;
    scol  := 1;
    field_att := cin_ls_enhanced;
    fieldmode := [  ] ;
    i50put2field (t30, 14, fieldpos, fieldtype);
    scol  := 16;
    fieldmode := [ ls_input] ;
    i50put5field (userset [ current] .xu_user, sizeof(tsp_knl_identifier),
          fieldpos, fieldtype);
    END;
(*ENDWITH*) 
WITH fieldpos, fieldtype DO
    BEGIN
    t30:='PASSWORD     :                ';
    sline := 8;
    scol  := 1;
    field_att := cin_ls_enhanced;
    fieldmode := [  ] ;
    i50put2field (t30, 14, fieldpos, fieldtype);
    p_local := bsp_c20;
    scol  := 16;
    field_att := cin_ls_invisible;
    fieldmode := [ ls_input] ;
    i50put4field (p_local, mxsp_c20, fieldpos, fieldtype);
    END;
(*ENDWITH*) 
WITH fieldpos, fieldtype DO
    BEGIN
    (*------------ REPEAT PASSWORD ---------------------------*)
    t30:='repeat passw :                ';
    sline := cin85_password_line;
    scol  := 1;
    field_att := cin_ls_enhanced;
    fieldmode := [  ] ;
    i50put2field (t30, 14, fieldpos, fieldtype);
    p_local := bsp_c20;
    scol  := 16;
    field_att := cin_ls_invisible;
    fieldmode := [ ls_input] ;
    i50put4field (p_local, mxsp_c20, fieldpos, fieldtype);
    END;
(*ENDWITH*) 
WITH fieldpos, fieldtype DO
    BEGIN
    t30:='SERVERDB     :                ';
    sline := cin85_serverdb_line;
    scol  := 1;
    field_att := cin_ls_enhanced;
    fieldmode := [  ] ;
    i50put2field (t30, 14, fieldpos, fieldtype);
    scol  := 16;
    fieldmode := [ ls_input] ;
    WITH userset [ current ] DO
        i50put3field (xu_serverdb, mxsp_dbname, fieldpos, fieldtype);
    (*ENDWITH*) 
    END;
(*ENDWITH*) 
WITH fieldpos, fieldtype DO
    BEGIN
    t30:='SERVERNODE   :                ';
    sline := cin85_servernode_line;
    scol  := 1;
    field_att := cin_ls_enhanced;
    fieldmode := [  ] ;
    i50put2field (t30, 14, fieldpos, fieldtype);
    scol  := 16;
    fieldmode := [ ls_input] ;
    i50put5field (userset [ current] .xu_servernode, mxsp_nodeid,
          fieldpos, fieldtype);
    END;
(*ENDWITH*) 
WITH fieldpos, fieldtype DO
    BEGIN
    t30:='SQLMODE      :                ';
    sline := cin85_sqlmode_line;
    scol  := 1;
    field_att := cin_ls_enhanced;
    fieldmode := [  ] ;
    i50put2field (t30, 14, fieldpos, fieldtype);
    scol  := 16;
    fieldmode := [ ls_input] ;
    i50put6field (userset [ current] .xu_sqlmode, mxsp_c8,
          fieldpos, fieldtype);
    END;
(*ENDWITH*) 
WITH fieldpos, fieldtype DO
    BEGIN
    t30:='CACHELIMIT   :                ';
    sline := cin85_cachelimit_line;
    scol  := 1;
    field_att := cin_ls_enhanced;
    fieldmode := [  ] ;
    i50put2field (t30, 14, fieldpos, fieldtype);
    scol  := 16;
    fieldmode := [ ls_input] ;
    i35intlj_into_str (userset [current ].xu_cachelimit, t10, l);
    IF  t10 = cin85_asterisk10
    THEN
        t10 := cin85_default_num;
    (*ENDIF*) 
    i50put7field (t10, 10, fieldpos, fieldtype);
    END;
(*ENDWITH*) 
WITH fieldpos, fieldtype DO
    BEGIN
    t30:='TIMEOUT      :                ';
    sline := cin85_timeout_line;
    scol  := 1;
    field_att := cin_ls_enhanced;
    fieldmode := [  ] ;
    i50put2field (t30, 14, fieldpos, fieldtype);
    scol  := 16;
    fieldmode := [ ls_input] ;
    i35intlj_into_str (userset [current ].xu_timeout, t10, l);
    IF  t10 = cin85_asterisk10
    THEN
        t10 := cin85_default_num;
    (*ENDIF*) 
    i50put7field (t10, 10, fieldpos, fieldtype);
    END;
(*ENDWITH*) 
WITH fieldpos, fieldtype DO
    BEGIN
    t30:='ISOLATION    :                ';
    sline := cin85_isolev_line;
    scol  := 1;
    field_att := cin_ls_enhanced;
    fieldmode := [  ] ;
    i50put2field (t30, 14, fieldpos, fieldtype);
    scol  := 16;
    fieldmode := [ ls_input] ;
    i35intlj_into_str (userset [current ].xu_isolation, t10, l);
    IF  t10 = cin85_asterisk10
    THEN
        t10 := cin85_default_num;
    (*ENDIF*) 
    i50put7field (t10, 10, fieldpos, fieldtype);
    END;
(*ENDWITH*) 
WITH fieldpos, fieldtype DO
    BEGIN
    t30:='DBLOCALE     :                ';
    sline := cin85_dblang_line;
    scol  := 1;
    field_att := cin_ls_enhanced;
    fieldmode := [  ] ;
    i50put2field (t30, 14, fieldpos, fieldtype);
    scol  := 16;
    fieldmode := [ ls_input] ;
    i50put5field (userset [ current] .xu_dblang, sizeof(tsp_knl_identifier),
          fieldpos, fieldtype);
    END;
(*ENDWITH*) 
WITH fieldpos DO
    BEGIN
    screen_part := cin_ls_sysline;
    fieldpos.sline := 1;
    fieldpos.scol  := 1;
    END;
(*ENDWITH*) 
IF  msg [1]  = bsp_c1
THEN
    fieldtype.field_att := cin_ls_normal
ELSE
    fieldtype.field_att := cin_ls_errormsg;
(*ENDIF*) 
fieldtype.fieldmode :=  [  ] ;
i50clear (cin_ls_sysline);
i50put8field  (msg, 40, fieldpos, fieldtype);
END; (* in85ib_init_body *)
 
(*------------------------------*) 
 
PROCEDURE
      in85_inscreen_userparms (
            VAR userset    : tin85_sqluserset;
            VAR count      : integer;
            VAR current    : integer;
            VAR pw_ok      : boolean;
            VAR mode_ok    : boolean;
            VAR isolev_ok  : boolean);
 
CONST
      mode_internal = 'INTERNAL';    (* PTS 1109748 *)
      mode_adabas   = 'ADABAS  ';
      mode_ansi     = 'ANSI    ';
      mode_db2      = 'DB2     ';
      mode_oracle   = 'ORACLE  ';
      mode_sapr3    = 'SAPR3   ';
      mode_sql_db   = 'SQL-DB  ';
 
VAR
      i               : integer;
      inp_buf         : tin_ls_input_field;
      field_found     : boolean;
      second_password : tsp_cryptpw;
 
BEGIN
i50getfield  (inp_buf, field_found);
&ifdef trace
m90bool (vin, 'usrkey found', field_found);
m90bool (vin, 'usrkey chngd', inp_buf.changed);
&endif
IF  field_found AND inp_buf.changed
THEN
    i87kgetuserkey (inp_buf.buf, inp_buf.len, userset [current].xu_key);
(*ENDIF*) 
IF  count < current
THEN
    BEGIN
    count := count + 1;
    userset [count].xu_key := userset [current].xu_key;
    current := count;
    END;
(*ENDIF*) 
IF  userset [current].xu_key = bsp_c18
THEN
    in85_delete (userset, current, count)
ELSE
    WITH userset [current] DO
        BEGIN
        i50getfield (inp_buf, field_found);
&       ifdef trace
        m90bool (vin, 'usrnam found', field_found);
        m90bool (vin, 'usrnam chngd', inp_buf.changed);
&       endif
        IF  field_found AND inp_buf.changed
        THEN
            BEGIN
                i87ngetusername  (inp_buf.buf, inp_buf.len, xu_user);
                xu_userUCS2[1] := chr(0); (* PTS 1109748 *)
                xu_userUCS2[2] := chr(0);
            END;
        (*ENDIF*) 
        i50getfield  (inp_buf, field_found);
&       ifdef trace
        m90bool (vin, 'psswrd found', field_found);
        m90bool (vin, 'psswrd chngd', inp_buf.changed);
&       endif
        IF  field_found AND inp_buf.changed
        THEN
            BEGIN
                i87pgetpassword  (inp_buf.buf, inp_buf.len, xu_password);
                xu_userUCS2[1] := chr(0); (* PTS 1109748 *)
                xu_userUCS2[2] := chr(0);
            END
        ELSE
            second_password := xu_password;
        (*ENDIF*) 
        i50getfield  (inp_buf, field_found);
&       ifdef trace
        m90bool (vin, 'psswr2 found', field_found);
        m90bool (vin, 'psswr2 chngd', inp_buf.changed);
&       endif
        IF  field_found AND inp_buf.changed
        THEN
            i87pgetpassword  (inp_buf.buf, inp_buf.len,
                  second_password);
        (*ENDIF*) 
        pw_ok := true;
        FOR i := 1 TO mxsp_cryptpw DO
            IF  xu_password [i]  <> second_password [i]
            THEN
                pw_ok := false;
&           ifdef trace
            (*ENDIF*) 
        (*ENDFOR*) 
        m90name (vin, 'xu_password       ');
        m90buf (vin, xu_password, 1, mxsp_cryptpw);
        m90name (vin, 'second_password   ');
        m90buf (vin, second_password, 1, mxsp_cryptpw);
&       endif
        i50getfield  (inp_buf, field_found);
&       ifdef trace
        m90bool (vin, 'servdb found', field_found);
        m90bool (vin, 'servdb chngd', inp_buf.changed);
&       endif
        IF  field_found AND inp_buf.changed
        THEN
            i87dgetserverdb (inp_buf.buf, inp_buf.len, xu_serverdb);
        (*ENDIF*) 
        i50getfield  (inp_buf, field_found);
&       ifdef trace
        m90bool (vin, 'srvnod found', field_found);
        m90bool (vin, 'srvnod chngd', inp_buf.changed);
&       endif
        IF  field_found AND inp_buf.changed
        THEN
            i87ngetservernode (inp_buf.buf, inp_buf.len, xu_servernode);
        (*ENDIF*) 
        i50getfield  (inp_buf, field_found);
&       ifdef trace
        m90bool (vin, 'sqlmod found', field_found);
        m90bool (vin, 'sqlmod chngd', inp_buf.changed);
&       endif
        IF  field_found AND inp_buf.changed
        THEN
            BEGIN
            i87mgetsqlmode (inp_buf.buf, inp_buf.len, xu_sqlmode);
            IF  xu_sqlmode = mode_adabas
            THEN
                xu_sqlmode := mode_internal;            (* PTS 1109748 *)
            (*ENDIF*) 
            IF  xu_sqlmode = mode_sql_db
            THEN
                xu_sqlmode := mode_internal;
            (*ENDIF*) 
            IF  (xu_sqlmode <> mode_internal)
                AND (xu_sqlmode <> mode_ansi)
                AND (xu_sqlmode <> mode_db2)
                AND (xu_sqlmode <> mode_oracle)
                AND (xu_sqlmode <> mode_sapr3)
                AND (xu_sqlmode <> '        ')
            THEN
                mode_ok := false
            ELSE
                mode_ok := true;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        i50getfield  (inp_buf, field_found);
&       ifdef trace
        m90bool (vin, 'climit found', field_found);
        m90bool (vin, 'climit chngd', inp_buf.changed);
&       endif
        IF  field_found AND inp_buf.changed
        THEN
            i87cgetcachelimit (inp_buf.buf, inp_buf.len, xu_cachelimit);
        (*ENDIF*) 
        i50getfield  (inp_buf, field_found);
&       ifdef trace
        m90bool (vin, 'timout found', field_found);
        m90bool (vin, 'timout chngd', inp_buf.changed);
&       endif
        IF  field_found AND inp_buf.changed
        THEN
            i87tgettimeout (inp_buf.buf, inp_buf.len, xu_timeout);
        (*ENDIF*) 
        i50getfield  (inp_buf, field_found);
&       ifdef trace
        m90bool (vin, 'isolev found', field_found);
        m90bool (vin, 'isolev chngd', inp_buf.changed);
&       endif
        IF  field_found (* AND inp_buf.changed *)
        THEN
            BEGIN
            i87igetisolation (inp_buf.buf, inp_buf.len, xu_isolation);
            IF  (xu_isolation <> -1)
                AND NOT (xu_isolation in [ 0..3, 9, 10, 15, 20, 30 ] )
            THEN
                isolev_ok := false
            ELSE
                isolev_ok := true;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        i50getfield  (inp_buf, field_found);
&       ifdef trace
        m90bool (vin, 'dblang found', field_found);
        m90bool (vin, 'dblang chngd', inp_buf.changed);
&       endif
        IF  field_found AND inp_buf.changed
        THEN
            i87lgetdblang (inp_buf.buf, inp_buf.len, xu_dblang);
        (*ENDIF*) 
        END;
    (*ENDWITH*) 
(*ENDIF*) 
&ifdef trace
m90bool (vin, 'pw_ok       ', pw_ok);
m90bool (vin, 'mode_ok     ', mode_ok);
m90bool (vin, 'isolev_ok   ', isolev_ok);
m90name (vin, 'ENDE in85_inscreen');
m90name (vin, '==================');
&endif
END; (* in85_inscreen_userparms *)
 
(*------------------------------*) 
 
PROCEDURE
      in85_store_userparms (
            VAR userset : tin85_sqluserset;
            count       : integer;
            VAR msg     : tsp_c40;
            VAR result  : tsp_int1;
            VAR ok      : boolean);
 
VAR
      i       : integer;
      j       : integer;
      k       : integer;
      errtext : tsp_errtext;
 
BEGIN
ok := true;
FOR i := 1 TO count - 1 DO
    FOR j := i + 1 TO count DO
        IF  ok (* checked 31 * 16 = 496 times *)
        THEN
            IF  userset [ i ].xu_key = userset [ j ].xu_key
            THEN
                ok := false;
            (*ENDIF*) 
        (*ENDIF*) 
    (*ENDFOR*) 
(*ENDFOR*) 
IF  NOT ok
THEN
    msg := 'Duplicate userkey                       '
ELSE
    BEGIN
    sqlclearuser;
    IF  count > 0
    THEN
        BEGIN
        sqlxuopenuser (errtext, ok);
        IF  userset [1].xu_key <> 'DEFAULT           '
        THEN
            userset [1].xu_key := 'DEFAULT           ';
        (*ENDIF*) 
        FOR k := 1 TO count DO
            BEGIN
            IF  ok AND (userset [k].xu_key <> bsp_c18)
            THEN
                sqlputuser  (userset [k], errtext, ok);
&           ifdef trace
            (*ENDIF*) 
            m90int (vin, 'current set ', k);
            m90identifier (vin, userset [k].xu_user);
            m90bool (vin, 'ok          ', ok);
&           endif
            END;
        (*ENDFOR*) 
        IF  ok
        THEN
            sqlxucloseuser (errtext, ok);
        (*ENDIF*) 
        IF  NOT ok
        THEN
            BEGIN
            msg := errtext;
            result := 2;
            END;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDIF*) 
END; (* in85_store_userparms *)
 
(*------------------------------*) 
 
PROCEDURE
      in85_delete (
            VAR userset : tin85_sqluserset;
            VAR current : integer;
            VAR count   : integer);
 
VAR
      i : integer;
 
BEGIN
&ifdef trace
m90int (vin, 'current     ', current);
m90name (vin, userset [current].xu_key);
m90int (vin, 'count       ', count  );
&endif
IF  current < count
THEN
    BEGIN
    FOR i := current TO count - 1 DO
        in85_copy_userset (userset, i, i + 1);
    (*ENDFOR*) 
    in85_reset (userset [count] );
    END;
(*ENDIF*) 
IF  current <= count
THEN
    count := count - 1;
(*ENDIF*) 
IF  current > count
THEN
    in85_reset (userset [current]);
(*ENDIF*) 
END; (* in85_delete *)
 
(*------------------------------*) 
 
PROCEDURE
      in85_copy_userset (
            VAR userset : tin85_sqluserset;
            target      : integer;
            source      : integer);
 
BEGIN
userset [target]. xu_key        := userset [source] .xu_key;
userset [target]. xu_servernode := userset [source] .xu_servernode;
userset [target]. xu_serverdb   := userset [source] .xu_serverdb;
userset [target]. xu_user       := userset [source] .xu_user;
userset [target]. xu_password   := userset [source] .xu_password;
userset [target]. xu_sqlmode    := userset [source] .xu_sqlmode;
userset [target]. xu_cachelimit := userset [source] .xu_cachelimit;
userset [target]. xu_timeout    := userset [source] .xu_timeout;
userset [target]. xu_isolation  := userset [source] .xu_isolation;
userset [target]. xu_dblang     := userset [source] .xu_dblang;
END; (* in85_copy_userset *)
 
(*------------------------------*) 
 
PROCEDURE
      in85_infile_userparms (
            VAR source_name : tsp00_VFilename;
            VAR msg         : tin_screenline;
            VAR result      : tsp_int1);
 
VAR
      file_error      : tsp_vf_return;
      errtext         : tsp_errtext;
      format          : tsp_vf_format;
      rec_len         : tsp_int4;
      source_fno      : tsp_int4;
      outblockaddress : tsp_vf_bufaddr;
      open            : boolean;
      ok              : boolean;
      isolev_ok       : boolean;
      count           : integer;
      remain          : integer;
      buf             : tin_screenline;
      userset         : tin85_sqluserset;
 
BEGIN
isolev_ok := true;
rec_len := 0;
format := vf_unknown;
&ifdef trace
writeln ('source_name ', source_name);
&endif
sqlfopen (source_name, vread, vf_stack, source_fno,
      format, rec_len, i01g^.vf_pool_ptr, 1,
      outblockaddress, file_error, errtext);
&ifdef trace
writeln ('open_error  ', ord (file_error));
writeln ('errtext     ', errtext);
&endif
open := file_error in [vf_ok, vf_eof];
IF  file_error = vf_ok
THEN
    BEGIN
    sqlfread (source_fno, s30gad (buf), rec_len, file_error, errtext);
&   ifdef trace
    writeln ('read_error  ', ord (file_error));
    writeln ('errtext     ', errtext);
    writeln ('source name ', source_name);
    writeln ('rec_len     ', rec_len);
&   endif
    END;
(*ENDIF*) 
IF  file_error = vf_ok
THEN
    (* Windows NT Test: empty file (0 bytes) doesn't work, therefore *)
    (* if first two lines are empty file is regarded empty *)
    (* thus also UNIX should still be alright *)
    IF  rec_len = 0
    THEN
        BEGIN
        sqlfread (source_fno, s30gad (buf), rec_len, file_error, errtext);
        IF  rec_len = 0
        THEN
            file_error := vf_eof;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
(*ENDIF*) 
count := 0;
WHILE (file_error = vf_ok) AND (count < cin85_max_entries)
      AND isolev_ok DO
    BEGIN
    count := count + 1;
    WITH userset [ count ] DO
        BEGIN
        IF  file_error = vf_ok
        THEN
            BEGIN
            i87kgetuserkey  (buf, rec_len, xu_key);
            sqlfread (source_fno, s30gad (buf), rec_len, file_error,
                  errtext);
            END;
        (*ENDIF*) 
        IF  file_error = vf_ok
        THEN
            BEGIN
            i87ngetusername  (buf, rec_len, xu_user);
            sqlfread (source_fno, s30gad (buf), rec_len, file_error,
                  errtext);
            END;
        (*ENDIF*) 
        IF  file_error = vf_ok
        THEN
            BEGIN
            i87pgetpassword  (buf, rec_len, xu_password);
            sqlfread (source_fno, s30gad (buf), rec_len, file_error,
                  errtext);
            END;
        (*ENDIF*) 
        IF  file_error = vf_ok
        THEN
            BEGIN
            i87dgetserverdb (buf, rec_len, xu_serverdb);
            sqlfread (source_fno, s30gad (buf), rec_len, file_error,
                  errtext);
            END;
        (*ENDIF*) 
        IF  file_error = vf_ok
        THEN
            BEGIN
            i87ngetservernode (buf, rec_len, xu_servernode);
            sqlfread (source_fno, s30gad (buf), rec_len, file_error,
                  errtext);
            END;
        (*ENDIF*) 
        IF  file_error = vf_ok
        THEN
            BEGIN
            i87mgetsqlmode (buf, rec_len, xu_sqlmode);
            sqlfread (source_fno, s30gad (buf), rec_len, file_error,
                  errtext);
            END;
        (*ENDIF*) 
        IF  file_error = vf_ok
        THEN
            BEGIN
            i87cgetcachelimit (buf, rec_len, xu_cachelimit);
            sqlfread (source_fno, s30gad (buf), rec_len, file_error,
                  errtext);
            END;
        (*ENDIF*) 
        IF  file_error = vf_ok
        THEN
            BEGIN
            i87tgettimeout (buf, rec_len, xu_timeout);
            sqlfread (source_fno, s30gad (buf), rec_len, file_error,
                  errtext);
            END;
        (*ENDIF*) 
        IF  file_error = vf_ok
        THEN
            BEGIN
            i87igetisolation (buf, rec_len, xu_isolation);
            IF  (xu_isolation <> -1)
                AND NOT (xu_isolation in [ 0..3, 9, 10, 15, 20, 30 ] )
            THEN
                isolev_ok := false
            ELSE
                sqlfread (source_fno, s30gad (buf), rec_len, file_error,
                      errtext);
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        IF  (file_error = vf_ok) AND isolev_ok
        THEN
            BEGIN
            i87lgetdblang (buf, rec_len, xu_dblang);
            sqlfread (source_fno, s30gad (buf), rec_len, file_error,
                  errtext);
            END;
        (*ENDIF*) 
        xu_userUCS2[1] := chr(0); (* PTS 1112745 *)
        xu_userUCS2[2] := chr(0);
        END;
    (*ENDWITH*) 
    END;
(*ENDWHILE*) 
IF  open
THEN
    BEGIN
    sqlfclose (source_fno, false, i01g^.vf_pool_ptr, 1,
          outblockaddress, file_error, errtext);
    IF  isolev_ok
    THEN
        BEGIN
&       ifdef trace
        writeln ('store count ', count);
&       endif
        in85_store_userparms (userset, count, errtext, result, ok);
        IF  (result = 0) AND (count = 0)
        THEN
            result := 3;
        (*ENDIF*) 
        END
    ELSE
        BEGIN
        ok := false;
        errtext := 'Invalid input file content              ';
        END;
    (*ENDIF*) 
    END
ELSE
    ok := false;
(*ENDIF*) 
IF  NOT ok
THEN
    BEGIN
    s10mv1 (mxsp_errtext, mxin_screenline,
          errtext, 1, msg, 1, mxsp_errtext);
    remain := mxin_screenline - mxsp_errtext;
    IF  remain > mxsp_c64
    THEN
        remain := mxsp_c64;
    (*ENDIF*) 
    s10mv2 (mxsp_vfilename, mxin_screenline,
          source_name, 1, msg, mxsp_errtext + 1, remain);
    END;
(*ENDIF*) 
END; (* in85_infile_userparms *)
 
(*------------------------------*) 
 
PROCEDURE
      in85_no_replace_check (
            VAR msg         : tin_screenline;
            VAR result      : tsp_int1);
 
VAR
      ok      : boolean;
      errtext : tsp_errtext;
      local   : tsp4_xuser_record;
 
BEGIN
result := 0;
ok := true;
sqlxuopenuser (errtext, ok);
&ifdef trace
writeln ('in85_no_replace_check');
writeln ('sqlxuopen ok ', ok);
writeln (errtext);
&endif
IF  ok
THEN
    BEGIN
    sqlindexuser (1, local, errtext, ok);
&   ifdef trace
    writeln ('sqlindexuser ok ', ok);
    writeln (errtext);
&   endif
    IF  ok
    THEN
        BEGIN
        errtext := 'Userfile exists, no REPLACE specified   ';
        s10mv1 (mxsp_errtext, mxin_screenline,
              errtext, 1, msg, 1, mxsp_errtext);
        result := 127;
        END
    ELSE
        ok := true;
    (*ENDIF*) 
    sqlxucloseuser (errtext, ok);
    END;
(*ENDIF*) 
IF  NOT ok
THEN
    BEGIN
    s10mv1 (mxsp_errtext, mxin_screenline,
          errtext, 1, msg, 1, mxsp_errtext);
    result := 5;
    END;
&ifdef trace
(*ENDIF*) 
writeln ('in85_no_replace_check');
writeln ('result ', result);
&endif
END; (* in85_no_replace_check *)
 
(*------------------------------*) 
 
PROCEDURE
      in85main;
 
BEGIN
i85_main_program;
END;
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
*-PRETTY-*  statements    :        566
*-PRETTY-*  lines of code :       1351        PRETTYX 3.10 
*-PRETTY-*  lines in file :       2087         1997-12-10 
.PA 
