Hello All
I had the following problem reported.
> almost always that I execute the rexx it leaves me an error window that
> puts: "ixemul.library mesage" "abort!"...
The 'ixemul.library' problem has been removed.
Please let me know how you get on, bug reports are very welcome; on or off
the list is fine.
-- 8< -- Cut here -- 8< --
/*
$VER: 1.4 UudecodeAttach.rx (26-02-2001)
$AUTHOR: by Jules <[EMAIL PROTECTED]> ©2001
$DESCRIPTION: The bulk saving of attachments.
This script requires the following.
Libraries:
ixemul.library (v48)
reqtools.library (v38.1413)
rexxreqtools.library (v37.95)
rexxsupport.library(34.9)
Commands:
Uudecode (on Aminet, search for 'slrn' in News/Comm)
(it has no version string but the size can be 80352 or 20052)
FreshBar 1.1 (On Aminet/util/rexx/FreshBar.lha)
Programme:
Snoopdos (Version >3)
Note:
This script cannot handle attachments which have been split across
more than one message.
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) If this scritp is run without arguments it will show a requester for you to
enter the number of files to be read. Output is by default to 'RAM:'.
(if run from shell - rx rexx:UudecodeAttach.rx [number of files])
4) When it has finished, it will either print to a window or show a requester.
*/
OPTIONS RESULTS
PARSE ARG PICOUNT
/* Snoopdos Path */
SNOOP='SNOOPDOS'
/* Libraries */
LIBR.1='rexxreqtools.library'
LIBR.2='reqtools.library'
LIBR.3='rexxsupport.library'
CMAD.1='uudecode'
CMAD.2='freshbar'
USINGREQTOOLS=0
DO I=1 TO 3
IF ~EXISTS('Libs:'||LIBR.I) THEN DO
ERRT='Could not find '||LIBR.I
CALL PROBLEMFOUND
END ; ELSE DO
IF ~SHOW('L',LIBR.I) THEN ADDLIB('Libs:'||LIBR.I, 0, -30, 0)
END
END
DROP I
IF PICOUNT <1 THEN DO ; USINGREQTOOLS=1 ; PICOUNT=1 ; END
/* Default Paths */
WHERETOPUTTHEM='RAM:'
SNOOPPATH='RUN >NIL: "'||SNOOP||'" HIDEMETHOD=TOOLSMENU HIDE'
DO I=1 TO 2
IF ~EXISTS('C:'||CMAD.I) THEN DO
ERRT='Could not find '||CMAD.I
CALL PROBLEMFOUND
END ; ELSE DO
IF I=2 THEN ADDRESS COMMAND "RUN >NIL: C:FreshBar"
END
END
DROP I
/* Is Microdot running */
IF ~SHOW('P','MD.1') THEN DO
ERRT="Microdot is not running"
CALL PROBLEMFOUND
END
IF USINGREQTOOLS=1 THEN DO
CALL WHERETOGO
CALL HOWMANY
END
/* The counters */
AA=0
MAINLOOP=1
PICOUNT=STRIP(PICOUNT)
CALL PRAGMA 'D',WHERETOPUTTHEM
IF EXISTS('T:SnoopMD') THEN CALL DELETE('T:SnoopMD')
/* Is SnoopDos running; if not, start it */
IF ~SHOW('P','SNOOPDOS') THEN DO
ADDRESS COMMAND SNOOPPATH
ADDRESS COMMAND 'WAITFORPORT SNOOPDOS'
END
/* Set up Snoopdos */
ADDRESS SNOOPDOS
FUNCTIONS NONE
NOONLYSHOWFAILS
NOSHOWCLI
NOMONITORPACKETS
NOPACKETDEBUGGER
NOMONITORROMCALLS
IGNORESHELL
NOUSEDEVICENAMES
NOSHOWFULLPATH
OPEN
SHOWFULLPATH
CLEARBUFFER
FORMAT "%255n"
ENABLE
/* Make the list of Files */
ADDRESS MD.1
DO SNLOOP=1 TO PICOUNT
IF SNLOOP<2 THEN READSELECTEDMSGS
ELSE GOTOMSG NEXT
END
ADDRESS COMMAND 'WAIT'
ADDRESS SNOOPDOS ; SAVEBUFFER "T:SnoopMD" ; DISABLE ; QUIT
ADDRESS COMMAND 'WAIT'
IF ~EXISTS('T:SnoopMD') THEN DO
ERRT='Could not find SnoopMD'
CALL PROBLEMFOUND
END
/* Find the correct line. */
DETEC=0 ; PDRAW="" ; PICOUNT=0
CALL OPEN('MD','T:SnoopMD','R')
CALL OPEN('DT','T:DETACH','W')
DO UNTIL EOF('MD')
PDRAW=STRIP(READLN('MD'),'B')
IF POS('DBX_',PDRAW)>1 THEN DO
IF EXISTS(PDRAW) THEN DO
CALL WRITELN('DT',PDRAW) ; PICOUNT=PICOUNT+1
END
END
END
CALL CLOSE('MD') ; CALL CLOSE ('DT')
CALL OPEN('DT','T:DETACH','R')
/* CALL DELETE('T:SnoopMD') */
/* Headers to look for */
CONTA='644'
CONTB='666'
CONTC='755'
CONTD='application'
CONTE='image'
CONTF='text'
CONTG='multipart'
CONTH='html'
CONTI='plain'
CONTJ='rtf'
CONTK='base64'
CONTL='BASE64'
LNSTA='Content-Transfer-Encoding:'
LNSTB='Content-Type:'
LNSTC='begin'
/* Set up progress bar */
ADDRESS FRESHBAR_REXX.1
CALL PROGRESSBARSETUP
/* Start of Main loop */
DO MAINLOOP=1 TO PICOUNT
BOUNDARY="" ; BOUNDARYCOUNTER=0 ; DETEC=0
SUBJECTCOUNTER=0 ; SUBCOUNT=0 ; HOWMUCH=0
SETCURRENT WINDI1 BARDI1 MAINLOOP
TARGETFILE=READLN('DT')
CALL OPEN('TF',TARGETFILE,'R')
HOWLONG=SUBWORD(STATEF(TARGETFILE),2,1)
DO UNTIL EOF('TF')
PDRAW=READLN('TF')
PARSE VAR PDRAW AAA AAB
IF SUBJECTCOUNTER=0 & AAA='Subject:' THEN DO
CALL FINDTHESUBJECT ; LEAVE
END
END
/* Start of inner loop */
DO UNTIL EOF('TF')=1
SUBCOUNT=SUBCOUNT+1 ; DETEC=0 ; PDRAW="" ; DFILE="" ; REFERRED=0
DO UNTIL DETEC=1
PDRAW=READLN('TF')
PARSE VAR PDRAW AAA BBB CCC
BBB=STRIP(BBB,'B')
IF AAA=LNSTB THEN DO
CCC=POS('/',BBB) ; BBA=COMPRESS(LEFT(BBB,CCC),'/') ;
BBC=COMPRESS(SUBSTR(BBB,CCC),'/;')
END
IF AAA=LNSTA THEN BBA=BBB
SELECT
WHEN EOF('TF')=1 THEN LEAVE
WHEN BOUNDARYCOUNTER<1 & AAA=LNSTB & BBA=CONTG THEN CALL FINDBOUNDARY
WHEN AAA = LNSTC & BBB = CONTA | BBB = CONTB | BBB = CONTC THEN DETEC=2
WHEN AAA = LNSTB & BBA = CONTE THEN DETEC=2
WHEN AAA = LNSTB & BBA = CONTF & BBC = CONTH THEN CALL HTMLATTACHMENT
WHEN AAA = LNSTB & BBA = CONTF & BBC = CONTI THEN CALL PLAINATTACHMENT
WHEN AAA = LNSTB & BBA = CONTD & BBC = CONTJ THEN CALL RTFATTACHMENT
WHEN AAA = LNSTA & BBA = CONTK | BBA = CONTL THEN DETEC=1
OTHERWISE NOP
END
IF DETEC=2 THEN DO ; DETEC=1 ; REFERRED=644 ; END
END
DETEC=0 ; OPF='T:TF'||MAINLOOP||SUBCOUNT
CALL OPEN('IMAGE',OPF,'W')
CALL WRITELN('IMAGE',PDRAW)
IF REFERRED=644 THEN DO ; SUBBARTITLE='Image:' ; CALL SUBBARSETUP
DO UNTIL EOF('TF')
PDRAW=READCH('TF',HOWLONG+1) ; CALL WRITECH('IMAGE',PDRAW) ; CALL SUBBARUPDATE
END ; REMOVEBAR WINDI1 BARDI2 ; DETEC=1
END ; ELSE DO ; SUBBARTITLE=BBA||' '||SUBCOUNT||':' ; CALL SUBBARSETUP
DO UNTIL DETEC=1
PDRAW=READLN('TF') ; CALL WRITELN('IMAGE',PDRAW) ; CALL SUBBARUPDATE
SELECT
WHEN EOF('TF')=1 | SUBSTR(PDRAW,1,3)='end' THEN DETEC=1
WHEN BOUNDARYCOUNTER=1 & PDRAW=BOUNDARY THEN DETEC=1
OTHERWISE NOP
END
END ; REMOVEBAR WINDI1 BARDI2
END
END
/* End of inner loop */
CALL CLOSE('IMAGE') ; CALL CLOSE('TF')
ADDRESS COMMAND "C:uudecode T:TF* >NIL:"
CALL DELETE(OPF)
END
/* End of Main loop */
CALL CLOSE('DT')
IF USINGREQTOOLS~=1 THEN SAY 'Cleaning up.'
CALL PRAGMA 'DIRECTORY','sys:'
CALL GETOUTOFHERE
IF USINGREQTOOLS=1 THEN CALL rtezrequest("Complete","Thank you","Never more.") ; ELSE
SAY 'Complete.'
EXIT
GETOUTOFHERE:
DELETEBARWINDOW WINDI1
QUIT
CALL DELETE('T:DETACH')
RETURN
RTFATTACHMENT:
SUBBARTITLE='RTF:' ;CALL SUBBARSETUP
DD=0
DO UNTIL POS('{\rtf',PDRAW)>0
CALL FINDFILENAME
PDRAW=READLN('TF')
CALL SUBBARUPDATE
END
IF DD<1 THEN EE='DUMMYNAME.RTF'
CALL OPEN('IMAGE',EE,'W')
DO UNTIL EOF('TF')
CALL WRITELN('IMAGE',PDRAW)
PDRAW=READLN('TF')
CALL SUBBARUPDATE
IF BOUNDARYCOUNTER=1 & SUBSTR(PDRAW,1,8)=SUBSTR(BOUNDARY,1,8) THEN DO
CALL CLOSE('IMAGE')
LEAVE
END
END
REMOVEBAR WINDI1 BARDI2
CALL NEEDADUMMY
SUBCOUNT=SUBCOUNT+1
RETURN
HTMLATTACHMENT:
SUBBARTITLE='HTML:' ;CALL SUBBARSETUP
DD=0
DO UNTIL POS('<html>',PDRAW)>0 | POS('<HTML>',PDRAW)>0
CALL FINDFILENAME
PDRAW=READLN('TF')
CALL SUBBARUPDATE
END
IF DD=1 THEN HTMLSTEM.0=EE ; ELSE HTMLSTEM.0=SUBJECTID||'-'||SUBCOUNT||'.html'
DDD=1
DO UNTIL EOF('TF')
HTMLSTEM.DDD = PDRAW
IF DD=0 & POS('<title>',PDRAW)>0 | POS('<TITLE>',PDRAW)>0 THEN DO
CALL HTMLTITLE ; HTMLSTEM.0=EE ; DD=1
END
IF POS('</html>',HTMLSTEM.DDD)>0 | POS('</HTML>',HTMLSTEM.DDD)>0 THEN LEAVE
PDRAW=READLN('TF')
CALL SUBBARUPDATE
DDD=DDD+1
END
REMOVEBAR WINDI1 BARDI2
CALL OPEN('IMAGE',HTMLSTEM.0,'W')
DO FF=1 TO DDD
CALL WRITELN('IMAGE',HTMLSTEM.FF)
END
CALL CLOSE('IMAGE')
CALL NEEDADUMMY
DROP DDD HTMLSTEM.
SUBCOUNT=SUBCOUNT+1
RETURN
NEEDADUMMY:
CALL OPEN('DUM','T:TFA','W')
CALL WRITELN('DUM','A')
CALL CLOSE('DUM')
RETURN
HTMLTITLE:
EE=UPPER(STRIP(PDRAW))
GG=STRIP(PDRAW)
GGA=POS('<TITLE>',EE)+7
GG=SUBSTR(GG,GGA)
EE=SUBSTR(EE,GGA)
GG=SUBSTR(GG,1,POS('</TITLE>',EE)-1)
EE=WHERETOPUTTHEM||GG||'.html'
DROP GG GGA
RETURN
PLAINATTACHMENT:
SUBBARTITLE='Plain text:' ; CALL SUBBARSETUP
PTP=WHERETOPUTTHEM||SUBJECTID||'_'||SUBCOUNT'.txt'
CALL OPEN('PT',PTP,'W')
DO UNTIL PDRAW=""
PDRAW=STRIP(READLN('TF'),'B') ; CALL SUBBARUPDATE
END
DO UNTIL EOF('TF')
PDRAW=READLN('TF') ; CALL SUBBARUPDATE
IF BOUNDARYCOUNTER=1 & SUBSTR(PDRAW,1,8)=SUBSTR(BOUNDARY,1,8) THEN DO
CALL CLOSE('PT') ; LEAVE
END
CALL WRITELN('PT',PDRAW)
END
REMOVEBAR WINDI1 BARDI2
IF SUBWORD(STATEF(PTP),2,1)<5 THEN CALL DELETE(PTP)
RETURN
FINDBOUNDARY:
DD=0
DO UNTIL EOF('TF')
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
FINDFILENAME:
IF POS('filename',PDRAW)>1 THEN DO
EE=STRIP(PDRAW,'B')
DO FF=1 TO 2
EE=SUBSTR(EE,POS('"',EE)+1) ; EE=REVERSE(EE)
END
EE=WHERETOPUTTHEM||EE ; DD=1
END
RETURN
FINDTHESUBJECT:
JJ=LASTPOS(':',PDRAW)
IF JJ>0 THEN PDRAW=SUBSTR(PDRAW,JJ+1)
PDRAW=COMPRESS(PDRAW,':!$%&*+=|\?/<>{}[]#~')
SUBJECTID=SPACE(PDRAW,1,'_')
SUBJECTCOUNTER=1 ; DROP JJ AAA AAB
RETURN
WHERETOGO:
WHERETOPUTTHEM = RTFILEREQUEST('RAM:',,"Destination ?","Alright","rtfi_flags =
freqf_nofiles")
IF RTRESULT==0 THEN EXIT
RETURN
HOWMANY:
NL = '0a'x
CALL RTGETLONG('1','How Many Messages'NL'do you wish to open','Get attachments by
Jules',"_Yes please|_No thank you",'RTGL_MIN=1 RTGL_MAX=250')
IF RTRESULT~=1 THEN EXIT
PICOUNT=RESULT
RETURN
PROBLEMFOUND:
IF USINGREQTOOLS=1 THEN CALL RTEZREQUEST(ERRT, "Shame", "Error!") ; ELSE SAY ERRT
EXIT
RETURN
PROGRESSBARSETUP:
CREATEBARWINDOW "Harvest" ; WINDI1 = RESULT
SETBARWINDOWWIDTH WINDI1 200
ADDBAR WINDI1 PICOUNT NAME 'Message:' ; BARDI1 = RESULT
SETPROGRESSMODE WINDI1 BARDI1 2
OPENBARWINDOW WINDI1
RETURN
SUBBARSETUP:
ADDBAR WINDI1 HOWLONG NAME SUBBARTITLE ; BARDI2 = RESULT
SETPROGRESSMODE WINDI1 BARDI2 1
RETURN
SUBBARUPDATE:
HOWMUCH=HOWMUCH+LENGTH(PDRAW)
SETCURRENT WINDI1 BARDI2 HOWMUCH
RETURN
/*
Version 1.0 - Speed increase - One 'open', many 'reads' introduced.
Version 1.1 - Added a progress bar due to the new read method.
Version 1.2 - Will now attempt Plain text - improved user feedback.
Version 1.3 - Made it smaller, until I added this.
Version 1.4 - Removed 'Ixemul' problem.
*/
-- 8< -- Cut here -- 8< --
Although I did only have one report of this fault, I could see that it was a
bad one. Sorry to those affected.
--
Regards
Jules
--
I will not snap bras.
-- 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
