home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 35 Internet / 35-Internet.zip / pmm15u11.zip / STRIP.PAS < prev   
Pascal/Delphi Source File  |  1997-01-16  |  8KB  |  197 lines
  1. program PMMail_Strip_1_1;
  2.  
  3. (* This liltle proggy is my first, and what it does is it searches the index file of e-mail
  4. messages of PMMail 1.5 and strips out any attachement's (uucode, base64 or binehex) data from
  5. it, but leaving the filename for future reference.
  6.  
  7. Copyright 1996-1997 Samuel Audet <guardia@cam.org>  distribute freely! *)
  8.  
  9. uses strings,dos;
  10.  
  11. const bagname = 'folder.bag';  (* index filenames *)
  12.       bakname = 'folder.bak';
  13.  
  14. var bag,tmp_file   : text;
  15.     bagline,dump   : array[0..400] of char; (* Does folder.bag record need any bigger? *)
  16.     statpos,sizepos,filepos : pchar;  (* pointer position for an index record *)
  17.     index          : word;
  18.     filename,size  : array[0..11] of char;
  19.     i              : byte;
  20.     byte_file      : file of byte;
  21.     stripdir       : string;
  22.  
  23.  
  24. procedure strip(sup_file : string); (* da file stripper, case mania *)
  25.  
  26. var temp      : string;    (* <- This stores a line of text of a message, max 255 columns. *)
  27.     unstrip, strip : text; (* It would be difficult to put more :(  *)
  28.     mode      : byte;
  29.     name      : namestr;   (* for 'fsplit' weird huh? *)
  30.     garbage, boundary : string;
  31.     found     : boolean;
  32.     boundpos  : byte;
  33.  
  34. begin
  35.    assign(unstrip,stripdir + sup_file);       (* renames the original file to *.bak and opens *)
  36.    fsplit(sup_file,garbage,name,garbage);     (* for writing to the original name *)
  37.    {$I-} rename(unstrip,stripdir + name + '.bak'); {$I+}
  38.    case ioresult of
  39.       2: begin writeln('Error: message file not found'); exit; end;
  40.       5: begin
  41.             assign(unstrip,stripdir + name + '.bak');
  42.             erase(unstrip);
  43.             assign(unstrip,stripdir + sup_file);
  44.             rename(unstrip,stripdir + name + '.bak');
  45.          end;
  46.    end;
  47.    assign(strip,stripdir + sup_file);
  48.    reset(unstrip);
  49.    rewrite(strip);
  50.  
  51.    (* Looks for the boundary string in the message, and also looks for UUcode attachements *)
  52.  
  53.    found := false;
  54.    mode := 0;
  55.    while not (eof(unstrip) or found) do    (* mode 0 = storing, searching for boundary *)
  56.    begin                                   (* or uucode start *)
  57.       readln(unstrip,temp);          (* mode 2 = no storing, searching end string of uucode *)
  58.       case mode of
  59.          2: if pos('end',temp) = 1 then begin mode := 0; writeln (strip,temp); end;
  60.          0: begin
  61.                boundpos := pos('boundary="',temp) + 10;
  62.                if boundpos > 10 then
  63.                begin
  64.                   boundary := copy(temp, boundpos, sizeof(temp));
  65.                   boundary := copy(boundary, 1, pos('"',boundary) - 1);
  66.                   found := true;
  67.                   writeln(strip,temp);
  68.                   writeln(strip,'');
  69.                end else
  70.                   if pos('begin 6',temp) = 1 then
  71.                   begin
  72.                      mode := 2;
  73.                      writeln(strip,temp);
  74.                      writeln(strip,'');
  75.                end else
  76.                   writeln(strip,temp);
  77.             end;
  78.       end;
  79.    end;
  80.  
  81. (* Looks for BinHex and MIME BASE64 attachement using the boundary, and also looks for UUcode *)
  82.  
  83.    mode := 0;
  84.    while not eof(unstrip) do         (* mode 0 = storing, searching attach start string *)
  85.    begin                             (* mode 1 = no storing, searching end boundary (binhex, base64) *)
  86.       readln(unstrip,temp);          (* mode 2 = no storing, searching end string of uucode *)
  87.       case mode of
  88.          1: if pos('--' + boundary,temp) = 1 then begin mode := 0; writeln (strip,temp); end;
  89.          2: if pos('end',temp) = 1 then begin mode := 0; writeln (strip,temp); end;
  90.          0: begin
  91.                if pos('Content-Transfer-Encoding: base64',temp)
  92.                   or pos('Content-Transfer-Encoding: BASE64',temp) = 1 then
  93.                begin
  94.                   mode := 1;
  95.                   writeln(strip,temp);
  96.                   writeln(strip,'');
  97.                end else
  98.                if pos('Content-Disposition: attachment; filename="',temp) = 1 then
  99.                begin
  100.                   mode := 1;
  101.                   writeln(strip,temp);
  102.                   writeln(strip,'');
  103.                end else
  104.                if pos('begin 6',temp) = 1 then
  105.                begin
  106.                   mode := 2;
  107.                   writeln(strip,temp);
  108.                   writeln(strip,'');
  109.                end else
  110.                   writeln(strip,temp);
  111.             end;
  112.       end;
  113.    end;
  114.    close(unstrip);
  115.    close(strip);
  116.    erase(unstrip);         (* clears the backup *)
  117. end;
  118.  
  119.  
  120. begin
  121.    Writeln('PMMail 1.5 Utilities 1.1, Attachment Stripper - Copyright 1996-1997 Samuel Audet');
  122.    stripdir := paramstr(1);
  123.    if (stripdir <> '') and (copy(stripdir,length(stripdir),1) <> '\')
  124.       then stripdir := stripdir + '\';   (* command line parameter formatting *)
  125.    assign(bag,stripdir + bagname);             (* Renames the original folder.bag to folder.bak, and *)
  126.    {$I-} rename(bag,stripdir + bakname); {$I+} (* opens writing to folder.bag. *)
  127.    case ioresult of
  128.       2: if stripdir = ''
  129.             then begin writeln('Error: ' + bagname + ' does not exist in the current directory'); halt; end
  130.             else begin writeln('Error: ' + bagname + ' does not exist in ' + stripdir); halt; end;
  131.       3: begin writeln('Error: the directory ' + stripdir + ' does not exist'); halt; end;
  132.       5: begin
  133.             assign(bag,stripdir + bakname);
  134.             erase(bag);
  135.             assign(bag,stripdir + bagname);
  136.             rename(bag,stripdir + bakname);
  137.          end;
  138.    end;
  139.    assign(tmp_file,stripdir + bagname);
  140.    reset(bag);
  141.    rewrite(tmp_file);
  142.  
  143. (* This part searches the index, folder.bag and will indicate which file has attachements. *)
  144.    while not eof(bag) do begin
  145.       readln(bag, bagline);
  146.       dump := bagline;
  147.       statpos := strscan(bagline, chr(222)) + 1; (* Checks for attachements entry *)
  148.  
  149.       (* Checks the position of various entries using null-terminated strings and P(ointer)chars *)
  150.  
  151.       sizepos := strrscan(bagline, chr(222));
  152.       for i := 1 to 2 do begin
  153.          index := 0;
  154.          repeat                   (* Checks the size entry ... *)
  155.             dec(sizepos);
  156.             inc(index);
  157.          until (sizepos^ = chr(222)) or (sizepos <= statpos);
  158.       end;
  159.       if sizepos <= statpos then begin
  160.          writeln ('Error: bad entry in ' + stripdir + bagname);
  161.          sizepos := nil;
  162.       end else strmove(size,sizepos + 1, index - 1);
  163.                                                   (* ... and sees if it already has stripped *)
  164.                                                   (* it if it contains 'KB', see below *)
  165.       if (statpos^ = '1') and (strpos(size,'KB') = nil) then begin
  166.          filepos := strrscan(bagline, chr(222));
  167.          index := 0;
  168.          repeat                   (* Checks the filename entry and stores it in 'filename' *)
  169.             dec(filepos);
  170.             inc(index);
  171.          until (filepos^ = chr(222)) or (filepos <= statpos);
  172.          if filepos <= statpos then begin
  173.             writeln ('Error: bad entry in ' + stripdir + bagname);
  174.             filepos := nil;
  175.          end else begin
  176.             fillchar(filename, sizeof(filename), #0);
  177.             strmove(filename,filepos + 1,index - 1);  (* This copies filename data to an array of *)
  178.             writeln(filename);                        (* chars starting at the position found. *)
  179.             strip(filename);
  180.  
  181.             assign(byte_file,stripdir + filename);    (* This opens the message file in Byte mode *)
  182.             reset(byte_file);                         (* calculates the size, and writes it to the index *)
  183.             str(round(filesize(byte_file)/1024),size); (* putting KB instead of K, for verification *)
  184.             close(byte_file);
  185.             fillchar(dump, sizeof(dump), #0);
  186.             strmove(dump, bagline, strlen(bagline) - strlen(sizepos + 1));
  187.             strlcat(dump, strcat(size, 'KB'), sizeof(dump));
  188.             strlcat(dump, filepos, sizeof(dump));
  189.          end;
  190.       end;
  191.    writeln(tmp_file,dump);
  192.    end;
  193.    close(bag);
  194.    close(tmp_file);
  195.    erase(bag);
  196. end.
  197.