mimepart.pas

snmp设计增加相应SNMP的OID,是实时处理的.

    begin
      b := False;
      for n := 0 to FPartBody.Count - 1 do
      begin
        t := uppercase(FPartBody[n]);
        if Pos('HTTP-EQUIV', t) > 0 then
          if Pos('CONTENT-TYPE', t) > 0 then
          begin
            b := True;
            Break;
          end;
        if Pos('</HEAD>', t) > 0 then
          Break;
      end;
      if not b then
        s := CharsetConversion(s, FCharsetCode, FTargetCharset);
    end
    else
      s := CharsetConversion(s, FCharsetCode, FTargetCharset);
  WriteStrToStream(FDecodedLines, s);
  FDecodedLines.Seek(0, soFromBeginning);
end;

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

procedure TMIMEPart.DecodePartHeader;
var
  n: integer;
  s, su, fn: string;
  st, st2: string;
begin
  Primary := 'text';
  FSecondary := 'plain';
  FDescription := '';
  Charset := FDefaultCharset;
  FFileName := '';
  Encoding := '7BIT';
  FDisposition := '';
  FContentID := '';
  fn := '';
  for n := 0 to FHeaders.Count - 1 do
    if FHeaders[n] <> '' then
    begin
      s := FHeaders[n];
      su := UpperCase(s);
      if Pos('CONTENT-TYPE:', su) = 1 then
      begin
        st := Trim(SeparateRight(su, ':'));
        st2 := Trim(SeparateLeft(st, ';'));
        Primary := Trim(SeparateLeft(st2, '/'));
        FSecondary := Trim(SeparateRight(st2, '/'));
        if (FSecondary = Primary) and (Pos('/', st2) < 1) then
          FSecondary := '';
        case FPrimaryCode of
          MP_TEXT:
            begin
              Charset := UpperCase(GetParameter(s, 'charset'));
              FFileName := GetParameter(s, 'name');
            end;
          MP_MULTIPART:
            FBoundary := GetParameter(s, 'Boundary');
          MP_MESSAGE:
            begin
            end;
          MP_BINARY:
            FFileName := GetParameter(s, 'name');
        end;
      end;
      if Pos('CONTENT-TRANSFER-ENCODING:', su) = 1 then
        Encoding := Trim(SeparateRight(su, ':'));
      if Pos('CONTENT-DESCRIPTION:', su) = 1 then
        FDescription := Trim(SeparateRight(s, ':'));
      if Pos('CONTENT-DISPOSITION:', su) = 1 then
      begin
        FDisposition := SeparateRight(su, ':');
        FDisposition := Trim(SeparateLeft(FDisposition, ';'));
        fn := GetParameter(s, 'FileName');
      end;
      if Pos('CONTENT-ID:', su) = 1 then
        FContentID := Trim(SeparateRight(s, ':'));
    end;
  if FFileName = '' then
    FFileName := fn;
  FFileName := InlineDecode(FFileName, FTargetCharset);
  FFileName := ExtractFileName(FFileName);
end;

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

procedure TMIMEPart.EncodePart;
var
  l: TStringList;
  s, t: string;
  n, x: Integer;
  d1, d2: integer;
  NeedBOM: Boolean;
begin
  if (FEncodingCode = ME_UU) or (FEncodingCode = ME_XX) then
    Encoding := 'base64';
  l := TStringList.Create;
  FPartBody.Clear;
  FDecodedLines.Seek(0, soFromBeginning);
  try
    NeedBOM := True;
    case FPrimaryCode of
      MP_MULTIPART, MP_MESSAGE:
        FPartBody.LoadFromStream(FDecodedLines);
      MP_TEXT, MP_BINARY:
        if FEncodingCode = ME_BASE64 then
        begin
          while FDecodedLines.Position < FDecodedLines.Size do
          begin
            s := ReadStrFromStream(FDecodedLines, 54);
//            Setlength(s, 54);
//            x := FDecodedLines.Read(pointer(s)^, 54);
//            Setlength(s, x);
            if FPrimaryCode = MP_TEXT then
            begin
              s := CharsetConversion(s, FTargetCharset, FCharsetCode);
              if NeedBOM then
              begin
                s := GetBOM(FCharSetCode) + s;
                NeedBOM := False;
              end;
            end;
            s := EncodeBase64(s);
            FPartBody.Add(s);
          end;
        end
        else
        begin
          if FPrimaryCode = MP_BINARY then
          begin
            s := ReadStrFromStream(FDecodedLines, FDecodedLines.Size);
//            SetLength(s, FDecodedLines.Size);
//            x := FDecodedLines.Read(pointer(s)^, FDecodedLines.Size);
//            Setlength(s, x);
            l.Add(s);
          end
          else
            l.LoadFromStream(FDecodedLines);
          for n := 0 to l.Count - 1 do
          begin
            s := l[n];
            if (FPrimaryCode = MP_TEXT) and (FEncodingCode <> ME_7BIT) then
            begin
              s := CharsetConversion(s, FTargetCharset, FCharsetCode);
              if NeedBOM then
              begin
                s := GetBOM(FCharSetCode) + s;
                NeedBOM := False;
              end;
            end;
            if FEncodingCode = ME_QUOTED_PRINTABLE then
            begin
              s := EncodeQuotedPrintable(s);
              repeat
                if Length(s) < FMaxLineLength then
                begin
                  t := s;
                  s := '';
                end
                else
                begin
                  d1 := RPosEx('=', s, FMaxLineLength);
                  d2 := RPosEx(' ', s, FMaxLineLength);
                  if (d1 = 0) and (d2 = 0) then
                    x := FMaxLineLength
                  else
                    if d1 > d2 then
                      x := d1 - 1
                    else
                      x := d2 - 1;
                  if x = 0 then
                    x := FMaxLineLength;
                  t := Copy(s, 1, x);
                  Delete(s, 1, x);
                  if s <> '' then
                    t := t + '=';
                end;
                FPartBody.Add(t);
              until s = '';
            end
            else
              FPartBody.Add(s);
          end;
          if (FPrimaryCode = MP_BINARY)
            and (FEncodingCode = ME_QUOTED_PRINTABLE) then
            FPartBody[FPartBody.Count - 1] := FPartBody[FPartBody.Count - 1] + '=';
        end;
    end;
  finally
    l.Free;
  end;
end;

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

procedure TMIMEPart.EncodePartHeader;
var
  s: string;
begin
  FHeaders.Clear;
  if FSecondary = '' then
    case FPrimaryCode of
      MP_TEXT:
        FSecondary := 'plain';
      MP_MULTIPART:
        FSecondary := 'mixed';
      MP_MESSAGE:
        FSecondary := 'rfc822';
      MP_BINARY:
        FSecondary := 'octet-stream';
    end;
  if FDescription <> '' then
    FHeaders.Insert(0, 'Content-Description: ' + FDescription);
  if FDisposition <> '' then
  begin
    s := '';
    if FFileName <> '' then
      s := '; FileName="' + InlineCodeEx(FileName, FTargetCharset) + '"';
    FHeaders.Insert(0, 'Content-Disposition: ' + LowerCase(FDisposition) + s);
  end;
  if FContentID <> '' then
    FHeaders.Insert(0, 'Content-ID: ' + FContentID);

  case FEncodingCode of
    ME_7BIT:
      s := '7bit';
    ME_8BIT:
      s := '8bit';
    ME_QUOTED_PRINTABLE:
      s := 'Quoted-printable';
    ME_BASE64:
      s := 'Base64';
  end;
  case FPrimaryCode of
    MP_TEXT,
      MP_BINARY: FHeaders.Insert(0, 'Content-Transfer-Encoding: ' + s);
  end;
  case FPrimaryCode of
    MP_TEXT:
      s := FPrimary + '/' + FSecondary + '; charset=' + GetIDfromCP(FCharsetCode);
    MP_MULTIPART:
      s := FPrimary + '/' + FSecondary + '; boundary="' + FBoundary + '"';
    MP_MESSAGE, MP_BINARY:
      s := FPrimary + '/' + FSecondary;
  end;
  if FFileName <> '' then
    s := s + '; name="' + InlineCodeEx(FileName, FTargetCharset) + '"';
  FHeaders.Insert(0, 'Content-type: ' + s);
end;

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

procedure TMIMEPart.MimeTypeFromExt(Value: string);
var
  s: string;
  n: Integer;
begin
  Primary := '';
  FSecondary := '';
  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];
      FSecondary := MimeType[n, 2];
      Break;
    end;
  if Primary = '' then
    Primary := 'application';
  if FSecondary = '' then
    FSecondary := 'octet-stream';
end;

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

procedure TMIMEPart.WalkPart;
var
  n: integer;
  m: TMimepart;
begin
  if assigned(OnWalkPart) then
  begin
    OnWalkPart(self);
    for n := 0 to GetSubPartCount - 1 do
    begin
      m := GetSubPart(n);
      m.OnWalkPart := OnWalkPart;
      m.WalkPart;
    end;
  end;
end;

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

procedure TMIMEPart.SetPrimary(Value: string);
var
  s: string;
begin
  FPrimary := Value;
  s := UpperCase(Value);
  FPrimaryCode := MP_BINARY;
  if Pos('TEXT', s) = 1 then
    FPrimaryCode := MP_TEXT;
  if Pos('MULTIPART', s) = 1 then
    FPrimaryCode := MP_MULTIPART;
  if Pos('MESSAGE', s) = 1 then
    FPrimaryCode := MP_MESSAGE;
end;

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

procedure TMIMEPart.SetCharset(Value: string);
begin
  FCharset := Value;
  FCharsetCode := GetCPFromID(Value);
end;

function TMIMEPart.CanSubPart: boolean;
begin
  Result := True;
  if FMaxSubLevel <> -1 then
    Result := FMaxSubLevel > FSubLevel;
end;

function TMIMEPart.IsUUcode(Value: string): boolean;
begin
  Value := UpperCase(Value);
  Result := (pos('BEGIN ', Value) = 1) and (Trim(SeparateRight(Value, ' ')) <> '');
end;

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

function GenerateBoundary: string;
var
  x, y: Integer;
begin
  y := GetTick;
  x := y;
  while TickDelta(y, x) = 0 do
  begin
    Sleep(1);
    x := GetTick;
  end;
  Randomize;
  y := Random(MaxInt);
  Result := IntToHex(x, 8) + '_' + IntToHex(y, 8) + '_Synapse_boundary';
end;

end.