stmime.pas

条码控件： 一维条码控件 二维条码控件 PDF417Barcode MaxiCodeBarcode

       (InBuf[2] = $64) and (InBuf[3] = $0D) then Exit;

    Count := I;
    I := 0;

    { Decode data to output stream }
    while I < Count do begin
      c1 := StD64Table[InBuf[I]];
      c2 := StD64Table[InBuf[I+1]];
      c3 := StD64Table[InBuf[I+2]];
      OutBuf[O] := ((c1 shl 2) or (c2 shr 4));
      Inc(O);
      if Char(InBuf[I+2]) <> '=' then begin
        OutBuf[O] := ((c2 shl 4) or (c3 shr 2));
        Inc(O);
        if Char(InBuf[I+3]) <> '=' then begin
          OutBuf[O] := ((c3 shl 6) or StD64Table[InBuf[I+3]]);
          Inc(O);
        end else
          Decoding := False;
      end else
        Decoding := False;
      Inc(I, 4);
    end;
    OutStream.Write(OutBuf, O);
  end;
end;

procedure TStBase64Stream.EncodeToStream(InStream, OutStream : TStream);
var
  I, O, Count : Integer;
  InBuf  : array[1..45] of Byte;
  OutBuf : array[0..62] of Char;
  Temp : Byte;
  S : string;                                                          
begin
  FillChar(OutBuf, Sizeof(OutBuf), #0);

  if not FOwner.MimeHeaders then begin
    S := Format('begin-base64 600 %s'#13#10, [FCurrentFile]);          
    OutStream.Write(S[1], Length(S));                                  
  end;

  { Encode and stream the attachment }
  repeat
    Count := InStream.Read(InBuf, SizeOf(InBuf));
    if Count = 0 then Break;
    I := 1;
    O := 0;
    while I <= (Count-2) do begin
      { Encode 1st byte }
      Temp := (InBuf[I] shr 2);
      OutBuf[O] := Char(St64Table[Temp and $3F]);

      { Encode 1st/2nd byte }
      Temp := (InBuf[I] shl 4) or (InBuf[I+1] shr 4);
      OutBuf[O+1] := Char(St64Table[Temp and $3F]);

      { Encode 2nd/3rd byte }
      Temp := (InBuf[I+1] shl 2) or (InBuf[I+2] shr 6);
      OutBuf[O+2] := Char(St64Table[Temp and $3F]);

      { Encode 3rd byte }
      Temp := (InBuf[I+2] and $3F);
      OutBuf[O+3] := Char(St64Table[Temp]);

      Inc(I, 3);
      Inc(O, 4);
    end;

    { Are there odd bytes to add? }
    if (I <= Count) then begin
      Temp := (InBuf[I] shr 2);
      OutBuf[O] := Char(St64Table[Temp and $3F]);

      { One odd byte }
      if I = Count then begin
        Temp := (InBuf[I] shl 4) and $30;
        OutBuf[O+1] := Char(St64Table[Temp and $3F]);
        OutBuf[O+2] := '=';
      { Two odd bytes }
      end else begin
        Temp := ((InBuf[I] shl 4) and $30) or ((InBuf[I+1] shr 4) and $0F);
        OutBuf[O+1] := Char(St64Table[Temp and $3F]);
        Temp := (InBuf[I+1] shl 2) and $3C;
        OutBuf[O+2] := Char(St64Table[Temp and $3F]);
      end;
      { Add padding }
      OutBuf[O+3] := '=';
      Inc(O, 4);
    end;

    { Add CR/LF }
    OutBuf[O] := #13;
    OutBuf[O+1] := #10;

    { Write line to stream }
    OutStream.Write(OutBuf, (O + 2));
  until Count < SizeOf(InBuf);

  { Add terminating end if necessary }
  if not FOwner.MimeHeaders then begin
    StrCopy(OutBuf, 'end'#13#10);
    OutStream.Write(OutBuf, StrLen(OutBuf));
  end;
end;


{ TConverterList }

type
  TCvtFormat = class
    ConverterClass : TStConverterClass;
    Description : string;
  end;

  TConverterList = class(TStringList)
  protected
    procedure LockList;
    procedure UnlockList;
  public
    constructor Create;
    destructor Destroy; override;
    procedure AddConverter(const ATag, ADesc : string; AClass : TStConverterClass);
    procedure Remove(AClass: TStConverterClass);
  end;

constructor TConverterList.Create;
begin
  inherited Create;
  Sorted := True;
  Duplicates := dupError;
  AddConverter('raw', 'Raw Copy', TStRawStream);
  AddConverter('base64', 'Base64', TStBase64Stream);
  AddConverter('quoted-printable', 'Quoted-Printable', TStQuotedStream);
  AddConverter('uuencoded', 'UUEncoded', TStUUStream);
end;

destructor TConverterList.Destroy;
var
  I: Integer;
begin
  LockList;
  try
    for I := 0 to Count-1 do
      TCvtFormat(Objects[I]).Free;
    inherited Destroy;
  finally
    UnlockList;
  end;
end;

procedure TConverterList.LockList;
begin
  EnterCriticalSection(CvtLock);
end;

procedure TConverterList.UnlockList;
begin
  LeaveCriticalSection(CvtLock);
end;

procedure TConverterList.AddConverter(const ATag, ADesc : string; AClass : TStConverterClass);
var
  Temp : TCvtFormat;
begin
  LockList;
  try
    Temp := TCvtFormat.Create;
    with Temp do begin
      ConverterClass := AClass;
      Description := ADesc;
    end;
    AddObject(ATag, Temp);
  finally
    UnlockList;
  end;
end;

procedure TConverterList.Remove(AClass: TStConverterClass);
var
  I : Integer;
  Cvt : TCvtFormat;
begin
  LockList;
  try
    for I := Count-1 downto 0 do begin
      Cvt := TCvtFormat(Objects[I]);
      if Cvt.ConverterClass.InheritsFrom(AClass) then begin
        Cvt.Free;
        Delete(I);
      end;
    end;
  finally
    UnlockList;
  end;
end;

const
  Converters : TConverterList = nil;

  function GetConverters : TConverterList;
  begin
    EnterCriticalSection(CvtLock);
    try
      if Converters = nil then
        Converters := TConverterList.Create;
      Result := Converters;
    finally
      LeaveCriticalSection(CvtLock);
    end;
  end;

{ TStMimeConverter }
constructor TStMimeConverter.Create;
begin
  inherited Create;
  InitConverter;
end;

constructor TStMimeConverter.CreateInit(AStream : TStream);
begin
  inherited Create;
  InitConverter;
  if Assigned(AStream) then
    Stream := AStream;
end;

destructor TStMimeConverter.Destroy;
begin
  DeleteAttachments;
  FAttachments.Free;
  FInternalStream.Free;
  FConverter.Free;                                                     
  inherited Destroy;
end;

procedure TStMimeConverter.AddFileAttachment(const AFileName : string);
var
  F : TFileStream;
begin
  F := TFileStream.Create(AFileName, AttachmentFileMode);
  try
    AddStreamAttachment(F, AFileName);
  finally
    F.Free;
  end;
end;

procedure TStMimeConverter.AddMimeFooters;
var
  SavePos : LongInt;
  Temp : string;
begin
  SavePos := Stream.Position;
  Stream.Write(CRLFStr, SizeOf(CRLFStr));
  Temp := '--' + Boundary + '--';
  Stream.Write(Temp[1], Length(Temp));
  Stream.Write(CRLFStr, SizeOf(CRLFStr));
  Stream.Position := SavePos;
end;

procedure TStMimeConverter.AddMimeHeaders(const AFileName : string);
var
  Temp, Descr : string;
begin
  Stream.Write(CRLFStr, SizeOf(CRLFStr));
  Temp := '--' + Boundary;
  Stream.Write(Temp[1], Length(Temp));
  Stream.Write(CRLFStr, SizeOf(CRLFStr));

  Temp := Format('Content-Type: %s; name="%s"'#13#10,
    [ContentType, ExtractFileName(AFileName)]);
  Stream.Write(Temp[1], Length(Temp));

  Temp := Format('Content-Transfer-Encoding: %s'#13#10, [Encoding]);
  Stream.Write(Temp[1], Length(Temp));

  if ContentDescription = '' then
    Descr := ExtractFileName(AFileName)
  else
    Descr := ContentDescription;
  Temp := Format('Content-Description: %s'#13#10, [Descr]);
  Stream.Write(Temp[1], Length(Temp));

  Temp := Format('Content-Disposition: %s; filename="%s"'#13#10#13#10,
    [ContentDisposition, ExtractFileName(AFileName)]);
  Stream.Write(Temp[1], Length(Temp));
end;

procedure TStMimeConverter.AddStreamAttachment(AStream : TStream; const AFileName : string);
var
  I : Integer;
  AttObj : TStAttachment;
  SavePos : LongInt;
begin
  if Converters.Find(FEncoding, I) then
    ForceType(TCvtFormat(Converters.Objects[I]).ConverterClass)
  else
    RaiseStError(EStMimeError, stscBadEncodeFmt);

  SavePos := Stream.Position;

  if FMimeHeaders then
    AddMimeHeaders(AFileName);

  FConverter.CurrentFile := ExtractFilename(AFileName);
  FConverter.EncodeToStream(AStream, Stream);

  if MimeHeaders then
    AddMimeFooters;

  AttObj := TStAttachment.Create;
  with AttObj do begin
    atContentDescription := ContentDescription;
    atContentDisposition := ContentDisposition;
    atContentType := ContentType;
    atEncoding := Encoding;
    atSize := AStream.Size;
    atStreamOffset := SavePos;
  end;

  FAttachments.AddObject(ExtractFilename(AFileName), AttObj);
end;

procedure TStMimeConverter.DeleteAttachments;
var
  I : Integer;
begin
  if not Assigned(FAttachments) then Exit;
  for I := 0 to (FAttachments.Count - 1) do
    TStAttachment(FAttachments.Objects[I]).Free;
  FAttachments.Clear;
end;

procedure TStMimeConverter.ExtractAttachment(const Attachment : string);
var
  I : Integer;
begin
  if FAttachments.Find(Attachment, I) then
    ExtractAttachmentIndex(I)
  else
    RaiseStError(EStMimeError, stscBadAttachment);
end;

procedure TStMimeConverter.ExtractAttachmentIndex(Index : Integer);
var
  F : TFileStream;
  S : string;
begin
  if (Index < 0) or (Index > (FAttachments.Count - 1)) then
    RaiseStError(EStMimeError, stscBadAttachment);

  if FDirectory <> '' then begin
    {$IFOPT H+}
    S := JustPathNameL(FDirectory);
    S := AddBackSlashL(S);
    {$ELSE}
    S := JustPathNameS(FDirectory);
    S := AddBackSlashS(S);
    {$ENDIF}
    S := S + TStAttachment(FAttachments.Objects[Index]).atFileName;
  end else begin
    S := TStAttachment(FAttachments.Objects[Index]).atFileName;
  end;

  SaveAs(S);
  F := TFileStream.Create(S, fmCreate);
  try
    ExtractToStream(Index, F);
  finally
    F.Free;
  end;
end;

procedure TStMimeConverter.ExtractToStream(Index : Integer; AStream : TStream);
var
  I : Integer;
  SaveEncoding : string;
begin
  SaveEncoding := FEncoding;
  try
    { Position stream to beginning of data }
    if (Index < 0) or (Index > (FAttachments.Count - 1)) then
      RaiseStError(EStMimeError, stscBadAttachment);
    PositionForExtract(TStAttachment(FAttachments.Objects[Index]));

    { Find matching converter type and use it }
    if Converters.Find(TStAttachment(FAttachments.Objects[Index]).atEncoding, I) then
      ForceType(TCvtFormat(Converters.Objects[I]).ConverterClass)
    else
      { If we don't have a matching converter, save as a raw stream }
      ForceType(TStRawStream);

    FConverter.DecodeToStream(Stream, AStream);
  finally
    FEncoding := SaveEncoding;
  end;
end;

procedure TStMimeConverter.ExtractAttachments;
var
  I : Integer;
begin
  for I := 0 to (FAttachments.Count - 1) do
    ExtractAttachmentIndex(I);
end;

procedure TStMimeConverter.FillConverterList(List : TStrings);
var
  I : Integer;
begin
  List.Clear;
  for I := 0 to (Converters.Count - 1) do
    List.Add(TCvtFormat(Converters.Objects[I]).Description);
end;

procedure TStMimeConverter.FindOldAttachment;
const
  StmSize = 32*1024;
type
  MemArray = array[0..(StmSize-1)] of Char;
var
  I, Pos, ScanSize, StmOffset : LongInt;
  NewAtt : TStAttachment;
  ScanStream : TMemoryStream;
  FoundPos : Cardinal;
  SearchString : array[0..80] of Char;
  TempBuf : array[0..80] of Char;
  TokenBuf : array[0..80] of Char;
  TempWord : Word;
  BMT : BTable;

  function Min(A, B : LongInt) : LongInt;
  begin
    Result := A;
    if A > B then
      Result := B;
  end;

begin
  NewAtt := nil;

  { Position stream to beginning }
  Stream.Seek(0, soFromBeginning);