clhttprequest.pas

Clever_Internet_Suite_6.2的代码 Clever_Internet_Suite_6.2的代码 Clever_Internet_Suite_6.2的代码

          if (temp <> '') and (item <> nil) then
          begin
            item.AddData(PChar(temp), Length(temp));
          end;
          temp := '';
        end;

        if ((buf + i)^ = eofHead[eofHeadCnt + 1]) then
        begin
          Inc(eofHeadCnt);
        end else
        begin
          eofHeadCnt := 0;
          if ((buf + i)^ = eofHead[eofHeadCnt + 1]) then
          begin
            Inc(eofHeadCnt);
          end;
        end;

        if (boundCnt >= Length(bound)) then
        begin
          dataSize := i - startPos - boundCnt + 1;
          if (item <> nil) and (startPos < len) and (dataSize > 0) then
          begin
            item.AddData((buf + startPos), dataSize);
            item.AfterAddData();
          end;
          item := nil;
          head := '';
          startPos := 0;
          boundCnt := 0;
        end else
        if (item = nil) then
        begin
          head := head + (buf + i)^;
          if (eofHeadCnt >= Length(eofHead)) then
          begin
            item := CreateMultiPartItem(Trim(head));
            head := '';
            startPos := i + 1;
          end;
        end;

        if (eofHeadCnt >= Length(eofHead)) then
        begin
          eofHeadCnt := 0;
        end;
      end;

      dataSize := len - startPos - boundCnt;
      if (item <> nil) and (startPos < len) and (dataSize > 0) then
      begin
        if (boundCnt > 0) then
        begin
          temp := temp + system.Copy((buf + len - boundCnt), 1, boundCnt);
        end;
        item.AddData((buf + startPos), dataSize);
      end;
    end;
  finally
    FreeMem(buf);
  end;
end;

procedure TclHttpRequest.SetRequestAsStream(const Value: TStream);
var
  s: string;
begin
{$IFDEF DEMO}
{$IFNDEF STANDALONEDEMO}
  if FindWindow('TAppBuilder', nil) = 0 then
  begin
    MessageBox(0, 'This demo version can be run under Delphi/C++Builder IDE only. ' +
      'Please visit www.clevercomponents.com to purchase your ' +
      'copy of the library.', 'Information', MB_ICONEXCLAMATION  or MB_TASKMODAL or MB_TOPMOST);
    ExitProcess(1);
  end else
{$ENDIF}
  begin
{$IFNDEF IDEDEMO}
    if (not IsHttpRequestDemoDisplayed) then
    begin
      MessageBox(0, 'Please visit www.clevercomponents.com to purchase your ' +
        'copy of the library.', 'Information', MB_ICONEXCLAMATION  or MB_TASKMODAL or MB_TOPMOST);
    end;
    IsHttpRequestDemoDisplayed := True;
{$ENDIF}
  end;
{$ENDIF}
  FIsParse := True;
  BeginUpdate();
  try
    ClearItems();
    if (Value = nil) then Exit;

    s := ReadLine(Value, 250);
    Value.Position := 0;
    if (Pos('--', s) = 1) then
    begin
      system.Delete(s, 1, 2);
      Header.Boundary := Trim(s);
      ParseMultiPartRequest(Value);
    end else
    begin
      Header.Boundary := '';
      CreateSingleItem(Value);
    end;
  finally
    ClearDataStream();
    EndUpdate();
    FIsParse := False;
  end;
end;

procedure TclHttpRequest.CreateSingleItem(AStream: TStream);
var
  s: string;
begin
  SetLength(s, AStream.Size);
  AStream.Read(Pointer(s)^, AStream.Size);
  if SameText(Header.ContentType, cFormDataContentType) then
  begin
    ParseFormFieldRequest(s);
  end else
  begin
    AddTextData(s).AfterAddData();
  end;
end;

procedure TclHttpRequest.DoOnHeaderChanged(Sender: TObject);
begin
  BeginUpdate();
  EndUpdate();
end;

function TclHttpRequest.IsForm: Boolean;
begin
  Result := SameText(cFormDataContentType, Header.ContentType)
end;

function TclHttpRequest.IsMultiPart: Boolean;
begin
  Result := (system.Pos('multipart/', LowerCase(Header.ContentType)) > 0);
end;

procedure TclHttpRequest.DoDataAdded(AItem: TclHttpRequestItem; AData: TStream);
begin
  if Assigned(OnDataAdded) then
  begin
    OnDataAdded(Self, AItem, AData);
  end;
end;

function TclHttpRequest.CreateMultiPartItem(const AHeader: string): TclHttpRequestItem;
var
  hdr, FieldList: TStrings;
begin
  ClearDataStream();
  hdr := nil;
  FieldList := nil;
  try
    hdr := TStringList.Create();
    FieldList := TStringList.Create();
    hdr.Text := AHeader;

    GetHeaderFieldList(0, hdr, FieldList);

    Result := CreateItem(hdr, FieldList);
    Result.ParseHeader(hdr, FieldList);
  finally
    FieldList.Free();
    hdr.Free();
  end;
end;

procedure TclHttpRequest.SetRequestSource(const Value: TStrings);
var
  stream: TStream;
begin
  stream := TMemoryStream.Create();
  try
    if (Value <> nil) then
    begin
      Value.SaveToStream(stream);
      stream.Position := 0;
    end;
    RequestStream := stream;
  finally
    stream.Free();
  end;
end;

function TclHttpRequest.AddSubmitFile(const AFileName, AFieldName: string): TclSubmitFileRequestItem;
begin
  BeginUpdate();
  try
    Result := Add(TclSubmitFileRequestItem) as TclSubmitFileRequestItem;
    Result.FileName := AFileName;
    Result.FieldName := AFieldName;
  finally
    EndUpdate();
  end;
end;

{ TclBinaryRequestItem }

function TclBinaryRequestItem.GetData: TStream;
begin
  Result := nil;
  if (Owner <> nil) then
  begin
    Owner.DoGetDataSourceStream(Self, Result);
  end;
  if (Result = nil) then
  begin
    Result := TclNullStream.Create();
  end;
  Result.Position := 0;
end;

procedure TclBinaryRequestItem.AddData(const AData: PChar; ADataSize: Integer);
var
  stream: TStream;
begin
  if (Owner = nil) then Exit;

  if (Owner.DataStream = nil) then
  begin
    stream := nil;
    Owner.DoGetDataStream(Self, stream);
    Owner.DataStream := stream;
  end;
  if (Owner.DataStream <> nil) then
  begin
    Owner.DataStream.Write(AData^, ADataSize);
  end;
end;

procedure TclBinaryRequestItem.AfterAddData;
begin
  if (Owner = nil) then Exit;

  if (Owner.DataStream <> nil) and Assigned(Owner.OnDataAdded) then
  begin
    Owner.DataStream.Position := 0;
    Owner.DoDataAdded(Self, Owner.DataStream);
  end;
end;

{ TclTextRequestItem }

procedure TclTextRequestItem.Assign(Source: TPersistent);
begin
  BeginUpdate();
  try
    if (Source is TclTextRequestItem) then
    begin
      TextData := (Source as TclTextRequestItem).TextData;
    end;
    inherited Assign(Source);
  finally
    EndUpdate();
  end;
end;

function TclTextRequestItem.GetData: TStream;
begin
  Result := TStringStream.Create(TextData);
end;

procedure TclTextRequestItem.ReadData(Reader: TReader);
begin
  BeginUpdate();
  try
    inherited ReadData(Reader);
    TextData := Reader.ReadString();
  finally
    EndUpdate();
  end;
end;

procedure TclTextRequestItem.WriteData(Writer: TWriter);
begin
  inherited WriteData(Writer);
  Writer.WriteString(TextData);
end;

procedure TclTextRequestItem.SetTextData(const Value: string);
begin
  if (FTextData <> Value) then
  begin
    FTextData := Value;
    Update();
  end;
end;

procedure TclTextRequestItem.AddData(const AData: PChar; ADataSize: Integer);
begin
  TextData := TextData + system.Copy(AData, 1, ADataSize);
end;

procedure TclTextRequestItem.AfterAddData;
var
  stream: TStream;
begin
  if (Owner = nil) then Exit;

  if Assigned(Owner.OnDataAdded) then
  begin
    stream := TStringStream.Create(TextData);
    try
      Owner.DoDataAdded(Self, stream);
    finally
      stream.Free();
    end;
  end;
end;

{ TclSubmitFileRequestItem }

procedure TclSubmitFileRequestItem.Assign(Source: TPersistent);
var
  Src: TclSubmitFileRequestItem;
begin
  BeginUpdate();
  try
    if (Source is TclSubmitFileRequestItem) then
    begin
      Src := (Source as TclSubmitFileRequestItem);
      FieldName := Src.FieldName;
      FileName := Src.FileName;
      ContentType := Src.ContentType;
    end;
    inherited Assign(Source);
  finally
    EndUpdate();
  end;
end;

constructor TclSubmitFileRequestItem.Create(AOwner: TclHttpRequest);
begin
  inherited Create(AOwner);
  FFieldName := 'FileName';
  FContentType := 'application/octet-stream';
end;

function TclSubmitFileRequestItem.GetData: TStream;
var
  stream: TStream;
begin
  if (Owner <> nil) and Owner.IsMultiPart() then
  begin
    Result := TclMultiStream.Create();
    try
      TclMultiStream(Result).AddStream(TStringStream.Create(
        Format('Content-Disposition: form-data; name="%s"; filename="%s"'#13#10
          + 'Content-Type: %s'#13#10#13#10,
        [GetCanonicalizedValue(FieldName), GetCanonicalizedValue(ExtractFileName(FileName)), ContentType])));

      stream := nil;
      Owner.DoGetDataSourceStream(Self, stream);
      if (stream = nil) then
      begin
        TclMultiStream(Result).AddStream(TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone));
      end else
      begin
        TclMultiStream(Result).AddStream(stream);
      end;
    except
      Result.Free();
      raise;
    end;
  end else
  begin
    Result := TclNullStream.Create();
  end;
end;

procedure TclSubmitFileRequestItem.ReadData(Reader: TReader);
begin
  BeginUpdate();
  try
    inherited ReadData(Reader);
    FieldName := Reader.ReadString();
    FileName := Reader.ReadString();
    ContentType := Reader.ReadString();
  finally
    EndUpdate();
  end;
end;

procedure TclSubmitFileRequestItem.WriteData(Writer: TWriter);
begin
  inherited WriteData(Writer);
  Writer.WriteString(FieldName);
  Writer.WriteString(FileName);
  Writer.WriteString(ContentType);
end;

procedure TclSubmitFileRequestItem.SetContentType(const Value: string);
begin
  if (FContentType <> Value) then
  begin
    FContentType := Value;
    Update();
  end;
end;

procedure TclSubmitFileRequestItem.SetFieldName(const Value: string);
begin
  if (FFieldName <> Value) then
  begin
    FFieldName := Value;
    Update();
  end;
end;

procedure TclSubmitFileRequestItem.SetFileName(const Value: string);
begin
  if (FFileName <> Value) then
  begin
    FFileName := Value;
    Update();
  end;
end;

procedure TclSubmitFileRequestItem.AddData(const AData: PChar; ADataSize: Integer);
var
  stream: TStream;
begin
  if (Owner = nil) then Exit;

  if (Owner.DataStream = nil) then
  begin
    stream := nil;
    Owner.DoGetDataStream(Self, stream);
    Owner.DataStream := stream;
  end;
  if (Owner.DataStream <> nil) then
  begin
    Owner.DataStream.Write(AData^, ADataSize);
  end;
end;

procedure TclSubmitFileRequestItem.AfterAddData;
begin
  if (Owner = nil) then Exit;

  if (Owner.DataStream <> nil) and Assigned(Owner.OnDataAdded) then
  begin
    Owner.DataStream.Position := 0;
    Owner.DoDataAdded(Self, Owner.DataStream);
  end;
end;

procedure TclSubmitFileRequestItem.ParseHeader(AHeader, AFieldList: TStrings);
var
  s: string;
begin
  BeginUpdate();
  try
    inherited ParseHeader(AHeader, AFieldList);

    ContentType := GetHeaderFieldValue(AHeader, AFieldList, 'Content-Type');

    s := GetHeaderFieldValue(AHeader, AFieldList, 'Content-Disposition');
    FieldName := GetHeaderFieldValueItem(s, 'name=');
  finally
    EndUpdate();
  end;
end;

{ TclFormFieldRequestItem }

function TclFormFieldRequestItem.GetData: TStream;
begin
  Result := TStringStream.Create(GetRequest());
end;

function TclFormFieldRequestItem.GetRequest(): string;
begin
  Result := '';
  if (Owner = nil) then Exit;

  if Owner.IsMultiPart() then
  begin
    Result := Format('Content-Disposition: form-data; name="%s"'#13#10#13#10'%s',
      [GetCanonicalizedValue(FieldName), GetCanonicalizedValue(FieldValue)]);
  end else
  if Owner.IsForm() then
  begin
    Result := Format('%s=%s', [GetCanonicalizedValue(FieldName), GetCanonicalizedValue(FieldValue)]);
  end;
end;

procedure TclFormFieldRequestItem.ReadData(Reader: TReader);
begin
  BeginUpdate();
  try
    inherited ReadData(Reader);
    FieldName := Reader.ReadString();
    FieldValue := Reader.ReadString();
  finally
    EndUpdate();
  end;
end;

procedure TclFormFieldRequestItem.WriteData(Writer: TWriter);
begin
  inherited WriteData(Writer);
  Writer.WriteString(FieldName);
  Writer.WriteString(FieldValue);
end;

procedure TclFormFieldRequestItem.Assign(Source: TPersistent);
var
  Src: TclFormFieldRequestItem;
begin
  BeginUpdate();
  try
    if (Source is TclFormFieldRequestItem) then
    begin
      Src := (Source as TclFormFieldRequestItem);
      FieldName :=  Src.FieldName;
      FieldValue := Src.FieldValue;
    end;
    inherited Assign(Source);
  finally
    EndUpdate();
  end;
end;

procedure TclFormFieldRequestItem.SetFieldName(const Value: string);
begin
  if (FFieldName <> Value) then
  begin
    FFieldName := Value;
    Update();
  end;
end;

procedure TclFormFieldRequestItem.SetFieldValue(const Value: string);
begin
  if (FFieldValue <> Value) then
  begin
    FFieldValue := Value;
    Update();
  end;
end;

procedure TclFormFieldRequestItem.AddData(const AData: PChar; ADataSize: Integer);
begin
  FieldValue := FieldValue + system.Copy(AData, 1, ADataSize);
end;

procedure TclFormFieldRequestItem.AfterAddData;
var
  stream: TStream;
begin
  if (Owner = nil) then Exit;

  if Assigned(Owner.OnDataAdded) then
  begin
    stream := TStringStream.Create(FieldValue);
    try
      Owner.DoDataAdded(Self, stream);
    finally
      stream.Free();
    end;
  end;
end;

initialization
  RegisterHttpRequestItem(TclBinaryRequestItem);
  RegisterHttpRequestItem(TclTextRequestItem);
  RegisterHttpRequestItem(TclSubmitFileRequestItem);
  RegisterHttpRequestItem(TclFormFieldRequestItem);

finalization
  RegisteredHttpRequestItems.Free();

end.