* CRTRPGMOD MODULE(NETSTATR) SRCFILE(xxx/QRPGLESRC) SRCMBR(NETSTATR)
* CRTPGM PGM(NETSTATR) BNDSRVPGM(QTOCNETSTS)
*
H DEBUG OPTION(*SRCSTMT:*NODEBUGIO) BNDDIR('QC2LE')
FQSYSPRT O F 198 Printer USROPN
D uSpaceName s 20 inz('NETSTAT 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 rmtAdr 15 overlay(uListEntry1:1)
D Reservedr 1 overlay(uListEntry1:16)
D rmtadrb 10i 0 overlay(uListEntry1:17)
D lclAdr 15 overlay(uListEntry1:21)
D Reserved1 1 overlay(uListEntry1:36)
D lcladrb 10i 0 overlay(uListEntry1:37)
D rmtPort 10i 0 overlay(uListEntry1:41)
D lclPort 10i 0 overlay(uListEntry1:45)
D tcpipState 10i 0 overlay(uListEntry1:49)
D idletime 10i 0 overlay(uListEntry1:53)
D byteIn 20i 0 overlay(uListEntry1:57)
D byteOut 20i 0 overlay(uListEntry1:65)
D cnnOpenType 10i 0 overlay(uListEntry1:73)
D netCnnType 10a overlay(uListEntry1:77)
D Reserved2 1a overlay(uListEntry1:87)
*----------------------------------------------------------------
* 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
*----------------------------------------------------------------
* NetCnn selection data structure.
*----------------------------------------------------------------
D CnnSelectDS ds
D netCnnTyp...
D 10 inz('*ALL') overlay(CnnSelectDS:1)
D lstRqsTyp...
D 10 inz('*ALL') overlay(CnnSelectDS:11)
D lstReserved...
D 12 overlay(CnnSelectDS:21)
D lclAdrLowVal...
D 10i 0 inz(0) overlay(CnnSelectDS:33)
D lclAdrUpVal...
D 10i 0 inz(0) overlay(CnnSelectDS:37)
D lclPortLowVal...
D 10i 0 inz(0) overlay(CnnSelectDS:41)
D lclPortUpVal...
D 10i 0 inz(0) overlay(CnnSelectDS:45)
D rmtAdrLowVal...
D 10i 0 inz(0) overlay(CnnSelectDS:49)
D rmtAdrUpVal...
D 10i 0 inz(0) overlay(CnnSelectDS:53)
D rmtPortLowVal...
D 10i 0 inz(0) overlay(CnnSelectDS:57)
D rmtPortUpVal...
D 10i 0 inz(0) overlay(CnnSelectDS:61)
*----------------------------------------------------------------
* 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 LstNetCnn PR ExtProc('QtocLstNetCnn')
D 20
D 8 const
Db like(CnnSelectDs)
D 10i 0 const
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('NETSTATR')
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 LstNetCnn(
C uSpaceName:
C 'NCNN0100':
C CnnSelectDS:
C %len(CnnSelectDS):
C 'NCLQ0100':
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 tcpipStateC 13
C select
C when tcpipState = 0
C eval tcpipStateC = 'Listen'
C when tcpipState = 1
C eval tcpipStateC = 'SYN-sent'
C when tcpipState = 2
C eval tcpipStateC = 'SYN-receievd'
C when tcpipState = 3
C eval tcpipStateC = 'Established'
C when tcpipState = 4
C eval tcpipStateC = 'FIN-wait-1'
C when tcpipState = 5
C eval tcpipStateC = 'FIN-wait-2'
C when tcpipState = 6
C eval tcpipStateC = 'Close-wait'
C when tcpipState = 7
C eval tcpipStateC = 'Closing'
C when tcpipState = 8
C eval tcpipStateC = 'Last-ACK'
C when tcpipState = 9
C eval tcpipStateC = 'Time-wait'
C when tcpipState = 10
C eval tcpipStateC = 'Closed'
C when tcpipState = 11
C eval tcpipStateC = 'Not Supported'
C endsl
C move *blanks cnnOpenTypeC 7
C select
C when cnnOpenType = 0
C eval cnnOpenTypeC = 'Passive'
C when cnnOpenType = 1
C eval cnnOpenTypeC = 'Active'
C when cnnOpenType = 2
C eval cnnOpenTypeC = ' '
C endsl
C EndSr
OQSYSPRT E HEAD 1
O 14 'Remote Address'
O 26 'Remote Port'
O 41 'Local Address'
O 54 'Local Port'
O 61 'State'
O 76 'OpnTyp'
O 84 'CnnTyp'
O 109 'Byte In'
O 131 'Byte Out'
O E OUT 1
O rmtAdr
O rmtPort L + 1
O lclAdr + 1
O lclPort L + 1
O tcpipStateC + 1
O cnnOpenTypeC + 1
O netCnnType + 1
O byteIn L + 1
O byteOut L + 1
Thanks to Vengoal Chang
阅读(1294) | 评论(0) | 转发(0) |
