|
midrange.com
Hi Mike,
On Tue, 27 Jun 2000, Mike Silvers wrote:
> I was hoping that someone would know a way in RPGIV......I was trying
> to avoid using CL. Anyone know a way in RPGIV???
> Thanks
> Mike
Sure, I know a way in RPG IV... :) Of course, its not nearly as simple
as calling the CL RTVNETA command, it actually involves calling an API.
But, if you wanted to make a service program, you could make it just as
easy to use as the CL command...
The API you need to use is called QWCRNETA and its documented in the
Work Management API manual.
As an example, I created a subprocedure (designed to be easily made into a
service program) that illustrates using this API to get the system name.
Hope you find it useful. Here it is:
** Note: To do this right, we should put this prototype into
* a /COPY member. (but will work okay as-is)
D RtvSysName PR 10I 0
D SystemName 8A
C if RtvSysName(MyName) < 0
c eval Msg = 'RtvSysName ended in error!'
c dsply Msg 50
c else
c dsply MyName 8
c endif
c eval *inlr = *on
** Note: If we wanted to do this right, the code below should
* be seperated into a service program (but will work
* okay as-is)
*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* Retrieve System Name procedure: RtvSysName
*
* Parm: SysName = name of system returned.
*
* Returns: 0 = Success
* negative value if an error occurred. See below
* for a list of possible negative values.
*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P RtvSysName B Export
D RtvSysName PI 10I 0
D SysName 8A
D QWCRNETA PR ExtPgm('QWCRNETA')
D RcvVar 32766A OPTIONS(*VARSIZE)
D RcvVarLen 10I 0 const
D NbrNetAtr 10I 0 const
D AttrNames 10A const
D ErrorCode 256A
D* Error code structure
D EC DS
D* Bytes Provided (size of struct)
D EC_BytesP 1 4B 0 INZ(256)
D* Bytes Available (returned by API)
D EC_BytesA 5 8B 0 INZ(0)
D* Msg ID of Error Msg Returned
D EC_MsgID 9 15
D* Reserved
D EC_Reserve 16 16
D* Msg Data of Error Msg Returned
D EC_MsgDta 17 256
D* Receiver variable for QWCRNETA with only one attribute
D RV ds
D* Number of Attrs returned
D RV_Attrs 10I 0
D* Offset to first attribute
D RV_Offset 10I 0
D* Add'l data returned.
D RV_Data 1A DIM(1000)
D* Network attribute structure
D p_NA S *
D NA ds based(p_NA)
D* Attribute Name
D NA_Attr 10A
D* Type of Data. C=Char, B=Binary
D NA_Type 1A
D* Status. L=Locked, Blank=Normal
D NA_Status 1A
D* Length of Data
D NA_Length 10I 0
D* Actual Data (in character)
D NA_DataChr 1000A
D* Actual Data (in binary)
D NA_DataInt 10I 0 overlay(NA_DataChr:1)
C* Call API to get system name
C* -1 = API returned an error
C callp QWCRNETA(RV: %size(RV): 1: 'SYSNAME': EC)
c if EC_BytesA > 0
c return -1
c endif
C* -2 = RcvVar contained data that we
C* dont understand :(
c if RV_Attrs <> 1
c or RV_Offset < 8
c or RV_Offset > 1000
c return -2
c endif
C* Attach NetAttr structure
c eval RV_Offset = RV_Offset - 7
c eval p_NA = %addr(RV_Data(RV_Offset))
C* -3 = NetAttr structure had data
C* that we don't understand :(
c if NA_Attr <> 'SYSNAME'
c or NA_Length < 1
c or NA_Length > 8
c return -3
c endif
C* -4 = Network attributes are locked
c if NA_Status = 'L'
c return -4
c endif
C* Ahhh... we got it!
c eval SysName = %subst(NA_DataChr:1:NA_Length)
c return 0
P E
+---
| This is the RPG/400 Mailing List!
| To submit a new message, send your mail to RPG400-L@midrange.com.
| To subscribe to this list send email to RPG400-L-SUB@midrange.com.
| To unsubscribe from this list send email to RPG400-L-UNSUB@midrange.com.
| Questions should be directed to the list owner/operator: david@midrange.com
+---
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
