idmultipartformdata.pas

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

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

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

// RLebeau - IdRead() should wrap multiple files using a single
// "multipart/mixed" MIME part, as recommended by RFC 1867

function TIdMultiPartFormDataStream.IdRead(var VBuffer: TIdBytes; AOffset, ACount: Longint): Longint;
var
  LTotalRead: Integer;
  LCount: Integer;
  LBufferCount: Integer;
  LRemaining : Integer;
  LItem: TIdFormDataField;
begin
  if not FInitialized then begin
    FInitialized := True;
    FCurrentItem := 0;
    SetLength(FInternalBuffer, 0);
  end;

  LTotalRead := 0;
  LBufferCount := 0;

  while (LTotalRead < ACount) and ((FCurrentItem < FFields.Count) or (Length(FInternalBuffer) > 0)) do begin
    if (Length(FInternalBuffer) = 0) and not Assigned(FInputStream) then begin
      LItem := FFields.Items[FCurrentItem];
      AddToInternalBuffer(LItem.FormatField);

      if Assigned(LItem.FieldObject) then begin
        if (LItem.FieldObject is TStream) then begin
          FInputStream := TStream(LItem.FieldObject);
          FInputStream.Position := 0;
        end else begin
          if (LItem.FieldObject is TIdStrings) then begin
            AddToInternalBuffer(TIdStrings(LItem.FieldObject).Text);
            Inc(FCurrentItem);
          end;
        end;
      end else begin
        Inc(FCurrentItem);
      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;

      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 Assigned(FInputStream) and (LTotalRead < ACount) then begin
      with TIdStreamVCL.Create(FInputStream, False) do try
        LCount := ReadBytes(VBuffer, ACount - LTotalRead, LBufferCount, False);
      finally
        Free;
      end;   

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

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

    if FCurrentItem = FFields.Count then begin
      AddToInternalBuffer(PrepareStreamForDispatch);
      Inc(FCurrentItem);
    end;
  end;
  Result := LTotalRead;
end;

function TIdMultiPartFormDataStream.IdSeek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64;
begin
  Result := 0;
  case AOrigin of
    IdFromBeginning: begin
        if (AOffset = 0) then begin
          FInitialized := False;
          FPosition := 0;
          Result := 0;
        end else begin
          Result := FPosition;
        end;
      end;
    IdFromCurrent: begin
        Result := FPosition;
      end;
    IdFromEnd: 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;

{ TIdFormDataField }

constructor TIdFormDataField.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FFieldObject := nil;
  FFileName := '';
  FFieldName := '';
  FContentType := '';
  FCanFreeFieldObject := False;
end;

destructor TIdFormDataField.Destroy;
begin
  if Assigned(FFieldObject) then begin
    if FCanFreeFieldObject then begin
      FreeAndNil(FFieldObject);
    end;
  end;
  inherited Destroy;
end;

function TIdFormDataField.FormatField: string;
var
  LBoundary: string;
begin
  LBoundary := TIdFormDataFields(Collection).MultipartFormDataStream.Boundary;

  if Assigned(FieldObject) then begin
    if Length(FileName) > 0 then begin
      Result := Format('--%s' + crlf + sContentDisposition +
        sFileNamePlaceHolder + crlf + sContentTypePlaceHolder +
        crlf + sContentTransferEncoding + crlf + crlf,
        [LBoundary, FieldName, FileName, ContentType]);
      Exit;
    end;
  end;

  Result := Format('--%s' + crlf + sContentDisposition + crlf + crlf +
        '%s' + crlf, [LBoundary, FieldName, FieldValue]);
end;

function TIdFormDataField.GetFieldSize: LongInt;
begin
  Result := Length(FormatField);
  if Assigned(FFieldObject) then begin
    if FieldObject is TIdStrings then begin
      Result := Result + Length(TIdStrings(FieldObject).Text) + 2;
    end else begin
      if FieldObject is TStream then begin
        Result := Result + TStream(FieldObject).Size + 2;
      end;
    end;
  end;
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;

function TIdFormDataField.GetFieldStrings: TIdStrings;
begin
  Result := nil;
  if Assigned(FFieldObject) then begin
    if (FFieldObject is TIdStrings) then begin
      Result := TIdStrings(FFieldObject);
    end else begin
      raise EIdInvalidObjectType.Create(RSMFDIvalidObjectType);
    end;
  end;
end;

procedure TIdFormDataField.SetContentType(const Value: string);
begin
  if Length(Value) > 0 then begin
    FContentType := Value;
  end else begin
    if Length(FFileName) > 0 then begin
      FContentType := GetMIMETypeFromFile(FFileName);
    end else begin;
      FContentType := sContentTypeOctetStream;
    end;
  end;
  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 not ((Value is TStream) or (Value is TIdStrings)) then begin
      raise EIdInvalidObjectType.Create(RSMFDIvalidObjectType);
    end;
  end;

  if Assigned(FFieldObject) then begin
    if FCanFreeFieldObject then begin
      FreeAndNil(FFieldObject);
    end;
  end;

  FFieldObject := Value;
  FCanFreeFieldObject := False;
  GetFieldSize;
end;

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

procedure TIdFormDataField.SetFieldStrings(const Value: TIdStrings);
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.