| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854 |
- {
- $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(TStream)
- 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;
- procedure SetSize(const NewSize: 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 AddFile(const AFieldName, AFileName: String; const AContentType: string = ''): TIdFormDataField;
- procedure Clear;
- function Read(var Buffer; Count: Longint): Longint; override;
- function Write(const Buffer; Count: Longint): Longint; override;
- function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
- 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,
- 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
- FFields.Free;
- inherited Destroy;
- 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
- LStream.Free;
- 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
- // TODO: add a way for a user-defined prefix to be placed in between
- // the dashes and the random data, such as 'WebKitFormBoundary'...
- 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 - Read() should wrap multiple files of the same field name
- // using a single "multipart/mixed" MIME part, as recommended by RFC 1867
- function TIdMultiPartFormDataStream.Read(var Buffer; Count: 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 < Count) and ((FInternalBuffer <> nil) or Assigned(FInputStream) or (FCurrentItem < FFields.Count)) do
- begin
- if (FInternalBuffer = nil) and (not Assigned(FInputStream)) then
- begin
- LItem := FFields.Items[FCurrentItem];
- EnsureEncoding(LEncoding, enc8Bit);
- AppendString(FInternalBuffer, LItem.FormatHeader, -1, LEncoding);
- FInputStream := LItem.PrepareDataStream(FFreeInputStream);
- if not Assigned(FInputStream) then begin
- AppendString(FInternalBuffer, CRLF);
- Inc(FCurrentItem);
- end;
- end;
- if FInternalBuffer <> nil then begin
- LCount := IndyMin(Count - LBufferCount, Length(FInternalBuffer));
- if LCount > 0 then begin
- LRemaining := Length(FInternalBuffer) - LCount;
- Move(FInternalBuffer[0], Pointer(PtrUInt(@Buffer) + 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 < Count) and (FInternalBuffer = nil) and Assigned(FInputStream) then begin
- LCount := FInputStream.Read(Pointer(PtrUInt(@Buffer)+(Count-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 (FInternalBuffer = nil) 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.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
- begin
- Result := 0;
- case Origin of
- soBeginning: begin
- if (Offset = 0) then begin
- FInitialized := False;
- FPosition := 0;
- Result := 0;
- end else begin
- Result := FPosition;
- end;
- end;
- soCurrent: begin
- Result := FPosition;
- end;
- soEnd: begin
- if (Offset = 0) then begin
- CalculateSize;
- Result := FSize;
- end else begin
- Result := FPosition;
- end;
- end;
- end;
- end;
- function TIdMultiPartFormDataStream.Write(const Buffer; Count: Longint): Longint;
- begin
- raise EIdUnsupportedOperation.Create(RSUnsupportedOperation);
- end;
- procedure TIdMultiPartFormDataStream.SetSize(const NewSize: 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}
- Result := IndyFormat('%s' + CRLF + sContentDispositionPlaceHolder,
- [LBoundary, EncodeHeader(FieldName, '', FHeaderEncoding, FHeaderCharSet)]); {do not localize}
- if FileName <> '' then begin
- Result := Result + IndyFormat(sFileNamePlaceHolder,
- [EncodeHeader(FileName, '', FHeaderEncoding, FHeaderCharSet)]); {do not localize}
- end;
- Result := Result + CRLF;
- if ContentType <> '' then begin
- Result := Result + IndyFormat(sContentTypePlaceHolder, [ContentType]); {do not localize}
- if CharSet <> '' then begin
- Result := Result + IndyFormat(sCharsetPlaceHolder, [Charset]); {do not localize}
- end;
- Result := Result + CRLF;
- end;
- if FContentTransfer <> '' then begin
- Result := Result + IndyFormat(sContentTransferPlaceHolder + CRLF, [FContentTransfer]);
- end;
- Result := Result + CRLF;
- end;
- function TIdFormDataField.GetFieldSize: Int64;
- var
- LStream: TStream;
- LOldPos: Int64;
- I: Integer;
- begin
- 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 FFieldValue <> '' then begin
- I := PosInStrArray(FContentTransfer, cAllowedContentTransfers, False);
- if I <= 0 then begin
- // 7bit
- I := IndyTextEncoding_ASCII.GetByteCount(FFieldValue);
- // 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
- I := CharsetToEncoding(FCharset).GetByteCount(FFieldValue);
- // need to include an explicit CRLF at the end of the data
- Result := Result + I + 2{CRLF};
- end else
- begin
- LStream := TIdCalculateSizeStream.Create;
- try
- if I = 3 then begin
- // quoted-printable
- TIdEncoderQuotedPrintable.EncodeString(FFieldValue, LStream, CharsetToEncoding(FCharset));
- // the encoded text always includes a CRLF at the end...
- Result := Result + LStream.Size {+2};
- end else begin
- // base64
- TIdEncoderMIME.EncodeString(FFieldValue, LStream, CharsetToEncoding(FCharset));
- // 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;
- begin
- 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
- Result.Free;
- raise;
- end;
- VCanFree := True;
- end;
- end
- else if FFieldValue <> '' then begin
- Result := TMemoryStream.Create;
- try
- I := PosInStrArray(FContentTransfer, cAllowedContentTransfers, False);
- if I <= 0 then begin
- // 7bit
- WriteStringToStream(Result, FFieldValue, IndyTextEncoding_ASCII);
- // 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
- WriteStringToStream(Result, FFieldValue, CharsetToEncoding(FCharset));
- // 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
- TIdEncoderQuotedPrintable.EncodeString(FFieldValue, Result, CharsetToEncoding(FCharset));
- // the encoded text always includes a CRLF at the end...
- end else begin
- // base64
- TIdEncoderMIME.EncodeString(FFieldValue, Result, CharsetToEncoding(FCharset));
- // the encoded text does not include a CRLF at the end...
- WriteStringToStream(Result, CRLF);
- end;
- end;
- except
- Result.Free;
- 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 Value <> '' 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 Value <> '' then begin
- LContentType := Value;
- end
- else if FFileName <> '' 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 (FCharSet = '') 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.
|