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:
- **FREE
-
- Ctl-Opt OPENOPT(*NOINZOFL) OPTION(*NODEBUGIO:*SRCSTMT);
- Ctl-Opt NOMAIN;
-
- Dcl-Ds APIERR Inz QUALIFIED;
- Len Int(10) Inz(%size(APIERR));
- RtnLen Int(10) Inz(0);
- CpfMsgID Char(7);
- apiResv1t Char(1);
- APIErrDta Char(240);
- End-Ds;
-
- //
- // Procedure name: RtvSysName RTVSYSNAME
- // Purpose: Return the system name
- // Returns: System name as seen on DSPNETA as Current System Name
- //
- Dcl-Proc RtvSysName Export;
- Dcl-Pi RtvSysName Char(8) End-Pi;
- Dcl-Pr QWCRNETA ExtPgm('QWCRNETA');
- RECEIVED_DATA LIKE(Receiver_T);
- LEN_OF_RECEIVER Int(10) CONST;
- NUM_ATTRS_TO_GET Int(10) CONST;
- ARRAY_OF_NET_ATTRS Char(10) CONST;
- IO_ERROR LIKE(APIERR);
- End-Pr;
-
- Dcl-Ds Receiver_T Qualified Template;
- NumAttrs Int(10);
- AttrsOffLen Int(10);
- DummyofNetAtr LIKE(NetAtr_T);
- End-Ds;
-
- Dcl-Ds NetAtr_T QUALIFIED Template;
- Name Char(10);
- Type Char(1);
- Inf_Status Char(1);
- Len Int(10);
- Data Char(256);
- End-Ds;
-
- // Local fields
- Dcl-S SysName Char(8);
- Dcl-ds Receiver LIkeds(Receiver_T);
- Dcl-S ReceiverPtr Pointer;
- Dcl-ds NetAtr Likeds(NetAtr_T) Based(ReceiverPtr);
-
- Clear ApiErr;
- ApiErr.Len=%size(APIERR);
- CALLP QWCRNETA(Receiver:%LEN(Receiver):1:'SYSNAME':APIERR);
- If APIERR.RtnLen = 0;
- ReceiverPtr = %ADDR(Receiver)+Receiver.AttrsOffLen;
- SysName = NetAtr.Data;
- Return SysName;
- Else;
- Return *BLANKS;
- Endif;
-
- End-Proc RtvSysName;
-
-
-
- create function &LIB/RtvSysName ()
- returns char(8)
- language rpgle
- specific &LIB/UTLSRVFN01
- deterministic
- no sql
- returns null on null input
- disallow parallel
- not fenced
- external name '&LIB/UTLSRVPGM(RTVSYSNAME)'
- parameter style general ;
-
- comment on specific function &LIB/UTLSRVFN01
- is 'Return the system name ';
-
-
|
|
|