如何擷取 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
星期二, 11月 07, 2023
2006-08-14 如何擷取 AS/400 FTP server 屬性?(Command: RTVFTPA with API QPTRTVPO)
訂閱：
張貼留言 (Atom)
沒有留言:
張貼留言