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

uses
  Classes,
  IdCoreGlobal,
  IdException,
  IdResourceStrings,
  IdStream,
  SysUtils;

const
  sContentType = 'multipart/form-data; boundary=';                    {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' + crlf + crlf;         {do not localize}

type
  TIdMultiPartFormDataStream = class;

  TIdFormDataField = class(TCollectionItem)
  protected
    FFieldSize: LongInt;

    FFieldValue: string;
    FFileName: string;
    FContentType: string;
    FFieldName: string;
    FFieldObject: TObject;
    FInternallyAssigned: Boolean;

    procedure SetFieldStream(const Value: TStream);
    function GetFieldSize: LongInt;
    procedure SetContentType(const Value: string);
    procedure SetFieldName(const Value: string);
    procedure SetFieldValue(const Value: string);
    function GetFieldStream: TStream;
    procedure SetFieldObject(const Value: TObject);
    procedure SetFileName(const Value: string);
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    // procedure Assign(Source: TPersistent); override;
    property ContentType: string read FContentType write SetContentType;
    property FieldName: string read FFieldName write SetFieldName;
    property FieldStream: TStream read GetFieldStream write SetFieldStream;
    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 write FFieldSize;
  end;

  TIdFormDataFields = class(TCollection)
  protected
    FParentStream: TIdMultiPartFormDataStream;

    function GetFormDataField(AIndex: Integer): TIdFormDataField;
    {procedure SetFormDataField(AIndex: Integer;
      const Value: TIdFormDataField);}
  public
    constructor Create(AMPStream: TIdMultiPartFormDataStream);

    function Add: TIdFormDataField;

    property MultipartFormDataStream: TIdMultiPartFormDataStream read FParentStream;
    property Items[AIndex: Integer]: TIdFormDataField read GetFormDataField { write SetFormDataField};
  end;

  TIdMultiPartFormDataStream = class(TIdBaseStream)
  protected
    FInputStream: TStream;
    FBoundary: string;
    FRequestContentType: string;
    FItem: integer;
    FInitialized: Boolean;
    FInternalBuffer: TIdBytes;

    FPosition: Int64;
    FSize: Int64;

    FFields: TIdFormDataFields;

    function GenerateUniqueBoundary: string;
    function FormatField(AIndex: Integer): 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

{ TIdMultiPartFormDataStream }

constructor TIdMultiPartFormDataStream.Create;
begin
  inherited Create;

  FSize := 0;
  FInitialized := false;
  FBoundary := GenerateUniqueBoundary;
  FRequestContentType := sContentType + 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
  FItem: TIdFormDataField;
begin
  FItem := FFields.Add;

  with FItem do begin
    FieldName := AFieldName;
    FileName := AFileName;
    FFieldObject := AFileData;
    ContentType := AContentType;
  end;

  FSize := FSize + FItem.FieldSize;
end;

procedure TIdMultiPartFormDataStream.AddFile(const AFieldName, AFileName,
  AContentType: string);
var
  FileStream: TFileStream;
  FItem: TIdFormDataField;
begin
  FItem := FFields.Add;
  FileStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite);

  with FItem do begin
    FieldName := AFieldName;
    FileName := AFileName;
    FFieldObject := FileStream;
    ContentType := AContentType;
    FInternallyAssigned := true;
  end;

  FSize := FSize + FItem.FieldSize;
end;

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

  with FItem do begin
    FieldName := AFieldName;
    FieldValue := AFieldValue;
  end;
  FSize := FSize + FItem.FieldSize;
end;

function TIdMultiPartFormDataStream.FormatField(AIndex: Integer): string;
  function FileField(AItem: TIdFormDataField): string;
  begin
    with AItem do begin
      result := Format('--' + Boundary + crlf + sContentDisposition +
        sFileNamePlaceHolder + crlf +
        sContentTypePlaceHolder, [FieldName, FileName, ContentType]);
    end;
  end;

  function NormalField(AItem: TIdFormDataField): string;
  begin
    with AItem do begin
      result := Format('--' + Boundary + crlf + sContentDisposition + crlf + crlf +
        FieldValue + crlf, [FieldName]);
    end;
  end;

begin
  with FFields.Items[AIndex] do begin
    if Assigned(FieldObject) then begin
      if Length(FileName) > 0 then begin
        result := FileField(FFields.Items[AIndex]);
      end
      else begin
        result := NormalField(FFields.Items[AIndex]);
      end;
    end
    else begin
      result := NormalField(FFields.Items[AIndex]);
    end;
  end;
end;


function TIdMultiPartFormDataStream.GenerateUniqueBoundary: string;
begin
  Result := '--------' + FormatDateTime('mmddyyhhnnsszzz', Now);  {do not localize}
end;

function TIdMultiPartFormDataStream.PrepareStreamForDispatch: string;
begin
  result := crlf + '--' + Boundary + '--' + crlf;
end;

function TIdMultiPartFormDataStream.IdRead(var VBuffer: TIdBytes; AOffset, ACount: Longint): Longint;
var
  LTotalRead: Integer;
  LCount: Integer;
  LBufferCount: Integer;
  LExtra : Integer;
begin
  if not FInitialized then begin
    FInitialized := true;
    FItem := 0;
    SetLength(FInternalBuffer, 0);
  end;

  LTotalRead := 0;
  LBufferCount := 0;

  while (LTotalRead < ACount) and ((FItem < FFields.Count) or (Length(FInternalBuffer) > 0)) do begin
    if (Length(FInternalBuffer) = 0) and not Assigned(FInputStream) then begin
      AddToInternalBuffer(FormatField(FItem));

      if Assigned(FFields.Items[FItem].FieldObject) then begin
        if (FFields.Items[FItem].FieldObject is TStream) then begin
          FInputStream := FFields.Items[FItem].FieldObject as TStream;
          FInputStream.Seek(0, soFromBeginning);
        end
        else
          FInputStream := nil;

        if (FFields.Items[FItem].FieldObject is TStrings) then begin
          AddToInternalBuffer((FFields.Items[FItem].FieldObject as TStrings).Text);
          Inc(FItem);
        end;
      end
      else begin
        Inc(FItem);
      end;
    end;

    if Length(FInternalBuffer) > 0 then begin
      if Length(FInternalBuffer) > ACount - LBufferCount then begin
        LCount := ACount - LBufferCount;
      end
      else begin
        LCount := Length(FInternalBuffer);
      end;

      LExtra := Length(FInternalBuffer) - LCount;
      CopyTIdBytes(FInternalBuffer, 0, VBuffer, LBufferCount, LCount);
      CopyTIdBytes(FInternalBuffer, LCount, FInternalBuffer, 0, LExtra);
      SetLength(FInternalBuffer, LExtra);

      LBufferCount := LBufferCount + LCount;
      FPosition := FPosition + LCount;
      LTotalRead := LTotalRead + LCount;
    end;

    if Assigned(FInputStream) and (LTotalRead < ACount) then begin
      with TIdStream.Create(FInputStream,False) do try
        LCount := ReadBytes(VBuffer, ACount - LTotalRead, LBufferCount, false);
      finally
        Free;
      end;   

      if LCount < ACount - LTotalRead then begin
        FInputStream.Seek(0, soFromBeginning);
        FInputStream := nil;
        Inc(FItem);
        SetLength(FInternalBuffer, 0);
        AddToInternalBuffer(#13#10);
      end;

      LBufferCount := LBufferCount + LCount;
      LTotalRead := LTotalRead + LCount;
      FPosition := FPosition + LCount;
    end;
    if FItem = FFields.Count then begin
      AddToInternalBuffer(PrepareStreamForDispatch);
      Inc(FItem);
    end;
  end;
  result := LTotalRead;
end;

function TIdMultiPartFormDataStream.IdSeek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64;
begin
  result := 0;
  case AOrigin of
    soFromBeginning: begin
        if (AOffset = 0) then begin
          FInitialized := false;
          FPosition := 0;
          result := 0;
        end
        else
          result := FPosition;
      end;
    soFromCurrent: begin
        result := FPosition;
      end;
    soFromEnd: begin
        result := FSize + Length(PrepareStreamForDispatch);
      end;
  end;
end;

function TIdMultiPartFormDataStream.IdWrite(const ABuffer: TIdBytes; AOffset, ACount: Longint): Longint;
begin
  raise EIdException.Create(RSUnsupportedOperation);
end;

procedure TIdMultiPartFormDataStream.AddToInternalBuffer(Const AStr : String);
var
  LBytes : TIdBytes;
begin
  LBytes := ToBytes(AStr);
  AppendBytes(FInternalBuffer, LBytes);
end;

procedure TIdMultiPartFormDataStream.IdSetSize(ASize: Int64);
begin
  raise EIdException.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;

{procedure TIdFormDataFields.SetFormDataField(AIndex: Integer;
  const Value: TIdFormDataField);
begin
  Items[AIndex].Assign(Value);
end;}

{ TIdFormDataField }

{procedure TIdFormDataField.Assign(Source: TPersistent);
begin
  if Source is TIdFormDataField then begin
    (Source as TIdFormDataField).FFileName := FFileName;
    (Source as TIdFormDataField).FContentType := FContentType;
    (Source as TIdFormDataField).FFieldObject := FFieldObject;
    (Source as TIdFormDataField).FieldName := FieldName;
  end
  else begin
    inherited Assign(Source);
  end;
end;}

constructor TIdFormDataField.Create(Collection: TCollection);
begin
  inherited Create(Collection);

  FFieldObject := nil;
  FFileName := '';
  FFieldName := '';
  FContentType := '';
  FInternallyAssigned := false;
end;

destructor TIdFormDataField.Destroy;
begin
  if Assigned(FFieldObject) and FInternallyAssigned then
    FFieldObject.Free;
  inherited Destroy;
end;

function TIdFormDataField.GetFieldSize: LongInt;
begin
  if Length(FFileName) > 0 then begin
    FFieldSize := Length(Format('--' + (Collection as TIdFormDataFields).FParentStream.Boundary
      + crlf + sContentDisposition + sFileNamePlaceHolder + crlf + sContentTypePlaceHolder,
      [FieldName, FileName, ContentType]));
  end
  else begin
    FFieldSize := Length(Format('--' + (Collection as TIdFormDataFields).FParentStream.Boundary +
      crlf + sContentDisposition + crlf + crlf + FFieldValue + crlf, [FieldName]));
  end;

  if Assigned(FFieldObject) then begin
    if FieldObject is TStrings then
      FFieldSize := FFieldSize + Length((FieldObject as TStrings).Text) + 2;
    if FieldObject is TStream then
      FFieldSize := FFieldSize + FieldStream.Size + 2;
  end;

  Result := FFieldSize;
end;

function TIdFormDataField.GetFieldStream: TStream;
begin
  result := nil;
  if Assigned(FFieldObject) then begin
    if (FFieldObject is TStream) then begin
      result := TStream(FFieldObject);
    end
    else begin
      raise EIdInvalidObjectType.Create(RSMFDIvalidObjectType);
    end;
  end;
end;

procedure TIdFormDataField.SetContentType(const Value: string);
begin
  FContentType := Value;
  GetFieldSize;
end;

procedure TIdFormDataField.SetFieldName(const Value: string);
begin
  FFieldName := Value;
  GetFieldSize;
end;

procedure TIdFormDataField.SetFieldObject(const Value: TObject);
begin
  if Assigned(Value) then begin
    if (Value is TStream) or (Value is TStrings) then begin
      FFieldObject := Value;
      GetFieldSize;
    end
    else begin
      raise EIdInvalidObjectType.Create(RSMFDIvalidObjectType);
    end;
  end
  else
    FFieldObject := Value;
end;

procedure TIdFormDataField.SetFieldStream(const Value: TStream);
begin
  FieldObject := Value;
end;

procedure TIdFormDataField.SetFieldValue(const Value: string);
begin
  FFieldValue := Value;
  GetFieldSize;
end;

procedure TIdFormDataField.SetFileName(const Value: string);
begin
  FFileName := Value;
  GetFieldSize;
end;

end.

