home *** CD-ROM | disk | FTP | other *** search
/ MACD 7 / MACD7.iso / internet / octetpurge / octetpurge.bas < prev    next >
Encoding:
BASIC Source File  |  1998-01-05  |  3.5 KB  |  166 lines
  1. REM Octet Purge by Simon N Goodwin, December 1997.
  2. REM
  3. REM WHAT?
  4. REM
  5. REM Program to scan MIME a mail file and remove all
  6. REM octet-stream binary encoded data sections.
  7. REM
  8. REM REQUIREMENTS
  9. REM
  10. REM Written in HiSoft BASIC. Requires ASL library.
  11. REM Uses 15 point Helvetica.font if it's available.
  12. REM
  13. REM WHY?
  14. REM
  15. REM Written to keep the size of archived YAM mail
  16. REM manageable, on the basis that binary contents
  17. REM ought to be archived somewhere else already.
  18. REM
  19. REM HOW?
  20. REM 
  21. REM Start from Workbench by clicking on the icon.
  22. REM Select a file to be scanned or CANCEL to quit.
  23. REM Repeat selection for each file to be purged.
  24. REM
  25. REM Input file is not modified. A new file on the
  26. REM same path with the suffix ".purged" is created
  27. REM containing the original contents except with
  28. REM the 'application octet-stream' data sections
  29. REM replaced with the text:
  30. REM
  31. REM     **** Octet stream deleted from archive.
  32. REM
  33. REM KNOWN BUGS
  34. REM
  35. REM No check that the output file name is valid.
  36. REM No diagnostics if the input file is malformed.
  37. REM
  38. REM
  39. REM STATUS
  40. REM
  41. REM Freely distributable; you must include source.
  42. REM
  43. REM AUTHOR
  44. REM
  45. REM Simon N Goodwin, simon@studio.woden.com
  46. REM
  47.  
  48. DEFINT a-z
  49.  
  50. ' HiSoft ASL library and disk font initialisation
  51.  
  52. REM $INCLUDE diskfont.bh
  53. REM $INCLUDE graphics.bh
  54. REM $include asl.bh
  55. LIBRARY OPEN "asl.library"
  56. LIBRARY OPEN "diskfont.library"
  57. LIBRARY OPEN "graphics.library"
  58.  
  59. WINDOW 1,"  MIME Mail archive file Octet Purger  ", _
  60.     (32,16)-(608,160),1+2+4+16+256
  61.  
  62. REM Use a groovier Compugraphic fo(u)nt if you wish
  63.  
  64. DIM TextAttr(4)
  65. InitTextAttr TextAttr(),"Helvetica.font",15,0,0
  66. font& = OpenDiskFont (VARPTR(TextAttr(0)))
  67.  
  68. IF font&
  69.   SetFont WINDOW (8), font&
  70. ELSE
  71.   PRINT " **** Preferred font not available. Using default."
  72. END IF
  73.  
  74. pattern$="Content-Type: application/octet-stream"
  75. patlen=LEN(pattern$)
  76.  
  77. boundary$="--BOUNDARY"
  78. boundlen=LEN(boundary$)
  79.  
  80. ' ASL requester initialisation
  81.  
  82. CONST TAG_DONE&=0,TRUE&=1,ABORT&=-1,FALSE&=0
  83. DIM frtags&(20)
  84.  
  85. ' Main program
  86.  
  87. ok=TRUE
  88.  
  89. REPEAT main
  90.     
  91.     TAGLIST VARPTR(frtags&(0)),ASLFR_TitleText&, _
  92.         "Select the file to be purged", _
  93.         ASLFR_InitialFile&,"", _
  94.         ASLFR_InitialDrawer&,"RAM:", _
  95.         ASLFR_InitialHeight&,     130, _
  96.         ASLFR_InitialLeftEdge&, 280, _
  97.         ASLFR_InitialWidth&,         310, _ 
  98.         TAG_DONE&
  99.         
  100.     fr&=AllocAslRequest&(ASL_FileRequest&,VARPTR(frtags&(0)))
  101.     IF fr& THEN
  102.         ok&=AslRequest&(fr&,0)
  103.         IF ok& THEN
  104.             file$=PEEK$(PEEKL(fr&+fr_File))
  105.             dir$=PEEK$(PEEKL(fr&+fr_Drawer))
  106.             IF LEN(dir$)
  107.                 suffix$=RIGHT$(dir$,1)
  108.                 IF suffix$<>"/" AND suffix$<>":" THEN dir$=dir$+"/"
  109.             END IF
  110.         END IF
  111.         FreeASlRequest fr&
  112.     ELSE
  113.         ok&=ABORT&
  114.     END IF
  115.  
  116.   IF ok&=FALSE& OR ok&=ABORT& THEN EXIT main
  117.  
  118.   file$=dir$+file$
  119.   
  120.     PRINT
  121.  
  122.     OPEN file$ FOR INPUT AS #3
  123.     OPEN file$+".purged" FOR OUTPUT AS #4
  124.  
  125.     copying=1 : found=0
  126.  
  127.     REPEAT scan
  128.       IF EOF(3) THEN EXIT scan
  129.       INPUT #3,a$
  130.       IF NOT copying
  131.         copying=LEFT$(a$,boundlen)=boundary$
  132.       END IF
  133.       IF LEFT$(a$,patlen)=pattern$
  134.         PRINT #4,a$
  135.         PRINT " Purging: ";a$
  136.         PRINT #4
  137.         PRINT #4,"**** Octet stream deleted from archive."
  138.         PRINT #4
  139.         copying=0: found=found+1
  140.       END IF
  141.       IF copying THEN PRINT #4,a$
  142.     END REPEAT scan 
  143.  
  144.     CLOSE #4
  145.     CLOSE #3
  146.  
  147.     PRINT
  148.     PRINT " OK,";found;"octet stream";
  149.     IF found<>1 THEN PRINT "s";
  150.     PRINT " found in ";file$
  151.     PRINT
  152.     PRINT " Condensed version written to ";file$+".purged"
  153.     
  154. END REPEAT main
  155.  
  156. SYSTEM
  157.  
  158. SUB InitTextAttr(T(1),FontName$,BYVAL Height,BYVAL style,BYVAL flags)
  159.  
  160. POKEL VARPTR(T(0))+ta_Name,SADD(FontName$+CHR$(0))
  161. t(ta_YSize\2)=Height
  162. POKEB VARPTR(T(0))+ta_Style,style
  163. POKEB VARPTR(T(0))+ta_Flags,flags
  164.  
  165. END SUB ' InitTextAttr
  166.