不達メールからidを抜き出すプログラム(Object REXX)

/* rexx */

/* File Name : RFC822.rex
Purpose : 不達メールのID抜きだしプログラム
created : by Ikezoe
asof : 2003/10/26
機能: Undelivered Mailを収集し、メール内にあるRFC822を検索した行にあるIDを抜き出す。
1. rfc822を含む行を抜き出す
*/

debug=0
time_out=1
trace E
'@ECHO OFF'

/* Load in function library */
Call RxFuncAdd "SysLoadFuncs","RexxUtil","SysLoadFuncs"
Call SysLoadFuncs

Main:
/* ---------- Main routine ---------- */
parse arg passfile
flag = 1
Do while flag <> 0

call SysCls

say ''
say ' Undelivered Mail ログ・データ加工プログラム( R0.01)'
say ' -----------------------------'
say ' 1. RFC822 の検索'
say ' 2. '
say ' 3. '
say ''
say ' 0. exit'
say ''
say ' 番号を入力してください'
pull answer

select
when answer = '1' then call selection
when answer = '2' then nop
when answer = '3' then nop
when answer = '0' then flag = 0
otherwise
end

end

exit(0)

/* Function */
Selection:
/* 画面のクリア */
call SysCls
/* 入力ファイル名の指定 */
curdir = directory()
say ''
say '現行ディレクトリーは :' curdir
say ''
say 'ディレクトリーを変更しますか？(Y :Yes / N: No)'
answer = ''
PULL answer
if answer ='Y' then do
say '変更先ディレクトリーを入力してください(例 D:\DOCS\REXX) '
PULL newdir
call directory newdir
curdir = directory()
end
say ''

say '入力ファイル名を入力してください'
PULL filename1
infile = curdir|| '\' || filename1
say ''
say '入力ファイル :' infile

call inopen infile
if openrc <> 'READY:' then return /* If file is not present then return to input. */
/* 出力ファイル名の指定 */
say ''
say '出力ファイル名を入力してください'
PULL filename2
outfile = curdir|| '\' || filename2
say ''
say '出力ファイル名 :' outfile

call isthere outfile
call outopen outfile

countrfc = 0
say ''
say ' Now Processing................'
/* データの入力 */
do while ifile~lines<>0
intext=ifile~linein
intextT=intext~TRANSLATE

select
when intextT~POS('RFC822;') > 0 then do
countrfc = countrfc + 1
mailid = intext~SUBSTR(intextT~POS('RFC822;') + 8)
call writedat mailid
end
otherwise
end /* end select */
end

ifile~close
ofile~close

SAY ''
SAY '処理件数'
SAY 'RFC822 :' countrfc
pause

return

Inopen:
/* インプット･ファイルのオープン */
parse arg infile
ifile=.stream~new(infile)
openrc=ifile~open('read')
if openrc<>'READY:' then do
say 'ファイルがありませんでした => ' ifile
pause
return openrc
end

return

Isthere:
/* 既存のファイルを削除 */
parse arg fid
qfile=.stream~new(fid)
if qfile~QUERY('exist')\='' then do
say '削除しますか(y/n)'
parse pull response
if response = 'y' then 'ERASE' outfile
end

return

Outopen:
/* 出力ファイルのオープン*/
parse arg fid
ofile=.stream~new(fid)
ofile~OPEN('write append')
return

Writedat:
/* データの書き出し */
parse arg text
ofile~lineout(text)
return

/* end of list */