idmultipartformdata.pas

photo.163.com 相册下载器 多线程下载

{ $HDR$}
{**********************************************************************}
{ Unit archived using Team Coherence                                   }
{ Team Coherence is Copyright 2002 by Quality Software Components      }
{                                                                      }
{ For further information / comments, visit our WEB site at            }
{ http://www.TeamCoherence.com                                         }
{**********************************************************************}
{}
{ $Log:  11687: IdMultipartFormData.pas
{
{   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
}
unit IdMultipartFormData;

{
  Implementation of the Multipart From data

  Author: Shiv Kumar
  Copyright: (c) Chad Z. Hower and The Winshoes Working Group.

Details of implementation
-------------------------
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.

 2001-Nov-23
  - changed spelling error from XxxDataFiled to XxxDataField
}


interface
{$I IdCompilerDefines.inc}

uses
  Classes,
  IdGlobal,
  IdException,
  IdResourceStringsProtocols,
  IdStreamVCL,
  SysUtils,
  IdTStrings;

const
  sContentTypeFormData = 'multipart/form-data; boundary=';            {do not localize}
  sContentTypeOctetStream = 'application/octet-stream';               {do not localize}
  crlf = #13#10;
  sContentDisposition = 'Content-Disposition: form-data; name="%s"';  {do not localize}
  sFileNamePlaceHolder = '; filename="%s"';                           {do not localize}
  sContentTypePlaceHolder = 'Content-Type: %s';                       {do not localize}
  sContentTransferEncoding = 'Content-Transfer-Encoding: binary';     {do not localize}

type
  TIdMultiPartFormDataStream = class;

  TIdFormDataField = class(TCollectionItem)
  protected
    FFieldValue: string;
    FFileName: string;
    FContentType: string;
    FFieldName: string;
    FFieldObject: TObject;
    FCanFreeFieldObject: Boolean;

    function GetFieldSize: LongInt;
    function GetFieldStream: TStream;
    function GetFieldStrings: TIdStrings;
    procedure SetContentType(const Value: string);
    procedure SetFieldName(const Value: string);
    procedure SetFieldStream(const Value: TStream);
    procedure SetFieldStrings(const Value: TIdStrings);
    procedure SetFieldValue(const Value: string);
    procedure SetFieldObject(const Value: TObject);
    procedure SetFileName(const Value: string);
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    // procedure Assign(Source: TPersistent); override;
    function FormatField: string;
    property ContentType: string read FContentType write SetContentType;
    property FieldName: string read FFieldName write SetFieldName;
    property FieldStream: TStream read GetFieldStream write SetFieldStream;
    property FieldStrings: TIdStrings read GetFieldStrings write SetFieldStrings;
    property FieldObject: TObject read FFieldObject write SetFieldObject;
    property FileName: string read FFileName write SetFileName;
    property FieldValue: string read FFieldValue write SetFieldValue;
    property FieldSize: LongInt read GetFieldSize;
  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;
    FBoundary: string;
    FRequestContentType: string;
    FCurrentItem: integer;
    FInitialized: Boolean;
    FInternalBuffer: TIdBytes;

    FPosition: Int64;
    FSize: Int64;

    FFields: TIdFormDataFields;

    function GenerateUniqueBoundary: string;
    function PrepareStreamForDispatch: string;
    procedure AddToInternalBuffer(Const AStr : String);

    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;

    procedure AddFormField(const AFieldName, AFieldValue: string);
    procedure AddObject(const AFieldName, AContentType: string; AFileData: TObject; const AFileName: string = '');
    procedure AddFile(const AFieldName, AFileName, AContentType: string);

    property Boundary: string read FBoundary;
    property RequestContentType: string read FRequestContentType;
  end;

  EIdInvalidObjectType = class(EIdException);

implementation

uses
  IdGlobalProtocols;

{ 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;

procedure TIdMultiPartFormDataStream.AddObject(const AFieldName,
  AContentType: string; AFileData: TObject; const AFileName: string = '');
var
  LItem: TIdFormDataField;
begin
  LItem := FFields.Add;

  with LItem do begin
    FFieldName := AFieldName;
    FFileName := AFileName;
    FFieldObject := AFileData;
    if Length(AContentType) > 0 then begin
  	  FContentType := AContentType;
    end else begin
      if Length(FFileName) > 0 then begin
        FContentType := GetMIMETypeFromFile(FFileName);
      end else begin
        FContentType := sContentTypeOctetStream;
      end;
    end;
  end;

  FSize := FSize + LItem.FieldSize;
end;

procedure TIdMultiPartFormDataStream.AddFile(const AFieldName, AFileName,
  AContentType: string);
var
  LStream: TFileStream;
  LItem: TIdFormDataField;
begin
  LStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite);
  try
    LItem := FFields.Add;
  except
    FreeAndNil(LStream);
    raise;
  end;

  with LItem do begin
    FFieldName := AFieldName;
    FFileName := AFileName;
    FFieldObject := LStream;
    FCanFreeFieldObject := True;
    if Length(AContentType) > 0 then begin
  	  FContentType := AContentType;
    end else begin
      FContentType := GetMIMETypeFromFile(AFileName);
    end;
  end;

  FSize := FSize + LItem.FieldSize;
end;

procedure TIdMultiPartFormDataStream.AddFormField(const AFieldName,
  AFieldValue: string);
var
  LItem: TIdFormDataField;
begin
  LItem := FFields.Add;

  with LItem do begin
    FFieldName := AFieldName;
    FFieldValue := AFieldValue;
  end;

  FSize := FSize + LItem.FieldSize;
end;