YarrowSoft

IdAttachmentMemory fixed for unicode file names

Download fixed idattachmentmemory.pas

unit IdAttachmentMemory;

interface

uses
  Classes, SysUtils, IdAttachment, IdMessageParts, IdGlobal,
  ExtStreams;

type
  TIdAttachmentMemory = class(TIdAttachment)
  protected
    FDataStream: TFastMemoryStream;
    FDataStreamBeforeLoadPosition: Int64;

    function GetDataStream: TStream;
    function GetDataString: string;
    procedure SetDataStream(const Value: TStream);
    procedure SetDataString(const Value: string);
  public
    {CC: Bug fix, remove default values to resolve ambiguities with Create(TCollection).}
    {constructor Create(Collection: TIdMessageParts; const CopyFrom: TStream = nil); reintroduce; overload;
    constructor Create(Collection: TIdMessageParts; const CopyFrom: String = ''); reintroduce; overload;
}
    constructor Create(Collection: TIdMessageParts; const CopyFrom: TStream); reintroduce; overload;
    constructor Create(Collection: TIdMessageParts; const CopyFrom: string); reintroduce; overload;
    constructor Create(Collection: TCollection); overload; override;
    destructor Destroy; override;

    property DataStream: TStream read GetDataStream write SetDataStream;
    property DataString: string read GetDataString write SetDataString;
    function OpenLoadStream: TStream; override;
    procedure CloseLoadStream; override;
    procedure FinishTempStream; override;
    function PrepareTempStream: TStream; override;
    procedure SaveToFile(const FileName: TFileName); override;
    procedure SaveToStream(const Stream: TStream); override;
  end;

  TWideAttachmentMemory = class(TIdAttachmentMemory)
  protected
    fWideFileName: widestring;
    function GetWideFileName: widestring;
  public
    property WideFileName: widestring read GetWideFileName;
    property FastMemStream: TFastMemoryStream read FDataStream;

  end;

function ExtractAttachmentFilename(const AContentType, AContentDisposition: string): string;

implementation

uses
  StrUtils, TntSysUtils, FileUtils, CharsetConvertors,
  IdCoderHeader, IdText, IdCharsets;

{ TIdAttachmentMemory }

constructor TIdAttachmentMemory.Create(Collection: TIdMessageParts;
  const CopyFrom: TStream);
begin
  inherited Create(Collection);
  FDataStream := TFastMemoryStream.Create();
  if Assigned(CopyFrom) then begin
    FDataStream.CopyFrom(CopyFrom, CopyFrom.Size);
  end;
end;

constructor TIdAttachmentMemory.Create(Collection: TIdMessageParts;
  const CopyFrom: string);
begin
  inherited Create(Collection);
  FDataStream := TFastMemoryStream.Create;
  SetDataString(CopyFrom);
end;

constructor TIdAttachmentMemory.Create(Collection: TCollection);
begin
  inherited;
  FDataStream := TFastMemoryStream.Create;
end;

destructor TIdAttachmentMemory.Destroy;
begin
  FreeAndNil(FDataStream);
  inherited;
end;

function TIdAttachmentMemory.GetDataStream: TStream;
begin
  Result := FDataStream;
end;

procedure TIdAttachmentMemory.SetDataStream(const Value: TStream);
begin
  FDataStream.CopyFrom(Value, Value.Size);
end;

function TIdAttachmentMemory.GetDataString: string;
begin
  Result := FDataStream.DataString;
end;

procedure TIdAttachmentMemory.SetDataString(const Value: string);
begin
  FDataStream.DataString := Value;
end;

function TIdAttachmentMemory.OpenLoadStream: TStream;
begin
  FDataStreamBeforeLoadPosition := DataStream.Position;
  fDataStream.Position := 0;
  Result := fDataStream;
end;

procedure TIdAttachmentMemory.CloseLoadStream;
begin
  fDataStream.Position := FDataStreamBeforeLoadPosition;
end;

function TIdAttachmentMemory.PrepareTempStream: TStream;
begin
  fDataStream.Size := 0;
  Result := fDataStream;
end;

procedure TIdAttachmentMemory.FinishTempStream;
begin
  fDataStream.Position := 0;
end;

procedure TIdAttachmentMemory.SaveToFile(const FileName: TFileName);
begin
  fDataStream.SaveToFile(FileName);
end;

procedure TIdAttachmentMemory.SaveToStream(const Stream: TStream);
begin
  fDataStream.SaveToStream(Stream);
end;

function ExtractAttachmentFilename(const AContentType, AContentDisposition: string): string;
var
  LValue: string;
  LPos: Integer;
begin
  LPos := IndyPos('FILENAME=', UpperCase(AContentDisposition)); {do not localize}
  if LPos > 0 then begin
    LValue := Trim(Copy(AContentDisposition, LPos + 9, MaxInt));
  end else begin
    LValue := ''; //FileName not found
  end;
  if Length(LValue) = 0 then begin
    // Get filename from Content-Type
    LPos := IndyPos('NAME=', UpperCase(AContentType)); {do not localize}
    if LPos > 0 then begin
      LValue := Trim(Copy(AContentType, LPos + 5, MaxInt)); {do not localize}
    end;
  end;
  if Length(LValue) > 0 then begin
    if LValue[1] = '"' then begin {do not localize}
      // RLebeau - shouldn't this code use AnsiExtractQuotedStr() instead?
      Fetch(LValue, '"'); {do not localize}
      Result := Fetch(LValue, '"'); {do not localize}
    end else begin
      // RLebeau - just in case the name is not the last field in the line
      Result := Fetch(LValue, ';'); {do not localize}
    end;
//    Result := RemoveInvalidCharsFromFilename(DecodeHeader(Result));
//    Result := MakeCorrectFileName(WideExtractFileName(WideDecodeHeader(Result)));
  end else begin
    Result := '';
  end;
end;

function TWideAttachmentMemory.GetWideFileName: widestring;
var
  lAnsiFilename, AContentDisposition: string;
  lIdCharset: TIdCharset;
  i: integer;
  idText: TidText;

begin
  if fWideFileName = '' then begin
    AContentDisposition := Headers.Values['Content-Disposition'];
    Fetch(AContentDisposition, ';');
    lAnsiFileName := ExtractAttachmentFilename(Headers.Values['Content-Type'],
      AContentDisposition);
    if PosIdx('=?', lAnsiFileName, 1) > 0 then fWideFileName := WideDecodeHeader(lAnsiFileName)
    else begin
      lIdCharset := idcsINVALID;
      for i := 0 to Collection.Count - 1 do
        if TIdMessageParts(Collection)[i].PartType = mptText then begin
          idText := TIdText(TIdMessageParts(Collection)[i]);
          if AnsiStartsText('text/', IdText.ContentType) then begin
            lIdCharset := FindCharset(NormalizeCharset(idText.Charset));
            break;
          end;
        end;
      fWideFileName := ConvertFromIdCharsetToWide(lAnsiFileName, lIdCharset);
    end;
    fWideFileName := MakeCorrectFileName(WideExtractFileName(fWideFileName));
  end;
  Result := fWideFileName;
end;

initialization
  RegisterClasses([TIdAttachmentMemory]);
end.

See also: INDY (Internet Direct) changes WideIdEMailAddress is same IdEMailAddress unit but works with unicode strings IdCoderHeader fixed and added decoding headers to unicode IdCoder3to4 fixed for wrong attachments IdMessageCoderMIME fixed RemoveInvalidCharsFromFilename function IdEMailAddress deleted exception on wrong addresses