/* @lastChanged: "1999-10-28"
 
 * @filename:   vxt01
 * @purpose:    "XT_Diagnose"
 * @release:    7.1.0.0
 * @see:        "-.-"
 *
 * @copyright:  (c) 1998-2004 SAP AG"
 */
 
.tt 1 $SAP$LiveCache$VXT01$
.tt 3 $$XT_Diagnose$1999-10-28$
 
.nf
 
 .nf
 
 .nf

    ========== licence begin  GPL
    Copyright (c) 1998-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
***********************************************************
 
Module  : XT_Diagnose
 
Define  :
 
&       ifndef WINDOWS
        PROCEDURE
              xt01main;
&       else
 
        FUNCTION
              sqldcinit (
                    VAR language : tsp00_C3) : integer;
 
        PROCEDURE
              sqldcmain (
                    VAR g : component_global_var );
 
        PROCEDURE
              sqldcterminate (
                    VAR g : component_global_var );
 
        FUNCTION
              sqldccallback (
                    VAR g           : tsp00_MoveObj;
                    term_ref        : tsp00_Int4;
                    key             : tsp00_VtKey;
                    context         : tsp00_BufAddr;
                    callback_switch : tsp00_Int2) : tsp00_DgcallbackResult;
&       endif
 
.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :
 
        FROM
              SQLManager : VAK101;
 
        PROCEDURE
              a101_CreateErrorHandler;
 
      ------------------------------ 
 
        FROM
              RTE_driver : VEN102;
 
        PROCEDURE
              sqldattime (VAR d : tsp00_Date;
                    VAR t       : tsp00_Time);
 
        PROCEDURE
              sqlfinish (terminate : boolean);
 
        PROCEDURE
              sqlinit (VAR component : tsp00_CompName;
                    canceladdr       : tsp00_BoolAddr);
 
        PROCEDURE
              sqlos (VAR os : tsp00_Os);
 
        PROCEDURE
              sqlresult (result : tsp00_Uint1);
 
        PROCEDURE
              sqltermid (VAR terminalid : tsp00_TermId);
 
        PROCEDURE
              sqlwrite (VAR text : tsp00_Line);
 
        PROCEDURE
              sqluid (VAR uid : tsp00_TaskId);
 
      ------------------------------ 
 
        FROM
              GG_edit_routines : VGG17;
 
        PROCEDURE
              g17nameto_line (n : tsp00_Name;
                    VAR ln_len  : integer;
                    VAR ln      : tsp00_Line);
 
        PROCEDURE
              g17sname_to_line (n : tsp00_Sname;
                    VAR ln_len    : integer;
                    VAR ln        : tsp00_Line);
 
      ------------------------------ 
 
        FROM
              Kernel_move_and_fill : VGG101;
 
        PROCEDURE
              SAPDB_PascalForcedFill (
                    size        : tsp00_Int4;
                    m           : tsp00_MoveObjPtr;
                    pos         : tsp00_Int4;
                    len         : tsp00_Int4;
                    fillchar    : char);
 
        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
              s30lnr (VAR str : tsp00_Line;
                    val   : char;
                    start : tsp00_Int4;
                    cnt   : tsp00_Int4) : tsp00_Int4;
 
      ------------------------------ 
 
        FROM
              TA_RTE_functions : VTA05;
 
        PROCEDURE
              t05getparam (VAR is_batch  : boolean;
                    VAR is_virt_term     : boolean;
                    VAR is_prompting     : boolean;
                    VAR is_command       : boolean;
                    VAR xusertype        : tsp4_xuser;
                    VAR username         : tsp00_KnlIdentifier;
                    VAR param_password   : tsp00_Pw;
                    VAR sqluser_pw       : tsp00_CryptPw;
                    VAR serverdb         : tsp00_DbName;
                    VAR servernode       : tsp00_NodeId;
                    VAR batch_fn         : tsp00_VFilename;
                    VAR param_line       : tsp00_Line;
                    VAR color_foreground : tsp00_VtColor;
                    VAR color_bright     : tsp00_VtColor;
                    VAR color_background : tsp00_VtColor;
                    VAR color_wng_foregr : tsp00_VtColor;
                    VAR color_wng_backgr : tsp00_VtColor;
                    VAR is_ok            : boolean);
 
      ------------------------------ 
 
        FROM
              TA_terminal_IO : VTA09;
 
        PROCEDURE
              t09endscreen (VAR term : tut_terminal);
 
        FUNCTION
              t09external_retcode (VAR t09 : tut_terminal) : integer;
 
        PROCEDURE
              t09frame (VAR term : tut_terminal; on : boolean);
 
        PROCEDURE
              t09getc256 (VAR term : tut_terminal;
                    msg           : tsp00_C20;
                    msg_attr      : char;
                    in_attr       : char;
                    in_len        : integer;
                    upper_case    : boolean;
                    VAR c256       : tsp00_VFilename;
                    VAR pfkey     : tut_pfkey);
 
        PROCEDURE
              t09header (VAR term : tut_terminal;
                    left_msg      : tsp00_C20;
                    right_msg     : tsp00_C20);
 
        PROCEDURE
              t09initscreen (VAR term : tut_terminal;
                    is_batch          : boolean;
                    is_virt_term      : boolean;
                    is_prompting      : boolean;
                    color_foreground  : tsp00_VtColor;
                    color_bright      : tsp00_VtColor;
                    color_background  : tsp00_VtColor;
                    color_wng_foregr  : tsp00_VtColor;
                    color_wng_backgr  : tsp00_VtColor;
                    VAR batch_fn      : tsp00_VFilename;
                    VAR param_ln      : tsp00_Line;
                    VAR is_ok         : boolean);
 
        PROCEDURE
              t09menu (VAR term  : tut_terminal;
                    size         : integer;
                    msg_attr     : char;
                    VAR msg      : tut_c20_array;
                    VAR selected : integer;
                    VAR pfkey    : tut_pfkey);
 
        PROCEDURE
              t09newscreen_page (VAR term : tut_terminal);
 
        PROCEDURE
              t09pfkeys (VAR term : tut_terminal; on : boolean);
 
        PROCEDURE
              t09put (VAR term : tut_terminal;
                    VAR text   : tsp00_Line;
                    text_attr  : char);
 
        FUNCTION
              t09retcode (VAR term : tut_terminal) : integer;
 
        PROCEDURE
              t09returncode_set (VAR term : tut_terminal;
                    retcode : integer);
 
        PROCEDURE
              t09uppercase_line (VAR ln : tsp00_Line;
                    lwb : integer;
                    upb : integer);
 
      ------------------------------ 
 
        FROM
              TA_write_protfile : VTA12;
 
        PROCEDURE
              t12create_prot (VAR fileref : tut_vf_fileref);
 
        PROCEDURE
              t12fncreate_prot (VAR fileref : tut_vf_fileref;
                    fn          : tsp00_VFilename;
                    append      : boolean;
                    VAR errtext : tsp00_ErrText;
                    VAR error   : integer);
 
        PROCEDURE
              t12write_prot (VAR fileref : tut_vf_fileref;
                    VAR ln    : tsp00_Line;
                    length    : integer;
                    VAR error : integer);
 
        PROCEDURE
              t12close_prot (VAR fileref : tut_vf_fileref);
 
      ------------------------------ 
 
        FROM
              UT_utility_driver : VUT02;
 
        PROCEDURE
              u02utility (VAR term  : tut_terminal;
                    VAR protfile    : tut_vf_fileref;
                    aid             : tsp00_TaskId;
                    VAR termid      : tsp00_TermId;
                    VAR xusertype   : tsp4_xuser;
                    VAR param_usern : tsp00_KnlIdentifier;
                    VAR sqluser_pw  : tsp00_CryptPw;
                    VAR serverdb    : tsp00_DbName;
                    VAR servernode  : tsp00_NodeId;
                    adbs_session    : boolean;
                    write_time      : boolean;
                    use_cmd_line    : boolean;
                    VAR cmd_line    : tsp00_Line;
                    VAR pfkey       : tut_pfkey);
 
      ------------------------------ 
 
        FROM
              UT_errormsg : VUT03;
 
        PROCEDURE
              u03getversion_no (VAR version_no : tsp00_Sname);
 
      ------------------------------ 
 
        FROM
              UT_auxiliary_procedures : VUT05;
 
        PROCEDURE
              u05encrypt (pw_clear : tsp00_Name;
                    VAR pw_crypt   : tsp00_CryptPw);
 
        PROCEDURE
              u05usewrite_prot (VAR protfile : tut_vf_fileref;
                    VAR blankln    : tsp00_Line;
                    VAR serverdb   : tsp00_DbName;
                    VAR servernode : tsp00_NodeId);
 
      ------------------------------ 
 
        FROM
              XT_kernprot : VXT02;
 
        PROCEDURE
              x02kernprot (VAR term : tut_terminal;
                    VAR protfile    : tut_vf_fileref;
                    VAR progname    : tsp00_C20;
                    VAR cmd_in_fn   : tsp00_VFilename;
                    cmd_token       : tsp00_Name;
                    VAR pfkey       : tut_pfkey);
 
      ------------------------------ 
 
        FROM
              XT_typebuf : VXT03;
 
        PROCEDURE
              x03typebuf (VAR term : tut_terminal;
                    VAR protfile   : tut_vf_fileref;
                    VAR progname   : tsp00_C20;
                    VAR fn         : tsp00_VFilename;
                    edit_file      : boolean;
                    VAR pfkey      : tut_pfkey);
 
      ------------------------------ 
 
        FROM
              XT_auxiliary_procedures : VXT05;
 
        PROCEDURE
              x05display_msg (VAR term : tut_terminal;
                    msg                : tsp00_C20;
                    is_warning         : boolean;
                    immediate_display  : boolean);
 
        PROCEDURE
              x05getversion_no (VAR version_no : tsp00_Sname);
 
        PROCEDURE
              x05handle_hexint (VAR term : tut_terminal;
                    adjust : boolean;
                    n      : tsp00_Name;
                    VAR ln : tsp00_Line);
 
        PROCEDURE
              x05hexint (VAR term : tut_terminal;
                    VAR protfile  : tut_vf_fileref;
                    VAR pfkey     : tut_pfkey);
 
        PROCEDURE
              x05hostfile_err (VAR term : tut_terminal;
                    io_msg  : tsp00_C6;
                    errtext : tsp00_ErrText);
 
        PROCEDURE
              x05version (VAR term : tut_terminal;
                    VAR protfile   : tut_vf_fileref);
 
.CM *-END-* use -----------------------------------------
.sp;.cp 3
Synonym :
 
        FUNCTION
              s30lnr;
 
              tsp00_Int4    tsp00_Int4
              tsp00_MoveObj tsp00_Line
 
        PROCEDURE
              t05getparam;
 
              tsp00_Pw tsp00_Name
 
        PROCEDURE
              t09getc256;
 
              tsp00_C256 tsp00_VFilename
 
        PROCEDURE
              t09put;
 
              tsp00_C80 tsp00_Line
 
        PROCEDURE
              u05encrypt;
 
              tsp00_Name tsp00_Pw
 
.CM *-END-* synonym -------------------------------------
.sp;.cp 3
Author  : JuergenA
.sp
.cp 3
Created : 1986-01-17
.sp
.cp 3
.sp
.cp 3
Release :      Date : 1999-10-28
.sp
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Specification:
 
.CM *-END-* specification -------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Description:
 
.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
      msg_diagnose  = 'DIAGNOSE            ';
      msg_editbuf   = 'EDITBUF             ';
      msg_hexint    = 'HEXINT              ';
      msg_kernprot  = 'KERNPROT            ';
      msg_typebuf   = 'TYPEBUF             ';
      msg_utility   = 'UTILITY             ';
      msg_util_diag = 'KERNEL/DIAGNOSE     ';
      msg_version   = 'DIAGNOSE VERSION    ';
      n_version     = 'VERSION           ';
      (* *)
      c_default_prot    = 'diag.prt          ';
      (* *)
      prot_linesize     =    72;
      rc_req_failed     = 10000;
      rc_sqlnotok       = -8888;
      rc_sqltasklimit   = -8026;
      rc_sqltimeout     =   700;
      retcode_undefined =    -1;
      retcode_sql_error =     1;
      retcode_rte_error =     2;
      retcode_sys_error =     9;
      (* *)
      c_adbs_session    = true;
      c_append          = true;
      c_immediate_displ = true;
      c_on              = true;
      c_upper_case      = true;
      c_warning         = true;
      c_write_prot      = true;
      c_write_term      = true;
      c_write_time      = true;
 
 
(*------------------------------*) 
 
PROCEDURE
      xt01header (VAR term : tut_terminal;
            VAR protfile   : tut_vf_fileref;
            write_prot     : boolean;
            write_term     : boolean;
            VAR progname   : tsp00_C20;
            VAR vers_no    : tsp00_Sname;
            VAR diag_funct : tsp00_C20);
 
VAR
      ln_len   : integer;
      pos      : integer;
      err      : integer;
      dat      : tsp00_Date;
      tim      : tsp00_Time;
      n        : tsp00_Sname;
      ln       : tsp00_Line;
 
BEGIN
IF  write_prot
THEN
    BEGIN
    t12write_prot (protfile, term.blankline, 1, err);
    SAPDB_PascalForcedFill (sizeof (ln), @ln, 1, prot_linesize, '*');
    t12write_prot (protfile, ln, prot_linesize, err)
    END;
(* '***', 5 * blank, progname, 2 * blank, vers_no *)
(*ENDIF*) 
s10mv (sizeof (progname), sizeof (n), @progname, 1, @n, 1, sizeof (n));
ln     := term.blankline;
ln [1] := '*';
ln [2] := '*';
ln [3] := '*';
ln_len := 3 + 5;
pos    := ln_len + 1;
g17sname_to_line (n, ln_len, ln);
ln_len := ln_len + 2;
g17sname_to_line (vers_no, ln_len, ln);
s10mv (sizeof (ln), sizeof (diag_funct), @ln, pos,
      @diag_funct, 1, sizeof (diag_funct));
IF  write_term
THEN
    t09header (term, diag_funct, bsp_c20);
(*ENDIF*) 
IF  write_prot
THEN
    BEGIN
    sqldattime (dat, tim);
    (* date, 2 * blank, time, 5 * blank, '***' *)
    ln_len         := prot_linesize - 3 - 5 - 8 - 2 - 10;
    ln [ln_len+ 1] := dat [1];
    ln [ln_len+ 2] := dat [2];
    ln [ln_len+ 3] := dat [3];
    ln [ln_len+ 4] := dat [4];
    ln [ln_len+ 5] := '-';
    ln [ln_len+ 6] := dat [5];
    ln [ln_len+ 7] := dat [6];
    ln [ln_len+ 8] := '-';
    ln [ln_len+ 9] := dat [7];
    ln [ln_len+10] := dat [8];
    ln_len         := ln_len + 10 + 2;
    ln [ln_len+ 1] := tim [3];
    ln [ln_len+ 2] := tim [4];
    ln [ln_len+ 3] := ':';
    ln [ln_len+ 4] := tim [5];
    ln [ln_len+ 5] := tim [6];
    ln [ln_len+ 6] := ':';
    ln [ln_len+ 7] := tim [7];
    ln [ln_len+ 8] := tim [8];
    ln_len         := ln_len + 8 + 5;
    ln [ln_len+ 1] := '*';
    ln [ln_len+ 2] := '*';
    ln [ln_len+ 3] := '*';
    t12write_prot (protfile, ln, prot_linesize, err);
    SAPDB_PascalForcedFill (sizeof (ln), @ln, 1, prot_linesize, '*');
    t12write_prot (protfile, ln, prot_linesize, err)
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      xt01diagnose (VAR term : tut_terminal;
            VAR protfile     : tut_vf_fileref;
            aid              : tsp00_TaskId;
            VAR termid       : tsp00_TermId;
            VAR xusertype    : tsp4_xuser;
            VAR username     : tsp00_KnlIdentifier;
            VAR sqluser_pw   : tsp00_CryptPw;
            VAR serverdb     : tsp00_DbName;
            VAR servernode   : tsp00_NodeId;
            is_command       : boolean;
            VAR cmd_line     : tsp00_Line);
 
CONST
      x_kernprot  =  1;
      x_typebuf   =  3;
      x_editbuf   =  5;
      x_utility   =  7;
      x_version   =  9;
      x_hexint    =  11;
      x_exit      =  15;
 
VAR
      prot_created : boolean;
      pfkey        : tut_pfkey;
      cmd_line_pos : integer;
      i            : integer;
      selected     : integer;
      prog         : tsp00_C20;
      diag_funct   : tsp00_C20;
      last_header  : tsp00_C20;
      dummy_c20    : tsp00_C20;
      vers_no      : tsp00_Sname;
      cmd_token    : tsp00_Name;
      in_fn        : tsp00_VFilename;
      cmd_out_fn   : tsp00_VFilename;
      msg          : tut_c20_array;
 
BEGIN
pfkey        := pf_none;
prog         := bsp_c20;
cmd_line_pos := 1;
in_fn        := term.blankfilename;
cmd_out_fn   := term.blankfilename;
cmd_token    := bsp_name;
FOR i := 1 TO sizeof (serverdb) DO
    prog [i] := serverdb [i];
(*ENDFOR*) 
IF  (prog = msg_kernprot) OR (prog = msg_typebuf)
THEN
    BEGIN
    IF  is_command AND (prog = msg_kernprot)
    THEN
        BEGIN
        xt01extract_filename     (cmd_line, cmd_line_pos, term.blankfilename, cmd_out_fn);
        xt01extract_filename     (cmd_line, cmd_line_pos, term.blankfilename, in_fn);
        xt01extract_trace_option (cmd_line, cmd_line_pos, cmd_token)
        END
    (*ENDIF*) 
    END
ELSE
    IF  prog <> msg_editbuf
    THEN
        BEGIN
        prog := msg_diagnose;
        IF  is_command
        THEN
            BEGIN
            t09uppercase_line (cmd_line, 1, LINE_MXSP00);
            FOR i := 1 TO sizeof (cmd_token) DO
                cmd_token [i] := cmd_line [i];
            (*ENDFOR*) 
            IF  cmd_token = n_version
            THEN
                x05version (term, protfile)
            ELSE
                BEGIN
                x05handle_hexint (term, false, cmd_token, cmd_line);
                t09put (term, cmd_line, cut_protected)
                END;
            (*ENDIF*) 
            pfkey := pf_cancel
            END
        (*ENDIF*) 
        END;
    (*ELSE*)
    (*ENDIF*) 
(*ENDIF*) 
IF  pfkey = pf_none
THEN
    BEGIN
    diag_funct  := bsp_c20;
    last_header := bsp_c20;
    t09frame  (term, c_on);
    t09pfkeys (term, c_on);
    x05getversion_no (vers_no);
    xt01header (term, protfile, NOT c_write_prot,
          (cmd_token = bsp_name), prog, vers_no, dummy_c20);
    xt01open_protfile (term, protfile, cmd_out_fn, prot_created, pfkey)
    END;
(*ENDIF*) 
IF  pfkey = pf_none
THEN
    BEGIN
    prog        := bsp_c20;
    diag_funct  := bsp_c20;
    last_header := bsp_c20;
    FOR i := 1 TO sizeof (serverdb) DO
        prog [i] := serverdb [i];
    (*ENDFOR*) 
    IF  (prog = msg_editbuf ) OR
        (prog = msg_kernprot) OR
        (prog = msg_typebuf )
    THEN
        xt01header (term, protfile, c_write_prot,
              (cmd_token = bsp_name), prog, vers_no, diag_funct)
    ELSE
        prog := msg_diagnose
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  (pfkey = pf_none) AND (prog <> msg_diagnose)
THEN
    BEGIN
    IF  (prog = msg_editbuf) OR (prog = msg_typebuf)
    THEN
        BEGIN
        x03typebuf (term, protfile, diag_funct, in_fn,
              (prog = msg_editbuf), pfkey);
        pfkey := pf_cancel
        END
    ELSE
        IF  prog = msg_kernprot
        THEN
            BEGIN
            x02kernprot (term, protfile, diag_funct,
                  in_fn, cmd_token, pfkey);
            pfkey := pf_cancel
            END
        (*ENDIF*) 
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  pfkey = pf_none
THEN
    BEGIN
    FOR selected := 1 TO x_exit DO
        msg [ selected ] :=  bsp_c20;
    (*ENDFOR*) 
    msg [x_kernprot ] := msg_kernprot;
    msg [x_typebuf  ] := msg_typebuf;
    msg [x_editbuf  ] := msg_editbuf;
    msg [x_utility  ] := msg_util_diag; (* PTS 1104396 JA 1999-10-28 *)
    msg [x_version  ] := msg_version;
    msg [x_hexint   ] := msg_hexint;
    msg [x_exit     ] := 'EXIT                ';
    (* *)
    WHILE (pfkey <> pf_cancel) AND (pfkey <> pf_end) DO
        BEGIN
        t09returncode_set (term, 0);
        xt01header (term, protfile, NOT c_write_prot,
              c_write_term, prog, vers_no, dummy_c20);
        t09menu (term, x_exit, cut_protected, msg, selected, pfkey);
        IF  pfkey = pf_none
        THEN
            BEGIN
            IF  (last_header <> msg [selected])
                AND
                ((selected = x_editbuf  ) OR
                ( selected = x_kernprot ) OR
                ( selected = x_typebuf ))
            THEN
                xt01header (term, protfile, c_write_prot, c_write_term,
                      msg [selected ], vers_no, diag_funct);
            (*ENDIF*) 
            CASE selected OF
                x_kernprot:
                    x02kernprot (term, protfile, diag_funct,
                          in_fn, cmd_token, pfkey);
                x_typebuf, x_editbuf:
                    x03typebuf (term, protfile, diag_funct, in_fn,
                          (selected = x_editbuf), pfkey);
                x_utility:
                    BEGIN
                    t09pfkeys (term, NOT c_on);
                    u02utility (term, protfile, aid, termid, xusertype,
                          username, sqluser_pw, serverdb, servernode,
                          NOT c_adbs_session,
                          c_write_time, is_command, cmd_line, pfkey);
                    t09pfkeys (term, c_on);
                    END;
                x_version:
                    x05version (term, protfile);
                x_hexint:
                    BEGIN
                    IF  last_header = bsp_c20
                    THEN
                        BEGIN
                        last_header := prog;
                        xt01header (term, protfile, c_write_prot,
                              c_write_term, prog, vers_no, dummy_c20)
                        END;
                    (*ENDIF*) 
                    x05hexint (term, protfile, pfkey)
                    END;
                x_exit:
                    pfkey := pf_cancel;
                OTHERWISE ;
                END
            (*ENDCASE*) 
            END
        (*ENDIF*) 
        END
    (*ENDWHILE*) 
    END;
(*ENDIF*) 
IF  NOT is_command
THEN
    x05display_msg (term, 'SESSION END         ', NOT c_warning,
          c_immediate_displ)
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      xt01open_protfile (VAR term : tut_terminal;
            VAR protfile          : tut_vf_fileref;
            VAR cmd_out_fn        : tsp00_VFilename;
            VAR prot_created      : boolean;
            VAR pfkey             : tut_pfkey);
 
VAR
      use_cmd_fn : boolean;
      append     : boolean;
      err        : integer;
      i          : integer;
      len        : integer;
      count      : integer;
      errtext    : tsp00_ErrText;
      n          : tsp00_Name;
      default_fn : tsp00_VFilename;
      prot_fn    : tsp00_VFilename;
 
BEGIN
default_fn := term.blankfilename;
use_cmd_fn := (cmd_out_fn <> term.blankfilename);
count      := 0;
err        := 0;
n          := c_default_prot;
FOR i := 1 TO sizeof (n) DO
    default_fn [i] := n [i];
(*ENDFOR*) 
IF  use_cmd_fn
THEN
    prot_fn := cmd_out_fn
ELSE
    prot_fn := default_fn;
(*ENDIF*) 
REPEAT
    t09returncode_set (term, 0);
    count  := count + 1;
    err    := 0;
    append := false;
    IF  NOT use_cmd_fn
    THEN
        BEGIN
        t09newscreen_page (term);
        t09getc256 (term, '      PROT FILENAME:', cut_protected,
              cut_bright_unprotected, sizeof (prot_fn),
              NOT c_upper_case, prot_fn, pfkey)
        END;
    (*ENDIF*) 
    IF  pfkey = pf_none
    THEN
        BEGIN
        IF  prot_fn = default_fn
        THEN
            append := true
        ELSE
            BEGIN
            len := sizeof (prot_fn);
            WHILE (len > 4) AND (prot_fn [len] = ' ') DO
                len := len - 1;
            (*ENDWHILE*) 
            IF  (prot_fn [len-3] <> '.') OR
                (prot_fn [len-2] <> 'p') OR
                (prot_fn [len-1] <> 'r') OR
                (prot_fn [len  ] <> 't')
            THEN
                BEGIN
                errtext := 'FILE NAME EXTENSION ''.prt'' MISSING      ';
                err     := 1
                END
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        IF  err = 0
        THEN
            t12fncreate_prot (protfile, prot_fn, append, errtext, err);
        (*ENDIF*) 
        IF  err <> 0
        THEN
            x05hostfile_err (term, 'OPEN  ', errtext)
        (*ENDIF*) 
        END
    (*ENDIF*) 
UNTIL
    (err = 0) OR (count >= 3) OR (pfkey <> pf_none) OR use_cmd_fn;
(*ENDREPEAT*) 
IF  pfkey = pf_none
THEN
    BEGIN
    IF  err <> 0
    THEN
        pfkey := pf_cancel
    ELSE
        prot_created := true
    (*ENDIF*) 
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ut01create_prot (VAR blankfilename : tsp00_VFilename;
            VAR protfile : tut_vf_fileref;
            VAR termid   : tsp00_TermId);
 
CONST
      prot_os2      = 'util.prt          ';
      prot_unix     = 'util.prot         ';
      prot_unix_ext = 'prot              ';
      prot_vms      = 'RVX_UTIL_DN       ';
      prot_windows  = 'util.prt          ';
      prot_win32    = 'util.prt          ';
      (* *)
      unix_prefix_len    = 4;
      unix_extension_len = 4;
 
VAR
      os          : tsp00_Os;
      i           : integer;
      start_pos   : integer;
      end_pos     : integer;
      n           : tsp00_Name;
      n_extension : tsp00_Name;
      fn          : tsp00_VFilename;
      dummy_err   : integer;
      dummy_txt   : tsp00_ErrText;
 
BEGIN
sqlos (os);
CASE os OF
    os_os2:
        n := prot_os2;
    os_unix:
        n := prot_unix;
    os_vms:
        n := prot_vms;
    os_windows:
        n := prot_windows;
    os_win32:
        n := prot_win32;
    OTHERWISE
        n := bsp_name
    END;
(*ENDCASE*) 
IF  n = bsp_name
THEN
    t12create_prot (protfile)
ELSE
    BEGIN
    fn := blankfilename;
    IF  (os <> os_unix) OR (termid = bsp_c18)
    THEN
        FOR i := 1 TO sizeof (n) DO
            fn [i] := n [i]
        (*ENDFOR*) 
    ELSE
        BEGIN
        end_pos := sizeof (termid);
        WHILE termid [end_pos] = ' ' DO
            end_pos := end_pos - 1;
        (*ENDWHILE*) 
        start_pos := end_pos;
        WHILE (termid [start_pos] in ['0'..'9'])
              AND (start_pos > 1) DO
            start_pos := start_pos - 1;
        (*ENDWHILE*) 
        IF  termid [start_pos] = 'p'
        THEN
            start_pos := start_pos - 1;
        (*ENDIF*) 
        start_pos := start_pos + 1;
        FOR i := 1 TO unix_prefix_len DO
            fn [i] := n [i];
        (*ENDFOR*) 
        i := unix_prefix_len + 1;
        WHILE (start_pos <= end_pos) AND (i <= sizeof (fn)) DO
            BEGIN
            fn [i]    := termid [start_pos];
            start_pos := start_pos + 1;
            i         := i + 1
            END;
        (*ENDWHILE*) 
        n_extension := prot_unix_ext;
        IF  i + unix_extension_len <= sizeof (fn)
        THEN
            BEGIN
            fn [i]    := '.';
            start_pos := i;
            FOR i := 1 TO unix_extension_len DO
                fn [start_pos+i] := n_extension [i]
            (*ENDFOR*) 
            END
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    t12fncreate_prot (protfile, fn, c_append, dummy_txt, dummy_err)
    END
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ut01finish_utility (VAR term : tut_terminal;
            VAR protfile : tut_vf_fileref);
 
VAR
      kernel_retcode   : integer;
      external_retcode : integer;
 
BEGIN
external_retcode := t09external_retcode (term);
IF  external_retcode = retcode_undefined
THEN
    BEGIN
    kernel_retcode := t09retcode (term);
    IF  kernel_retcode <= -9000
    THEN
        external_retcode := retcode_sys_error
    ELSE
        IF  (kernel_retcode = rc_req_failed  ) OR
            (kernel_retcode = rc_sqlnotok    ) OR
            (kernel_retcode = rc_sqltasklimit) OR
            (kernel_retcode = rc_sqltimeout  )
        THEN
            external_retcode := retcode_rte_error
        ELSE
            IF  kernel_retcode <> 0
            THEN
                external_retcode := retcode_sql_error
            ELSE
                external_retcode := 0
            (*ENDIF*) 
        (*ENDIF*) 
    (*ENDIF*) 
    END;
(*ENDIF*) 
t09endscreen  (term);
t12close_prot (protfile);
sqlresult (external_retcode);
sqlfinish (true)
END;
 
(*------------------------------*) 
 
PROCEDURE
      xt01extract_filename (
            VAR cmd_ln        : tsp00_Line;
            VAR cmd_ln_pos    : integer;
            VAR blankfilename : tsp00_VFilename;
            VAR fn            : tsp00_VFilename);
 
CONST
      c_double_quote  = '"';
 
VAR
      i             : integer;
      bOpenBrackets : boolean;
      bStop         : boolean;
 
BEGIN
bOpenBrackets := false;
bStop         := false;
fn            := blankfilename;
WHILE (cmd_ln [cmd_ln_pos] = ' ') AND (cmd_ln_pos < sizeof (cmd_ln)) DO
    cmd_ln_pos := cmd_ln_pos + 1;
(*ENDWHILE*) 
i := 1;
WHILE (NOT bStop) AND (cmd_ln_pos <  sizeof (cmd_ln)) AND (i <= sizeof (fn)) DO
    BEGIN
    IF  (cmd_ln [cmd_ln_pos] = bsp_c1) AND (NOT bOpenBrackets)
    THEN
        bStop := true
    ELSE
        BEGIN
        IF  cmd_ln [cmd_ln_pos] = c_double_quote
        THEN
            bOpenBrackets := NOT bOpenBrackets
        ELSE
            BEGIN
            fn [i] := cmd_ln [cmd_ln_pos];
            i      := i + 1
            END;
        (*ENDIF*) 
        cmd_ln_pos := cmd_ln_pos + 1;
        END
    (*ENDIF*) 
    END
(*ENDWHILE*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      xt01extract_trace_option (VAR cmd_ln : tsp00_Line;
            VAR cmd_ln_pos : integer;
            VAR token      : tsp00_Name);
 
VAR
      i : integer;
 
BEGIN
token := bsp_name;
WHILE (cmd_ln [cmd_ln_pos] = ' ') AND (cmd_ln_pos < sizeof (cmd_ln)) DO
    cmd_ln_pos := cmd_ln_pos + 1;
(*ENDWHILE*) 
i := 1;
WHILE (cmd_ln [cmd_ln_pos] <> ' ')
      AND (cmd_ln_pos <  sizeof (cmd_ln))
      AND (i          <= sizeof (token )) DO
    BEGIN
    token [i]  := cmd_ln [cmd_ln_pos];
    cmd_ln_pos := cmd_ln_pos + 1;
    i          := i + 1
    END
(*ENDWHILE*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ut01init_utility (VAR term : tut_terminal;
            VAR protfile         : tut_vf_fileref;
            VAR utility_only     : boolean;
            VAR aid              : tsp00_TaskId;
            VAR termid           : tsp00_TermId;
            VAR xusertype        : tsp4_xuser;
            VAR username         : tsp00_KnlIdentifier;
            VAR param_password   : tsp00_Pw;
            VAR sqluser_pw       : tsp00_CryptPw;
            VAR serverdb         : tsp00_DbName;
            VAR servernode       : tsp00_NodeId;
            VAR use_cmd_line     : boolean;
            VAR cmd_line         : tsp00_Line;
            VAR pfkey            : tut_pfkey);
 
VAR
      is_batch         : boolean;
      is_ok            : boolean;
      is_prompting     : boolean;
      is_virt_term     : boolean;
      color_foreground : tsp00_VtColor;
      color_bright     : tsp00_VtColor;
      color_background : tsp00_VtColor;
      color_wng_foregr : tsp00_VtColor;
      color_wng_backgr : tsp00_VtColor;
      ln_len           : integer;
      i                : integer;
      prot_err         : integer;
      dat              : tsp00_Date;
      tim              : tsp00_Time;
      progname         : tsp00_Sname;
      version_no       : tsp00_Sname;
      prog             : tsp00_C20;
      batch_fn         : tsp00_VFilename;
      ln               : tsp00_Line;
      component        : tsp00_CompName;
 
BEGIN
FOR i := 1 TO sizeof(term.blankfilename) DO
    term.blankfilename [i] := ' ';
(*ENDFOR*) 
pfkey        := pf_none;
is_ok        := true;
utility_only := false;
use_cmd_line := false;
component    := bsp_c64;
progname     := 'DIAGNOSE    ';
protfile.utvf_handle  := 0;
term.is_virt_term     := false;
term.curr_inputfile   := 0;
term.retcode_external := retcode_undefined;
term.use_script       := true;
t09returncode_set (term, 0);
FOR i := 1 TO sizeof (progname) DO
    component [i] := progname [i];
(*ENDFOR*) 
sqlinit (component, @term.is_reset_called);
sqluid (aid);
termid := bsp_termid;
sqltermid (termid);
color_foreground := vt_white;
color_bright     := vt_white;
color_background := vt_blue;
color_wng_foregr := vt_white;
color_wng_backgr := vt_red;
t05getparam (is_batch, is_virt_term, is_prompting, use_cmd_line,
      xusertype, username, param_password, sqluser_pw, serverdb,
      servernode, batch_fn, ln, color_foreground, color_bright,
      color_background, color_wng_foregr, color_wng_backgr, is_ok);
IF  is_ok
THEN
    BEGIN
    prog := bsp_c20;
    FOR i := 1 TO sizeof (serverdb) DO
        prog [i] := serverdb [i];
    (*ENDFOR*) 
    utility_only :=
          (prog = msg_utility)
          OR
          ((username <> bsp_c64      ) AND
          ( serverdb <> bsp_dbname   ) AND
          ( prog     <> msg_editbuf  ) AND
          ( prog     <> msg_kernprot ) AND
          ( prog     <> msg_typebuf  ));
    IF  prog = msg_utility
    THEN
        serverdb := bsp_dbname
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  is_ok AND NOT utility_only
THEN
    (* set diagnose color *)
    BEGIN
    color_foreground := vt_blue;
    color_bright     := vt_red;
    color_background := vt_white;
    color_wng_foregr := vt_white;
    color_wng_backgr := vt_red;
    t05getparam (is_batch, is_virt_term, is_prompting, use_cmd_line,
          xusertype, username, param_password, sqluser_pw, serverdb,
          servernode, batch_fn, ln, color_foreground, color_bright,
          color_background, color_wng_foregr, color_wng_backgr, is_ok)
    END;
(*ENDIF*) 
IF  is_ok
THEN
    BEGIN
    IF  use_cmd_line
    THEN
        cmd_line := ln;
    (*ENDIF*) 
    t09initscreen (term, is_batch, is_virt_term,
          is_prompting, color_foreground, color_bright,
          color_background, color_wng_foregr, color_wng_backgr,
          batch_fn, ln, is_ok);
    IF  NOT is_ok
    THEN
        BEGIN
        SAPDB_PascalForcedFill (sizeof (ln), @ln, 1, sizeof (ln), ' ');
        ln_len := 0;
        g17sname_to_line ('*** TERMINAL', ln_len, ln);
        g17sname_to_line (' init failed', ln_len, ln);
        sqlwrite(ln)
        END
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  NOT is_ok
THEN
    BEGIN
    t09returncode_set (term, retcode_rte_error);
    pfkey := pf_cancel
    END
ELSE
    IF  utility_only
    THEN
        BEGIN
        ut01create_prot (term.blankfilename, protfile, termid);
        t12write_prot (protfile, term.blankline, 1, prot_err);
        IF  prot_err = 0
        THEN
            BEGIN
            ln     := term.blankline;
            ln_len := 0;
            g17sname_to_line ('-----       ', ln_len, ln);
            ln_len := ln_len + 1;
            g17nameto_line ('KERNEL/DIAGNOSE   ', ln_len, ln); (* PTS 1104396 JA 1999-10-28 *)
            ln_len := ln_len + 2;
            u03getversion_no (version_no);
            g17sname_to_line (version_no, ln_len, ln);
            ln_len      := ln_len + 3;
            ln [ln_len] := '(';
            sqldattime (dat, tim);
            ln [ln_len+ 1] := dat[1]; (* year *)
            ln [ln_len+ 2] := dat[2];
            ln [ln_len+ 3] := dat[3]; (* year *)
            ln [ln_len+ 4] := dat[4];
            ln [ln_len+ 5] := '-';
            ln [ln_len+ 6] := dat[5]; (* month *)
            ln [ln_len+ 7] := dat[6];
            ln [ln_len+ 8] := '-';
            ln [ln_len+ 9] := dat[7]; (* day *)
            ln [ln_len+10] := dat[8];
            ln_len := ln_len + 10 + 1;
            ln [ln_len+ 1] := tim[3]; (* hour *)
            ln [ln_len+ 2] := tim[4];
            ln [ln_len+ 3] := ':';
            ln [ln_len+ 4] := tim[5]; (* min *)
            ln [ln_len+ 5] := tim[6];
            ln [ln_len+ 6] := ':';
            ln [ln_len+ 7] := tim[7]; (* sec *)
            ln [ln_len+ 8] := tim[8];
            ln [ln_len+ 9] := ')';
            SAPDB_PascalForcedFill (sizeof (ln), @ln, ln_len+11, prot_linesize, '-');
            t12write_prot (protfile, ln, prot_linesize, prot_err)
            END;
        (*ENDIF*) 
        IF  (prot_err = 0) AND is_batch
        THEN
            BEGIN
            ln     := term.blankline;
            ln_len := 0;
            g17sname_to_line ('BATCH FILE  ', ln_len, ln);
            IF  t09retcode (term) <> 0
            THEN
                BEGIN
                g17sname_to_line (' NOT FOUND  ', ln_len, ln);
                t09returncode_set (term, retcode_rte_error);
                pfkey := pf_cancel
                END;
            (*ENDIF*) 
            ln[ ln_len+1 ] := ':';
            s10mv (sizeof (batch_fn), sizeof (ln),
                  @batch_fn, 1, @ln, ln_len+3, sizeof (batch_fn));
            ln_len := s30lnr(ln, ' ', 1, ln_len + 2 + sizeof(batch_fn));
            t12write_prot (protfile, ln, ln_len, prot_err)
            END;
        (*ENDIF*) 
        IF  (prot_err = 0) AND
            (xusertype <> sp4xu_sql_usermask) AND
            (serverdb  <> bsp_dbname)
        THEN
            u05usewrite_prot (protfile, term.blankline,
                  serverdb, servernode)
        (*ENDIF*) 
        END
    (*ENDIF*) 
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      ut01start_utility;
 
VAR
      pfkey          : tut_pfkey;
      use_cmd_line   : boolean;
      utility_only   : boolean;
      xusertype      : tsp4_xuser;
      aid            : tsp00_TaskId;
      termid         : tsp00_TermId;
      protfile       : tut_vf_fileref;
      username       : tsp00_KnlIdentifier;
      sqluser_pw     : tsp00_CryptPw;
      param_password : tsp00_Pw;
      serverdb       : tsp00_DbName;
      servernode     : tsp00_NodeId;
      cmd_line       : tsp00_Line;
      term           : tut_terminal;
 
BEGIN
pfkey := pf_none;
a101_CreateErrorHandler;
ut01init_utility (term, protfile, utility_only, aid, termid,
      xusertype, username,
      param_password, sqluser_pw, serverdb, servernode, use_cmd_line,
      cmd_line, pfkey);
IF  (pfkey = pf_none) AND utility_only
THEN
    BEGIN
    IF  (xusertype = sp4xu_sql_userparms) AND
        (param_password <> bsp_name)
    THEN
        u05encrypt (param_password, sqluser_pw);
    (*ENDIF*) 
    IF  (username = bsp_c64) OR (serverdb = bsp_dbname)
    THEN
        xusertype := sp4xu_sql_usermask;
    (*ENDIF*) 
    u02utility (term, protfile, aid, termid, xusertype, username,
          sqluser_pw, serverdb, servernode,
          NOT c_adbs_session, c_write_time, use_cmd_line,
          cmd_line, pfkey)
    END
ELSE
    IF  pfkey = pf_none
    THEN
        xt01diagnose (term, protfile, aid, termid, xusertype, username,
              sqluser_pw, serverdb, servernode, use_cmd_line, cmd_line);
    (*ENDIF*) 
(*ENDIF*) 
ut01finish_utility (term, protfile)
END;
 
&ifdef WINDOWS
(*------------------------------*) 
 
FUNCTION
      sqldcinit (
            VAR language : tsp00_C3) : integer;
 
VAR
      cancel_bool_ptr : tsp00_BoolAddr;
 
BEGIN
cancel_bool_ptr := @u01cancel;
sqldcinit       := 0;
END;
 
(*------------------------------*) 
 
PROCEDURE
      sqldcterminate (
            VAR g : component_global_var );
 
BEGIN
END;
 
(*------------------------------*) 
 
FUNCTION
      sqldccallback (
            VAR g           : tsp00_MoveObj;
            term_ref        : tsp00_Int4;
            key             : tsp00_VtKey;
            context         : tsp00_BufAddr;
            callback_switch : tsp00_Int2) : tsp00_DgcallbackResult;
 
BEGIN
sqldccallback := dg_ok;
END;
 
&endif
&ifdef WINDOWS
(*------------------------------*) 
 
PROCEDURE
      sqldcmain (
            VAR g : component_global_var );
 
BEGIN
ut01start_utility
END;
 
&else
(*------------------------------*) 
 
PROCEDURE
      xt01main;
 
BEGIN
ut01start_utility
END;
 
&endif
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
.PA 
