midrange.com code scratchpad
Name:
RtvSysName
Scriptlanguage:
SQL
Tabwidth:
4
Date:
08/16/2022 05:16:24 pm
IP:
Logged
Description:
Use QWCRNETA to get system name. Wrap with SQL Function.
Code:
  1. **FREE
  2.  
  3. Ctl-Opt OPENOPT(*NOINZOFL) OPTION(*NODEBUGIO:*SRCSTMT);
  4. Ctl-Opt NOMAIN;
  5.  
  6. Dcl-Ds APIERR Inz QUALIFIED;
  7.   Len Int(10) Inz(%size(APIERR));
  8.   RtnLen Int(10) Inz(0);
  9.   CpfMsgID Char(7);
  10.   apiResv1t Char(1);
  11.   APIErrDta Char(240);
  12. End-Ds;
  13.  
  14. //--------------------------------------------------
  15. // Procedure name: RtvSysName                          RTVSYSNAME
  16. // Purpose:        Return the system name
  17. // Returns:        System name as seen on DSPNETA as Current System Name
  18. //--------------------------------------------------
  19. Dcl-Proc RtvSysName Export;
  20. Dcl-Pi RtvSysName Char(8) End-Pi;
  21. Dcl-Pr QWCRNETA ExtPgm('QWCRNETA');
  22.   RECEIVED_DATA LIKE(Receiver_T);
  23.   LEN_OF_RECEIVER Int(10) CONST;
  24.   NUM_ATTRS_TO_GET Int(10) CONST;
  25.   ARRAY_OF_NET_ATTRS Char(10) CONST;
  26.   IO_ERROR LIKE(APIERR);
  27. End-Pr;
  28.  
  29. Dcl-Ds Receiver_T Qualified Template;
  30.   NumAttrs Int(10);
  31.   AttrsOffLen Int(10);
  32.   DummyofNetAtr LIKE(NetAtr_T);
  33. End-Ds;
  34.  
  35. Dcl-Ds NetAtr_T QUALIFIED Template;
  36.   Name Char(10);
  37.   Type Char(1);
  38.   Inf_Status Char(1);
  39.   Len Int(10);
  40.   Data Char(256);
  41. End-Ds;
  42.  
  43. // Local fields
  44. Dcl-S SysName Char(8);
  45. Dcl-ds Receiver LIkeds(Receiver_T);
  46. Dcl-S ReceiverPtr Pointer;
  47. Dcl-ds NetAtr Likeds(NetAtr_T) Based(ReceiverPtr);
  48.  
  49. Clear ApiErr;
  50. ApiErr.Len=%size(APIERR);
  51. CALLP QWCRNETA(Receiver:%LEN(Receiver):1:'SYSNAME':APIERR);
  52. If APIERR.RtnLen = 0;
  53.   ReceiverPtr = %ADDR(Receiver)+Receiver.AttrsOffLen;
  54.   SysName = NetAtr.Data;
  55.   Return SysName;
  56. Else;
  57.   Return *BLANKS;
  58. Endif;
  59.  
  60. End-Proc RtvSysName;
  61.  
  62.  -----------------------------------------------------------------------------------------------------------------
  63.  
  64. create function &LIB/RtvSysName () 
  65.   returns char(8)
  66.   language rpgle
  67.   specific &LIB/UTLSRVFN01
  68.   deterministic
  69.   no sql
  70.   returns null on null input
  71.   disallow parallel
  72.   not fenced
  73.   external name '&LIB/UTLSRVPGM(RTVSYSNAME)'
  74.   parameter style general ;
  75.  
  76. comment on specific function &LIB/UTLSRVFN01
  77. is 'Return the system name   ';
  78.  
  79.  
© 2004-2019 by midrange.com generated in 0.021s valid xhtml & css