home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 18 REXX
/
18-REXX.zip
/
rxjiscmd.zip
/
PMMLSEND.CMD
< prev
Wrap
OS/2 REXX Batch file
|
1996-06-20
|
12KB
|
367 lines
/* product name: RXJIS */
/* Version: 0.85 */
/* author: YANO Takashi */
/* target: OS/2 Warp J3.0+ */
/* module name: MIMESEND.CMD */
/* source name: MIMESEND.CMD */
/* compiler: N.A. */
/* address: tyano@ca2.so-net.or.jp or tyano@yamato.ibm.co.jp */
/* comment: RXJIS is a utility functions for REXX. */
/* It encodes and decodes JIS 7 bit strings and MIME */
/* format strings. */
/* */
/* MIMESEND.CMD is a sample program how to use */
/* RXJIS. I am using it with PostRoadMailer 1.03a. */
/* It converts a mail message with PC Kanji codes */
/* into MIME or JIS7bit mail message. */
/* */
/* how to use: MIMESEND fn */
/* fn is a mail message file. The converted result is */
/* in fn. The original is lost. */
/* */
/* history: 1996-2-5 initial release */
/* 1996-2-14 0.10 fix small bugs */
/* missing REXXUTIL loading. */
/* if NOMIME is missing, novalue occurs. */
/* 1996-2-19 remove trace */
/* 1996-10-20 Avoid to put duplicated headers. */
/* */
/* 02/14/96 Modified by K.Wakamiya for PMMail and */
/* rename from mimesend.cmd to pmmlsend.cmd */
/* modify 'CONTENT-TYPE:' header handling to */
/* be able to send attach mail */
/* modify 'REPLY-TO:' header handling */
/* */
/* */
/* */
arg fn
signal on novalue
call rxfuncadd 'SysLoadFuncs', 'REXXUTIL', 'SysLoadFuncs' /* A@0.10 */
call SysLoadFuncs /* A@0.10 */
call rxfuncdrop 'RxJisLoadFuncs'
call rxfuncadd 'RxJisLoadFuncs', 'RXJIS', 'RxJisLoadFuncs'
call RxJisLoadFuncs
if stream(fn, 'c', 'query exists') = '' then exit
call LoadHeader fn
call LoadBody fn
call stream fn, 'c', 'close'
call CheckIfNomimeHost
i = 1
j = 1
newheader.1 = 'MIME-Version: 1.0'
do while i <= header.0
select
when translate(word(header.i, 1)) = 'SUBJECT:' then parse value processsubject(i, j) with i j
when translate(word(header.i, 1)) = 'REPLY-TO:' then parse value processreplyto(i, j) with i j
when translate(word(header.i, 1)) = 'FROM:' then parse value processaddress(i, j) with i j
when translate(word(header.i, 1)) = 'TO:' then parse value processaddress(i, j) with i j
when translate(word(header.i, 1)) = 'CC:' then parse value processaddress(i, j) with i j
when translate(word(header.i, 1)) = 'BCC:' then parse value processaddress(i, j) with i j
when wordpos(translate(word(header.i, 1)), 'MIME-VERSION: CONTENT-TRANSFER-ENCODING:') > 0 then i = i + 1 /* A@0.85 */
otherwise
j = j + 1
newheader.j = header.i
if wordpos(translate(word(header.i, 1)), 'CONTENT-TYPE:') > 0 then content_type_pos = j /* 02/14/96 */
i = i + 1
end /* select */
end /* do */
if iso2022jp then do
if wordpos( 'TEXT/PLAIN;', translate(newheader.content_type_pos)) > 0 then do /* 02/14/97 */
newheader.content_type_pos = 'Content-Type: text/plain; charset="ISO-2022-JP"'
end
j = j + 1
newheader.j = 'Content-Transfer-Encoding: 7bit'
do i = 1 to body.0
if body.i <> '' then do
if wordpos(translate(word(body.i, 1)), 'CONTENT-TYPE:') > 0 & wordpos('TEXT/PLAIN;', translate(body.i)) > 0 then do /* 02/14/97 */
body.i = 'Content-Type: text/plain; charset="ISO-2022-JP"'
end
body.i = RxJisToJis(body.i)
end
end /* do */
end /* Do */
else do
if wordpos('TEXT/PLAIN;', translate(newheader.content_type_pos)) > 0 then do /* 02/14/97 */
newheader.content_type_pos = 'Content-Type: text/plain; charset="US-ASCII"'
end
j = j + 1
newheader.j = 'Content-Transfer-Encoding: 7bit'
end /* Do */
newheader.0 = j
tfn = value('TMP', , 'OS2ENVIRONMENT')
if tfn = '' then tfn = workingdir
if right(tfn, 1) <> '\' then tfn = tfn || '\'
tfn = SysTempFileName(tfn || '????')
do i = 1 to newheader.0
call lineout tfn, newheader.i
end /* do */
call lineout tfn, ''
do i = 1 to body.0
call lineout tfn, body.i
end /* do */
call stream tfn, 'C', 'CLOSE'
'@COPY' tfn fn
call SysFileDelete tfn
exit
processreplyto: procedure expose header. newheader. nomimeisrequired
arg i, j
c = words(header.i)
h = word(header.i, 1)
a = word(header.i, c)
/* 02/14/97 */
m = word(header.i, 2)
if (m = '*' | m = '"*"') & (a = '*' | a = '<*>') then return i + 1 j
/* 02/14/97 */
j = j + 1
if words(header.i) = 2 then newheader.j = h a
else do
c = wordindex(header.i, words(header.i))
m = wordindex(header.i, 2)
n = strip(substr(header.i, m, c - m))
if dbvalidate(header.i) = 0 then do
if left(n, 1) <> '"' & n <> '' then n = '"' || n || '"'
end /* Do */
else do
options 'EXMODE'
if dbwidth(n) <> length(n) then do
n = RxJisToJis(n)
if nomimeisrequired = 0 then n = '=?ISO-2022-JP?B?' || RxJisToBase64(n) || '?='
end /* Do */
if n <> '' then n = '"' || n || '"'
end /* Do */
newheader.j = h n a
end /* Do */
return i + 1 j
CheckIfNomimeHost: procedure expose header. nomimeaddress. nomimeisrequired workingdir errorlog
parse source . . a
workingdir = filespec('D', a) || filespec('P', a)
errorlog = workingdir || 'errorlog.log'
f = workingdir || 'NOMIME'
nomimeisrequired = 0 /* A@0.10 */
if stream(f, 'c', 'query exists') = '' then return
nomimeaddress = ''
i = 0
do while lines(f)
parse upper value linein(f) with a
a = strip(a)
if a = '' then iterate
if pos(left(a, 1), '#;*') > 0 then iterate
i = i + 1
nomimeaddress.i = word(a, 1)
end /* do */
call stream f, 'c', 'close'
nomimeaddress.0 = i
i = 1
do while i <= header.0
select
when translate(word(header.i, 1)) = 'TO:' then i = checkdestaddress(i)
when translate(word(header.i, 1)) = 'CC:' then i = checkdestaddress(i)
when translate(word(header.i, 1)) = 'BCC:' then i = checkdestaddress(i)
otherwise
i = i + 1
end /* select */
end /* do */
return
checkdestaddress: procedure expose header. nomimeaddress. nomimeisrequired
arg i
line = header.i
i = i + 1
do while i <= header.0
a = header.i
if left(a, 1) <> ' ' then leave
i = i + 1
line = line a
end /* do */
do j = 1 to nomimeaddress.0
n = pos(nomimeaddress.j, translate(line))
if n = 0 then iterate
nomimeisrequired = 1
leave
end /* do */
if nomimeisrequired = 0 then return i
line = translate(subword(line, 2), ' ', '09'x)
do while line <> ''
do j = 1 by 1
t = gettoken()
if t = '' | t = ',' then leave
t.j = t
end /* do */
j = j - 1
parse var t.j with '<' a '>'
if a = '' then a = t.j
do z = 1 to nomimeaddress.0
if translate(right(a, length(nomimeaddress.z))) = nomimeaddress.z then return i
end /* do */
end /* do */
nomimeisrequired = 0
return i
gettoken: procedure expose line
parse value strip(line) with t line
if left(t, 1) = ',' then do
parse var t 2 a
line = a line
return t
end /* Do */
zdsl = '"<'
zdsr = '">'
i = pos(left(t, 1), zdsl)
if i = 0 then do
i = pos(',', t)
if i = 0 then return t
if i > 1 then do
line = substr(t, i) line
t = left(t, i - 1)
end /* Do */
else do
t = left(t, 1)
line = substr(t, 2) line
end /* Do */
return t
end /* Do */
zd = substr(zdsr, i, 1)
i = 2
line = t line
t = ''
do while line <> ''
i = pos(zd, line, i)
if i = 0 then do
t = t || line
line = ''
leave
end /* Do */
if i = 1 then do
parse var line a 2 line
t = t || a
leave
end /* Do */
if substr(line, i - 1, 1) <> '\' then do
a = left(line, i)
line = substr(line, i + 1)
t = t || a
if pos(left(line, 1), ' ,') > 0 then leave
t = t || gettoken()
leave
end /* Do */
i = i + 1
end /* do */
return t
LoadHeader: procedure expose header.
arg fn
do i = 1 by 1 while lines(fn)
header.i = linein(fn)
if header.i = '' then do
header.0 = i - 1
leave
end /* Do */
end /* do */
return
LoadBody: procedure expose body. iso2022jp
arg fn
options 'EXMODE'
iso2022jp = 0
do i = 1 by 1 while lines(fn)
body.i = linein(fn)
if dbvalidate(body.i) = 0 then iterate
if dbwidth(body.i) = length(body.i) then iterate
iso2022jp = 1
end /* do */
body.0 = i - 1
return
processaddress: procedure expose nomimeisrequired header. newheader.
arg i, j
zi = i
line = header.i
i = i + 1
do while i <= header.0
a = header.i
if left(a, 1) <> ' ' then leave
i = i + 1
line = line a
end /* do */
if dbvalidate(line) = 0 then do
do m = zi to i - 1
j = j + 1
newheader.j = header.m
end /* do */
return i j
end /* Do */
options 'EXMODE'
zh = word(line, 1)
line = translate(subword(line, 2), ' ', '09'x)
do m = 1 by 1 while line <> ''
do z = 1 by 1
t = gettoken()
if t = '' then leave
if t = ',' & z > 2 then leave
if t = ',' & z = 2 then do
if pos('@', t.1) > 0 then leave
end /* Do */
t.z = t
end /* do */
t.0 = z - 1
n = ''
do z = 1 to t.0 - 1
if z = 2 & t.2 = ',' then n = n || t.z
else n = n t.z
say 1 t.z
end /* do */
n = strip(n)
if left(n, 1) <> '"' & n <> '' then n = '"' || n || '"'
a = t.z t
if dbwidth(n) <> length(n) then do
n = RxJisToJis(n)
if nomimeisrequired = 0 then n = '=?ISO-2022-JP?B?' || RxJisToBase64(n) || '?='
end /* Do */
j = j + 1
if m = 1 then newheader.j = zh n a
else newheader.j = copies(' ', length(zh)) n a
end /* do */
return i j
processsubject: procedure expose nomimeisrequired header. newheader.
parse arg i, j
options 'EXMODE'
do n = 1 by 1
if i > header.0 then leave
if n > 1 & left(header.i, 1) <> '' then leave
if dbvalidate(header.i) = 0 then do
j = j + 1
newheader.j = header.i
i = i + 1
iterate
end /* Do */
if dbwidth(header.i) = length(header.i) then do
j = j + 1
newheader.j = header.i
i = i + 1
iterate
end /* Do */
if n = 1 then parse var header.i h b
else do
h = ' '
b = header.i
end /* Do */
b = RxJisToJis(strip(b))
j = j + 1
if nomimeisrequired then newheader.j = h b
else newheader.j = h '=?ISO-2022-JP?B?' || RxJisToBase64(b) || '?='
i = i + 1
end /* do */
return i j
novalue:
call lineout errorlog, date('S') time() condition('C') '@' sigl
call lineout errorlog, date('S') time() condition('D')
call lineout errorlog, date('S') time() condition('I')
call stream errorlog, 'c', 'close'
exit