如何得知 AS/400(iSeries) 上某一網卡的 TCP/IP 狀態是否正常？(API QtocLstNetIfc)
由於 AS/400 上的 Ethernet 網卡支援多個 IP 位址於同一張網卡上，
於 OS/400 V5R1 後可以利用 API QtocLstNetIfc 即時得知所有 AS/400 上 TCP/IP
界面的詳細資訊，若於 OS/400 V4R5 以前只能用 PING command 來確認 TCP/IP 是
否啟動。此範例直接呼叫 API QtocLstNetIfc 列出所有 TCP/IP 界面的部份定義及狀態。
File : QRPGLESRC
Member: NETIFCR
Type : RPGLE
Usage : CRTBNDRPG NETIFCR
OS Version: V5R1 以後
*http://publib.boulder.ibm.com/html/as400/v5r1/ic2924/index.htm?info/apis/qtoclstnetifc.htm
*
* CRTRPGMOD MODULE(NETIFCR) SRCFILE(xxx/QRPGLESRC) SRCMBR(NETIFCR)
* CRTPGM PGM(NETIFCR) BNDSRVPGM(QTOCNETSTS)
*
H DEBUG OPTION(*SRCSTMT:*NODEBUGIO) BNDDIR('QC2LE')
H dftactgrp(*NO)
FQSYSPRT O F 198 Printer USROPN
D uSpaceName s 20 inz('NETIFC QTEMP ')
D cmdStr1 s 256 inz('OVRPRTF FILE(QSYSPRT) PAGESIZE(-
D *N 198) CPI(15) OVRSCOPE(*JOB)')
D cmdStr2 s 256 inz('DLTOVR FILE(QSYSPRT) LVL(*JOB)')
*----------------------------------------------------------------
* Get user space list info from header section.
*----------------------------------------------------------------
D ds based(uHeadPtr)
D uOffSetToList 125 128i 0
D uNumOfEntrys 133 136i 0
D uSizeOfEntry 137 140i 0
*
D uListEntry1 ds Based(uListPtr )
D InetAdr 15 overlay(uListEntry1:1)
D Reservedr 1 overlay(uListEntry1:16)
D InetAdrb 10i 0 overlay(uListEntry1:17)
D NetAdr 15 overlay(uListEntry1:21)
D Reserved1 1 overlay(uListEntry1:36)
D NetAdrb 10i 0 overlay(uListEntry1:37)
D NetName 10 overlay(uListEntry1:41)
D LineDsc 10 overlay(uListEntry1:51)
D IfcName 10 overlay(uListEntry1:61)
D Reserved2 2 overlay(uListEntry1:71)
D IfcSts 10i 0 overlay(uListEntry1:73)
D IfcTypSrv 10i 0 overlay(uListEntry1:77)
D IfcMtu 10i 0 overlay(uListEntry1:81)
D IfcLinTyp 10i 0 overlay(uListEntry1:85)
D HostAdr 15 overlay(uListEntry1:89)
D Reserved3 1a overlay(uListEntry1:104)
D HostAdrb 10i 0 overlay(uListEntry1:105)
D IfcSbnMask 15 overlay(uListEntry1:109)
D Reserved4 1a overlay(uListEntry1:124)
D IfcSbnMaskb 10i 0 overlay(uListEntry1:125)
D DrtBrdCstAdr 15 overlay(uListEntry1:129)
D Reserved5 1a overlay(uListEntry1:144)
D DrtBrdCstAdrb 10i 0 overlay(uListEntry1:145)
D ChgDate 8 overlay(uListEntry1:149)
D ChgTime 6 overlay(uListEntry1:157)
D AsoLclIfc 15 overlay(uListEntry1:163)
D Reserved6 3a overlay(uListEntry1:178)
D AsoLclIfcb 10i 0 overlay(uListEntry1:181)
D ChgSts 10i 0 overlay(uListEntry1:185)
D PacketRules 10i 0 overlay(uListEntry1:189)
D AutoStart 10i 0 overlay(uListEntry1:193)
D TorkenRingSeq 10i 0 overlay(uListEntry1:197)
D IfcType 10i 0 overlay(uListEntry1:201)
D ProxyARPEbl 10i 0 overlay(uListEntry1:205)
D ProxyARPAlw 10i 0 overlay(uListEntry1:209)
D CfgMTU 10i 0 overlay(uListEntry1:213)
D NetNameFull 24 overlay(uListEntry1:217)
D IfcNameFull 24 overlay(uListEntry1:241)
*----------------------------------------------------------------
* Error return code parm for APIs.
*----------------------------------------------------------------
D vApiErrDs ds
D vbytpv 10i 0 inz(%size(vApiErrDs))
D vbytav 10i 0 inz(0)
D vmsgid 7a
D vresvd 1a
D vrpldta 50a
*----------------------------------------------------------------
* Create Prototypes for calls
*----------------------------------------------------------------
**-- Create user space: -----------------------------------------
D quscrtus PR ExtPgm('QUSCRTUS')
D 20
D 10 const
D 10i 0 const
D 1 const
D 10 const
D 50 const
D 10 const
Db like(vApiErrDS)
**-- Delete user space: ------------------------------------------
D qusdltus Pr ExtPgm( 'QUSDLTUS' )
D 20 Const
Db like(vApiErrDS)
**-- Call system command: ---------------------------------------
D system PR 10I 0 extproc('system')
D i_cmd * value options(*string)
*
D EXCP_MSGID S 7A import('_EXCP_MSGID')
**-- List network connections: ----------------------------------
D LstNetIfc PR ExtProc('QtocLstNetIfc')
D 20
D 8 const
Db like(vApiErrDS)
**-- Retrieve pointer to user space: ----------------------------
D qusptrus PR ExtPgm('QUSPTRUS')
D 20
D *
Db like(vApiErrDS)
D main PR extpgm('NETIFCR')
D main PI
*----------------------------------------------------------------
* Create user space
C callp QUSCRTUS(
C uSpaceName:
C 'TEST':
C 1500000:
C x'00':
C '*ALL':
C 'User Space JCR ':
C '*NO':
C vApiErrDs)
* Get pointer to user space
C callp QUSPTRUS(
C uSpaceName:
C uHeadPtr:
C vApiErrDs)
* call api to load job log into user space.
C callp LstNetIfc(
C uSpaceName:
C 'NIFC0100':
C vApiErrDs)
* Process elements
*
C callp system(cmdStr1)
C open QSYSPRT
C eval uListPtr = uHeadPtr + uOffSetToList
C except Head
1B C do uNumOfEntrys
C exsr cvtTxtSr
C except Out
C eval uListPtr = uListPtr + uSizeOfEntry
1E C enddo
C close QSYSPRT
C callp system(cmdStr2)
* Delete user space
C callp qusdltus(
C uSpaceName:
C vApiErrDs)
*
C eval *inlr = *on
C return
**-- Convert text : ----------------------------------------------
C cvtTxtSr BegSr
C Move *blanks IfcStsC 11
C Select
C When IfcSts = 0
c eval IfcStsC = 'Inactive'
C When IfcSts = 1
c eval IfcStsC = 'Active'
C When IfcSts = 2
c eval IfcStsC = 'Starting'
C When IfcSts = 3
c eval IfcStsC = 'Ending'
C When IfcSts = 4
c eval IfcStsC = 'RCYPND'
C When IfcSts = 5
c eval IfcStsC = 'RCYCNL'
C When IfcSts = 6
c eval IfcStsC = 'Failed'
C When IfcSts = 7
c eval IfcStsC = 'Failed(TCP)'
C When IfcSts = 8
c eval IfcStsC = 'DOD'
C EndSl
C EndSr
OQSYSPRT E HEAD 1
O 8 'Inet Adr'
O 23 'Net Adr'
O 40 'Net Name'
O 51 'Line Dsc'
O 61 'Ifc Name'
O 75 'Ifc Status'
O 85 'Host Adr'
O E OUT 1
O InetAdr
O NetAdr + 1
O NetName + 1
O LineDsc + 1
O IfcName + 1
O IfcStsC + 1
O HostAdr + 1
星期一, 11月 06, 2023
2003-06-27 如何得知 AS/400(iSeries) 上某一網卡的 TCP/IP 狀態是否正常？(API QtocLstNetIfc)
訂閱：
張貼留言 (Atom)
沒有留言:
張貼留言