mimepart.pas

delphi写的mib browser 源码,界面友好!

{==============================================================================|
| Project : Delphree - Synapse                                   | 001.003.001 |
|==============================================================================|
| Content: MIME support procedures and functions                               |
|==============================================================================|
| The contents of this file are subject to the Mozilla Public License Ver. 1.0 |
| (the "License"); you may not use this file except in compliance with the     |
| License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ |
|                                                                              |
| Software distributed under the License is distributed on an "AS IS" basis,   |
| WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for |
| the specific language governing rights and limitations under the License.    |
|==============================================================================|
| The Original Code is Synapse Delphi Library.                                 |
|==============================================================================|
| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
| Portions created by Lukas Gebauer are Copyright (c)2000,2001.                |
| All Rights Reserved.                                                         |
|==============================================================================|
| Contributor(s):                                                              |
|==============================================================================|
| History: see HISTORY.HTM from distribution package                           |
|          (Found at URL: http://www.ararat.cz/synapse/)                       |
|==============================================================================}

unit MIMEpart;

interface

uses
  sysutils, classes, windows, MIMEchar, SynaCode, SynaUtil, MIMEinLn;

type

TMimePrimary=(MP_TEXT,
              MP_MULTIPART,
              MP_MESSAGE,
              MP_BINARY);

TMimeEncoding=(ME_7BIT,
               ME_8BIT,
               ME_QUOTED_PRINTABLE,
               ME_BASE64,
               ME_UU,
               ME_XX);

TMimePart=class
  private
    FPrimary:string;
    FEncoding:string;
    FCharset:string;
    procedure Setprimary(Value:string);
    procedure SetEncoding(Value:string);
    procedure SetCharset(Value:string);
  protected
  public
    PrimaryCode:TMimePrimary;
    EncodingCode:TMimeEncoding;
    CharsetCode:TMimeChar;
    TargetCharset:TMimeChar;
    secondary:string;
    description:string;
    disposition:string;
    boundary:string;
    FileName:string;
    Lines:TStringList;
    DecodedLines:TmemoryStream;
    constructor Create;
    destructor Destroy; override;
    procedure clear;
    function ExtractPart(value:TStringList; BeginLine:integer):integer;
    procedure DecodePart;
    procedure EncodePart;
    procedure MimeTypeFromExt(value:string);
  property
    Primary:string read FPrimary Write SetPrimary;
  property
    encoding:string read FEncoding write SetEncoding;
  property
    Charset:string read FCharset write SetCharset;
end;

const
  MaxMimeType=25;
  MimeType:array [0..MaxMimeType,0..2] of string=
    (
      ('AU','audio','basic'),
      ('AVI','video','x-msvideo'),
      ('BMP','image','BMP'),
      ('DOC','application','MSWord'),
      ('EPS','application','Postscript'),
      ('GIF','image','GIF'),
      ('JPEG','image','JPEG'),
      ('JPG','image','JPEG'),
      ('MID','audio','midi'),
      ('MOV','video','quicktime'),
      ('MPEG','video','MPEG'),
      ('MPG','video','MPEG'),
      ('MP2','audio','mpeg'),
      ('MP3','audio','mpeg'),
      ('PDF','application','PDF'),
      ('PNG','image','PNG'),
      ('PS','application','Postscript'),
      ('QT','video','quicktime'),
      ('RA','audio','x-realaudio'),
      ('RTF','application','RTF'),
      ('SND','audio','basic'),
      ('TIF','image','TIFF'),
      ('TIFF','image','TIFF'),
      ('WAV','audio','x-wav'),
      ('WPD','application','Wordperfect5.1'),
      ('ZIP','application','ZIP')
    );

function NormalizeHeader(value:TStringList;var index:integer):string;
function GenerateBoundary:string;

implementation

function NormalizeHeader(value:TStringList;var index:integer):string;
var
  s,t:string;
  n:integer;
begin
  s:=value[index];
  inc(index);
  if s<>''
    then
      while (value.Count-1) > index do
        begin
          t:=value[index];
          if t=''
            then break;
          for n:=1 to length(t) do
            if t[n]=#9
              then t[n]:=' ';
          if t[1]<>' '
            then break
            else
              begin
                s:=s+' '+trim(t);
                inc(index);
              end;
        end;
  result:=s;
end;

{==============================================================================}
{TMIMEPart.Create}
Constructor TMIMEPart.Create;
begin
  inherited Create;
  Lines:=TStringList.Create;
  DecodedLines:=TmemoryStream.create;
  TargetCharset:=GetCurCP;
end;

{TMIMEPart.Destroy}
Destructor TMIMEPart.Destroy;
begin
  DecodedLines.free;
  Lines.free;
  inherited destroy;
end;

{==============================================================================}
{TMIMEPart.Clear}
procedure TMIMEPart.Clear;
begin
  FPrimary:='';
  FEncoding:='';
  FCharset:='';
  PrimaryCode:=MP_TEXT;
  EncodingCode:=ME_7BIT;
  CharsetCode:=ISO_8859_1;
  TargetCharset:=GetCurCP;
  secondary:='';
  disposition:='';
  description:='';
  boundary:='';
  FileName:='';
  Lines.clear;
  DecodedLines.clear;
end;

{==============================================================================}
{TMIMEPart.ExtractPart}
function TMIMEPart.ExtractPart(value:TStringList; BeginLine:integer):integer;
var
  n,x,x1,x2:integer;
  t:tstringlist;
  s,su,b:string;
  st,st2:string;
  e:boolean;
  fn:string;
begin
  t:=tstringlist.create;
  try
    {defaults}
    lines.clear;
    primary:='text';
    secondary:='plain';
    description:='';
    charset:='US-ASCII';
    FileName:='';
    encoding:='7BIT';

    fn:='';
    x:=beginline;
    b:=boundary;
    if b<>'' then
      while value.count>x do
        begin
          s:=value[x];
          inc(x);
          if pos('--'+b,s)>0
            then break;
        end;

    {parse header}
    while value.count>x do
      begin
        s:=normalizeheader(value,x);
        if s=''
          then break;
        su:=uppercase(s);
        if pos('CONTENT-TYPE:',su)=1 then
          begin
            st:=separateright(su,':');
            st2:=separateleft(st,';');
            primary:=separateleft(st2,'/');
            secondary:=separateright(st2,'/');
            if (secondary=primary) and (pos('/',st2)<1)
              then secondary:='';
            case primarycode of
              MP_TEXT:
                begin
                  charset:=uppercase(getparameter(s,'charset='));
                end;
              MP_MULTIPART:
                begin
                  boundary:=getparameter(s,'boundary=');
                end;
              MP_MESSAGE:
                begin
                end;
              MP_BINARY:
                begin
                  filename:=getparameter(s,'name=');
                end;
            end;
          end;
        if pos('CONTENT-TRANSFER-ENCODING:',su)=1 then
          begin
            encoding:=separateright(su,':');
          end;
        if pos('CONTENT-DESCRIPTION:',su)=1 then
          begin
            description:=separateright(s,':');
          end;
        if pos('CONTENT-DISPOSITION:',su)=1 then
          begin
            disposition:=separateright(su,':');
            disposition:=trim(separateleft(disposition,';'));
            fn:=getparameter(s,'filename=');
          end;
      end;

    if (primarycode=MP_BINARY) and (filename='')
      then filename:=fn;
    filename:=InlineDecode(filename,getCurCP);
    filename:=extractfilename(filename);

    x1:=x;
    x2:=value.count-1;
    if b<>'' then
      begin
        for n:=x to value.count-1 do
          begin
            x2:=n;
            s:=value[n];
            if pos('--'+b,s)>0
              then begin
                dec(x2);
                break;
              end;
          end;