rtchttpcli.pas

Delphi快速开发Web Server

      TMyProvider2(Con).MaxResponseSize:=MaxResponseSize;
      TMyProvider2(Con).MaxHeaderSize:=MaxHeaderSize;
      end;
    end;
  end;

procedure TRtcHttpClient.SetTriggers;
  begin
  inherited;
  if assigned(Con) then
    begin
    if Con is TMyProvider1 then
      TMyProvider1(Con).CryptPlugin:=CryptPlugin;
    {$IFDEF FPC}
      if Con is TMyProvider1 then
        TMyProvider1(Con).SetTriggerInvalidResponse(@TriggerInvalidResponse)
      else
        TMyProvider2(Con).SetTriggerInvalidResponse(@TriggerInvalidResponse);
    {$ELSE}
      if Con is TMyProvider1 then
        TMyProvider1(Con).SetTriggerInvalidResponse(TriggerInvalidResponse)
      else
        TMyProvider2(Con).SetTriggerInvalidResponse(TriggerInvalidResponse);
    {$ENDIF}
    end;
  end;

procedure TRtcHttpClient.ClearTriggers;
  begin
  inherited;
  if assigned(Con) then
    begin
    if Con is TMyProvider1 then
      begin
      TMyProvider1(Con).CryptPlugin:=nil;
      TMyProvider1(Con).SetTriggerInvalidResponse(nil);
      end
    else
      TMyProvider2(Con).SetTriggerInvalidResponse(nil);
    end;
  end;

procedure TRtcHttpClient.WriteHeader(SendNow:boolean=True);
  begin
  if assigned(Con) and (State<>conInactive) then
    begin
    if Request.Active then
      raise Exception.Create('Error! Sending multiple headers for one request.');

    Timeout.DataSending;
      if Con is TMyProvider1 then
        TMyProvider1(Con).WriteHeader(SendNow)
      else
        TMyProvider2(Con).WriteHeader(SendNow);
    end;
  end;

procedure TRtcHttpClient.WriteHeader(const HeaderText: string; SendNow:boolean=True);
  begin
  if assigned(Con) and (State<>conInactive) then
    begin
    if Request.Active then
      raise Exception.Create('Error! Sending multiple headers for one request.');

    Timeout.DataSending;
      if Con is TMyProvider1 then
        TMyProvider1(Con).WriteHeader(HeaderText, SendNow)
      else
        TMyProvider2(Con).WriteHeader(HeaderText, SendNow);
    end;
  end;

procedure TRtcHttpClient.Write(const s: string='');
  begin
  if assigned(Con) and (State<>conInactive) then
    begin
    if Request.Complete then
      raise Exception.Create('Error! Request already sent, can not send more request data now! Request Header wrong?');

    if Request.Active then
      begin
      { Header is out }

      if Request['Content-Length']<>'' then
        if Request.ContentLength - Request.ContentOut < length(s) then
          raise Exception.Create('Error! Sending more data out than specified in header.');

      { Data size is known or unimportant.
        We can just write the string out, without buffering }

      Con.Write(s);
      end
    else
      begin
      if (Request['CONTENT-LENGTH']<>'') and not FWritten then
        begin
        { Content length defined and no data buffered,
          send out header prior to sending first content bytes }
        WriteHeader(length(s)=0);
        if Request.ContentLength - Request.ContentOut < length(s) then
          raise Exception.Create('Error! Sending more data out than specified in header.');
        Con.Write(s);
        end
      else
        begin
        { Header is not out.
          Buffer all Write() operations,
          so we can determine content size and write it all out in a flush. }
        FWritten:=True;
        FWriteBuffer.Add(s);
        end;
      end;
    end;
  end;

procedure TRtcHttpClient.Flush;
  var
    Temp:string;
  begin
  if not FWritten then
    Exit
  else
    FWritten:=False; // so we don't re-enter this method.

  if assigned(Con) and (State<>conInactive) then
    begin
    Timeout.DataSending;

    if Request.Complete then
      raise Exception.Create('Error! Request was already sent! Can not send more data now! Request Header wrong?');

    if not Request.Active then
      begin
      if Request['CONTENT-LENGTH']='' then // length not specified
        begin
        Request.AutoLength:=True;
        Request.ContentLength:=FWriteBuffer.Size;
        end;

        if Con is TMyProvider1 then
          TMyProvider1(Con).WriteHeader(FWriteBuffer.Size=0)
        else
          TMyProvider2(Con).WriteHeader(FWriteBuffer.Size=0);
      end;

    if FWriteBuffer.Size>0 then
      begin
      Temp:=FWriteBuffer.Get;
      FWriteBuffer.Clear;
      Con.Write(Temp);
      Temp:='';
      end;
    end;
  end;

procedure TRtcHttpClient.CallInvalidResponse;
  begin
  if assigned(OnInvalidResponse) then
    OnInvalidResponse(self);
  end;

procedure TRtcHttpClient.TriggerDataReceived;
  begin
  inherited;
  Flush;
  end;

procedure TRtcHttpClient.TriggerDataSent;
  begin
  if FWriteCount>0 then
    Timeout.DataSent;
  EnterEvent;
  try
    if FWriteCount>0 then
      begin
      CallDataSent;
      Flush;
      end;

    if not isClosing then
      begin
      CallReadyToSend;
      Flush;
      end;
  finally
    LeaveEvent;
    end;
  end;

procedure TRtcHttpClient.TriggerDataOut;
  begin
  inherited;
  Flush;
  end;

procedure TRtcHttpClient.TriggerInvalidResponse;
  begin
  EnterEvent;
  try
    CallInvalidResponse;
    Flush;

    Disconnect;
  finally
    LeaveEvent;
    end;
  end;

procedure TRtcHttpClient.SetRequest(const Value: TRtcClientRequest);
  begin
  inherited SetRequest(Value);
  if assigned(Con) then
      if Con is TMyProvider1 then
        TMyProvider1(Con).Request:=Request
      else
        TMyProvider2(Con).Request:=Request;
  end;

procedure TRtcHttpClient.SetResponse(const Value: TRtcClientResponse);
  begin
  inherited SetResponse(Value);
  if assigned(Con) then
      if Con is TMyProvider1 then
        TMyProvider1(Con).Response:=Response
      else
        TMyProvider2(Con).Response:=Response;
  end;

function TRtcHttpClient.GetUseProxy: boolean;
  begin
  Result:=FUseProxy;
  end;

procedure TRtcHttpClient.SetUseProxy(const Value: boolean);
  begin
  if Value<>FUseProxy then
    begin
    if assigned(Con) then
      if isConnected or isConnecting then
        Error('Can not change UseProxy after Connect.')
      else
        ReleaseProvider;
    FUseProxy:=Value;
    end;
  end;

function TRtcHttpClient.GetUseSSL: boolean;
  begin
  Result:=FUseSSL;
  end;

procedure TRtcHttpClient.SetUseSSL(const Value: boolean);
  begin
  if Value<>FUseSSL then
    begin
    if assigned(Con) then
      if isConnected or isConnecting then
        Error('Can not change UseSSL after Connect.')
      else
        ReleaseProvider;
    FUseSSL:=Value;
    end;
  end;

procedure TRtcHttpClient.UserDataChange;
  begin
  if assigned(Con) then
    if isConnected or isConnecting then
      Error('Can not change UserLogin data after Connect.')
    else
      ReleaseProvider;
  end;

procedure TRtcHttpClient.LeaveEvent;
  begin
  inherited;
    if not InsideEvent then
      if assigned(Con) then
        if Con is TMyProvider2 then
          TMyProvider2(Con).LeavingEvent;
  end;

{ TRtcHttpUserLogin }

constructor TRtcHttpUserLogin.Create;
  begin

  end;

destructor TRtcHttpUserLogin.Destroy;
  begin

  inherited;
  end;

procedure TRtcHttpUserLogin.SetCertStoreType(const Value: TRtcCertStoreType);
  begin
  if Value<>FCertStoreType then
    begin
    Con.UserDataChange;
    FCertStoreType := Value;
    end;
  end;

procedure TRtcHttpUserLogin.SetCertSubject(const Value: string);
  begin
  if Value<>FCertSubject then
    begin
    Con.UserDataChange;
    FCertSubject := Value;
    end;
  end;

procedure TRtcHttpUserLogin.SetUserName(const Value: string);
  begin
  if Value<>FUserName then
    begin
    Con.UserDataChange;
    FUserName := Value;
    end;
  end;

procedure TRtcHttpUserLogin.SetUserPassword(const Value: string);
  begin
  if Value<>FUserPassword then
    begin
    Con.UserDataChange;
    FUserPassword := Value;
    end;
  end;

end.