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
|