ここでは、コマンドSRCDSTの概要とSRCDST自身の作成方法を説明しています。

SRCDSTの実行概要

SRCDST実行後には、ソースメンバーと、オブジェクト（コマンド）が出来ています。

SRCDSTの仕組み

プログラム側のソースで、SRCDSTの対象となる、INFILEファイルは次の構成で作られています。

INFILEは、普通の物理ファイルです。ソースファイルでは有りません。レコード長102バイトの漢字可能ファイルです。

見出し情報
CALEN M#CALD DSPF CALENDAR CALEN I#CALINST CLP CALENDAR INSTALL CALEN M#CALR RPG CALENDAR CALEN +9999999999 ...
明細（ソース本体）　80バイト	ソースメンバー名ID　21バイト	改行 1バイト
H Y/ 1 F#CALD CF E WORKSTN F KINFDS INFDSP E****************************************************** E* A R R A Y T A B L E : * E****************************************************** E DDD 42 6 : E SLS 42 6 0 : E AMT 31 6 0 : I****************************************************** I* D E F I N E I N P U T F I E L D * I****************************************************** ....	RPG_#CALR************ RPG_#CALR************ RPG_#CALR************ RPG_#CALR************ RPG_#CALR************ RPG_#CALR************ RPG_#CALR************ RPG_#CALR************ RPG_#CALR************ RPG_#CALR************ RPG_#CALR************ RPG_#CALR************

実際の中身はこんな感じです。

CALEN M#CALD DSPF CALENDAR CALEN I#CALINST CLP CALENDAR INSTALL CALEN M#CALR RPG CALENDAR CALEN +9999999999 A DSPSIZ(24 80 *DS3) DSPF_#CALD*********** A CHGINPDFT DSPF_#CALD*********** A PRINT DSPF_#CALD*********** A INDARA DSPF_#CALD*********** A CA03 DSPF_#CALD*********** A CA12 DSPF_#CALD*********** A ROLLUP DSPF_#CALD*********** A ROLLDOWN DSPF_#CALD*********** A* DSPF_#CALD*********** ....

このデータを「見出し情報」に合わせて、実際のソースメンバーに分配してくれるのが、SRCDSTです。そして、SRCDSTはインストール用のCLプログラムを判定して、自動的にコンパイルして、さらにそれを勝手に呼び出します。

このようにしてSRCDSTは、�@ソースメンバーを作成して、�Aオブジェクトを作成します。

(関連記事：16.6.ダウンロードをもっとよくしよう）

srcdst.lzhのダウンロード

srcdst.lzhの中身

テキストファイル名	ソースタイプ	作成コマンド
SRCDST.CMD	CMD	CRTCMD
SRCDSTCL.CLP	CLP	CRTCLPGM
SRCDSTR.RPG	RPG400	CRTRPGPGM
SRCDSTC2.CLP	CLP	CRTCLPGM

以下が解凍後、得られる、ソースメンバーの中身です。念のため掲載しました。

SRCDSTの作成

SRCDSTの作成先ライブラリーはKTKUTLをおすすめします。

�@ srcdst.lzhで得られる4つのテキストをアップロードして、4つのソースメンバーとして保管します。

�A 各々のソースメンバーをコンパイルします。

以上で終わりです。

SRCDST (CPPはSRCDSTCL)

CMD ('転送用ファイル作成') PARM KWD(INFILE) TYPE(QUAL1) + PROMPT('入力ファイル') PARM KWD(SRCFILE) TYPE(QUAL2) + PROMPT('原始ファイル') QUAL1: QUAL TYPE(*NAME) LEN(10) MIN(1) QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) + SPCVAL((*LIBL)) PROMPT('ライブラリー') QUAL2: QUAL TYPE(*NAME) LEN(10) MIN(1) QUAL TYPE(*CHAR) LEN(10) CONSTANT('KTKUTL')

SRCDSTCL

PGM (&FRMFLB &SRCFLB) DCL &INSTALL *CHAR 10 DCL &PIERR *CHAR 1 DCL &FRMFLB *CHAR 20 DCL &SRCFLB *CHAR 20 DCL &ERR *CHAR 256 'ソース分配中エラーあり' DCL &CPFMSG *CHAR 256 DCL &FRMFILE *CHAR 10 DCL &FRMLIB *CHAR 10 DCL &SRCFILE *CHAR 10 DCL &SRCLIB *CHAR 10 MONMSG CPF0000 *N GOTO \END CHGVAR &FRMFILE %SST(&FRMFLB 1 10) CHGVAR &FRMLIB %SST(&FRMFLB 11 10) CHKOBJ &FRMLIB/&FRMFILE *FILE CHGVAR &SRCFILE %SST(&SRCFLB 1 10) CHGVAR &SRCLIB %SST(&SRCFLB 11 10) CHKOBJ &SRCLIB *LIB MONMSG CPF9800 *N + CRTLIB &SRCLIB *TEST TEXT('K''S TIPS-NKICKS OF AS400') CHKOBJ &SRCLIB/&SRCFILE *FILE MONMSG CPF9800 *N + CRTSRCPF &SRCLIB/&SRCFILE RCDLEN(92) IGCDTA(*YES) OVRDBF INPUT &FRMLIB/&FRMFILE LVLCHK(*NO) CALL SRCDSTR (&PIERR &FRMFILE &FRMLIB &SRCFILE &SRCLIB &INSTALL) DLTOVR INPUT IF (&PIERR='E') DO SNDPGMMSG MSG(&ERR) GOTO \END ENDDO IF (&INSTALL *NE ' ') DO CRTCLPGM QTEMP/&INSTALL &SRCLIB/&SRCFILE OPTION(*NOSRC) CALL QTEMP/&INSTALL (&SRCFILE &SRCLIB) /*ツールのコンパイル*/ ENDDO RETURN /* NORMAL END */ \END: END_MSG: RCVMSG MSG(&CPFMSG) MONMSG CPF0000 *N RETURN IF (&CPFMSG=' ') RETURN SNDPGMMSG MSG(&CPFMSG) MONMSG CPF0000 *N RETURN GOTO END_MSG RETURN ENDPGM

SRCDSTR

H 1 Y/ 1 FINPUT IP F 86 DISK IINPUT AA 01 I 1 15 SRCID I 16 16 CTL I 17 26 SRCMBR I 27 36 SRCTYP I 37 86 SRCTXT C* : C *ENTRY PLIST : C PARM POERR 1 : C PARM FRMFIL 10 : C PARM FRMLIB 10 : C PARM SRCFIL 10 : C PARM SRCLIB 10 : C PARM INSTAL 10 : C* : B001 C CTL IFEQ '+' :END 001 C MOVE *ON *INLR : 001 C RETRN : E001 C END : C* : B001 C CTL IFEQ 'I' : 001 C MOVELSRCMBR INSTAL : E001 C END : C* : C CALL 'SRCDSTC2' : C PARM PIERR 1 : C PARM FRMFIL 10 : C PARM FRMLIB 10 : C PARM SRCFIL : C PARM SRCLIB : C PARM SRCMBR : C PARM SRCTYP : C PARM SRCTXT : C* : B001 C PIERR IFEQ 'Y' :ERROR 001 C MOVE 'E' POERR : 001 C MOVE *ON *INLR : 001 C RETRN : E001 C END : C* : CLR RETRN :

SRCDSTC2

PGM (&POERR &FRMFILE &FRMLIB &SRCFILE &SRCLIB &SRCMBR &SRCTYPE &SRCTXT) DCL &POERR *CHAR 1 DCL &FRMFILE *CHAR 10 DCL &FRMLIB *CHAR 10 DCL &SRCFILE *CHAR 10 DCL &SRCLIB *CHAR 10 DCL &SRCMBR *CHAR 10 DCL &SRCTYPE *CHAR 10 DCL &SRCTXT *CHAR 50 DCL &SRCID *CHAR 21 CHGVAR &SRCID (&SRCTYPE|<'_'|<&SRCMBR|<'******************') CPYF FROMFILE(&FRMLIB/&FRMFILE) + TOFILE(&SRCLIB/&SRCFILE) FROMMBR(*FIRST) + TOMBR(&SRCMBR) MBROPT(*REPLACE) + INCCHAR(*RCD 81 *EQ &SRCID) FMTOPT(*CVTSRC) MONMSG CPF2817 *N DO CHGVAR &POERR 'E' GOTO \END ENDDO CHGPFM FILE(&SRCLIB/&SRCFILE) MBR(&SRCMBR) + SRCTYPE(&SRCTYPE) TEXT(&SRCTXT) \END: RETURN ENDPGM

2000-1-16

You are at K's tips-n-kicks of AS/400