Hello All

 I've killed another way for the script to get lost and improved error
checking, hopefully if this one fails it should close the progress bar.

-- 8< -- Cut Here -- 8< --
/*
 $VER: 1.5 UudecodeAttach.rx (01-03-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)
  (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 message, as the script will do that.
 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

SIGNAL ON SYNTAX
SIGNAL ON ERROR

/* 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
IF PICOUNT <1 THEN DO
 USINGREQTOOLS=1
 PICOUNT=1
 END

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 CALL ADDLIB('Libs:'||LIBR.I,0,-30,0)
 END
END
DROP I

/* Default Paths */
FILEPATH='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
 IF I=2 THEN ADDRESS COMMAND "RUN >NIL: C:FreshBar"
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 PUTTHEMHERE ; CALL HOWMANY
END

/* The counters */
AA=0;MAINLOOP=1;PICOUNT=STRIP(PICOUNT)

CALL PRAGMA 'D',FILEPATH
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 I=1 TO PICOUNT
 IF I<2 THEN READSELECTEDMSGS
 ELSE GOTOMSG NEXT
END ; DROP I

ADDRESS COMMAND 'WAIT'
ADDRESS SNOOPDOS;DISABLE;SAVEBUFFER "T:SnoopMD";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
CREATEBARWINDOW "Harvest" ; WINDI1 = RESULT
ADDBAR WINDI1 PICOUNT NAME 'Message:' ; BARDI1 = RESULT
SETBARWINDOWWIDTH WINDI1 200
SETPROGRESSMODE WINDI1 BARDI1 2
OPENBARWINDOW WINDI1

/* Start of Main loop */
DO MAINLOOP=1 TO PICOUNT
BOUNDARY="";BOUNDARYCOUNTER=0;DETEC=0;HOWMUCH=0;SUBCOUNT=0;SUBJECTCOUNTER=0
SETCURRENT WINDI1 BARDI1 MAINLOOP
TARGETFILE=READLN('DT')
CALL OPEN('TF',TARGETFILE,'R')
HOWLONG=WORD(STATEF(TARGETFILE),2)
DO UNTIL EOF('TF')
 PDRAW=READLN('TF')
 PARSE VAR PDRAW AAA AAB
 IF SUBJECTCOUNTER=0 & AAA='Subject:' THEN DO ; CALL FINDSUBJECT ; LEAVE ; END
END
/* Start of inner loop */
DO UNTIL EOF('TF')=1
 DETEC=0;PDRAW="";DFILE="";REFERRED=0
 SUBCOUNT=SUBCOUNT+1
 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 ; REFERRED=644 ; DETEC=1 ; 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 'D','SYS:'
CALL GETOUTOFHERE
IF USINGREQTOOLS=1 THEN CALL rtezrequest("Completed","Thank you","I have finished.")
 ELSE SAY 'Complete.'
EXIT

ERROR:
SYNTAX:
IF RC~=0 THEN SAY '+++ ['RC']' ERRORTEXT(RC) 'at line' SIGL
CALL GETOUTOFHERE
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=FILEPATH||GG||'.html'
DROP GG GGA
RETURN

PLAINATTACHMENT:
SUBBARTITLE='Plain text:';CALL SUBBARSETUP
PTP=FILEPATH||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=FILEPATH||EE;DD=1
END
RETURN

FINDSUBJECT:
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

PUTTHEMHERE:
FILEPATH = 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

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.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.
Version 1.5 - More error checks.
*/

-- 8< -- And Here -- 8< --

-- 
Regards
  Jules
__________________________________________________________________
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

Reply via email to