924 lines
29 KiB
Plaintext
924 lines
29 KiB
Plaintext
{
|
|
$Project$
|
|
$Workfile$
|
|
$Revision$
|
|
$DateUTC$
|
|
$Id$
|
|
|
|
This file is part of the Indy (Internet Direct) project, and is offered
|
|
under the dual-licensing agreement described on the Indy website.
|
|
(http://www.indyproject.org/)
|
|
|
|
Copyright:
|
|
(c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
|
|
}
|
|
{
|
|
$Log$
|
|
|
|
|
|
Prior revision history:
|
|
|
|
Rev 1.17 2/8/05 6:07:16 PM RLebeau
|
|
Removed AddToInternalBuffer() method, using new AppendString() function
|
|
from IdGlobal instead
|
|
|
|
Rev 1.16 10/26/2004 10:29:30 PM JPMugaas
|
|
Updated refs.
|
|
|
|
Rev 1.15 7/16/04 12:02:16 PM RLebeau
|
|
Reverted FileName fields to not strip off folder paths anymore.
|
|
|
|
Rev 1.14 7/5/04 1:19:06 PM RLebeau
|
|
Updated IdRead() to check the calculated byte count before copying data
|
|
into the caller's buffer.
|
|
|
|
Rev 1.13 5/31/04 9:28:58 PM RLebeau
|
|
Updated FileName fields to strip off folder paths.
|
|
Added "Content-Transfer-Encoding" header to file fields
|
|
Updated "Content-Type" headers to be the appropriate media types when
|
|
applicable
|
|
|
|
Rev 1.12 5/30/04 7:39:02 PM RLebeau
|
|
Moved FormatField() method from TIdMultiPartFormDataStream to
|
|
TIdFormDataField instead
|
|
Misc. tweaks and bug fixes
|
|
|
|
Rev 1.11 2004.05.20 11:37:02 AM czhower
|
|
IdStreamVCL
|
|
|
|
Rev 1.10 3/1/04 8:57:34 PM RLebeau
|
|
Format() fixes for TIdMultiPartFormDataStream.FormatField() and
|
|
TIdFormDataField.GetFieldSize().
|
|
|
|
Rev 1.9 2004.02.03 5:44:08 PM czhower
|
|
Name changes
|
|
|
|
Rev 1.8 2004.02.03 2:12:16 PM czhower
|
|
$I path change
|
|
|
|
Rev 1.7 25/01/2004 21:56:42 CCostelloe
|
|
Updated IdSeek to use new IdFromBeginning
|
|
|
|
Rev 1.6 24/01/2004 19:26:56 CCostelloe
|
|
Cleaned up warnings
|
|
|
|
Rev 1.5 22/11/2003 12:05:26 AM GGrieve
|
|
Get working on both win32 and DotNet after other DotNet changes
|
|
|
|
Rev 1.4 11/10/2003 8:03:54 PM BGooijen
|
|
Did all todo's ( TStream to TIdStream mainly )
|
|
|
|
Rev 1.3 2003.10.24 10:43:12 AM czhower
|
|
TIdSTream to dos
|
|
|
|
Rev 1.2 10/17/2003 12:49:52 AM DSiders
|
|
Added localization comments.
|
|
Added resource string for unsupported operation exception.
|
|
|
|
Rev 1.1 10/7/2003 10:07:06 PM GGrieve
|
|
Get HTTP compiling for DotNet
|
|
|
|
Rev 1.0 11/13/2002 07:57:42 AM JPMugaas
|
|
Initial version control checkin.
|
|
|
|
2001-Nov-23
|
|
changed spelling error from XxxDataFiled to XxxDataField
|
|
|
|
2001-Nov Doychin Bondzhev
|
|
Now it descends from TStream and does not do buffering.
|
|
Changes in the way the form parts are added to the stream.
|
|
}
|
|
|
|
unit IdMultipartFormData;
|
|
|
|
{
|
|
Implementation of the Multipart Form data
|
|
|
|
Based on Internet standards outlined in:
|
|
RFC 1867 - Form-based File Upload in HTML
|
|
RFC 2388 - Returning Values from Forms: multipart/form-data
|
|
|
|
Author: Shiv Kumar
|
|
}
|
|
|
|
interface
|
|
|
|
{$I IdCompilerDefines.inc}
|
|
|
|
uses
|
|
Classes,
|
|
IdGlobal,
|
|
IdException,
|
|
IdCharsets,
|
|
IdCoderHeader,
|
|
IdResourceStringsProtocols;
|
|
|
|
const
|
|
sContentTypeFormData = 'multipart/form-data; boundary='; {do not localize}
|
|
sContentTypeOctetStream = 'application/octet-stream'; {do not localize}
|
|
sContentTypeTextPlain = 'text/plain'; {do not localize}
|
|
CRLF = #13#10;
|
|
sContentDispositionPlaceHolder = 'Content-Disposition: form-data; name="%s"'; {do not localize}
|
|
sFileNamePlaceHolder = '; filename="%s"'; {do not localize}
|
|
sContentTypePlaceHolder = 'Content-Type: %s'; {do not localize}
|
|
sCharsetPlaceHolder = '; charset="%s"'; {do not localize}
|
|
sContentTransferPlaceHolder = 'Content-Transfer-Encoding: %s'; {do not localize}
|
|
sContentTransferQuotedPrintable = 'quoted-printable'; {do not localize}
|
|
sContentTransferBinary = 'binary'; {do not localize}
|
|
|
|
type
|
|
TIdMultiPartFormDataStream = class;
|
|
|
|
TIdFormDataField = class(TCollectionItem)
|
|
protected
|
|
FFileName: string;
|
|
FCharset: string;
|
|
FContentType: string;
|
|
FContentTransfer: string;
|
|
FFieldName: string;
|
|
FFieldStream: TStream;
|
|
FFieldValue: String;
|
|
FCanFreeFieldStream: Boolean;
|
|
FHeaderCharSet: string;
|
|
FHeaderEncoding: Char;
|
|
|
|
function FormatHeader: string;
|
|
function PrepareDataStream(var VCanFree: Boolean): TStream;
|
|
|
|
function GetFieldSize: Int64;
|
|
function GetFieldStream: TStream;
|
|
function GetFieldValue: string;
|
|
procedure SetCharset(const Value: string);
|
|
procedure SetContentType(const Value: string);
|
|
procedure SetContentTransfer(const Value: string);
|
|
procedure SetFieldName(const Value: string);
|
|
procedure SetFieldStream(const Value: TStream);
|
|
procedure SetFieldValue(const Value: string);
|
|
procedure SetFileName(const Value: string);
|
|
procedure SetHeaderCharSet(const Value: string);
|
|
procedure SetHeaderEncoding(const Value: Char);
|
|
public
|
|
constructor Create(Collection: TCollection); override;
|
|
destructor Destroy; override;
|
|
// procedure Assign(Source: TPersistent); override;
|
|
property ContentTransfer: string read FContentTransfer write SetContentTransfer;
|
|
property ContentType: string read FContentType write SetContentType;
|
|
property Charset: string read FCharset write SetCharset;
|
|
property FieldName: string read FFieldName write SetFieldName;
|
|
property FieldStream: TStream read GetFieldStream write SetFieldStream;
|
|
property FileName: string read FFileName write SetFileName;
|
|
property FieldValue: string read GetFieldValue write SetFieldValue;
|
|
property FieldSize: Int64 read GetFieldSize;
|
|
property HeaderCharSet: string read FHeaderCharSet write SetHeaderCharSet;
|
|
property HeaderEncoding: Char read FHeaderEncoding write SetHeaderEncoding;
|
|
end;
|
|
|
|
TIdFormDataFields = class(TCollection)
|
|
protected
|
|
FParentStream: TIdMultiPartFormDataStream;
|
|
function GetFormDataField(AIndex: Integer): TIdFormDataField;
|
|
public
|
|
constructor Create(AMPStream: TIdMultiPartFormDataStream);
|
|
function Add: TIdFormDataField;
|
|
property MultipartFormDataStream: TIdMultiPartFormDataStream read FParentStream;
|
|
property Items[AIndex: Integer]: TIdFormDataField read GetFormDataField;
|
|
end;
|
|
|
|
TIdMultiPartFormDataStream = class(TIdBaseStream)
|
|
protected
|
|
FInputStream: TStream;
|
|
FFreeInputStream: Boolean;
|
|
FBoundary: string;
|
|
FRequestContentType: string;
|
|
FCurrentItem: integer;
|
|
FInitialized: Boolean;
|
|
FInternalBuffer: TIdBytes;
|
|
|
|
FPosition: Int64;
|
|
FSize: Int64;
|
|
|
|
FFields: TIdFormDataFields;
|
|
|
|
function GenerateUniqueBoundary: string;
|
|
procedure CalculateSize;
|
|
|
|
function IdRead(var VBuffer: TIdBytes; AOffset, ACount: Longint): Longint; override;
|
|
function IdWrite(const ABuffer: TIdBytes; AOffset, ACount: Longint): Longint; override;
|
|
function IdSeek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64; override;
|
|
procedure IdSetSize(ASize : Int64); override;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
|
|
function AddFormField(const AFieldName, AFieldValue: string; const ACharset: string = ''; const AContentType: string = ''; const AFileName: string = ''): TIdFormDataField; overload;
|
|
function AddFormField(const AFieldName, AContentType, ACharset: string; AFieldValue: TStream; const AFileName: string = ''): TIdFormDataField; overload;
|
|
function AddObject(const AFieldName, AContentType, ACharset: string; AFileData: TObject; const AFileName: string = ''): TIdFormDataField; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use overloaded version of AddFormField()'{$ENDIF};{$ENDIF}
|
|
function AddFile(const AFieldName, AFileName: String; const AContentType: string = ''): TIdFormDataField;
|
|
|
|
procedure Clear;
|
|
|
|
property Boundary: string read FBoundary;
|
|
property RequestContentType: string read FRequestContentType;
|
|
end;
|
|
|
|
EIdInvalidObjectType = class(EIdException);
|
|
EIdUnsupportedOperation = class(EIdException);
|
|
EIdUnsupportedTransfer = class(EIdException);
|
|
EIdUnsupportedEncoding = class(EIdException);
|
|
|
|
implementation
|
|
|
|
uses
|
|
SysUtils,
|
|
IdCoderQuotedPrintable,
|
|
IdCoderMIME,
|
|
IdStream,
|
|
IdGlobalProtocols;
|
|
|
|
const
|
|
cAllowedContentTransfers: array[0..4] of String = (
|
|
'7bit', '8bit', 'binary', 'quoted-printable', 'base64' {do not localize}
|
|
);
|
|
|
|
cAllowedHeaderEncodings: array[0..2] of String = (
|
|
'Q', 'B', '8' {do not localize}
|
|
);
|
|
|
|
{ TIdMultiPartFormDataStream }
|
|
|
|
constructor TIdMultiPartFormDataStream.Create;
|
|
begin
|
|
inherited Create;
|
|
FSize := 0;
|
|
FInitialized := False;
|
|
FBoundary := GenerateUniqueBoundary;
|
|
FRequestContentType := sContentTypeFormData + FBoundary;
|
|
FFields := TIdFormDataFields.Create(Self);
|
|
end;
|
|
|
|
destructor TIdMultiPartFormDataStream.Destroy;
|
|
begin
|
|
FreeAndNil(FFields);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{$I IdDeprecatedImplBugOff.inc}
|
|
function TIdMultiPartFormDataStream.AddObject(const AFieldName,
|
|
AContentType, ACharset: string; AFileData: TObject;
|
|
const AFileName: string = ''): TIdFormDataField;
|
|
{$I IdDeprecatedImplBugOn.inc}
|
|
begin
|
|
if not (AFileData is TStream) then begin
|
|
raise EIdInvalidObjectType.Create(RSMFDInvalidObjectType);
|
|
end;
|
|
Result := AddFormField(AFieldName, AContentType, ACharset, TStream(AFileData), AFileName);
|
|
end;
|
|
|
|
function TIdMultiPartFormDataStream.AddFile(const AFieldName, AFileName: String;
|
|
const AContentType: string = ''): TIdFormDataField;
|
|
var
|
|
LStream: TIdReadFileExclusiveStream;
|
|
LItem: TIdFormDataField;
|
|
begin
|
|
LStream := TIdReadFileExclusiveStream.Create(AFileName);
|
|
try
|
|
LItem := FFields.Add;
|
|
except
|
|
FreeAndNil(LStream);
|
|
raise;
|
|
end;
|
|
|
|
LItem.FFieldName := AFieldName;
|
|
LItem.FFileName := ExtractFileName(AFileName);
|
|
LItem.FFieldStream := LStream;
|
|
LItem.FCanFreeFieldStream := True;
|
|
if AContentType <> '' then begin
|
|
LItem.ContentType := AContentType;
|
|
end else begin
|
|
LItem.FContentType := GetMIMETypeFromFile(AFileName);
|
|
end;
|
|
LItem.FContentTransfer := sContentTransferBinary;
|
|
|
|
Result := LItem;
|
|
end;
|
|
|
|
function TIdMultiPartFormDataStream.AddFormField(const AFieldName, AFieldValue: string;
|
|
const ACharset: string = ''; const AContentType: string = ''; const AFileName: string = ''): TIdFormDataField;
|
|
var
|
|
LItem: TIdFormDataField;
|
|
begin
|
|
LItem := FFields.Add;
|
|
|
|
LItem.FFieldName := AFieldName;
|
|
LItem.FFileName := ExtractFileName(AFileName);
|
|
LItem.FFieldValue := AFieldValue;
|
|
if AContentType <> '' then begin
|
|
LItem.ContentType := AContentType;
|
|
end else begin
|
|
LItem.FContentType := sContentTypeTextPlain;
|
|
end;
|
|
if ACharset <> '' then begin
|
|
LItem.FCharset := ACharset;
|
|
end;
|
|
LItem.FContentTransfer := sContentTransferQuotedPrintable;
|
|
|
|
Result := LItem;
|
|
end;
|
|
|
|
function TIdMultiPartFormDataStream.AddFormField(const AFieldName, AContentType, ACharset: string;
|
|
AFieldValue: TStream; const AFileName: string = ''): TIdFormDataField;
|
|
var
|
|
LItem: TIdFormDataField;
|
|
begin
|
|
if not Assigned(AFieldValue) then begin
|
|
raise EIdInvalidObjectType.Create(RSMFDInvalidObjectType);
|
|
end;
|
|
|
|
LItem := FFields.Add;
|
|
|
|
LItem.FFieldName := AFieldName;
|
|
LItem.FFileName := ExtractFileName(AFileName);
|
|
LItem.FFieldStream := AFieldValue;
|
|
if AContentType <> '' then begin
|
|
LItem.ContentType := AContentType;
|
|
end else begin
|
|
LItem.FContentType := GetMIMETypeFromFile(AFileName);
|
|
end;
|
|
if ACharset <> '' then begin
|
|
LItem.FCharSet := ACharset;
|
|
end;
|
|
LItem.FContentTransfer := sContentTransferBinary;
|
|
|
|
Result := LItem;
|
|
end;
|
|
|
|
procedure TIdMultiPartFormDataStream.Clear;
|
|
begin
|
|
FInitialized := False;
|
|
FFields.Clear;
|
|
if FFreeInputStream then begin
|
|
FInputStream.Free;
|
|
end;
|
|
FInputStream := nil;
|
|
FFreeInputStream := False;
|
|
FCurrentItem := 0;
|
|
FPosition := 0;
|
|
FSize := 0;
|
|
SetLength(FInternalBuffer, 0);
|
|
end;
|
|
|
|
function TIdMultiPartFormDataStream.GenerateUniqueBoundary: string;
|
|
begin
|
|
Result := '--------' + FormatDateTime('mmddyyhhnnsszzz', Now); {do not localize}
|
|
end;
|
|
|
|
procedure TIdMultiPartFormDataStream.CalculateSize;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
FSize := 0;
|
|
if FFields.Count > 0 then begin
|
|
for I := 0 to FFields.Count-1 do begin
|
|
FSize := FSize + FFields.Items[I].FieldSize;
|
|
end;
|
|
FSize := FSize + 2{'--'} + Length(Boundary) + 4{'--'+CRLF};
|
|
end;
|
|
end;
|
|
|
|
// RLebeau - IdRead() should wrap multiple files of the same field name
|
|
// using a single "multipart/mixed" MIME part, as recommended by RFC 1867
|
|
|
|
function TIdMultiPartFormDataStream.IdRead(var VBuffer: TIdBytes; AOffset, ACount: Longint): Longint;
|
|
var
|
|
LTotalRead, LCount, LBufferCount, LRemaining : Integer;
|
|
LItem: TIdFormDataField;
|
|
LEncoding: IIdTextEncoding;
|
|
begin
|
|
if not FInitialized then begin
|
|
FInitialized := True;
|
|
FCurrentItem := 0;
|
|
SetLength(FInternalBuffer, 0);
|
|
end;
|
|
|
|
LTotalRead := 0;
|
|
LBufferCount := 0;
|
|
|
|
while (LTotalRead < ACount) and ((Length(FInternalBuffer) > 0) or Assigned(FInputStream) or (FCurrentItem < FFields.Count)) do
|
|
begin
|
|
if (Length(FInternalBuffer) = 0) and (not Assigned(FInputStream)) then
|
|
begin
|
|
LItem := FFields.Items[FCurrentItem];
|
|
EnsureEncoding(LEncoding, enc8Bit);
|
|
AppendString(FInternalBuffer, LItem.FormatHeader, -1, LEncoding{$IFDEF STRING_IS_ANSI}, LEncoding{$ENDIF});
|
|
|
|
FInputStream := LItem.PrepareDataStream(FFreeInputStream);
|
|
if not Assigned(FInputStream) then begin
|
|
AppendString(FInternalBuffer, CRLF);
|
|
Inc(FCurrentItem);
|
|
end;
|
|
end;
|
|
|
|
if Length(FInternalBuffer) > 0 then begin
|
|
LCount := IndyMin(ACount - LBufferCount, Length(FInternalBuffer));
|
|
if LCount > 0 then begin
|
|
LRemaining := Length(FInternalBuffer) - LCount;
|
|
CopyTIdBytes(FInternalBuffer, 0, VBuffer, LBufferCount, LCount);
|
|
if LRemaining > 0 then begin
|
|
CopyTIdBytes(FInternalBuffer, LCount, FInternalBuffer, 0, LRemaining);
|
|
end;
|
|
SetLength(FInternalBuffer, LRemaining);
|
|
LBufferCount := LBufferCount + LCount;
|
|
FPosition := FPosition + LCount;
|
|
LTotalRead := LTotalRead + LCount;
|
|
end;
|
|
end;
|
|
|
|
if (LTotalRead < ACount) and (Length(FInternalBuffer) = 0) and Assigned(FInputStream) then begin
|
|
LCount := TIdStreamHelper.ReadBytes(FInputStream, VBuffer, ACount - LTotalRead, LBufferCount);
|
|
if LCount > 0 then begin
|
|
LBufferCount := LBufferCount + LCount;
|
|
LTotalRead := LTotalRead + LCount;
|
|
FPosition := FPosition + LCount;
|
|
end
|
|
else begin
|
|
SetLength(FInternalBuffer, 0);
|
|
if FFreeInputStream then begin
|
|
FInputStream.Free;
|
|
end else begin
|
|
FInputStream.Position := 0;
|
|
AppendString(FInternalBuffer, CRLF);
|
|
end;
|
|
FInputStream := nil;
|
|
FFreeInputStream := False;
|
|
Inc(FCurrentItem);
|
|
end;
|
|
end;
|
|
|
|
if (Length(FInternalBuffer) = 0) and (not Assigned(FInputStream)) and (FCurrentItem = FFields.Count) then begin
|
|
AppendString(FInternalBuffer, '--' + Boundary + '--' + CRLF); {do not localize}
|
|
Inc(FCurrentItem);
|
|
end;
|
|
end;
|
|
|
|
Result := LTotalRead;
|
|
end;
|
|
|
|
function TIdMultiPartFormDataStream.IdSeek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64;
|
|
begin
|
|
Result := 0;
|
|
case AOrigin of
|
|
soBeginning: begin
|
|
if (AOffset = 0) then begin
|
|
FInitialized := False;
|
|
FPosition := 0;
|
|
Result := 0;
|
|
end else begin
|
|
Result := FPosition;
|
|
end;
|
|
end;
|
|
soCurrent: begin
|
|
Result := FPosition;
|
|
end;
|
|
soEnd: begin
|
|
if (AOffset = 0) then begin
|
|
CalculateSize;
|
|
Result := FSize;
|
|
end else begin
|
|
Result := FPosition;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TIdMultiPartFormDataStream.IdWrite(const ABuffer: TIdBytes; AOffset, ACount: Longint): Longint;
|
|
begin
|
|
raise EIdUnsupportedOperation.Create(RSUnsupportedOperation);
|
|
end;
|
|
|
|
procedure TIdMultiPartFormDataStream.IdSetSize(ASize: Int64);
|
|
begin
|
|
raise EIdUnsupportedOperation.Create(RSUnsupportedOperation);
|
|
end;
|
|
|
|
{ TIdFormDataFields }
|
|
|
|
function TIdFormDataFields.Add: TIdFormDataField;
|
|
begin
|
|
Result := TIdFormDataField(inherited Add);
|
|
end;
|
|
|
|
constructor TIdFormDataFields.Create(AMPStream: TIdMultiPartFormDataStream);
|
|
begin
|
|
inherited Create(TIdFormDataField);
|
|
FParentStream := AMPStream;
|
|
end;
|
|
|
|
function TIdFormDataFields.GetFormDataField(AIndex: Integer): TIdFormDataField;
|
|
begin
|
|
Result := TIdFormDataField(inherited Items[AIndex]);
|
|
end;
|
|
|
|
{ TIdFormDataField }
|
|
|
|
constructor TIdFormDataField.Create(Collection: TCollection);
|
|
var
|
|
LDefCharset: TIdCharSet;
|
|
begin
|
|
inherited Create(Collection);
|
|
FFieldStream := nil;
|
|
FFileName := '';
|
|
FFieldName := '';
|
|
FContentType := '';
|
|
FCanFreeFieldStream := False;
|
|
|
|
// it's not clear when FHeaderEncoding should be Q not B.
|
|
// Comments welcome on atozedsoftware.indy.general
|
|
|
|
LDefCharset := IdGetDefaultCharSet;
|
|
|
|
case LDefCharset of
|
|
idcs_ISO_8859_1:
|
|
begin
|
|
FHeaderEncoding := 'Q'; { quoted-printable } {Do not Localize}
|
|
FHeaderCharSet := IdCharsetNames[LDefCharset];
|
|
end;
|
|
idcs_UNICODE_1_1:
|
|
begin
|
|
FHeaderEncoding := 'B'; { base64 } {Do not Localize}
|
|
FHeaderCharSet := IdCharsetNames[idcs_UTF_8];
|
|
end;
|
|
else
|
|
begin
|
|
FHeaderEncoding := 'B'; { base64 } {Do not Localize}
|
|
FHeaderCharSet := IdCharsetNames[LDefCharset];
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
destructor TIdFormDataField.Destroy;
|
|
begin
|
|
if Assigned(FFieldStream) then begin
|
|
if FCanFreeFieldStream then begin
|
|
FFieldStream.Free;
|
|
end;
|
|
end;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TIdFormDataField.FormatHeader: string;
|
|
var
|
|
LBoundary: string;
|
|
begin
|
|
LBoundary := '--' + TIdFormDataFields(Collection).MultipartFormDataStream.Boundary; {do not localize}
|
|
|
|
// TODO: when STRING_IS_ANSI is defined, provide a way for the user to specify the AnsiString encoding for header values...
|
|
|
|
Result := IndyFormat('%s' + CRLF + sContentDispositionPlaceHolder,
|
|
[LBoundary, EncodeHeader(FieldName, '', FHeaderEncoding, FHeaderCharSet)]); {do not localize}
|
|
|
|
if Length(FileName) > 0 then begin
|
|
Result := Result + IndyFormat(sFileNamePlaceHolder,
|
|
[EncodeHeader(FileName, '', FHeaderEncoding, FHeaderCharSet)]); {do not localize}
|
|
end;
|
|
|
|
Result := Result + CRLF;
|
|
|
|
if Length(ContentType) > 0 then begin
|
|
Result := Result + IndyFormat(sContentTypePlaceHolder, [ContentType]); {do not localize}
|
|
if Length(CharSet) > 0 then begin
|
|
Result := Result + IndyFormat(sCharsetPlaceHolder, [Charset]); {do not localize}
|
|
end;
|
|
Result := Result + CRLF;
|
|
end;
|
|
|
|
if Length(FContentTransfer) > 0 then begin
|
|
Result := Result + IndyFormat(sContentTransferPlaceHolder + CRLF, [FContentTransfer]);
|
|
end;
|
|
|
|
Result := Result + CRLF;
|
|
end;
|
|
|
|
function TIdFormDataField.GetFieldSize: Int64;
|
|
var
|
|
LStream: TStream;
|
|
LOldPos: TIdStreamSize;
|
|
{$IFDEF STRING_IS_ANSI}
|
|
LBytes: TIdBytes;
|
|
{$ENDIF}
|
|
I: Integer;
|
|
begin
|
|
{$IFDEF STRING_IS_ANSI}
|
|
LBytes := nil; // keep the compiler happy
|
|
{$ENDIF}
|
|
Result := Length(FormatHeader);
|
|
if Assigned(FFieldStream) then begin
|
|
I := PosInStrArray(ContentTransfer, cAllowedContentTransfers, False);
|
|
if I <= 2 then begin
|
|
// need to include an explicit CRLF at the end of the data
|
|
Result := Result + FFieldStream.Size + 2{CRLF};
|
|
end else
|
|
begin
|
|
LStream := TIdCalculateSizeStream.Create;
|
|
try
|
|
LOldPos := FFieldStream.Position;
|
|
try
|
|
if I = 3 then begin
|
|
TIdEncoderQuotedPrintable.EncodeStream(FFieldStream, LStream);
|
|
// the encoded text always includes a CRLF at the end...
|
|
Result := Result + LStream.Size {+2};
|
|
end else begin
|
|
TIdEncoderMime.EncodeStream(FFieldStream, LStream);
|
|
// the encoded text does not include a CRLF at the end...
|
|
Result := Result + LStream.Size + 2;
|
|
end;
|
|
finally
|
|
FFieldStream.Position := LOldPos;
|
|
end;
|
|
finally
|
|
LStream.Free;
|
|
end;
|
|
end;
|
|
end
|
|
else if Length(FFieldValue) > 0 then begin
|
|
I := PosInStrArray(FContentTransfer, cAllowedContentTransfers, False);
|
|
if I <= 0 then begin
|
|
// 7bit
|
|
{$IFDEF STRING_IS_UNICODE}
|
|
I := IndyTextEncoding_ASCII.GetByteCount(FFieldValue);
|
|
{$ELSE}
|
|
// the methods useful for calculating a length without actually
|
|
// encoding are protected, so have to actually encode the
|
|
// string to find out the final length...
|
|
LBytes := RawToBytes(FFieldValue[1], Length(FFieldValue));
|
|
CheckByteEncoding(LBytes, CharsetToEncoding(FCharset), IndyTextEncoding_ASCII);
|
|
I := Length(LBytes);
|
|
{$ENDIF}
|
|
// need to include an explicit CRLF at the end of the data
|
|
Result := Result + I + 2{CRLF};
|
|
end
|
|
else if (I = 1) or (I = 2) then begin
|
|
// 8bit/binary
|
|
{$IFDEF STRING_IS_UNICODE}
|
|
I := CharsetToEncoding(FCharset).GetByteCount(FFieldValue);
|
|
{$ELSE}
|
|
I := Length(FFieldValue);
|
|
{$ENDIF}
|
|
// need to include an explicit CRLF at the end of the data
|
|
Result := Result + I + 2{CRLF};
|
|
end else
|
|
begin
|
|
LStream := TIdCalculateSizeStream.Create;
|
|
try
|
|
{$IFNDEF STRING_IS_UNICODE}
|
|
LBytes := RawToBytes(FFieldValue[1], Length(FFieldValue));
|
|
{$ENDIF}
|
|
if I = 3 then begin
|
|
// quoted-printable
|
|
{$IFDEF STRING_IS_UNICODE}
|
|
TIdEncoderQuotedPrintable.EncodeString(FFieldValue, LStream, CharsetToEncoding(FCharset));
|
|
{$ELSE}
|
|
TIdEncoderQuotedPrintable.EncodeBytes(LBytes, LStream);
|
|
{$ENDIF}
|
|
// the encoded text always includes a CRLF at the end...
|
|
Result := Result + LStream.Size {+2};
|
|
end else begin
|
|
// base64
|
|
{$IFDEF STRING_IS_UNICODE}
|
|
TIdEncoderMIME.EncodeString(FFieldValue, LStream, CharsetToEncoding(FCharset){$IFDEF STRING_IS_ANSI}, IndyTextEncoding_OSDefault{$ENDIF});
|
|
{$ELSE}
|
|
TIdEncoderMIME.EncodeBytes(LBytes, LStream);
|
|
{$ENDIF}
|
|
// the encoded text does not include a CRLF at the end...
|
|
Result := Result + LStream.Size + 2;
|
|
end;
|
|
finally
|
|
LStream.Free;
|
|
end;
|
|
end;
|
|
end else begin
|
|
// need to include an explicit CRLF at the end of blank text
|
|
Result := Result + 2{CRLF};
|
|
end;
|
|
end;
|
|
|
|
function TIdFormDataField.PrepareDataStream(var VCanFree: Boolean): TStream;
|
|
var
|
|
I: Integer;
|
|
{$IFDEF STRING_IS_ANSI}
|
|
LBytes: TIdBytes;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF STRING_IS_ANSI}
|
|
LBytes := nil; // keep the compiler happy
|
|
{$ENDIF}
|
|
Result := nil;
|
|
VCanFree := False;
|
|
|
|
if Assigned(FFieldStream) then begin
|
|
FFieldStream.Position := 0;
|
|
I := PosInStrArray(FContentTransfer, cAllowedContentTransfers, False);
|
|
if I <= 2 then begin
|
|
Result := FFieldStream;
|
|
end else begin
|
|
Result := TMemoryStream.Create;
|
|
try
|
|
if I = 3 then begin
|
|
TIdEncoderQuotedPrintable.EncodeStream(FFieldStream, Result);
|
|
// the encoded text always includes a CRLF at the end...
|
|
end else begin
|
|
TIdEncoderMime.EncodeStream(FFieldStream, Result);
|
|
// the encoded text does not include a CRLF at the end...
|
|
WriteStringToStream(Result, CRLF);
|
|
end;
|
|
Result.Position := 0;
|
|
except
|
|
FreeAndNil(Result);
|
|
raise;
|
|
end;
|
|
VCanFree := True;
|
|
end;
|
|
end
|
|
else if Length(FFieldValue) > 0 then begin
|
|
Result := TMemoryStream.Create;
|
|
try
|
|
{$IFDEF STRING_IS_ANSI}
|
|
LBytes := RawToBytes(FFieldValue[1], Length(FFieldValue));
|
|
{$ENDIF}
|
|
I := PosInStrArray(FContentTransfer, cAllowedContentTransfers, False);
|
|
if I <= 0 then begin
|
|
// 7bit
|
|
{$IFDEF STRING_IS_UNICODE}
|
|
WriteStringToStream(Result, FFieldValue, IndyTextEncoding_ASCII);
|
|
{$ELSE}
|
|
CheckByteEncoding(LBytes, CharsetToEncoding(FCharset), IndyTextEncoding_ASCII);
|
|
WriteTIdBytesToStream(Result, LBytes);
|
|
{$ENDIF}
|
|
// need to include an explicit CRLF at the end of the data
|
|
WriteStringToStream(Result, CRLF);
|
|
end
|
|
else if (I = 1) or (I = 2) then begin
|
|
// 8bit/binary
|
|
{$IFDEF STRING_IS_UNICODE}
|
|
WriteStringToStream(Result, FFieldValue, CharsetToEncoding(FCharset));
|
|
{$ELSE}
|
|
WriteTIdBytesToStream(Result, LBytes);
|
|
{$ENDIF}
|
|
// need to include an explicit CRLF at the end of the data
|
|
WriteStringToStream(Result, CRLF);
|
|
end else
|
|
begin
|
|
if I = 3 then begin
|
|
// quoted-printable
|
|
{$IFDEF STRING_IS_UNICODE}
|
|
TIdEncoderQuotedPrintable.EncodeString(FFieldValue, Result, CharsetToEncoding(FCharset));
|
|
{$ELSE}
|
|
TIdEncoderQuotedPrintable.EncodeBytes(LBytes, Result);
|
|
{$ENDIF}
|
|
// the encoded text always includes a CRLF at the end...
|
|
end else begin
|
|
// base64
|
|
{$IFDEF STRING_IS_UNICODE}
|
|
TIdEncoderMIME.EncodeString(FFieldValue, Result, CharsetToEncoding(FCharset));
|
|
{$ELSE}
|
|
TIdEncoderMIME.EncodeBytes(LBytes, Result);
|
|
{$ENDIF}
|
|
// the encoded text does not include a CRLF at the end...
|
|
WriteStringToStream(Result, CRLF);
|
|
end;
|
|
end;
|
|
except
|
|
FreeAndNil(Result);
|
|
raise;
|
|
end;
|
|
Result.Position := 0;
|
|
VCanFree := True;
|
|
end;
|
|
end;
|
|
|
|
function TIdFormDataField.GetFieldStream: TStream;
|
|
begin
|
|
if not Assigned(FFieldStream) then begin
|
|
raise EIdInvalidObjectType.Create(RSMFDInvalidObjectType);
|
|
end;
|
|
Result := FFieldStream;
|
|
end;
|
|
|
|
function TIdFormDataField.GetFieldValue: string;
|
|
begin
|
|
if Assigned(FFieldStream) then begin
|
|
raise EIdInvalidObjectType.Create(RSMFDInvalidObjectType);
|
|
end;
|
|
Result := FFieldValue;
|
|
end;
|
|
|
|
procedure TIdFormDataField.SetCharset(const Value: string);
|
|
begin
|
|
FCharset := Value;
|
|
end;
|
|
|
|
procedure TIdFormDataField.SetContentTransfer(const Value: string);
|
|
begin
|
|
if Length(Value) > 0 then begin
|
|
if PosInStrArray(Value, cAllowedContentTransfers, False) = -1 then begin
|
|
raise EIdUnsupportedTransfer.Create(RSMFDInvalidTransfer);
|
|
end;
|
|
end;
|
|
FContentTransfer := Value;
|
|
end;
|
|
|
|
procedure TIdFormDataField.SetContentType(const Value: string);
|
|
var
|
|
LContentType, LCharSet: string;
|
|
begin
|
|
if Length(Value) > 0 then begin
|
|
LContentType := Value;
|
|
end
|
|
else if Length(FFileName) > 0 then begin
|
|
LContentType := GetMIMETypeFromFile(FFileName);
|
|
end
|
|
else begin
|
|
LContentType := sContentTypeOctetStream;
|
|
end;
|
|
|
|
FContentType := RemoveHeaderEntry(LContentType, 'charset', LCharSet, QuoteMIME); {do not localize}
|
|
|
|
// RLebeau: per RFC 2045 Section 5.2:
|
|
//
|
|
// Default RFC 822 messages without a MIME Content-Type header are taken
|
|
// by this protocol to be plain text in the US-ASCII character set,
|
|
// which can be explicitly specified as:
|
|
//
|
|
// Content-type: text/plain; charset=us-ascii
|
|
//
|
|
// This default is assumed if no Content-Type header field is specified.
|
|
// It is also recommend that this default be assumed when a
|
|
// syntactically invalid Content-Type header field is encountered. In
|
|
// the presence of a MIME-Version header field and the absence of any
|
|
// Content-Type header field, a receiving User Agent can also assume
|
|
// that plain US-ASCII text was the sender's intent. Plain US-ASCII
|
|
// text may still be assumed in the absence of a MIME-Version or the
|
|
// presence of an syntactically invalid Content-Type header field, but
|
|
// the sender's intent might have been otherwise.
|
|
if (LCharSet = '') and IsHeaderMediaType(FContentType, 'text') then begin {do not localize}
|
|
LCharSet := 'us-ascii'; {do not localize}
|
|
end;
|
|
{RLebeau: override the current CharSet only if the header specifies a new value}
|
|
if LCharSet <> '' then begin
|
|
FCharSet := LCharSet;
|
|
end;
|
|
end;
|
|
|
|
procedure TIdFormDataField.SetFieldName(const Value: string);
|
|
begin
|
|
FFieldName := Value;
|
|
end;
|
|
|
|
procedure TIdFormDataField.SetFieldStream(const Value: TStream);
|
|
begin
|
|
if not Assigned(Value) then begin
|
|
raise EIdInvalidObjectType.Create(RSMFDInvalidObjectType);
|
|
end;
|
|
|
|
if Assigned(FFieldStream) and FCanFreeFieldStream then begin
|
|
FFieldStream.Free;
|
|
end;
|
|
|
|
FFieldValue := '';
|
|
FFieldStream := Value;
|
|
FCanFreeFieldStream := False;
|
|
end;
|
|
|
|
procedure TIdFormDataField.SetFieldValue(const Value: string);
|
|
begin
|
|
if Assigned(FFieldStream) then begin
|
|
if FCanFreeFieldStream then begin
|
|
FFieldStream.Free;
|
|
end;
|
|
FFieldStream := nil;
|
|
FCanFreeFieldStream := False;
|
|
end;
|
|
FFieldValue := Value;
|
|
end;
|
|
|
|
procedure TIdFormDataField.SetFileName(const Value: string);
|
|
begin
|
|
FFileName := ExtractFileName(Value);
|
|
end;
|
|
|
|
procedure TIdFormDataField.SetHeaderCharSet(const Value: string);
|
|
begin
|
|
FHeaderCharset := Value;
|
|
end;
|
|
|
|
procedure TIdFormDataField.SetHeaderEncoding(const Value: Char);
|
|
begin
|
|
if FHeaderEncoding <> Value then begin
|
|
if PosInStrArray(Value, cAllowedHeaderEncodings, False) = -1 then begin
|
|
raise EIdUnsupportedEncoding.Create(RSMFDInvalidEncoding);
|
|
end;
|
|
FHeaderEncoding := Value;
|
|
end;
|
|
end;
|
|
|
|
end.
|