- SMTP Configuration Checklist
- Configuration of the IBM i SMTP Client to Relay Email to Office365 and Gmail
- How To Migrate SMTP on IBM i from *SDD to *SMTP/*SMTPMSF
- Configuring TLS Between IBM i and Remote Mail Router WITHOUT Authentication
- How To Configure the SMTP Client To Use SMTP Authentication with a SMTP Relay
星期一, 10月 21, 2024
IBM i SMTP
星期四, 11月 09, 2023
2015-09-17 Retrieve AS400 Network Interfaces with java( List Network Interfaces (QtocLstNetIfc) API format NIFC0100)
Retrieve AS400 Network Interfaces with java( List Network Interfaces (QtocLstNetIfc) API format NIFC0100)
(RtvNetIfc.java)
File : RtvNetIfc.java
/* ==================================================================*/
/* */
/* Program . . : RtvNetIfc.java */
/* Description : List Network Interfaces */
/* Author . . : Vengoal Chang */
/* Published . : AS400ePaper */
/* Date . . . : September 17, 2015 */
/* */
/* ==================================================================*/
package com.free400.vengoal.as400api;
import com.ibm.as400.access.AS400;
import com.ibm.as400.access.AS400Bin4;
import com.ibm.as400.access.AS400Exception;
import com.ibm.as400.access.AS400Text;
import com.ibm.as400.access.ProgramParameter;
import com.ibm.as400.access.ServiceProgramCall;
import com.ibm.as400.access.SystemStatus;
import com.ibm.as400.access.UserSpace;
public class RtvNetIfc {
public static void main(String[] args) {
final AS400Bin4 intConverter_ = new AS400Bin4();
// Change following as400ip, as400user, as400password as your system and user profile setting
AS400 as400 = new AS400("as400ip", "as400user", "as400password");
try {
// The first parm is 20 characters, 10 chars of user space followed by 10 chars of library.
// Create a converter for 20 chars. AS400Text char20 = new AS400Text(20, system);
// The second parm is the format name (8 chars). Create a converter.
AS400Text char20 = new AS400Text(20, as400);
AS400Text char8 = new AS400Text(8, as400);
// Create program parameters
ProgramParameter[] parms = new ProgramParameter[3];
UserSpace usrSpc = new UserSpace(as400, "/QSYS.LIB/QTEMP.LIB/MYSPACE.USRSPC");
usrSpc.setMustUseProgramCall(true);
usrSpc.create(10240, // The initial size is 10KB
true, // Replace if the user space already exists
" ", // No extended attribute
(byte) 0x00, // The initial value is a null
"Created by a Java program", // The description of the user
// space
"*USE");
// First parm is qualified user space CHAR(20)
// CHAR(0-9) is the user space name
// CHAR(10-19) is the library name
String qSpace = "MYSPACE QTEMP ";
// First parm is the library qualified UserSpace
parms[0] = new ProgramParameter(char20.toBytes(qSpace));
parms[0].setParameterType(ProgramParameter.PASS_BY_REFERENCE);
// Second parm is the format
parms[1] = new ProgramParameter(char8.toBytes("NIFC0100"));
parms[1].setParameterType(ProgramParameter.PASS_BY_REFERENCE);
// Last parm is the error code. We pass an array of 0x00s so
// messages are returned.
byte[] bytes = new byte[32];
parms[2] = new ProgramParameter(bytes, 32);
parms[2].setParameterType(ProgramParameter.PASS_BY_REFERENCE);
System.out.println("Retrieving network interface information for system "
+ new SystemStatus(as400).getSystemName() + " ...");
ServiceProgramCall sPGMCall = new ServiceProgramCall(as400, "/QSYS.LIB/QTOCNETSTS.SRVPGM", "QtocLstNetIfc",
ServiceProgramCall.NO_RETURN_VALUE, parms);
if (sPGMCall.run() != true) {
throw new AS400Exception(sPGMCall.getMessageList());
} else {
byte[] header = new byte[140];
usrSpc.read(header, 0);
int list_Offset = intConverter_.toInt(header, 124);
int list_Size = intConverter_.toInt(header, 128);
int entry_count = intConverter_.toInt(header, 132);
int entry_size = intConverter_.toInt(header, 136);
int strPos = list_Offset;
System.out.println("IP Address " + " " + "NetWork Address" + " " + "Line Desc " + " " + "Status");
System.out.println("===============" + " " + "===============" + " " + "==========" + " " + "======");
for (int i = 0; i < entry_count; i++) {
String ipAdr = usrSpc.read(strPos, 15);
String netAdr = usrSpc.read(strPos + 20, 15);
String netWork = usrSpc.read(strPos + 40, 10);
String lineDesc = usrSpc.read(strPos + 50, 10);
String ifc = usrSpc.read(strPos + 60, 10);
byte[] ifcStatusBytes = new byte[4];
usrSpc.read(ifcStatusBytes, strPos + 72);
int ifcStatus = intConverter_.toInt(ifcStatusBytes);
System.out.println(ipAdr + " " + netAdr + " " + lineDesc + " " + ifcStatus);
strPos += entry_size;
}
}
} catch (Exception e) {
e.printStackTrace();
}
}
}
參照: List Network Interfaces (QtocLstNetIfc) API
2012-07-18 如何於 AS400 系統中取得 AS/400 主機的 HOST name 及 Domain name ？(Retrieve TCP/IP Attributes (QtocRtvTCPA) API)
如何於 AS400 系統中取得 AS/400 主機的 HOST name 及 Domain name ？(Retrieve TCP/IP Attributes (QtocRtvTCPA) API)
ile : QCLSRC
Member: RTVTCPHOST
Type : CLLE
Usage : CRTBNDCL RTVTCPHOST
CALL RTVTCPHOST
pgm
/*http://publib.boulder.ibm.com/infocenter/iseries/v6r1m0/index.jsp? */
/*topic=/apis/qtocrtvtcpa.htm */
Dcl &hostname *CHAR 64
Dcl &domainname *CHAR 255
Dcl &RcvVar *CHAR 512
Dcl &ApiErr *CHAR 8 X'0000000000000000'
Dcl &TCPAFormat *CHAR 8 'TCPA0300'
Dcl &RcvVarLen *CHAR 4
Dcl &MsgId *CHAR 7
Dcl &MsgDta *CHAR 256
Dcl &MsgF *CHAR 10
Dcl &MsgFLib *CHAR 10
Dcl &MsgTxt *CHAR 256
MonMsg MsgId(CPF0000 MCH0000) Exec(Goto Error)
ChgVar %Bin(&RcvVarLen) 512
CallPrc 'QtocRtvTCPA' ( &RcvVar +
&RcvVarLen +
&TCPAFormat +
&ApiErr)
ChgVar &hostname %SST(&RcvVar 177 64)
ChgVar &domainname %SST(&RcvVar 241 255)
SndPgmMsg MsgId(CPF9897) MsgF(QCPFMSG) +
MsgDta('Hostname:' *BCAT &hostname *Bcat +
'Domainname:' *Bcat &domainname) +
MsgType(*info )
Return
/* =============================================================== */
/* = Error routine = */
/* =============================================================== */
Error:
RcvMsg MsgType( *Excp ) +
MsgDta( &MsgDta ) +
MsgID( &MsgID ) +
MsgF( &MsgF ) +
MsgFLib( &MsgFLib )
MonMsg ( CPF0000 MCH0000 )
SndMsg:
SndPgmMsg MsgID( &MsgID ) +
MsgF( &MsgFLib/&MsgF ) +
MsgDta( &MsgDta ) +
MsgType( *Escape )
MonMsg ( CPF0000 MCH0000 )
/* =============================================================== */
/* = End of program = */
/* =============================================================== */
endpgm
星期三, 11月 08, 2023
2008-07-01 如何於 CLP 中以 Host name 取得主機的 IP 或以 IP 取得主機的 Host name？(Command GETHOSTGet Host by Name(gethostbyname) & Get Host by Address(gethostbyaddr))
如何於 CLP 中以 Host name 取得主機的 IP 或以 IP 取得主機的 Host name？(Command GETHOSTGet Host by Name(gethostbyname) & Get Host by Address(gethostbyaddr))
File : QRPGLESRC
Member: GETHOST
Type : RPGLE
Usage : CRTBNDRPG PGM(GETHOST)
**
** To compile:
** CRTBNDRPG PGM(xxxx) SRCFILE(xxxx/xxxx) DFTACTGRP(*NO) +
** ACTGRP(*CALLER)
** (actually, activation group can be whatever you prefer)
**
H DEBUG OPTION(*SRCSTMT:*NODEBUGIO) DFTACTGRP(*NO) ACTGRP(*CALLER)
** -------------------------------------------------------------------
D* The "internet" address family.
** -------------------------------------------------------------------
D AF_INET C CONST(2)
** -------------------------------------------------------------------
D INet_Addr PR 10U 0 ExtProc('inet_addr')
D char_addr 16A
** -------------------------------------------------------------------
D inet_ntoa PR * ExtProc('inet_ntoa')
D ulong_addr 10U 0 VALUE
** -------------------------------------------------------------------
D* any address availabl
D INADDR_ANY C CONST(0)
D* broadcast
D INADDR_BRO C CONST(4294967295)
D* loopback/localhost
D INADDR_LOO C CONST(2130706433)
D* no address exists
D INADDR_NON C CONST(4294967295)
** -------------------------------------------------------------------
D GetHostNam PR * extProc('gethostbyname')
D HostName 256A
** -------------------------------------------------------------------
** gethostbyaddr()--Get Host Information for IP Address
** -------------------------------------------------------------------
D GetHostAdr PR * ExtProc('gethostbyaddr')
D IP_Address 10U 0
D Addr_Len 10I 0 VALUE
D Addr_Fam 10I 0 VALUE
** -------------------------------------------------------------------
** Host Database Entry (for DNS lookups, etc)
** -------------------------------------------------------------------
D p_hostent S *
D hostent DS Based(p_hostent)
D h_name *
D h_aliases *
D h_addrtype 5I 0
D h_length 5I 0
D h_addrlist *
D p_h_addr S * Based(h_addrlist)
D h_addr S 10U 0 Based(p_h_addr)
D*** internal "work" variables. (not part of /COPY file)
D wkInput S 256A
D wkIP S 10U 0
D wkLen S 10I 0
D p_Name S * INZ(*NULL)
D wkName S 256A BASED(p_name)
C****************************************************************
C* Parameters:
C*
C* RetType: May be *NAME or *ADDR. If *NAME is given,
C* we'll return a domain name. If *ADDR we'll return an
C* IP Address.
C*
C* Input: Host or IP address to lookup. IP addresses should
C* be given in x.x.x.x format.
C*
C* Output: Resulting IP address, host name or error code.
C* Error codes are: *TYPE = invalid "RetType" parameter.
C* *BLANK = Input cant be blank
C* *FAIL = Lookup failed for this host.
C****************************************************************
C *entry plist
c parm RetType 5
c parm Input 256
c parm Output 256
C* If we werent given enough parms, just end this program now...
C* (we'll seton LR, even) We can't return an error since we
c* don't have an output parm to return it in (ack!)
c if %parms < 3
c eval *inlr = *on
c return
c endif
C* Did we have a valid return type?
c if RetType <> '*NAME'
c and RetType <> '*ADDR'
c eval Output = '*TYPE'
c Return
c endif
C* Was some input given?
C if Input = *blanks
c eval Output = '*BLANK'
c Return
c endif
C* were we given an IP address or a name?
c eval wkInput = %trim(Input) + x'00'
c eval wkIP = inet_addr(wkInput)
C* An address was requested... and the input was already
C* an address... return the input directly.
c if RetType = '*ADDR'
c and wkIP <> INADDR_NON
c eval Output = %trim(Input)
c Return
c endif
C* Call the OS/400 resolver routines to get the information that
C* we require. (It will check the hosts table first, then try DNS)
c if wkIP = INADDR_NON
c eval p_hostent = gethostnam(wkInput)
c else
c eval p_hostent = gethostadr(wkIP:4:AF_INET)
c endif
c if p_hostent = *NULL
c eval Output = '*FAIL'
c return
c endif
C* if we're returning an address, we'll need to use inet_ntoa
C* to convert it back to dotted-decimal x.x.x.x format.
C*
c if RetType = '*ADDR'
c eval p_name = inet_ntoa(h_addr)
c if p_name = *NULL
c eval Output = '*FAIL'
c else
c x'00' scan wkName wkLen
c eval Output = %subst(wkName:1:wkLen-1)
c endif
c return
c endif
C* the hostent structure contains a pointer to the requested
C* domain name... we'll need to base a variable on that pointer,
C* and then convert it from the "C" format for strings to a
C* fixed-length RPG string
c if h_name = *NULL
c eval Output = '*FAIL'
c return
c endif
c eval p_name = h_name
c x'00' scan wkName wkLen
c eval Output = %subst(wkName:1:wkLen-1)
c return
File : QCMDSRC
Member: GETHOST
Type : CMD
Usage : CRTCMD CMD(GETHOST) PGM(GETHOST) ALLOW(*IPGM *BPGM)
/* COMMAND GETHOST */
/* TO COMPILE : */
/* CRTCMD CMD(XXX/GETHOST) PGM(XXX/GETHOST ) + */
/* SRCFILE(XXX/QCMDSRC) */
/*================================================================*/
/* USAGE SAMPLE in CLP: */
/* GETHOST RETTYPE(*ADDR) INPUT(&HOSTNAME) OUTPUT(&HOSTIP) */
/* GETHOST RETTYPE(*NAME) INPUT(&HOSTIP) OUTPUT(&HOSTNAME) */
/* */
/* OUTPUT Resulting IP address, host name or error code. */
/* Error codes are: *TYPE = invalid "RetType" parameter */
/* *BLANK = Input cant be blank */
/* *FAIL = Lookup failed for this host */
/*================================================================*/
GETHOST: CMD PROMPT('Get Host by Name & by Address')
PARM KWD(RETTYPE) TYPE(*CHAR) LEN(5) RSTD(*YES) +
VALUES(*ADDR *NAME) MIN(1) PROMPT('Return +
type')
PARM KWD(INPUT) TYPE(*CHAR) LEN(256) MIN(0) +
EXPR(*YES) PROMPT('Input Host name or +
address')
PARM KWD(OUTPUT) TYPE(*CHAR) LEN(256) +
RTNVAL(*YES) PROMPT('Output Host name or +
address')
File : QCLSRC
Member: GETHOSTC
Type : CLP
Usage : CRTCLPGM GETHOSTC
執行 CALL RTVSQLINFC 後，會產生 QPPGMDMP 報表，檢視 QPPGMDMP 報表，
PGM
DCL &INPUT *CHAR 256
DCL &IPOUTPUT *CHAR 256
DCL &NMOUTPUT *CHAR 256
/* 以主機名稱取 IP 位址 */
GETHOST RETTYPE(*ADDR) INPUT('tw.yahoo.com') +
OUTPUT(&IPOUTPUT)
/* 以 IP 位址取主機名稱 */
GETHOST RETTYPE(*NAME) INPUT(&IPOUTPUT) +
OUTPUT(&NMOUTPUT)
DMPCLPGM
ENDPGM
部分報表輸出範例：
Display Spooled File
File . . . . . : QPPGMDMP Page/Line 1/24
Control . . . . . Columns 1 - 78
Find . . . . . .
*...+....1....+....2....+....3....+....4....+....5....+....6....+....7....+...
Variable Type Length Value
*...+....1....+....2....+
&IPOUTPUT *CHAR 256 '202.43.195.52 '
+26 ' '
+51 ' '
+76 ' '
+101 ' '
+126 ' '
+151 ' '
+176 ' '
+201 ' '
+226 ' '
+251 ' '
&NMOUTPUT *CHAR 256 'vip1.tw.tpe.yahoo.com '
+26 ' '
+51 ' '
星期二, 11月 07, 2023
2007-06-27 如何判斷系統上某一 IP 位址是否已啟動? (CHKTCPIFC with API QtocRtvTCPA, QtocLstNetIfc)
如何判斷系統上某一 IP 位址是否已啟動? (CHKTCPIFC with API QtocRtvTCPA, QtocLstNetIfc)
如何判斷系統上某一 IP 位址是否已啟動? (CHKTCPIFC with API QtocRtvTCPA, QtocLstNetIfc)
由於我們時常使用 TCP/IP Socket 程式, 要讓程式自動於開機時啟動, 我們大多會將程式置於系統的開機
啟動程式(指定於系統值 QSTRUPPGM)中 , 有時候系統於開機過程中啟動 TCP/IP 介面會比我們所設定的開
機啟動程式慢,此時若於啟動程式中直接啟動 Socket 程式, 會導致該 Socket 程式由於該 Interface 位址
未啟動而造成某些錯誤,所以於執行 TCP/IP Socket 程式前就要判斷該 Interface 位址是否已啟動, 如此
方式可以使 TCP/IP Scoket 程式較容易撰寫重試(retry)過程.所以 Command CHKTCPIFC 就是來確認所指
定的 Interface 位址是否已啟動,
File : QCLSRC
Member: CHKTCPIFC
Type : CLLE
Usage : CRTBNDCL CHKTGTRLSC
OS version: V5R1 以後(含)
/* =============================================================== */
/* = Command ChkTcpIfc CPP = */
/* = ChkTcpIfc CLLE = */
/* = Paramater notes: = */
/* = NetIfc :Network interface address = */
/* = = */
/* = For V5R1 and later use = */
/* = = */
/* = Usage in CLP: = */
/* = ChkTcpIfc NETIFC( ip_address ) = */
/* = MONMSG CPF9898 => Possible error as following: = */
/* = 1. TCP/IP is not active. = */
/* = 2. Interface address is not active. = */
/* = 3. Interface address is not defined. = */
/* =============================================================== */
/* = Date : 2007/06/26 = */
/* = Author: Vengoal Chang = */
/* =============================================================== */
PGM (&NetIfc)
DCL VAR(&NETIFC) TYPE(*CHAR) LEN(15)
DCL VAR(&RCVVAR) TYPE(*CHAR) LEN(140)
DCL VAR(&APIERR) TYPE(*CHAR) LEN(8) +
VALUE(X'0000000000000000')
DCL VAR(&TCPAFORMAT) TYPE(*CHAR) LEN(8) +
VALUE('TCPA0100')
DCL VAR(&NIFCFORMAT) TYPE(*CHAR) LEN(8) +
VALUE('NIFC0100')
DCL VAR(&RCVVARLEN) TYPE(*CHAR) LEN(4)
DCL VAR(&TCPSTKSTS) TYPE(*CHAR) LEN(4)
DCL VAR(&TCPSTKSTSN) TYPE(*DEC) LEN(10) VALUE(0)
DCL VAR(&USP_NAME) TYPE(*CHAR) LEN(10)
DCL VAR(&USP_LIB) TYPE(*CHAR) LEN(10)
DCL VAR(&USP_QUAL) TYPE(*CHAR) LEN(20)
DCL VAR(&USP_TYPE) TYPE(*CHAR) LEN(10)
DCL VAR(&USP_SIZE) TYPE(*CHAR) LEN(4)
DCL VAR(&USP_FILL) TYPE(*CHAR) LEN(1)
DCL VAR(&USP_AUT) TYPE(*CHAR) LEN(10)
DCL VAR(&USP_TEXT) TYPE(*CHAR) LEN(50)
DCL VAR(&STARTPOS) TYPE(*CHAR) LEN(4)
DCL VAR(&DATALEN) TYPE(*CHAR) LEN(4)
DCL VAR(&HEADER) TYPE(*CHAR) LEN(150)
DCL VAR(&LST_OFFSET) TYPE(*DEC) LEN(5 0)
DCL VAR(&LST_SIZE) TYPE(*DEC) LEN(5 0)
DCL VAR(&LST_DATA) TYPE(*CHAR) LEN(4096)
DCL VAR(&LST_NBR) TYPE(*DEC) LEN(5 0)
DCL VAR(&LST_LEN) TYPE(*DEC) LEN(5 0)
DCL VAR(&LST_LENBIN) TYPE(*CHAR) LEN(4)
DCL VAR(&LST_POSBIN) TYPE(*CHAR) LEN(4)
DCL VAR(&LST_COUNT) TYPE(*DEC) LEN(5) VALUE(0)
DCL VAR(&EXC_COUNT) TYPE(*DEC) LEN(5) VALUE(0)
DCL VAR(&INTNETADR) TYPE(*CHAR) LEN(15)
DCL VAR(&NETWORKADR) TYPE(*CHAR) LEN(15)
DCL VAR(&HOSTADR) TYPE(*CHAR) LEN(15)
DCL VAR(&IFCSTSN) TYPE(*DEC) LEN(5) VALUE(0)
DCL VAR(&IFCSTSC) TYPE(*CHAR) LEN(5)
DCL VAR(&NULL) TYPE(*CHAR) LEN(1) VALUE(X'00')
DCL VAR(&idx ) TYPE(*dec ) LEN(5) VALUE(0)
DCL VAR(&NETIFCDFN) TYPE(*CHAR) LEN(1)
DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(256)
DCL VAR(&MSGF) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGTXT) TYPE(*CHAR) LEN(256)
MONMSG MSGID(CPF0000 MCH0000) EXEC(GOTO CMDLBL(ERROR))
chgvar %Bin(&RcvVarLen) 140
callprc 'QtocRtvTCPA' ( +
&RcvVar +
&RcvVarLen +
&TCPAFormat +
&ApiErr)
ChgVar &TcpStkSts %SST(&RcvVar 9 4)
ChgVar &TcpStkStsn %bin(&TcpStkSts)
IF (&TCPStkStsn *EQ 0) DO
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('TCP/IP +
status is not active.') MSGTYPE(*ESCAPE)
ENDDO
CHGVAR VAR(&USP_NAME) VALUE('CHKTCPIFC' )
CHGVAR VAR(&USP_LIB) VALUE('QTEMP')
CHGVAR VAR(&USP_QUAL) VALUE(&USP_NAME *CAT +
&USP_LIB)
CHGVAR VAR(&USP_TYPE) VALUE('MYTYPE')
CHGVAR VAR(%BIN(&USP_SIZE)) VALUE(65535)
CHGVAR VAR(&USP_FILL) VALUE(' ')
CHGVAR VAR(&USP_AUT) VALUE('*CHANGE')
CHGVAR VAR(&USP_TEXT) VALUE('my user space')
DLTUSRSPC USRSPC(&USP_LIB/&USP_NAME)
MONMSG CPF0000
CALL PGM(QUSCRTUS) PARM(&USP_QUAL &USP_TYPE +
&USP_SIZE &USP_FILL &USP_AUT &USP_TEXT)
ChgVar &ApiErr X'0000000000000000'
callprc 'QtocLstNetIfc' ( +
&USP_QUAL +
&NIFCFormat +
&ApiErr)
CHGVAR VAR(%BIN(&STARTPOS)) VALUE(1)
CHGVAR VAR(%BIN(&DATALEN)) VALUE(140)
CALL PGM(QUSRTVUS) PARM(&USP_QUAL &STARTPOS +
&DATALEN &HEADER)
CHGVAR VAR(&LST_OFFSET) VALUE(%BIN(&HEADER 125 4))
CHGVAR VAR(&LST_SIZE) VALUE(%BIN(&HEADER 129 4))
CHGVAR VAR(&LST_NBR) VALUE(%BIN(&HEADER 133 4))
CHGVAR VAR(&LST_LEN) VALUE(%BIN(&HEADER 137 4))
CHGVAR VAR(%BIN(&LST_POSBIN)) VALUE(&LST_OFFSET + 1)
CHGVAR VAR(&LST_LENBIN) VALUE(%SST(&HEADER 137 4))
CHGVAR VAR(&LST_COUNT) VALUE(0)
CHGVAR VAR(&EXC_COUNT) VALUE(0)
LST_LOOP: IF COND(&LST_COUNT *EQ &LST_NBR) THEN(GOTO +
CMDLBL(LST_END))
CALL PGM(QUSRTVUS) PARM(&USP_QUAL &LST_POSBIN +
&LST_LENBIN &LST_DATA)
CHGVAR VAR(&INTNETADR) VALUE(%SST(&LST_DATA 1 15))
/* CHGVAR VAR(&NETWORKADR) VALUE(%SST(&LST_DATA 21 15))*/
/* CHGVAR VAR(&HOSTADR ) VALUE(%SST(&LST_DATA 89 15))*/
CHGVAR VAR(&IFCSTSN) VALUE(%BIN(&LST_DATA 73 4))
CHGVAR VAR(&IFCSTSC) VALUE(&IFCSTSN)
ChgVar &Idx 1
CVTNULLS:
If (&Idx > 15) goto CVTNULLE
If (%SST(&INTNETADR &Idx 1) *EQ &null) +
ChgVar %SST(&INTNETADR &Idx 1) ' '
ChgVar &Idx (&Idx+1)
goto CVTNULLS
CVTNULLE:
If (&NETIFC *EQ &INTNETADR) DO
ChgVar &NETIFCDFN '1'
If (&IFCSTSN *EQ 1) DO
SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) +
MSGDTA('Interface' *BCAT &NETIFC *BCAT +
'is active.') MSGTYPE(*INFO)
CHGVAR VAR(&EXC_COUNT) VALUE(&EXC_COUNT + 1)
GOTO LST_END
ENDDO
ENDDO
CHGVAR VAR(&LST_COUNT) VALUE(&LST_COUNT + 1)
CHGVAR VAR(%BIN(&LST_POSBIN)) +
VALUE(%BIN(&LST_POSBIN) + &LST_LEN)
GOTO CMDLBL(LST_LOOP)
LST_END:
IF (&EXC_COUNT *EQ 0) DO
If (&NetIfcDfn *EQ '1') +
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) +
MSGDTA('Interface' *BCAT +
&NETIFC *BCAT 'is not active') +
MSGTYPE(*ESCAPE)
Else +
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) +
MSGDTA('Interface' *BCAT +
&NETIFC *BCAT 'is not defined') +
MSGTYPE(*ESCAPE)
ENDDO
DLTUSRSPC USRSPC(&USP_LIB/&USP_NAME)
Return
/* =============================================================== */
/* = Error routine = */
/* =============================================================== */
Error:
RcvMsg MsgType( *Excp ) +
MsgDta( &MsgDta ) +
MsgID( &MsgID ) +
MsgF( &MsgF ) +
MsgFLib( &MsgFLib )
MonMsg ( CPF0000 MCH0000 )
SndMsg:
SndPgmMsg MsgID( &MsgID ) +
MsgF( &MsgFLib/&MsgF ) +
MsgDta( &MsgDta ) +
MsgType( *Escape )
MonMsg ( CPF0000 MCH0000 )
/* =============================================================== */
/* = End of program = */
/* =============================================================== */
ENDPGM
File : QCMDSRC
Member: CHKTCPIFC
Type : CMD
Usage : CRTCMD CMD(lib/CHKTCPIFC) PGM(lib/CHKTCPIFC)
OS version: V5R1 以後(含)
/* =============================================================== */
/* = Command....... ChkTcpIfc = */
/* = CPP........... ChkTcpIfc = */
/* = Description... Check TCP/IP Interface Status = */
/* = = */
/* = CrtCmd Cmd( ChkTcpIfc ) = */
/* = Pgm( ChkTcpIfc ) = */
/* = SrcFile( YourSourceFile ) = */
/* = = */
/* = For V5R1 and later use = */
/* = = */
/* = Usage in CLP: = */
/* = ChkTcpIfc NETIFC( ip_address ) = */
/* = MONMSG CPF9898 => Possible error as following: = */
/* = 1. TCP/IP is not active. = */
/* = 2. Interface address is not active. = */
/* = 3. Interface address is not defined. = */
/* =============================================================== */
/* = Date : 2007/06/26 = */
/* = Author: Vengoal Chang = */
/* =============================================================== */
CMD PROMPT('Check TCP/IP Interface Status')
PARM KWD(NETIFC) TYPE(*CHAR) LEN(15) MIN(1) +
PROMPT('Network interface address')
於指令行下亦可以直接使用 CHKTCPIFC, 會輸出該介面的狀態或錯誤訊息
測試程式 CLP CHKTCPIFCT
CRTCLPGM CHKTCPIFCT
CALL CHKTCPIFCT
例如系統中已設定 IP: 192.16.15.28
未設定 IP: 192.16.15.27
當所指定的 IP 無法使用時, 此指令會有一個錯誤訊息 ID CPF9898,
程式中只要收到 CPF9898 即表示該 IP 無法使用
PGM
DCL VAR(&NETIFC) TYPE(*CHAR) LEN(15)
CHGVAR VAR(&NETIFC) VALUE('192.16.15.27')
CHKTCPIFC NETIFC(&NETIFC)
MONMSG CPF9898 EXEC(DO)
SNDPGMMSG MSG('Interface' *BCAT &NETIFC *BCAT 'is not +
active or defined')
ENDDO
CHKTCPIFC NETIFC('192.16.15.28')
ENDPGM
2006-08-14 如何擷取 AS/400 FTP server 屬性?(Command: RTVFTPA with API QPTRTVPO)
如何擷取 AS/400 FTP server 屬性?(Command : RTVFTPA with API QPTRTVPO)
File : QRPGLESRC
Member: RTVFTPA
Type : RPGLE
Usage : CRTBNDRPG RTVFTPA
*=============================================================
*= Command RTVFTPA CPP =
*= RTVFTPA RPGLE =
*=============================================================
*= Date : 2006/08/14 =
*= Author: Vengoal Chang =
*=============================================================
H DEBUG OPTION(*SRCSTMT:*NODEBUGIO)
D****************************************************************
D*Prototype for calling API QPTRTVPO
D****************************************************************
D QPTRTVPO pr ExtPgm('QPTRTVPO')
D rcvVar 32767 Options( *VarSize )
D rcvLen 10I 0 const
D rcvFmt 8 const
D cmd 10 const
D cmdLen 10I 0 const
D apierrorDs 272
D*****************************************************************
D APIErrorDS DS
D BytesProvided 10I 0 Inz( %Size( APIErrorDS ) )
D BytesAvail 10I 0 Inz( *Zero )
D MsgID 7 Inz( *Blanks )
D Reserved 1 Inz( X'00' )
D MsgDta 256 Inz( *Blanks )
D*****************************************************************
D*Type definition for the RTVP0100 format
D*****************************************************************
DQPTP0100 DS
D QPTBRTN 10i 0
D QPTBAVL 10i 0
D QPTPOPN 10
D QPTPOPLN 10
D QPTOPRCO 10i 0
D QPTOPRCL 10i 0
D QPTPOPRC 1000
D cmd S 7 Inz('CHGFTPA')
D cmdLen S 10I 0 Inz(%size(cmd))
D values DS 108
D parms 9 dim(12)
D autostartp 9 Overlay(values:1)
D Inz('AUTOSTART')
D nbrsvrp 9 Overlay(values:10)
D Inz('NBRSVR')
D inacttimop 9 Overlay(values:19)
D Inz('INACTTIMO')
D ccsidp 9 Overlay(values:28)
D Inz('CCSID')
D tblftpoutp 9 Overlay(values:37)
D Inz('TBLFTPOUT')
D tblftpinp 9 Overlay(values:46)
D Inz('TBLFTPIN')
D namefmtp 9 Overlay(values:55)
D Inz('NAMEFMT')
D curdirp 9 Overlay(values:64)
D Inz('CURDIR')
D listfmtp 9 Overlay(values:73)
D Inz('LISTFMT')
D crtccsidp 9 Overlay(values:82)
D Inz('CRTCCSID')
D sbsdp 9 Overlay(values:91)
D Inz('SBSD')
D alwsslp 9 Overlay(values:100)
D Inz('ALWSSL')
D*chgftpa DS
D autostart S 5
D nbrsvr S 5
D inacttimo S 10
D ccsid S 5
D tblftpoutqual S 21
D tblftpinqual S 21
D namefmt S 5
D curdir S 8
D listfmt S 5
D crtccsid S 7
D sbsdqual S 21
D alwssl S 5
D parmIdx S 10I 0
D strpos S 10I 0
D endpos S 10I 0
C *Entry plist
C parm AUTOSTART
C parm NBRSVR
C parm INACTTIMO
C parm CCSID
C Parm TBLFTPOUT 10
C Parm LIBFTPOUT 10
C Parm TBLFTPIN 10
C Parm LIBFTPIN 10
C Parm NAMEFMT
C Parm CURDIR
C Parm LISTFMT
C Parm CRTCCSID
C Parm SBSD 10
C Parm SBSDLIB 10
C Parm ALWSSL
C callp QPTRTVPO(
C QPTP0100 :
C %size(QPTP0100) :
C 'RTVP0100' :
C cmd :
C cmdLen :
C APIErrorDs)
C For parmidx = 1 to %elem(parms)
C eval strPos = %scan(%trim(parms(parmidx)):
C QPTPOPRC:1)
C if strPos > 0
C eval endPos = %scan(')':
C QPTPOPRC:strPos)
C eval strPos= strPos+
C %len(%trim(parms(parmidx)))+1
C Select
C When parmidx = 1 and %addr(autostart) <>*NULL
C eval autostart = %Subst(QPTPOPRC:
C strPos: endPos - strPos)
C When parmidx = 2 and %addr(nbrsvr) <> *NULL
C eval nbrsvr = %Subst(QPTPOPRC:
C strPos: endPos - strPos)
C When parmidx = 3 and %addr(inacttimo)<> *NULL
C eval inacttimo = %Subst(QPTPOPRC:
C strPos: endPos - strPos)
C When parmidx = 4 and %addr(ccsid) <> *NULL
C eval ccsid = %Subst(QPTPOPRC:
C strPos: endPos - strPos)
C When parmidx = 5 and %addr(tblftpout)<> *NULL
C eval tblftpoutqual = %Subst(QPTPOPRC:
C strPos: endPos - strPos)
C eval strPos = %scan('/':tblftpoutqual:1)
C If strPos > 0
C eval endPos = %len(%trimR(tblftpoutqual))
C eval tblftpout =%subst(tblftpoutqual:strPos+1:
C endPos - (strPos+1))
C If %addr(libftpout)<> *NULL
C eval libftpout = %subst(tblftpoutqual:2:
C strPos - 2)
C EndIf
C else
C eval tblftpout = %trim(tblftpoutqual)
C If %addr(libftpout)<> *NULL
C eval libftpout = ' '
C EndIf
C EndIf
C When parmidx = 6 and %addr(tblftpin)<> *NULL
C eval tblftpinqual = %Subst(QPTPOPRC:
C strPos: endPos - strPos)
C eval strPos = %scan('/':tblftpinqual:1)
C If strPos > 0
C eval endPos = %len(%trimR(tblftpinqual))
C eval tblftpin = %subst(tblftpinqual:strPos+1:
C endPos - (strPos+1))
C If %addr(libftpin)<> *NULL
C eval libftpin = %subst(tblftpinqual:2:
C strPos - 2)
C EndIf
C else
C eval tblftpin = %trim(tblftpinqual)
C If %addr(libftpin)<> *NULL
C eval libftpin = ' '
C EndIf
C EndIf
C When parmidx = 7 and %addr(namefmt)<> *NULL
C eval namefmt = %Subst(QPTPOPRC:
C strPos: endPos - strPos)
C When parmidx = 8 and %addr(curdir)<> *NULL
C eval curdir = %Subst(QPTPOPRC:
C strPos: endPos - strPos)
C When parmidx = 9 and %addr(listfmt)<> *NULL
C eval listfmt = %Subst(QPTPOPRC:
C strPos: endPos - strPos)
C When parmidx = 10 and %addr(crtccsid)<> *NULL
C eval crtccsid = %Subst(QPTPOPRC:
C strPos: endPos - strPos)
C When parmidx = 11 and %addr(sbsd)<> *NULL
C eval sbsdqual = %Subst(QPTPOPRC:
C strPos: endPos - strPos)
C eval strPos = %scan('/':sbsdqual:1)
C If strPos > 0
C eval endPos = %len(%trimR(sbsdqual))
C eval sbsd = %subst(sbsdqual: strPos + 1:
C endPos - (strPos+1))
C If %addr(sbsdLib)<> *NULL
C eval sbsdLib = %subst(sbsdqual:2:
C strPos - 2)
C EndIf
C else
C eval sbsd = %trim(sbsdqual)
C If %addr(sbsdLib)<> *NULL
C eval sbsdLib = ' '
C EndIf
C EndIf
C When parmidx = 12 and %addr(alwssl)<> *NULL
C eval alwssl = %Subst(QPTPOPRC:
C strPos: endPos - strPos)
C EndSl
C endIf
C EndFor
C* dump
C eval *InLr = *On
File : QCMDSRC
Member: RTVFTPA
Type : CMD
Usage : CRTCMD CMD(RTVFTPA) PGM(yourlib/RTVFTPA) ALLOW(*IPGM *BPGM)
/* =============================================================== */
/* = Command....... RTVFTPA = */
/* = CPP........... RTVFTPA = */
/* = Description... RTTRIEVE FTP server attributes = */
/* = = */
/* =============================================================== */
/* = Date : 2006/08/14 = */
/* = Author: Vengoal Chang = */
/* =============================================================== */
/* */
/* To compile it do: */
/* */
/* CRTCMD CMD(yourlib/RTVFTPA) */
/* PGM(yourlib/RTVFTPA) */
/* SRCFILE(yourlib/QCMDSRC) */
/* SRCMBR(RTVFTPA) */
/* THDSAFE(*YES) */
/* TEXT('Retrieve FTP Attributes') */
/* VLDCKR(*NONE) */
/* MODE(*ALL) */
/* ALLOW(*BPGM *IPGM *BREXX *IREXX) */
/* ALWLMTUSR(*NO) */
/* MAXPOS(3) */
/* CURLIB(*NOCHG) */
/* PRDLIB(*NOCHG) */
/* PMTOVRPGM(*NONE) */
/* AUT(*USE) REPLACE(*YES) ENBGUI(*YES) */
/* */
/* =============================================================== */
CMD PROMPT('Retrieve FTP Attributes')
PARM KWD(AUTOSTART) +
TYPE(*CHAR) +
LEN(5) +
RTNVAL(*YES) +
VARY(*NO) +
PASSATR(*NO) +
PROMPT('CL var for AUTOSTART (5)')
PARM KWD(NBRSVR) +
TYPE(*CHAR) +
LEN(5) +
RTNVAL(*YES) +
VARY(*NO) +
PASSATR(*NO) +
PROMPT('CL var for NBRSVR (5)')
PARM KWD(INACTTIMO) +
TYPE(*CHAR) +
LEN(10) +
RTNVAL(*YES) +
VARY(*NO) +
PASSATR(*NO) +
PROMPT('CL var for INACTTIMO (10)')
PARM KWD(CCSID) +
TYPE(*CHAR) +
LEN(5) +
RTNVAL(*YES) +
VARY(*NO) +
PASSATR(*NO) +
PROMPT('CL var for CCSID (5)')
PARM KWD(TBLFTPOUT) +
TYPE(*CHAR) +
LEN(10) +
RTNVAL(*YES) +
VARY(*NO) +
PASSATR(*NO) +
PROMPT('CL var for TBLFTPOUT (10)')
PARM KWD(LIBFTPOUT) +
TYPE(*CHAR) +
LEN(10) +
RTNVAL(*YES) +
VARY(*NO) +
PASSATR(*NO) +
PROMPT('Library for TBLFTPOUT (10)')
PARM KWD(TBLFTPIN) +
TYPE(*CHAR) +
LEN(10) +
RTNVAL(*YES) +
VARY(*NO) +
PASSATR(*NO) +
PROMPT('CL var for TBLFTPIN (10)')
PARM KWD(LIBFTPIN) +
TYPE(*CHAR) +
LEN(10) +
RTNVAL(*YES) +
VARY(*NO) +
PASSATR(*NO) +
PROMPT('Library for TBLFTPIN (10)')
PARM KWD(NAMEFMT) +
TYPE(*CHAR) +
LEN(5) +
RTNVAL(*YES) +
VARY(*NO) +
PASSATR(*NO) +
PROMPT('CL var for NAMEFMT (5)')
PARM KWD(CURDIR) +
TYPE(*CHAR) +
LEN(8) +
RTNVAL(*YES) +
VARY(*NO) +
PASSATR(*NO) +
PROMPT('CL var for CURDIR (8)')
PARM KWD(LISTFMT) +
TYPE(*CHAR) +
LEN(5) +
RTNVAL(*YES) +
VARY(*NO) +
PASSATR(*NO) +
PROMPT('CL var for LISTFMT (5)')
PARM KWD(CRTCCSID) +
TYPE(*CHAR) +
LEN(7) +
RTNVAL(*YES) +
VARY(*NO) +
PASSATR(*NO) +
PROMPT('CL var for CRTCCSID (7)')
PARM KWD(SBSD) +
TYPE(*CHAR) +
LEN(10) +
RTNVAL(*YES) +
VARY(*NO) +
PASSATR(*NO) +
PROMPT('CL var for SBSD (10)')
PARM KWD(SBSDLIB) +
TYPE(*CHAR) +
LEN(10) +
RTNVAL(*YES) +
VARY(*NO) +
PASSATR(*NO) +
PROMPT('CL var for SBSDLIB (10)')
PARM KWD(ALWSSL) +
TYPE(*CHAR) +
LEN(5) +
RTNVAL(*YES) +
VARY(*NO) +
PASSATR(*NO) +
PROMPT('CL var for ALWSSL (5)')
File : QCLSRC
Member: RTVFTPATST
Type : CLP
Usage : CRTCLPGM RTVFTPATST
CALL RTVFTPATST
/* This is a test CL program that exercises the use of RTVFTPA command */
pgm
dcl &autostart *char 5
dcl &nbrsvr *char 5
dcl &inacttimo *char 10
dcl &ccsid *char 5
dcl &tblftpout *char 10
dcl &libftpout *char 10
dcl &tblftpin *char 10
dcl &libftpin *char 10
dcl &namefmt *char 5
dcl &curdir *char 8
dcl &listfmt *char 5
dcl &crtccsid *char 7
dcl &sbsd *char 10
dcl &sbsdlib *char 10
dcl &alwssl *char 5
RTVFTPA AUTOSTART(&AUTOSTART) INACTTIMO(&INACTTIMO) +
TBLFTPOUT(&TBLFTPOUT) +
LIBFTPOUT(&LIBFTPOUT) TBLFTPIN(&TBLFTPIN) +
LIBFTPIN(&LIBFTPIN) NAMEFMT(&NAMEFMT) +
SBSD(&SBSD) SBSDLIB(&SBSDLIB) ALWSSL(&ALWSSL)
sndpgmmsg ('name format is: ' *cat &namefmt *cat +
' inactivity timeout is: ' *cat &inacttimo *cat +
' and allow ssl is: ' *cat &alwssl *cat +
' tblftpout = ' *cat &tblftpout *cat +
' libftpout = ' *cat &libftpout *cat +
' tblftpin = ' *cat &tblftpin *cat +
' libftpin = ' *cat &libftpin *cat +
' sbsd = ' *cat &sbsd *cat +
' sbsdlib = ' *cat &sbsdlib *cat +
' autostart = ' *cat &autostart )
endpgm
2006-07-04 要如何得知AS/400 上 TCP/IP 位址及 port 所連結的 Job ?(Command TCPCNNJOB)
要如何得知AS/400 上 TCP/IP 位址及 port 所連結的 Job ?(Command TCPCNNJOB)
要如何得知AS/400 上 TCP/IP 位址及 port 所連結的 Job ?(TCPCNNJOB)
要得知AS/400 上 TCP/IP 位址及 port 所連結的 Job, 可以使用command NETSTAT 選項 3,
Work with TCP/IP Network Status
System: TEST810
Select one of the following:
1. Work with TCP/IP interface status
2. Display TCP/IP route information
3. Work with TCP/IP connection status
Selection or command
===> 3
Work with TCP/IP Connection Status
System: TEST810
Type options, press Enter.
3=Enable debug 4=End 5=Display details 6=Disable debug
8=Display jobs
Remote Remote Local
Opt Address Port Port Idle Time State
* * as-dtaq-s 026:39:39 Listen
* * as-file-s 026:40:52 Listen
* * as-netp > 026:39:39 Listen
* * as-rmtc > 026:39:38 Listen
* * as-sign > 026:39:38 Listen
* * 4003 000:01:25 Listen
* * 5000 023:26:16 Listen
172.16.1.1 3246 telnet 000:00:18 Established
8 172.16.1.1 3247 telnet 000:00:59 Established
172.16.1.1 3248 telnet 000:00:48 Established
172.16.1.1 3249 telnet 000:00:25 Established
172.16.1.3 3019 telnet 000:06:08 Established
More...
F3=Exit F5=Refresh F9=Command line F11=Display byte counts F12=Cancel
F15=Subset F22=Display entire field F24=More keys
Display Jobs Using Connection
System: DDSC810
Connection type . . . . . . : *TCP
Local address . . . . . . . : 172.16.15.28
Local port . . . . . . . . . : 23
Remote address . . . . . . . : 172.16.1.1
Remote port . . . . . . . . : 3247
Type options, press Enter.
5=Work with job
Opt Name User Number Opt Name User Number
QPADEV001F TEST 349792
QTVDEVICE QTCP 347585
Bottom
F3=Exit F5=Refresh F6=Print F9=Command line F12=Cancel
即可得知現有 IP 及 port 的組合所連結的 Job,但這樣查太慢了, 如果只知 job name 要從上百個
連線手動查, 可能還沒查到網路就斷線了, NETSTAT 是從 網路位址查起, 但是系統並不提供
output to print or file, 同時也未提供以 Job API 取得相關 Job 的 TCP/IP 資訊, 所以我寫了一
個command TCPCNNJOB 將 TCP connection data output to print or file, 此程式是以
TCP/IP management APIs (1) by Carsten Flensburg 未範本修改而成,非常感謝 Carsten Flensburg
的幫助.
File : QRPGLESRC
Member: TCPCNNJOB
Type : SQLRPGLE
Usage : CRTSQLRPG OBJ(TCPCNNJOB) SRCFILE(lib/file) SRCMBR(TCPCNNJOB)
**
** Program . . : TCPCNNJOB
** Description : Retrieve TCP/IP connection Job to ptint or file
** Author . . : Vengoal Chang
** Published . : AS400ePaper
** Date . . . : April 21, 2006
** Based on : iSeriesnetwork
** TCP/IP management APIs (1) by Carsten Flensburg
**
** Program summary
** ---------------
**
** Object - User space APIs:
** QUSCRTUS Create user space Creates a user space in either
** user domain or system domain.
** Only user domain user spaces are
** accessible by the user space APIs.
**
** QUSDLTUS Delete user space Deletes the user space specified.
**
** QUSPTRUS Retrieve pointer to The address of the first byte
** user space of the storage allocated by the
** user space requested is returned.
**
**
** Communication - TCP/IP management APIs:
** QtocRtvTCPA Retrieve TCP/IP Retrieves TCP/IPv4 and TCP/IPv6
** attributes (V5R2) stack attributes.
**
** QtocLstNetCnn List network Returns a non-detailed list of
** connections network connections based on a
** set of selection criteria defined
** in the list qualifier parameter.
**
** QtocRtvNetCnnDta List network Retrieves detailed information
** connection data and connection totals for the
** specified network connection.
**
**
** Sequence of events:
** 1. The current operational status of the TCP/IP stack is retrieved
** to ensure that TCP/IP connection information is available.
**
** 2. A user space is created and a list of the current TCP/IP network
** connections is loaded to the user space.
**
** 3. For each TCP/IP network connection retrieved from user space a
** report line is printed and subsequently the associated network
** connection data are retrieved.
**
** 4. The based data and list structures are allocated to the storage
** adresses defined by the offsets found in the basic and additional
** information API formats.
**
** 5. A report line is printed for each of the servicing jobs associated
** with the current network connection.
**
** 6. Finally the user space is deleted, explicitly allocated storage
** freed and the program is terminated.
**
**
** Programmer's notes:
** Earliest release program will run: V5R1
**
** The examples here are all retrieving information about TCP/IPv4
** stacks and connections. As of V5R2 new API formats are available
** for retrieval of similar TCP/IPv6 stack and connection information.
**
** Be careful to allocate sufficient storage for the return structure
** of the QtocRtvNetCnnDta API initially. The returned value for bytes
** actually available might not include the additional structures,
** Socket options and Associated jobs/tasks.
**
** The QtocRtvNetCnnDta API has a reported problem involving a memory
** leak. The following PTFs have been released to fix the problem:
** R510 SI09122 1000
** R520 SI09175 1000
**
**
** Compile options:
**
** CRTSQLRPG OBJ(TCPCNNJOB) SRCFILE(lib/file) SRCMBR(TCPCNNJOB)
**
**
**-- Header specifications: --------------------------------------------**
H Option( *SrcStmt ) DFTACTGRP(*NO)
**-- Printer file: -----------------------------------------------------**
FQSYSPRT O F 132 Printer InfDs( PrtLinInf ) OflInd( *InOf )
F UsrOpn
**-- Printer file information: -----------------------------------------**
D PrtLinInf Ds
D PlOvfLin 5i 0 Overlay( PrtLinInf: 188 )
D PlCurLin 5i 0 Overlay( PrtLinInf: 367 )
D PlCurPag 5i 0 Overlay( PrtLinInf: 369 )
**-- System information: -----------------------------------------------**
D SDs
D PsPgmNam *Proc
**-- Global declarations: ----------------------------------------------**
D Lix s 10u 0
D Dix s 10u 0
D BytAlc s 10u 0
D UsrSpc c 'LSTNETCNN QTEMP'
**
DOutFile DS
D ##file 10a
D ##lib 10a
D sqlstm s 500
D sqlstm1 s 500
D tick s 1 Inz('''')
D IdleSecs s 10U 0
**
D Time s 6s 0
D NbrRcds s 10u 0
D TcpCnnStt s 4a
D ConOpnTyp s 3a
**-- Tcp state table: --------------------------------------------------**
D SttTbl Ds
D TcpStt 5a Dim( 12 )
D 60a Overlay( SttTbl )
D Inz( 'LST SYNR SYNS EST FIN1 FIN2 +
D CLO2 CLO1 LACK WAIT CLO n/s ')
**-- Open type table: --------------------------------------------------**
D OpnTbl Ds
D OpnTyp 4a Dim( 3 )
D 12a Overlay( OpnTbl )
D Inz( 'PSV ACT n/s ' )
**-- Api error data structure: -----------------------------------------**
D ApiError Ds
D AeBytPro 10i 0 Inz( %Size( ApiError ))
D AeBytAvl 10i 0 Inz
D AeMsgId 7a
D 1a
D AeMsgDta 128a
**
**-- API Header information: -------------------------------------------**
D HdrInf Ds Based( pHdrInf )
D HiUsrSpcNamSp 10a
D HiUsrSpcLibSp 10a
**-- User space generic header: ---------- -----------------------------**
D UsrSpcHdr Ds Based( pUsrSpc )
D UsOfsHdr 10i 0 Overlay( UsrSpcHdr: 117 )
D UsOfsLst 10i 0 Overlay( UsrSpcHdr: 125 )
D UsNumLstEnt 10i 0 Overlay( UsrSpcHdr: 133 )
D UsSizLstEnt 10i 0 Overlay( UsrSpcHdr: 137 )
**-- User space pointers: ----------------------------------------------**
D pUsrSpc s * Inz( *Null )
D pHdrInf s * Inz( *Null )
D pLstEnt s * Inz( *Null )
**-- TCP/IP attributes: ------------------------------------------------**
D TCPA0100 Ds
D T1BytRtn 10u 0
D T1BytAvl 10u 0
D T1StkSts 10u 0
D T1ActTim 10u 0
D T1LstStrD 8a
D T1LstStrT 6a
D T1LstEndD 8a
D T1LstEndT 6a
D T1StrJob 10a
D T1StrUsr 10a
D T1StrNbr 6a
D T1StrJobInt 16a
D T1EndJob 10a
D T1EndUsr 10a
D T1EndNbr 6a
D T1EndJobInt 16a
D T1OfsAddInf 10u 0
D T1LenAddInf 10u 0
**-- Connection list qualifier: ----------------------------------------**
D NCLQ0100 Ds
D N1NetCnnTyp 10a Inz( '*ALL' )
D N1LstRqsTyp 10a Inz( '*ALL' )
D 12a Inz( *Allx'00' )
D N1LocAdrLow 10u 0 Inz( 0 )
D N1LocAdrUpr 10u 0 Inz( 0 )
D N1LocPortLow 10u 0 Inz( 0 )
D N1LocPortUpr 10u 0 Inz( 0 )
D N1RmtAdrLow 10u 0 Inz( 0 )
D N1RmtAdrUpr 10u 0 Inz( 0 )
D N1RmtPortLow 10u 0 Inz( 0 )
D N1RmmPortUpr 10u 0 Inz( 0 )
**-- Connection list entry: --------------------------------------------**
D NCNN0100 Ds Based( pLstEnt )
D C1RmtAdr 15a
D 1a
D C1RmtAdrBin 10u 0
D C1LocAdr 15a
D 1a
D C1LocAdrBin 10u 0
D C1RmtPort 10u 0
D C1LocPort 10u 0
D C1TcpState 10u 0
D C1IdlTimMs 10u 0
D C1BytIn 20u 0
D C1BytOut 20u 0
D C1ConOpnTyp 10u 0
D C1NetCnnTyp 10a
D 1a
**-- Following fields were added in V5R2 - do not reference in V5R1:
D 1a
D C1AscUsrPrf 10a
D 2a
**-- Socket connection request: ----------------------------------------**
D SocCnnRqs Ds
D ScProtocol 10u 0
D ScLocIpAdr 10u 0
D ScLocPortNbr 10u 0
D ScRmtIpAdr 10u 0
D ScRmtPortNbr 10u 0
**-- Connection data: --------------------------------------------------**
D NCND0100 Ds Based( pCnnDta )
D D1BytRtn 10u 0
D D1BytAvl 10u 0
D D1CurCnnEst 10u 0
D D1ActOpn 10u 0
D D1PasOpn 10u 0
D D1AttOpnFail 10u 0
D D1EstNxtRes 10u 0
D D1SegSnt 10u 0
D D1SegRtr 10u 0
D D1SegRsn 10u 0
D D1SegRcv 10u 0
D D1SegRcvErr 10u 0
D D1DtgSnt 10u 0
D D1DtgRcv 10u 0
D D1DtgNdlPort 10u 0
D D1DtgNdlOde 10u 0
D D1AddInfOfs 10u 0
D D1AddInfLen 10u 0
**
D NCND0200 Ds Based( pCnnDtaInf )
D D2Protocol 10u 0
D D2LocIpAdr 10u 0
D D2LocPortNbr 10u 0
D D2RmtIpAdr 10u 0
D D2RmtPortNbr 10u 0
D D2RndTrpTim 10u 0
D D2RndTrpVar 10u 0
D D2OutBytBuf 10u 0
D D2UsrSndNxt 10u 0
D D2SndNxt 10u 0
D D2SndUnack 10u 0
D D2OutPshNbr 10u 0
D D2OutUrgNbr 10u 0
D D2OutWdwNbr 10u 0
D D2IncBytBuf 10u 0
D D2RcvNxt 10u 0
D D2UsrRcvNxt 10u 0
D D2IncPshNbr 10u 0
D D2IncUrgNbr 10u 0
D D2IncWdwNbr 10u 0
D D2TotRtr 10u 0
D D2CurRtr 10u 0
D D2MaxWdwSiz 10u 0
D D2CurWdwSiz 10u 0
D D2LastUpd 10u 0
D D2LastUpdAck 10u 0
D D2CngWdw 10u 0
D D2SlwStrThr 10u 0
D D2MaxSegSiz 10u 0
D D2InzSndSeqNb 10u 0
D D2InzRcvSeqNb 10u 0
D D2CnnTspLayer 10u 0
D D2TcpState 10u 0
D D2CnnOpnTyp 10u 0
D D2IdlTimMs 10u 0
D D2IpOpt 40a
D D2BytIn 10u 0
D D2BytOut 10u 0
D D2SocState 10u 0
D D2SocLstOfs 10u 0
D D2SocEntNbr 10u 0
D D2SocEntLen 10u 0
D D2JobLstOfs 10u 0
D D2JobEntNbr 10u 0
D D2JobEntLen 10u 0
**-- Following fields were added in V5R2 - do not reference in V5R1:
D D2AscUsrPrf 10a
D 2a
**-- Socket options list:
D SocOptLst Ds Based( pSocOptLst )
D SoSocOpt 10u 0
D SoOptVal 10u 0
**-- Associated jobs/tasks list:
D JobCnnLst Ds Based( pJobCnnLst )
D JcFmtEnt 10u 0
D JcTskNam 16a
D JcJobNam 10a
D JcJobUsr 10a
D JcJobNbr 6a
D JcJobId 16a
**-- Create user space: -------------------------------------------------**
D CrtUsrSpc Pr ExtPgm( 'QUSCRTUS' )
D CsSpcNamQ 20a Const
D CsExtAtr 10a Const
D CsInzSiz 10i 0 Const
D CsInzVal 1a Const
D CsPubAut 10a Const
D CsText 50a Const
**-- Optional 1:
D CsReplace 10a Const Options( *NoPass )
D CsError 32767a Options( *NoPass: *VarSize )
**-- Optional 2:
D CsDomain 10a Const Options( *NoPass )
**-- Delete user space: -------------------------------------------------**
D DltUsrSpc Pr ExtPgm( 'QUSDLTUS' )
D DsSpcNamQ 20a Const
D DsError 32767a Options( *VarSize )
**-- Retrieve pointer to user space: ------------------------------------**
D RtvPtrSpc Pr ExtPgm( 'QUSPTRUS' )
D RpSpcNamQ 20a Const
D RpPointer *
D RpError 32767a Options( *NoPass: *VarSize )
**-- Retrieve TCP/IP attributes: ---------------------------------------**
D RtvTcpA Pr ExtProc( 'QtocRtvTCPA' )
D RtRcvVar 32767a Options( *VarSize )
D RtRcvVarLen 10i 0 Const
D RtFmtNam 8a Const
D RtError 32767a Options( *VarSize )
**-- List network connections: -----------------------------------------**
D LstNetCnn Pr ExtProc( 'QtocLstNetCnn' )
D LcSpcNamQ 20a Const
D LcFmtNam 8a Const
D LcCnnQual 64a Const
D LcCnnQualSiz 10i 0 Const
D LcCnnQualFmt 8a Const
D LcError 32767a Options( *VarSize )
**-- Retrieve network connection data: ---------------------------------**
D RtvCnnDta Pr ExtProc( 'QtocRtvNetCnnDta' )
D RcRcvVar 65535a Options( *VarSize )
D RcRcvVarLen 10i 0 Const
D RcFmtNam 8a Const
D RcSocCnnRqs 20a Const
D RcError 32767a Options( *VarSize )
**
**-- Mainline: ---------------------------------------------------------**
**
C *Entry Plist
c Parm include 1
c Parm OutPut 6
* OutPut(*Print *File)
c Parm OutFile
* OutPutFile and Library
c Parm FileOpt 8
* File Option(*REPLACE -or- *ADD)
C Time Time
C
C If OutPut = '*PRINT'
C Except Header
C EndIf
**
C CallP RtvTcpA( TCPA0100
C : %Size( TCPA0100 )
C : 'TCPA0100'
C : ApiError
C )
**
C Select
C When AeBytAvl > *Zero
**-- Error occurred...
C Except NoStack
**
C When T1StkSts = 0 Or
C T1StkSts = 2
**-- TCP/IP stack not operational...
C Except NoStack
**
C Other
C Eval BytAlc = 32767
C Eval pCnnDta = %Alloc( BytAlc )
**
C CallP CrtUsrSpc( UsrSpc
C : *Blanks
C : 65535
C : x'00'
C : '*CHANGE'
C : *Blanks
C : '*YES'
C : ApiError
C )
**
C CallP LstNetCnn( UsrSpc
C : 'NCNN0100'
C : NCLQ0100
C : %Size( NCLQ0100 )
C : 'NCLQ0100'
C : ApiError
C )
**
C If AeBytAvl = *Zero
C ExSr PrcLstEnt
C EndIf
**
C CallP DltUsrSpc( UsrSpc
C : ApiError
C )
**
C DeAlloc pCnnDta
**
C If NbrRcds = *Zero and
C OutPut = '*PRINT'
C Except NoRcds
C EndIf
C EndSl
**
C Eval *InLr = *On
C Return
*--------- Start the program ---------------
C *inzsr Begsr
c if Output = '*FILE' and
c Fileopt = '*REPLACE'
C Exsr $SQLDrop
C Exsr $SQLCreate
c endif
c if Output = '*FILE' and
c Fileopt = '*ADD'
C Exsr $SQLCreate
c endif
c if OutPut = '*PRINT'
c Open Qsysprt
c endif
C Endsr
**
**-- Process list entries: ---------------------------------------------**
C PrcLstEnt BegSr
**
C CallP RtvPtrSpc( UsrSpc
C : pUsrSpc
C )
**
C Eval pHdrInf = pUsrSpc + UsOfsHdr
C Eval pLstEnt = pUsrSpc + UsOfsLst
**
C For Lix = 1 to UsNumLstEnt
**
C If Include = 'Y' OR
C (Include = 'N' and C1TcpState <> 0)
C Eval TcpCnnStt = TcpStt(C1TcpState + 1)
C If OutPut = '*PRINT'
C ExSr PrtCnnDtl
C EndIf
**
C Select
C When C1NetCnnTyp = '*TCP'
C Eval ScProtocol = 1
**
C When C1NetCnnTyp = '*UDP'
C Eval ScProtocol = 2
**
C Other
C Eval ScProtocol = 0
C EndSl
C
C If ScProtocol > 0
**
C Eval ScLocIpAdr = C1LocAdrBin
C Eval ScLocPortNbr= C1LocPort
C Eval ScRmtIpAdr = C1RmtAdrBin
C Eval ScRmtPortNbr= C1RmtPort
**
C if C1IdlTimMs > 0
C Eval IdleSecs = C1IdlTimMs / 1000
C Else
C Eval IdleSecs = 0
C EndIf
C DoU D1BytAvl <= BytAlc
**
C If D1BytAvl > BytAlc
C Eval BytAlc = D1BytAvl
C Eval pCnnDta = %ReAlloc( pCnnDta: BytAlc )
C EndIf
**
C CallP RtvCnnDta( NCND0100
C : BytAlc
C : 'NCND0200'
C : SocCnnRqs
C : ApiError
C )
C EndDo
**
C If AeBytAvl = *Zero
C ExSr PrcDtaEnt
C EndIf
C EndIf
C EndIf
**
C If Lix < UsNumLstEnt
C Eval pLstEnt = pLstEnt + UsSizLstEnt
C EndIf
C EndFor
**
C EndSr
**-- Process data list entries: ----------------------------------------**
C PrcDtaEnt BegSr
**
C Eval pCnnDtaInf = pCnnDta + D1AddInfOfs
**
**-- Socket options:
C Eval pSocOptLst = pCnnDta + D2SocLstOfs
C For Dix = 1 to D2SocEntNbr
**
**--
C If Dix < D2SocEntNbr
C Eval pSocOptLst = pSocOptLst + D2SocEntLen
C EndIf
C EndFor
**
**-- Associated jobs:
C Eval pJobCnnLst = pCnnDta + D2JobLstOfs
**
C For Dix = 1 to D2JobEntNbr
**
C If JcFmtEnt = 1
C If OutPut = '*FILE'
C Exsr $SQLAddRec
C Else
C ExSr PrtJobDtl
C EndIf
C EndIf
**
C If Dix < D2JobEntNbr
C Eval pJobCnnLst = pJobCnnLst + D2JobEntLen
C EndIf
C EndFor
**
C EndSr
**-- Print connection detail line: -------------------------------------**
C PrtCnnDtl BegSr
**
C If PlCurLin > PlOvfLin - 3
C Except Header
C EndIf
**
C Eval TcpCnnStt = TcpStt(C1TcpState + 1)
C Eval ConOpnTyp = OpnTyp(C1ConOpnTyp + 1)
**
C Eval NbrRcds = NbrRcds + 1
C Except CnnDtl
**
C EndSr
**-- Print connection job detail line: ---------------------------------**
C PrtJobDtl BegSr
**
C If PlCurLin > PlOvfLin - 2
C Except Header
C EndIf
**
C Except JobDtl
**
C EndSr
*---------------------------------------------------------------
C* SQL Create Table
*---------------------------------------------------------------
C $SQLCreate Begsr
C eval sqlStm = 'create table ' +
C %trim(##lib) + '/' +
C %trim(##File) + '(' +
C ' LclAddr CHAR(15) NOT NULL,' +
C ' RmtAddr CHAR(15) NOT NULL,' +
C ' LclPort NUMERIC(5,0) NOT NULL,' +
C ' RmtPort NUMERIC(5,0) NOT NULL,' +
C ' JcJobNam CHAR(10) NOT NULL,' +
C ' JcJobUsr CHAR(10) NOT NULL,' +
C ' JcJobNbr CHAR(6) NOT NULL,' +
C ' TcpCnnStt CHAR(4) NOT NULL,' +
C ' IdleSecs NUMERIC(10,0) NOT NULL,' +
C ' OutPutTime TIMESTAMP +
C NOT NULL WITH DEFAULT ' +
C ') '
c/Exec Sql
c+ declare s statement
c/End-Exec
c/Exec Sql
c+ prepare s from :sqlStm
c/End-Exec
c/Exec Sql
c+ execute s
c/End-Exec
C Endsr
*---------------------------------------------------------------
C* SQL Drop Table
*---------------------------------------------------------------
C $SQLDrop Begsr
C eval sqlStm = 'drop table ' +
C %trim(##lib) + '/' +
C %trim(##File)
C/exec SQL
C+ Set option commit = *none
C/end-EXEC
c/Exec Sql
c+ declare d statement
c/End-Exec
c/Exec Sql
c+ prepare d from :sqlStm
c/End-Exec
c/Exec Sql
c+ execute d
c/End-Exec
C Endsr
*---------------------------------------------------------------
C* SQL Add to Table
*---------------------------------------------------------------
C $SQLAddRec Begsr
C X'00':' ' xlate c1locadr c1locadr
C X'00':' ' xlate c1rmtadr c1rmtadr
C eval sqlStm1 = 'insert into ' +
C %trim(##lib) + '/' +
C %trim(##File) + '(' +
C ' LclAddr,' +
C ' RmtAddr,' +
C ' LclPort,' +
C ' RmtPort,' +
C ' JcJobNam,' +
C ' JcJobUsr,' +
C ' JcJobNbr,' +
C ' TcpCnnStt,'+
C ' IdleSecs' +
C ') Values('+ tick +
c c1locadr + tick + ', ' + tick +
c c1rmtadr + tick + ', ' +
c %editc(c1locport : '3') + ', ' +
c %editc(c1rmtport : '3') + ', ' +tick +
c JcJobNam + tick + ', ' + tick +
c JcJobUsr + tick + ', ' + tick +
c JcJobNbr + tick + ', ' + tick +
c TcpCnnStt + tick + ', ' +
c %editc(idlesecs: '3')+ ')'
c/Exec Sql
c+ declare w statement
c/End-Exec
c/Exec Sql
c+ prepare w from :sqlStm1
c/End-Exec
c/Exec Sql
c+ execute w
c/End-Exec
C Endsr
*---------------------------------------------------------------
**-- Print file definition: --------------------------------------------**
OQSYSPRT EF Header 2 3
O UDATE Y 8
O Time 18 ' : : '
O 75 'Print TCP/IP connection -
O status'
O 107 'Program:'
O PsPgmNam 118
O 126 'Page:'
O PAGE + 1
OQSYSPRT EF Header 1
O 14 'Remote address'
O 25 '- Port'
O 40 'Local address'
O 52 '- Port'
O 58 'Type'
O 70 'Open'
O 76 'State'
O 90 'Idle time ms'
O 111 'Bytes in'
O 132 'Bytes out'
**
OQSYSPRT EF CnnDtl 1
O C1RmtAdr 15
O C1RmtPort 3 25
O C1LocAdr 42
O C1LocPort 3 52
O C1NetCnnTyp 64
O ConOpnTyp 69
O TcpCnnStt 76
O C1IdlTimMs 3 90
O C1BytIn 3 111
O C1BytOut 3 132
**
OQSYSPRT EF JobDtl 1
O 22 'Connection job name:'
O JcJobNam 33
O 41 '- user:'
O JcJobUsr 52
O 61 '- number:'
O JcJobNbr 68
**
OQSYSPRT EF NoStack 1
O 26 '(TCP/IP stack not active)'
OQSYSPRT EF NoRcds 1
O 26 '(No entries found)'
File : QCMDSRC
Member: TCPCNNJOB
Type : CMD
Usage : CRTCMD CMD(TCPCNNJOB) PGM(TCPCNNJOB)
/* =============================================================== */
/* = Command....... TCPCNNJOB = */
/* = CPP........... TCPCNNJOB = */
/* = Description... Output TCP connection job information to = */
/* = print or file = */
/* = = */
/* = CrtCmd Cmd( TcpCnnJob ) = */
/* = Pgm( TcpCnnJob ) = */
/* = SrcFile( YourSourceFile ) = */
/* =============================================================== */
/* = Date : 2006/04/26 = */
/* = Author: Vengoal Chang = */
/* =============================================================== */
CMD PROMPT('TCPCnnJob - OutPut for TCP job')
PARM KWD(LISTEN) TYPE(*CHAR) LEN(1) RSTD(*YES) +
DFT(N) VALUES(Y N) PROMPT('Include +
Listening Ports?' 1)
PARM KWD(OUTPUT) TYPE(*CHAR) LEN(6) RSTD(*YES) +
DFT(*PRINT) VALUES(*PRINT *FILE) +
PROMPT('Output' 2)
PARM KWD(FILE) TYPE(FILE) PMTCTL(ISFILE) +
PROMPT('File Name' 3)
PARM KWD(FILEOPT) TYPE(*NAME) LEN(8) DFT(*ADD) +
SPCVAL((*ADD) (*REPLACE)) PMTCTL(ISFILE) +
PROMPT('File Option' 4)
FILE: QUAL TYPE(*NAME) LEN(10) DFT(TCPCNNJOB)
QUAL TYPE(*NAME) LEN(10) DFT(QTEMP) +
SPCVAL((*LIBL)) PROMPT('Library')
ISFILE: PMTCTL CTL(OUTPUT) COND((*EQ '*FILE'))
Run sample:
TCPCNNJOB, 按 F4:
TCPCnnJob - OutPut for TCP job (TCPCNNJOB)
Type choices, press Enter.
Include Listening Ports? . . . . N Y, N
Output . . . . . . . . . . . . . > *FILE *PRINT, *FILE
File Name . . . . . . . . . . . TCPCNNJOB Name
Library . . . . . . . . . . . QTEMP Name, *LIBL
File Option . . . . . . . . . . *ADD Name, *ADD, *REPLACE
按 Enter,此時 QTEMP 下會有 TCPCNNJOB PF, RUNQRY *N TCPCNNJOB 即可以 Job name 查詢
2006-05-29 如何於 OS/400 V4R5 檢核 TCPIP 是否已啟動 ?
如何於 OS/400 V4R5 檢核 TCPIP 是否已啟動 ?
前一期 "如何檢核 TCPIP 是否已啟動 ?(RTVTCPSTS with API QtocRtvTCPA)"
僅適用於從 V5R1 以後, 那 V4R5 以前就要利用偵測兩個系統作業是否已啟動,
來決定, 下述範例是利用前期
"2003-09-08 如何確認某個 Job 已在系統中執行？(CMD: RTVJOBSTS)" 電子報,
來檢核 TCP/IP 是否已啟動.
當然此法也適用於 V5R1 以後.
File : QCLSRC
Member: RTVTCPSTSC
Type : CLP
Usage : CRTCLPGM RTVTCPSTSC
CALL RTVTCPSTSC
/*********************************************************************/
/* The pgm to check TCP/IP status ans uesd before V4R5(include) */
/* */
/* After started TCP/IP, there are two system jobs started */
/* as following: */
/* QTCPIP, QTCPMONITR */
/* */
/* We just check these two jobs active or not to determine TCP/IP */
/* Status */
/* */
/*********************************************************************/
PGM
DCL &RC1 *CHAR 1
DCL &RC2 *CHAR 1
RTVJOBSTS JOB(QTCPIP) STATUS(&RC1)
RTVJOBSTS JOB(QTCPMONITR) STATUS(&RC2)
IF (&RC1 *EQ '1' *AND &RC2 *EQ '1') +
SNDPGMMSG MSG('TCP/IP is active.')
ELSE +
SNDPGMMSG MSG('TCP/IP is not active.')
ENDPGM
2006-04-25 如何檢核 TCPIP 是否已啟動 ?(Command RTVTCPSTS with API QtocRtvTCPA)
如何檢核 TCPIP 是否已啟動 ?(Command RTVTCPSTS with API QtocRtvTCPA)
File : QRPGLESRC
Member: RTVTCPSTS
Type : RPGLE
Usage : CRTBNDRPG RTVTCPSTS
**
** Program . . : RTVTCPSTS
** Description : Retrieve TCP/IP status
** Author . . : Vengoal Chang
** Published . : AS400ePaper
** Date . . . : April 21, 2006
**
**
** Program summary
** ---------------
**
** Object - User space APIs:
** QUSCRTUS Create user space Creates a user space in either
** user domain or system domain.
** Only user domain user spaces are
** accessible by the user space APIs.
**
** QUSDLTUS Delete user space Deletes the user space specified.
**
** QUSPTRUS Retrieve pointer to The address of the first byte
** user space of the storage allocated by the
** user space requested is returned.
**
**
** Communication - TCP/IP management APIs:
** QtocRtvTCPA Retrieve TCP/IP Retrieves TCP/IPv4 and TCP/IPv6
** attributes (V5R2) stack attributes.
** API introduced: V5R1
**
** TCP/IP stack status
** 0 Inactive
** 1 Active
** 2 Starting
** 3 Ending, immediate
** 4 Ending, controlled
**
**
** events:
** The current operational status of the TCP/IP stack is retrieved
** to ensure that TCP/IP connection information is available.
**
**
** Compile options:
**
** CrtRpgMod Module( RTVTCPSTS ) DbgView( *LIST )
**
** CrtPgm Pgm( RTVSCPSTS )
** Module( RTVTCPSTS )
**
**-- Header specifications: --------------------------------------------**
H Option( *SrcStmt ) DFTACTGRP(*NO) debug
**-- Api error data structure: -----------------------------------------**
D ApiError Ds
D AeBytPro 10i 0 Inz( %Size( ApiError ))
D AeBytAvl 10i 0 Inz
D AeMsgId 7a
D 1a
D AeMsgDta 128a
**
**-- TCP/IP attributes: ------------------------------------------------**
D TCPA0100 Ds
D T1BytRtn 10u 0
D T1BytAvl 10u 0
D T1StkSts 10u 0
D T1ActTim 10u 0
D T1LstStrD 8a
D T1LstStrT 6a
D T1LstEndD 8a
D T1LstEndT 6a
D T1StrJob 10a
D T1StrUsr 10a
D T1StrNbr 6a
D T1StrJobInt 16a
D T1EndJob 10a
D T1EndUsr 10a
D T1EndNbr 6a
D T1EndJobInt 16a
D T1OfsAddInf 10u 0
D T1LenAddInf 10u 0
**-- Retrieve TCP/IP attributes: ---------------------------------------**
D RtvTcpA Pr ExtProc( 'QtocRtvTCPA' )
D RtRcvVar 32767a Options( *VarSize )
D RtRcvVarLen 10i 0 Const
D RtFmtNam 8a Const
D RtError 32767a Options( *VarSize )
**
D TCPSTS s 1
** Return TCP/IP status
** 'E' --> TCP/IP API error.
** '0' --> TCP/IP not active.
** '1' --> TCP/IP is active.
**
**-- Mainline: ---------------------------------------------------------**
**
C *entry Plist
C Parm TCPSTS
**
C CallP RtvTcpA( TCPA0100
C : %Size( TCPA0100 )
C : 'TCPA0100'
C : ApiError
C )
**
C Select
C When AeBytAvl > *Zero
**-- Error occurred...
C Eval TcpSts = 'E'
C* dump
**
C When T1StkSts = 0 Or
C T1StkSts = 2
**-- TCP/IP stack not operational...
C Eval TcpSts = '0'
**
C When T1StkSts = 3 Or
C T1StkSts = 4
**-- TCP/IP Ending ....
C Eval TcpSts = '0'
**
C Other
**-- TCP/IP Active ...
C Eval TcpSts = '1'
C EndSl
**
C Eval *InLr = *On
C Return
**
File : QCMDSRC
Member: RTVTCPSTS
Type : CMD
Usage : CRTCMD CMD(RTVTCPSTS) PGM(RTVTCPSTDS) ALLOW(*IPGM *BPGM)
/* =============================================================== */
/* = Command....... RtvTcpSts = */
/* = CPP........... RtvTcpSts RPGLE = */
/* = Description... Retrieve TCP/IP Status = */
/* = = */
/* = CrtCmd Cmd( RtvTcpSts ) = */
/* = Pgm( RtvTcpSts ) = */
/* = SrcFile( YourSourceFile ) Allow(*Ipgm *Bpgm) = */
/* =============================================================== */
/* = TCPSTS return value : = */
/* = '0' -- TCP/IP not active = */
/* = '1' -- TCP/IP active = */
/* = 'E' -- TCP/IP API error = */
/* =============================================================== */
/* = Date : 2006/04/24 = */
/* = Author: Vengoal Chang = */
/* =============================================================== */
CMD PROMPT('Retrieve TCP/TP Status')
PARM KWD(TCPSTS) TYPE(*CHAR) LEN(1) RTNVAL(*YES) +
PROMPT('TCP/IP status')
File : QCLSRC
Member: RTVTCPSTST
Type : CLP
Usage : CRTCLPGM RTVTCPSTST
測試程式
CALL RTVTCPSTST
PGM
DCL VAR(&TCPSTS) TYPE(*CHAR) LEN(1)
RTVTCPSTS TCPSTS(&TCPSTS)
IF COND(&TCPSTS *EQ '1') THEN(SNDPGMMSG +
MSG('TCP/IP status is active.'))
IF COND(&TCPSTS *EQ '2') THEN(SNDPGMMSG +
MSG('TCP/IP status is ending.'))
IF COND(&TCPSTS *EQ '0') THEN(SNDPGMMSG +
MSG('TCP/IP status is not active.'))
IF COND(&TCPSTS *EQ 'E') THEN(SNDPGMMSG +
MSG('TCP/IP API call error! Please see +
dump printer file.'))
ENDPGM
訂閱：
文章 (Atom)