{ $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.