mimepart.pas

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

      end;
    if primarycode=MP_MULTIPART then
      begin
        for n:=x to value.count-1 do
          begin
            s:=value[n];
            if pos('--'+boundary,s)>0 then
              begin
                x1:=n;
                break;
              end;
          end;
        for n:=value.count-1 downto x do
          begin
            s:=value[n];
            if pos('--'+boundary,s)>0 then
              begin
                x2:=n;
                break;
              end;
          end;
      end;
    for n:=x1 to x2 do
      lines.add(value[n]);
    result:=x2;
    if primarycode=MP_MULTIPART then
      begin
        e:=false;
        for n:=x2+1 to value.count-1 do
          if pos('--'+boundary,value[n])>0 then
            begin
              e:=true;
              break;
            end;
        if not e
          then result:=value.count-1;
      end;
  finally
    t.free;
  end;
end;

{==============================================================================}
{TMIMEPart.DecodePart}
procedure TMIMEPart.DecodePart;
const
  CRLF=#$0D+#$0A;
var
  n:integer;
  s:string;
begin
  decodedLines.Clear;
  for n:=0 to lines.count-1 do
    begin
      s:=lines[n];
      case EncodingCode of
        ME_7BIT:
          begin
            s:=s+CRLF;
          end;
        ME_8BIT:
          begin
            s:=decodeChar(s,CharsetCode,TargetCharset);
            s:=s+CRLF;
          end;
        ME_QUOTED_PRINTABLE:
          begin
            if s=''
              then s:=CRLF
              else
                if s[length(s)]<>'='
                  then s:=s+CRLF;
            s:=DecodeQuotedPrintable(s);
            if PrimaryCode=MP_TEXT
              then s:=decodeChar(s,CharsetCode,TargetCharset);
          end;
        ME_BASE64:
          begin
            if s<>''
              then s:=DecodeBase64(s);
            if PrimaryCode=MP_TEXT
              then s:=decodeChar(s,CharsetCode,TargetCharset);
          end;
        ME_UU:
          begin
            if s<>''
              then s:=DecodeUU(s);
          end;
        ME_XX:
          begin
            if s<>''
              then s:=DecodeXX(s);
          end;
      end;
      Decodedlines.Write(pointer(s)^,length(s));
    end;
  decodedlines.Seek(0,soFromBeginning);
end;

{==============================================================================}
{TMIMEPart.EncodePart}
procedure TMIMEPart.EncodePart;
var
  l:TStringList;
  s,buff:string;
  n,x:integer;
begin
  if EncodingCode=ME_UU
    then encoding:='base64';
  if EncodingCode=ME_XX
    then encoding:='base64';
  l:=tstringlist.create;
  Lines.clear;
  decodedlines.Seek(0,soFromBeginning);
  try
    case primarycode of
      MP_MULTIPART,
      MP_MESSAGE:
        begin
          lines.LoadFromStream(DecodedLines);
        end;
      MP_TEXT,
      MP_BINARY:
        if EncodingCode=ME_BASE64
          then
            begin
              while decodedlines.Position<decodedlines.Size do
                begin
                  Setlength(Buff,54);
                  s:='';
                  x:=Decodedlines.Read(pointer(Buff)^,54);
                  for n:=1 to x do
                    s:=s+Buff[n];
                  if PrimaryCode=MP_TEXT
                    then s:=decodeChar(s,TargetCharset,CharsetCode);
                  s:=EncodeBase64(s);
                  if x<>54
                    then s:=s+'=';
                  Lines.add(s);
                end;
            end
          else
            begin
              l.LoadFromStream(DecodedLines);
              for n:=0 to l.count-1 do
                begin
                  s:=l[n];
                  if PrimaryCode=MP_TEXT
                    then s:=decodeChar(s,TargetCharset,CharsetCode);
                  s:=EncodeQuotedPrintable(s);
                  Lines.add(s);
                end;
            end;

    end;
    Lines.add('');
    lines.insert(0,'');
    if secondary='' then
      case PrimaryCode of
        MP_TEXT:       secondary:='plain';
        MP_MULTIPART:  secondary:='mixed';
        MP_MESSAGE:    secondary:='rfc822';
        MP_BINARY:     secondary:='octet-stream';
      end;
    if description<>''
      then lines.insert(0,'Content-Description: '+Description);
    if disposition<>'' then
      begin
        s:='';
        if filename<>''
          then s:='; filename="'+filename+'"';
        lines.insert(0,'Content-Disposition: '+lowercase(disposition)+s);
      end;


    case EncodingCode of
      ME_7BIT:              s:='7bit';
      ME_8BIT:              s:='8bit';
      ME_QUOTED_PRINTABLE:  s:='Quoted-printable';
      ME_BASE64:            s:='Base64';
    end;
    case PrimaryCode of
      MP_TEXT,
      MP_BINARY:     lines.insert(0,'Content-Transfer-Encoding: '+s);
    end;
    case PrimaryCode of
      MP_TEXT:       s:=primary+'/'+secondary+'; charset='+GetIDfromCP(charsetcode);
      MP_MULTIPART:  s:=primary+'/'+secondary+'; boundary="'+boundary+'"';
      MP_MESSAGE:    s:=primary+'/'+secondary+'';
      MP_BINARY:     s:=primary+'/'+secondary+'; name="'+FileName+'"';
    end;
    lines.insert(0,'Content-type: '+s);
  finally
    l.free;
  end;
end;

{==============================================================================}
{TMIMEPart.MimeTypeFromExt}
procedure TMIMEPart.MimeTypeFromExt(value:string);
var
  s:string;
  n:integer;
begin
  primary:='';
  secondary:='';
  s:=uppercase(extractfileext(value));
  if s=''
    then s:=uppercase(value);
  s:=separateright(s,'.');
  for n:=0 to MaxMimeType do
    if MimeType[n,0]=s then
      begin
        primary:=MimeType[n,1];
        secondary:=MimeType[n,2];
        break;
      end;
  if primary=''
    then primary:='application';
  if secondary=''
    then secondary:='mixed';
end;

{==============================================================================}
{TMIMEPart.Setprimary}
procedure TMIMEPart.Setprimary(Value:string);
var
  s:string;
begin
  Fprimary:=Value;
  s:=uppercase(Value);
  PrimaryCode:=MP_BINARY;
  if Pos('TEXT',s)=1
    then PrimaryCode:=MP_TEXT;
  if Pos('MULTIPART',s)=1
    then PrimaryCode:=MP_MULTIPART;
  if Pos('MESSAGE',s)=1
    then PrimaryCode:=MP_MESSAGE;
end;

{TMIMEPart.SetEncoding}
procedure TMIMEPart.SetEncoding(Value:string);
var
  s:string;
begin
  FEncoding:=Value;
  s:=uppercase(Value);
  EncodingCode:=ME_7BIT;
  if Pos('8BIT',s)=1
    then EncodingCode:=ME_8BIT;
  if Pos('QUOTED-PRINTABLE',s)=1
    then EncodingCode:=ME_QUOTED_PRINTABLE;
  if Pos('BASE64',s)=1
    then EncodingCode:=ME_BASE64;
  if Pos('X-UU',s)=1
    then EncodingCode:=ME_UU;
  if Pos('X-XX',s)=1
    then EncodingCode:=ME_XX;
end;

{TMIMEPart.SetCharset}
procedure TMIMEPart.SetCharset(Value:string);
begin
  FCharset:=Value;
  CharsetCode:=GetCPfromID(value);
end;

{==============================================================================}
{GenerateBoundary}
function GenerateBoundary:string;
var
  x:integer;
begin
  randomize;
  x:=random(maxint);
  result:='----'+Inttohex(x,8)+'_Synapse_message_boundary';
end;

{==============================================================================}

begin
  exit;
  asm
    db 'Synapse MIME messages encoding and decoding library by Lukas Gebauer',0
  end;
end.