mimepart.pas

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

        s := s + ' ' + Trim(t);
        Inc(Index);
      end;
    end;
  Result := TrimRight(s);
end;

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

constructor TMIMEPart.Create;
begin
  inherited Create;
  FOnWalkPart := nil;
  FLines := TStringList.Create;
  FPartBody := TStringList.Create;
  FHeaders := TStringList.Create;
  FPrePart := TStringList.Create;
  FPostPart := TStringList.Create;
  FDecodedLines := TMemoryStream.Create;
  FSubParts := TList.Create;
  FTargetCharset := GetCurCP;
  FDefaultCharset := 'US-ASCII';
  FMaxLineLength := 78;
  FSubLevel := 0;
  FMaxSubLevel := -1;
  FAttachInside := false;
end;

destructor TMIMEPart.Destroy;
begin
  ClearSubParts;
  FSubParts.Free;
  FDecodedLines.Free;
  FPartBody.Free;
  FLines.Free;
  FHeaders.Free;
  FPrePart.Free;
  FPostPart.Free;
  inherited Destroy;
end;

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

procedure TMIMEPart.Clear;
begin
  FPrimary := '';
  FEncoding := '';
  FCharset := '';
  FPrimaryCode := MP_TEXT;
  FEncodingCode := ME_7BIT;
  FCharsetCode := ISO_8859_1;
  FTargetCharset := GetCurCP;
  FSecondary := '';
  FDisposition := '';
  FContentID := '';
  FDescription := '';
  FBoundary := '';
  FFileName := '';
  FAttachInside := False;
  FPartBody.Clear;
  FHeaders.Clear;
  FPrePart.Clear;
  FPostPart.Clear;
  FDecodedLines.Clear;
  ClearSubParts;
end;

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

procedure TMIMEPart.Assign(Value: TMimePart);
begin
  Primary := Value.Primary;
  Encoding := Value.Encoding;
  Charset := Value.Charset;
  DefaultCharset := Value.DefaultCharset;
  PrimaryCode := Value.PrimaryCode;
  EncodingCode := Value.EncodingCode;
  CharsetCode := Value.CharsetCode;
  TargetCharset := Value.TargetCharset;
  Secondary := Value.Secondary;
  Description := Value.Description;
  Disposition := Value.Disposition;
  ContentID := Value.ContentID;
  Boundary := Value.Boundary;
  FileName := Value.FileName;
  Lines.Assign(Value.Lines);
  PartBody.Assign(Value.PartBody);
  Headers.Assign(Value.Headers);
  PrePart.Assign(Value.PrePart);
  PostPart.Assign(Value.PostPart);
  MaxLineLength := Value.MaxLineLength;
  FAttachInside := Value.AttachInside;
end;

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

procedure TMIMEPart.AssignSubParts(Value: TMimePart);
var
  n: integer;
  p: TMimePart;
begin
  Assign(Value);
  for n := 0 to Value.GetSubPartCount - 1 do
  begin
    p := AddSubPart;
    p.AssignSubParts(Value.GetSubPart(n));
  end;
end;

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

function TMIMEPart.GetSubPartCount: integer;
begin
  Result :=  FSubParts.Count;
end;

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

function TMIMEPart.GetSubPart(index: integer): TMimePart;
begin
  Result := nil;
  if Index < GetSubPartCount then
    Result := TMimePart(FSubParts[Index]);
end;

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

procedure TMIMEPart.DeleteSubPart(index: integer);
begin
  if Index < GetSubPartCount then
  begin
    GetSubPart(Index).Free;
    FSubParts.Delete(Index);
  end;
end;

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

procedure TMIMEPart.ClearSubParts;
var
  n: integer;
begin
  for n := 0 to GetSubPartCount - 1 do
    TMimePart(FSubParts[n]).Free;
  FSubParts.Clear;
end;

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

function TMIMEPart.AddSubPart: TMimePart;
begin
  Result := TMimePart.Create;
  Result.DefaultCharset := FDefaultCharset;
  FSubParts.Add(Result);
  Result.SubLevel := FSubLevel + 1;
end;

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

procedure TMIMEPart.DecomposeParts;
var
  x: integer;
  s: string;
  Mime: TMimePart;

  procedure SkipEmpty;
  begin
    while FLines.Count > x do
    begin
      s := TrimRight(FLines[x]);
      if s <> '' then
        Break;
      Inc(x);
    end;
  end;

begin
  x := 0;
  Clear;
  //extract headers
  while FLines.Count > x do
  begin
    s := NormalizeHeader(FLines, x);
    if s = '' then
      Break;
    FHeaders.Add(s);
  end;
  DecodePartHeader;
  //extract prepart
  if FPrimaryCode = MP_MULTIPART then
  begin
    while FLines.Count > x do
    begin
      s := FLines[x];
      Inc(x);
      if TrimRight(s) = '--' + FBoundary then
        Break;
      FPrePart.Add(s);
      if not FAttachInside then
        FAttachInside := IsUUcode(s);
    end;
  end;
  //extract body part
  if FPrimaryCode = MP_MULTIPART then
  begin
    repeat
      if CanSubPart then
      begin
        Mime := AddSubPart;
        while FLines.Count > x do
        begin
          s := FLines[x];
          Inc(x);
          if Pos('--' + FBoundary, s) = 1 then
            Break;
          Mime.Lines.Add(s);
        end;
        Mime.DecomposeParts;
      end
      else
      begin
        s := FLines[x];
        Inc(x);
        FPartBody.Add(s);
      end;
      if x >= FLines.Count then
        break;
    until s = '--' + FBoundary + '--';
  end;
  if (FPrimaryCode = MP_MESSAGE) and CanSubPart then
  begin
    Mime := AddSubPart;
    SkipEmpty;
    while FLines.Count > x do
    begin
      s := TrimRight(FLines[x]);
      Inc(x);
      Mime.Lines.Add(s);
    end;
    Mime.DecomposeParts;
  end
  else
  begin
    while FLines.Count > x do
    begin
      s := FLines[x];
      Inc(x);
      FPartBody.Add(s);
      if not FAttachInside then
        FAttachInside := IsUUcode(s);
    end;
  end;
  //extract postpart
  if FPrimaryCode = MP_MULTIPART then
  begin
    while FLines.Count > x do
    begin
      s := TrimRight(FLines[x]);
      Inc(x);
      FPostPart.Add(s);
      if not FAttachInside then
        FAttachInside := IsUUcode(s);
    end;
  end;
end;

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

procedure TMIMEPart.ComposeParts;
var
  n: integer;
  mime: TMimePart;
  s, t: string;
  d1, d2, d3: integer;
  x: integer;
begin
  FLines.Clear;
  //add headers
  for n := 0 to FHeaders.Count -1 do
  begin
    s := FHeaders[n];
    repeat
      if Length(s) < FMaxLineLength then
      begin
        t := s;
        s := '';
      end
      else
      begin
        d1 := RPosEx('; ', s, FMaxLineLength);
        d2 := RPosEx(' ', s, FMaxLineLength);
        d3 := RPosEx(', ', s, FMaxLineLength);
        if (d1 <= 1) and (d2 <= 1) and (d3 <= 1) then
        begin
          x := Pos(' ', Copy(s, 2, Length(s) - 1));
          if x < 1 then
            x := Length(s);
        end
        else
          if d1 > 0 then
            x := d1
          else
            if d3 > 0 then
              x := d3
            else
              x := d2 - 1;
        t := Copy(s, 1, x);
        Delete(s, 1, x);
      end;
      Flines.Add(t);
    until s = '';
  end;

  Flines.Add('');
  //add body
  //if multipart
  if FPrimaryCode = MP_MULTIPART then
  begin
    Flines.AddStrings(FPrePart);
    for n := 0 to GetSubPartCount - 1 do
    begin
      Flines.Add('--' + FBoundary);
      mime := GetSubPart(n);
      mime.ComposeParts;
      FLines.AddStrings(mime.Lines);
    end;
    Flines.Add('--' + FBoundary + '--');
    Flines.AddStrings(FPostPart);
  end;
  //if message
  if FPrimaryCode = MP_MESSAGE then
  begin
    if GetSubPartCount > 0 then
    begin
      mime := GetSubPart(0);
      mime.ComposeParts;
      FLines.AddStrings(mime.Lines);
    end;
  end
  else
  //if normal part
  begin
    FLines.AddStrings(FPartBody);
  end;
end;

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

procedure TMIMEPart.DecodePart;
var
  n: Integer;
  s, t: string;
  b: Boolean;
begin
  FDecodedLines.Clear;
  case FEncodingCode of
    ME_QUOTED_PRINTABLE:
      s := DecodeQuotedPrintable(FPartBody.Text);
    ME_BASE64:
      s := DecodeBase64(FPartBody.Text);
    ME_UU, ME_XX:
      begin
        s := '';
        for n := 0 to FPartBody.Count - 1 do
          if FEncodingCode = ME_UU then
            s := s + DecodeUU(FPartBody[n])
          else
            s := s + DecodeXX(FPartBody[n]);
      end;
  else
    s := FPartBody.Text;
  end;
  if FPrimaryCode = MP_TEXT then
    if uppercase(FSecondary) = 'HTML' then