Hello All
The script I posted Tuesday has improved, as in what it can handle, even if
the quality of the code hasn't. :)
--- 8< -- Cut Here -- 8< ---
/*
$VER: 0.9 UudecodeAttach.rx (14-12-2000)
$AUTHOR: by Jules (JA888)� 2000
$DESCRIPTION: Near automatic Uudecode of attachments.
Need at least version 48 of ixemul.library.
And the Command Uudecode (on Aminet, search slrn in News/Comm)
Snoopdos (by Eddy Carroll)
Note:
This script cannot handle attachments which have been split across
more than one message.
Nor will it; as yet, save plain ASCII attachments.
Version 0.7 - base64 only.
Version 0.8 - Some HTML and RTF added.
Instructions:
1) If 'Snoopdos' is not in your system path, enter the new path
in this script.
2) Select but do not open the first Email or news message, as the script
will do that. (the first file will be opened with the
'READSELECTEDMSGS' command and the subsequent ones' will use the
'GotoMsg Next' command.)
3) This script should be run with a numerical argument for the number
of files to be read. Output is by default to 'RAM:'.
(rx rexx:UudecodeAttach.rx 3)
*/
OPTIONS RESULTS
PARSE ARG PICOUNT
CALL PRAGMA 'DIRECTORY','RAM:'
/*
And the path of Snoopdos. Example SNOOP="SYS:Tools/Snoopdos"
*/
SNOOP="SNOOPDOS"
/*
Check that Microdot is running
*/
IF ~SHOW('P','MD.1') THEN EXIT
/*
The counters
*/
PICOUNT=STRIP(PICOUNT)
IF PICOUNT < 1 THEN PICOUNT=1
AA=0 ; A=1
/*
Check if SnoopDos is running; if not, then start it
*/
SNOOPPATH="RUN >NIL: "||SNOOP||" HIDEMETHOD=TOOLSMENU HIDE"
IF ~SHOW('P','SNOOPDOS') THEN DO
ADDRESS COMMAND SNOOPPATH ; ADDRESS COMMAND "WAITFORPORT SNOOPDOS"
END
/*
Start of Main loop
*/
DO A=1 TO PICOUNT
/*
Set up Snoopdos
*/
ADDRESS SNOOPDOS ; ENABLE ; CLEARBUFFER ; FORMAT "%50n"
/*
Read the message in MD-II
*/
ADDRESS MD.1
IF A<2 THEN READSELECTEDMSGS
ELSE GOTOMSG NEXT
ADDRESS COMMAND 'WAIT'
ADDRESS SNOOPDOS ; SAVEBUFFER "T:SnoopMD"
ADDRESS COMMAND 'WAIT'
DISABLE
CALL OPEN('MD','T:SnoopMD','R')
AA=READCH('MD',125) ; AA=STRIP(AA,B)
CALL CLOSE('MD')
IF LENGTH(AA)<120 THEN DO
CALL GETOUTOFHERE ; EXIT
END
/*
Find the correct line.
*/
DETEC=0 ; PDRAW="" ; DFILE=""
CALL OPEN('MD','T:SnoopMD','R')
DO UNTIL DETEC>1
PDRAW=READLN('MD') ; DETEC=POS('DBX_',PDRAW)
IF EOF('MD')=1 THEN DO
CALL GETOUTOFHERE ; EXIT
END
END
DFILE=READLN('MD')
CALL CLOSE('MD')
/*
Give it a hair cut
*/
TARGETFILE=STRIP(PDRAW)||"/"||STRIP(DFILE)
/*
OPF = OUTPUT FILE
SUBCOUNT = Counter for the number of attachments
BOUNDARY = Mailer boundary
BOUNDARYCOUNTER = Only look for one boundary
*/
BOUNDARY=""
BOUNDARYCOUNTER=0
CALL OPEN('TF',TARGETFILE,'R')
SUBCOUNT=0
/*
Start of inner loop
*/
DO UNTIL EOF('TF')=1
SUBCOUNT=SUBCOUNT+1 ; DETEC=0 ; PDRAW="" ; DFILE=""
DO UNTIL DETEC=1
PDRAW=READLN('TF')
IF BOUNDARYCOUNTER<1 THEN DO
IF POS('Content-Type',PDRAW)>0 THEN CALL FINDBOUNDARY
END
IF SUBSTR(PDRAW,1,9)='begin 644' THEN DETEC=1
IF SUBSTR(PDRAW,1,20)='Content-Type: image/' THEN DETEC=1
IF SUBSTR(PDRAW,1,33)='Content-Transfer-Encoding: base64' THEN DETEC=1
IF SUBSTR(PDRAW,1,29)='Content-Type: application/rtf' THEN CALL OHNOITSRTF
IF SUBSTR(PDRAW,1,23)='Content-Type: text/html' THEN CALL OHNOITSHTML
IF EOF('TF')=1 THEN LEAVE
END
DETEC=0 ; OPF='T:TF'||PICOUNT||SUBCOUNT
CALL OPEN('IMAGE',OPF,'W')
CALL WRITELN('IMAGE',PDRAW)
DO UNTIL DETEC=1
PDRAW=READLN('TF') ; CALL WRITELN('IMAGE',PDRAW)
IF SUBSTR(PDRAW,1,3)='end' THEN DETEC=1
IF PDRAW=BOUNDARY THEN DETEC=1
IF EOF('TF')=1 THEN DETEC=1
END
END
/*
End of inner loop
*/
CALL CLOSE('IMAGE') ; CALL CLOSE('TF')
ADDRESS COMMAND 'C:uudecode T:TF* >NIL:'
SAY A' of 'PICOUNT' saved.'
END
/*
End of Main loop
*/
SAY 'Cleaning up.'
CALL PRAGMA 'DIRECTORY','sys:'
CALL GETOUTOFHERE
ADDRESS COMMAND "C:WAIT"
SAY 'Complete.'
EXIT
GETOUTOFHERE:
ADDRESS COMMAND "C:DELETE T:SnoopMD QUIET >NIL:"
ADDRESS COMMAND "C:DELETE T:TF#? QUIET >NIL:"
ADDRESS SNOOPDOS ; QUIT
RETURN
OHNOITSRTF:
CALL FINDFILENAME
DO UNTIL SUBSTR(PDRAW,1,5)='{\rtf' ; PDRAW=READLN('TF') ; END
CALL OPEN('IMAGE',EE,'W')
DO UNTIL EOF('TF')
CALL WRITELN('IMAGE',PDRAW)
PDRAW=READLN('TF')
IF PDRAW=BOUNDARY THEN DO
CALL CLOSE('IMAGE') ; LEAVE
END
END
CALL NEEDADUMMY
RETURN
OHNOITSHTML:
DD=0
DO UNTIL POS('<HTML>',PDRAW)>0
IF POS('filename',PDRAW)>0 THEN DO
EE=PDRAW ; EE=SUBSTR(EE,POS('filename',EE)+10)
HTMLSTEM.0='RAM:'||SUBSTR(EE,1,LENGTH(EE)-1) ; DD=1
END
PDRAW=READLN('TF')
END
DDD=1
DO UNTIL EOF('TF')
HTMLSTEM.DDD = PDRAW
IF DD=0 THEN DO
IF POS('<TITLE>',PDRAW)>0 THEN DO
CALL HTMLTITLE ; HTMLSTEM.0=EE ; DD=1
END
END
IF POS('</HTML>',HTMLSTEM.DDD)>0 THEN LEAVE
PDRAW=READLN('TF')
DDD=DDD+1
END
CALL OPEN('IMAGE',HTMLSTEM.0,'W')
DO FF=1 TO DDD
CALL WRITELN('IMAGE',HTMLSTEM.FF)
END
CALL CLOSE('IMAGE')
CALL NEEDADUMMY
DROP HTMLSTEM.
RETURN
HTMLTITLE:
EE=""
EE=STRIP(PDRAW)
EE=SUBSTR(EE,POS('<TITLE>',EE)+7) ; EE=REVERSE(EE)
EE=SUBSTR(EE,POS('</TITLE>',EE)+9) ; EE=REVERSE(EE)
EE='RAM:'||EE||'.HTML'
RETURN
FINDFILENAME:
DO UNTIL DD>0
IF POS('filename',PDRAW)>1 THEN DO
EE=PDRAW ; EE=SUBSTR(EE,POS('filename',PDRAW)+10)
EE='RAM:'||SUBSTR(EE,1,LENGTH(EE)-1) ; DD=1
END
PDRAW=READLN('TF')
END
DD=0
RETURN
NEEDADUMMY:
CALL OPEN('DUM','T:TFA','W') ; CALL WRITELN('DUM','A') ; CALL CLOSE('DUM')
RETURN
FINDBOUNDARY:
DD=0
DO UNTIL LENGTH(BOUNDARY)>5
DD=POS('boundary=',PDRAW)
IF DD>0 THEN DO
PDRAW=STRIP(PDRAW) ; EE=SUBSTR(PDRAW,DD+10)
BOUNDARY='--'||SUBSTR(EE,1,LENGTH(EE)-1) ; DD=0 ; LEAVE
END
PDRAW=READLN('TF')
END
BOUNDARYCOUNTER=1
RETURN
--- 8< -- And Here -- 8< ---
--
Regards
Jules
--
I will not call the principal 'spud head'.
-- Bart Simpson
__________________________________________________________________
MicroDot-II Mailing List - http://www.vapor.com/md2/
MicroDot-II FAQ: http://faq.vapor.com/md2/
Listserver Help: mailto:[EMAIL PROTECTED]?Subject=HELP
Unsubscribe....: mailto:[EMAIL PROTECTED]?Subject=UNSUBSCRIBE
