如何於 CLP 中，將資料存入原始程式檔案成員中(Source Physical File member)？(Command: WRTSRCREC)
由於現行商業環境中時常需要做資料轉換及傳輸，最常用的工具是 SQL 或 FTP，所以時常需要寫 script
於 source 中，讓 FTP 或 RUNSQLSTM 執行時使用，而此類指令都是使用原始程式檔案成員當成script 指令來源，
所以需要事先將 script 指令寫於原始程式檔案成員中，若遇上某些名稱是動態時，便需要另寫程式控制，往往因
此類需求愈多造成困擾及維護困難，所以我寫一個指令 WRTSRCREC 來達成動態寫入資料到所指定的原始程式檔案成員。
File : QRPGLESRC
Member: WRKSRCREC
Type : RPGLE
Usage : CRTBNDRPG WRKSRCREC
**
** Program . . : WRTSRCREC
** Description : Write text to source member
** Author . . : Vengoal Chang
**
** Date . . : 2008/05/31
**
** Compile and setup instructions:
** CrtBndRpg Pgm( WRTSRCREC )
** DbgView( *LIST )
**
**
**-- Control specification: --------------------------------------------**
H DFTACTGRP(*NO) BNDDIR('QC2LE')
H OPTION(*NODEBUGIO : *SRCSTMT) DEBUG
FQSRC O A F 266 DISK USROPN INFDS(INFDS)
D WRTSRCREC PR Extpgm('WRTSRCREC')
D SRCFILE 20A CONST
D SRCMBR 10A CONST
D inData 252A
D WRTSRCREC PI
D SRCFILE 20A CONST
D SRCMBR 10A CONST
D inData 252A
D Data DS Based(pData)
D nInDataLen 5I 0
D szData 250A
D INFDS DS
D szSrcFileName 83 92A
D szSrcFileLib 93 102A
D szSrcFileMbr 129 138A
D nSrcRecLen 125 126I 0
D nSrcRecCnt 156 159I 0
* QCMDEXC - Prototyped Call
D qcmdexc PR EXTPGM('QCMDEXC')
D cmd_str 1024 OPTIONS(*VARSIZE) CONST
D cmd_len 15P 5 CONST
D cmdStr S 512A Varying
D today S D Inz(*SYS)
D SRCSEQ S 6S 2
D SRCDATE S 6S 0
D SRCDATA S 250A
**-- Send program message:
D SndPgmMsg Pr ExtPgm( 'QMHSNDPM' )
D SpMsgId 7a Const
D SpMsgFq 20a Const
D SpMsgDta 128a Const
D SpMsgDtaLen 10i 0 Const
D SpMsgTyp 10a Const
D SpCalStkE 10a Const Options( *VarSize )
D SpCalStkCtr 10i 0 Const
D SpMsgKey 4a
D SpError 32767a Options( *VarSize )
D MsgKey s 4a
D MsgTxt s 512a
**-- Receive Program Message (QMHRCVPM) API
D QMHRCVPM PR ExtPgm('QMHRCVPM')
D MsgInfo 32767A options(*varsize)
D MsgInfoLen 10I 0 const
D Format 8A const
D StackEntry 10A const
D StackCount 10I 0 const
D MsgType 10A const
D MsgKey 4A const
D WaitTime 10I 0 const
D MsgAction 10A const
D ErrorCode 32767A options(*varsize)
**-- Message text parameter: ------------------------------------
D RCVM0200 Ds
D M2BytPrv 10i 0
D M2BytAvl 10i 0
D M2MsgSev 10i 0
D M2MsgId 7a
D M2MsgTyp 2a
D M2MsgKey 4a
D M2MsgF 10a
D M2MsgFlib 10a
D M2MsgFlibUsd 10a
D M2SndJob 10a
D M2SndUsrPrf 10a
D M2SndJobNbr 6a
D M2SndPgm 12a
D 4a
D M2SndDat 7a
D M2SndTim 6a
D 17a
D M2CcsIdCsiTxt 10i 0
D M2CcsIdCsiDta 10i 0
D M2AlrOpt 9a
D M2CcsIdTxt 10i 0
D M2CcsIdDta 10i 0
D M2MsgDtaRtn 10i 0
D M2MsgDtaAvl 10i 0
D M2MsgTxtRtn 10i 0
D M2MsgTxtAvl 10i 0
D M2MsgHlpRtn 10i 0
D M2MsgHlpAvl 10i 0
D M2MsgVarFld 4096a
D ErrorNull ds
D BytesProv 10i 0 inz(0)
D BytesAvaile 10i 0 inz(0)
C eval *INLR = *ON
C eval cmdStr= 'CHKOBJ OBJ(' +
C %TrimR(%SUBST(SRCFILE:11:10)) + '/' +
C %TrimR(%SUBST(SRCFILE:01:10)) + ')' +
C ' OBJTYPE(*FILE)' +
C ' MBR(' + %TrimR(srcmbr) + ')'
C ExSr PrcCmd
C eval cmdStr= 'OVRDBF FILE(QSRC) TOFILE(' +
C %TrimR(%SUBST(SRCFILE:11:10)) + '/' +
C %TrimR(%SUBST(SRCFILE:01:10)) + ')' +
C ' MBR(' + %TrimR(srcmbr) + ')' +
C ' SECURE(*YES)'
C ExSr PrcCmd
C open QSRC
C if NOT %OPEN(QSRC)
C return
C endif
C eval pData = %addr(inData)
C if nInDataLen > nSrcRecLen
C eval srcData = %subst(szData:1:nSrcRecLen)
C eval %Subst(srcData : nSrcRecLen : 1) = '-'
C eval srcseq = nSrcRecCnt + 1
C except OUTPUT
C eval srcData = %subst(szData:nSrcRecLen)
C eval srcseq = nSrcRecCnt + 1
C except OUTPUT
C else
C eval srcseq = nSrcRecCnt + 1
C eval srcData = %subst(szData:1:nInDataLen)
C except OUTPUT
C endif
C CLOSE QSRC
C return
*=====================================================================
* Process command
*=====================================================================
C PrcCmd BegSr
C CALLP(e) QCMDEXC( cmdStr : %len(%trimr(cmdStr)))
C If %error
C ExSr RcvErrMsg
C ExSr SndEscMsg
C return
C EndIf
C EndSr
*=====================================================================
* Retrieve error message from joblog and get message text from MSGF
*=====================================================================
C RcvErrMsg BegSr
C Callp QMHRCVPM( RCVM0200
C : %size(RCVM0200)
C : 'RCVM0200'
C : '*'
C : 0
C : '*EXCP'
C : *blanks
C : 0
C : '*SAME'
C : ErrorNull )
* Only error message
C eval MsgTxt = %SubSt( M2MsgVarFld
C : M2MsgDtaRtn + 1
C : M2MsgTxtRtn
C )
* include error and help message
C* eval MsgTxt = %SubSt( M2MsgVarFld
C* : M2MsgDtaRtn + 1
C* )
C EndSr
*=====================================================================
*-- Send escape message --**
*=====================================================================
C SndEscMsg BegSr
C callP SndPgmMsg( 'CPF9898'
C : 'QCPFMSG *LIBL'
C : MsgTxt
C : %Len( MsgTxt )
C : '*ESCAPE'
C : '*PGMBDY'
C : 1
C : MsgKey
C : ErrorNull
C )
C EndSr
*=====================================================================
OQSRC EADD OUTPUT
O SRCSEQ 6
O SRCDATE 12
O SRCDATA 266
File : QCMDSRC
Member: WRKSRCREC
Type : CMD
Usage : CRTCMD CMD(WRTSRCREC) PGM(WRTSRCREC)
/* =============================================================== */
/* = Command....... WrtSrcRec = */
/* = CPP........... WrtSrcRec = */
/* = Description... Write data to Source File Member = */
/* = = */
/* = CrtCmd Cmd( WrtSrcRec ) = */
/* = Pgm( WrtSrcRec ) = */
/* = SrcFile( YourSourceFile ) = */
/* =============================================================== */
/* = Date : 2008/05/31 = */
/* = Author: Vengoal Chang = */
/* =============================================================== */
WRTSRCREC: CMD PROMPT('Write Source Record')
/* Command processing program is WRTSRCREC */
PARM KWD(SRCFILE) TYPE(SRCF) MIN(1) +
PROMPT('Source file')
SRCF: QUAL TYPE(*NAME) DFT(QCLSRC) SPCVAL((QCLSRC) +
(QCLLESRC QRPGLESRC)) EXPR(*YES)
QUAL TYPE(*NAME) DFT(*LIBL) SPCVAL((*LIBL) +
(*CURLIB)) EXPR(*YES) PROMPT('Library')
PARM KWD(SRCMBR) TYPE(*NAME) SPCVAL((*FIRST) +
(*LAST)) MIN(1) EXPR(*YES) PROMPT('Source +
member')
PARM KWD(DATA) TYPE(*CHAR) LEN(250) +
SPCVAL((*BLANKS ' ')) EXPR(*YES) +
VARY(*YES) PROMPT('Source data')
範例測試程式：此範例是利用 WRTSRCREC 指令產生下傳 QGPL/QCLSRC 原始程式檔案中所有成員的 FTP script 指令，
一般 FTP 將 AS/400 上文字資料下傳到 FTP aserver 需要下如下 FTP script 指令:
user password
LType c 950
put QGPL/QDDSSRC.mbr QDSIGNON.txt
quit
上述第一行為 FTP server 上的使用者及密碼，
第三行為將 EBCDIC CCSID 937 中文資料轉換回 Big5 中文資料(若資料中有含中文時需要加入此行 FTP 指令)
第三行為將 AS/400 上 QGPL library 中檔案 QDDSSRC 的成員 QDSIGNON，放置 FTP server 上檔名為 QDSIGNON.txt，
第四行為退出 FTP。
此範例程式將組成下傳所有 QGPL/QDDSSRC 檔案成員的 FTP script。
File : QCLSRC
Member: WRKSRCRECT
Type : CLP
Usage : CRTCLPGM PGM(WRTSRCRECT)
CALL WRTSRCREC，執行完後 DSPPFM FILE(QTEMP/QFTPSRC) MBR(MBRLIST) 即可檢視所產生的 FTP script
PGM
DCLF FILE(QAFDMBRL)
DSPFD FILE(QGPL/QDDSSRC) TYPE(*MBRLIST) +
OUTPUT(*OUTFILE) OUTFILE(QTEMP/MBRLISTP)
DLTF FILE(QTEMP/QFTPSRC)
MONMSG CPF0000
CRTSRCPF FILE(QTEMP/QFTPSRC)
ADDPFM FILE(QTEMP/QFTPSRC) MBR(MBRLIST)
/* FTP server user and password */
WRTSRCREC SRCFILE(QTEMP/QFTPSRC) SRCMBR(MBRLIST) +
DATA('user password')
/* for DBCS in data need */
WRTSRCREC SRCFILE(QTEMP/QFTPSRC) SRCMBR(MBRLIST) +
DATA('Ltpye c 950')
OVRDBF FILE(QAFDMBRL) TOFILE(QTEMP/MBRLISTP)
READ: RCVF
MONMSG CPF0864 *N GOTO END
WRTSRCREC SRCFILE(QTEMP/QFTPSRC) SRCMBR(MBRLIST) +
DATA('PUT' *BCAT &MLLIB *TCAT '/' +
*CAT &MLNAME *TCAT '.' *CAT &MLNAME +
*BCAT &MLNAME *TCAT '.TXT')
GOTO READ
END: DLTOVR FILE(QAFDMBRL)
WRTSRCREC SRCFILE(QTEMP/QFTPSRC) SRCMBR(MBRLIST) +
DATA('quit')
RETURN
ENDPGM
批次 FTP 範例程式:
File : QCLSRC
Member: FTPSRCTEST
Type : CLP
Usage : CRTCLPGM FTPSRCTEST
CALL FTPSRCTEST
PGM
DCL &SVRIP *CHAR 32
DLTF FILE(QTEMP/QFTPSRC)
MONMSG CPF0000
CRTSRCPF FILE(QTEMP/QFTPSRC)
ADDPFM FILE(QTEMP/QFTPSRC) MBR(MBRLISTOUT)
CALL WRTSRCRECT
OVRDBF FILE(INPUT) TOFILE(QTEMP/QFTPSRC) MBR(MBRLIST)
OVRDBF FILE(OUTPUT) TOFILE(QTEMP/QFTPSRC) MBR(MBRLISTOUT)
/* Specify FTP server here */
CHGVAR &SVRIP 'xxx.xxx.xxx.xxx'
FTP RMTSYS(&SVRIP)
CPYF FROMFILE(OUTPUT) TOFILE(*PRINT)
DLTOVR FILE(INPUT)
DLTOVR FILE(OUTPUT)
ENDPGM
星期三, 11月 08, 2023
2008-06-02 如何於 CLP 中，將資料存入原始程式檔案成員中(Source Physical File member)？(Command: WRTSRCREC)
訂閱：
張貼留言 (Atom)
沒有留言:
張貼留言