idhttpwebbrokerbridge.pas

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

    {$IFDEF CLR}
    LASCII := System.Text.ASCIIEncoding.Create;
    LASCII.GetBytes(FRequestInfo.UnparsedParams.ToCharArray(FClientCursor + 1, Result), 0, Result, Buffer, 0);
    {$ELSE}
    Move(FRequestInfo.UnparsedParams[FClientCursor + 1], Buffer, Result);
    {$ENDIF}
    Inc(FClientCursor, Result);
  end else begin
    // well, it shouldn't be less than 0. but let's not take chances
    Result := 0;
  end;
end;

function TIdHTTPAppRequest.ReadString(Count: Integer): string;
var
  LLength: Integer;
begin
  LLength := Min(Count, length(FRequestInfo.UnparsedParams)) - FClientCursor;
  if LLength > 0 then
    begin
    Result := copy(FRequestInfo.UnparsedParams, FClientCursor, LLength);
    inc(FClientCursor, LLength);
    end
  else
    Result := '';
end;

function TIdHTTPAppRequest.TranslateURI(const URI: string): string;
begin
  // we don't have the concept of a path translation. It's not quite clear
  // what to do about this. Comments welcome ([e-mail])
  Result := URI;
end;

{$IFDEF VCL6ORABOVEORCLR}
function TIdHTTPAppRequest.WriteHeaders(StatusCode: Integer; const ReasonString, Headers: string): Boolean;
begin
  FResponseInfo.ResponseNo := StatusCode;
  FResponseInfo.ResponseText := ReasonString;
  FResponseInfo.CustomHeaders.Add(Headers);
  FResponseInfo.WriteHeader;
  Result := True;
end;
{$ENDIF}

function TIdHTTPAppRequest.WriteString(const AString: string): Boolean;
begin
  FThread.Connection.IOHandler.Write(AString);
  Result := True;
end;

function TIdHTTPAppRequest.WriteClient(var ABuffer; ACount: Integer): Integer;
var
  LBuffer: TIdBytes;
begin
  SetLength(LBuffer, ACount);
{$IFNDEF CLR}
  Move(ABuffer, LBuffer[0], ACount);
{$ELSE}
  CopyTIdBytes(ToBytes(string(ABuffer)), 0, LBuffer, 0, ACount);
{$ENDIF}
  FThread.Connection.IOHandler.Write(LBuffer);
  Result := ACount;
end;

{ TIdHTTPAppResponse }

constructor TIdHTTPAppResponse.Create(AHTTPRequest: TWebRequest; AThread: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
  FThread := AThread;
  FRequestInfo := ARequestInfo;
  FResponseInfo := AResponseInfo;
  inherited Create(AHTTPRequest);
  if Length(FHTTPRequest.ProtocolVersion) = 0 then begin
    Version := '1.0'; {do not localize}
  end;
  StatusCode := 200;
  LastModified := -1;
  Expires := -1;
  Date := -1;
  ContentType := 'text/html'; {do not localize}
end;

function TIdHTTPAppResponse.GetContent: string;
begin
  Result := FResponseInfo.ContentText;
end;

function TIdHTTPAppResponse.GetLogMessage: string;
begin
  Result := '';
end;

function TIdHTTPAppResponse.GetStatusCode: Integer;
begin
  Result := FResponseInfo.ResponseNo;
end;

function TIdHTTPAppResponse.GetDateVariable(Index: Integer): TDateTime;
begin
  //TODO: resource string these
  case Index of
    INDEX_RESP_Date             : Result := FResponseInfo.Date;
    INDEX_RESP_Expires          : Result := FResponseInfo.Expires;
    INDEX_RESP_LastModified     : Result := FResponseInfo.LastModified;
  else
    raise EIdException.Create('Invalid Index ' + inttostr(Index) + ' in TIdHTTPAppResponse.GetDateVariable'); {do not localize}
  end;
end;

procedure TIdHTTPAppResponse.SetDateVariable(Index: Integer; const Value: TDateTime);
begin
  //TODO: resource string these
  case Index of
    INDEX_RESP_Date             : FResponseInfo.Date := Value;
    INDEX_RESP_Expires          : FResponseInfo.Expires := Value;
    INDEX_RESP_LastModified     : FResponseInfo.LastModified := Value;
  else
    raise EIdException.Create('Invalid Index ' + inttostr(Index) + ' in TIdHTTPAppResponse.SetDateVariable'); {do not localize}
  end;
end;

function TIdHTTPAppResponse.GetIntegerVariable(Index: Integer): Integer;
begin
  //TODO: resource string these
  case Index of
    INDEX_RESP_ContentLength: Result := FResponseInfo.ContentLength;
  else
    raise EIdException.Create('Invalid Index ' + inttostr(Index) + ' in TIdHTTPAppResponse.GetIntegerVariable');  {do not localize}
  end;
end;

procedure TIdHTTPAppResponse.SetIntegerVariable(Index, Value: Integer);
begin
  //TODO: resource string these
  case Index of
    INDEX_RESP_ContentLength: FResponseInfo.ContentLength := Value;
  else
    raise EIdException.Create('Invalid Index ' + inttostr(Index) + ' in TIdHTTPAppResponse.SetIntegerVariable');  {do not localize}
  end;
end;

function TIdHTTPAppResponse.GetStringVariable(Index: Integer): string;
begin
  //TODO: resource string these
  case Index of
    INDEX_RESP_Version           :Result := FRequestInfo.Version;
    INDEX_RESP_ReasonString      :Result := FResponseInfo.ResponseText;
    INDEX_RESP_Server            :Result := FResponseInfo.Server;
    INDEX_RESP_WWWAuthenticate   :Result := FResponseInfo.WWWAuthenticate.Text;
    INDEX_RESP_Realm             :Result := FResponseInfo.AuthRealm;
    INDEX_RESP_Allow             :Result := FResponseInfo.CustomHeaders.Values['Allow'];        {do not localize}
    INDEX_RESP_Location          :Result := FResponseInfo.Location;
    INDEX_RESP_ContentEncoding   :Result := FResponseInfo.ContentEncoding;
    INDEX_RESP_ContentType       :Result := FResponseInfo.ContentType;
    INDEX_RESP_ContentVersion    :Result := FResponseInfo.ContentVersion;
    INDEX_RESP_DerivedFrom       :Result := FResponseInfo.CustomHeaders.Values['Derived-From']; {do not localize}
    INDEX_RESP_Title             :Result := FResponseInfo.CustomHeaders.Values['Title'];        {do not localize}
  else
    raise EIdException.Create('Invalid Index ' + IntToStr(Index) +  {do not localize}
     ' in TIdHTTPAppResponse.GetStringVariable');                   {do not localize}
  end;
end;

procedure TIdHTTPAppResponse.SetStringVariable(Index: Integer; const Value: string);
begin
  //TODO: resource string these
  case Index of
    INDEX_RESP_Version           :EIdException.Create('TIdHTTPAppResponse.SetStringVariable: Cannot set the version');  {do not localize}
    INDEX_RESP_ReasonString      :FResponseInfo.ResponseText := Value;
    INDEX_RESP_Server            :FResponseInfo.Server := Value;
    INDEX_RESP_WWWAuthenticate   :FResponseInfo.WWWAuthenticate.Text := Value;
    INDEX_RESP_Realm             :FResponseInfo.AuthRealm := Value;
    INDEX_RESP_Allow             :FResponseInfo.CustomHeaders.Values['Allow'] := Value; {do not localize}
    INDEX_RESP_Location          :FResponseInfo.Location := Value;
    INDEX_RESP_ContentEncoding   :FResponseInfo.ContentEncoding := Value;
    INDEX_RESP_ContentType       :FResponseInfo.ContentType := Value;
    INDEX_RESP_ContentVersion    :FResponseInfo.ContentVersion := Value;
    INDEX_RESP_DerivedFrom       :FResponseInfo.CustomHeaders.Values['Derived-From'] := Value;  {do not localize}
    INDEX_RESP_Title             :FResponseInfo.CustomHeaders.Values['Title'] := Value; {do not localize}
  else
    raise EIdException.Create('Invalid Index ' + IntToStr(Index) +  {do not localize}
     ' in TIdHTTPAppResponse.SetStringVariable');                   {do not localize}
  end;
end;

procedure TIdHTTPAppResponse.SendRedirect(const URI: string);
begin
  FSent := True;
  MoveCookiesAndCustomHeaders;
  FResponseInfo.Redirect(URI);
end;

procedure TIdHTTPAppResponse.SendResponse;
begin
  FSent := True;
  // Reset to -1 so Indy will auto set it
  FResponseInfo.ContentLength := -1;
  MoveCookiesAndCustomHeaders;
  FResponseInfo.WriteContent;
end;

procedure TIdHTTPAppResponse.SendStream(AStream: TStream);
var
  LStream : TIdStreamVCL;
begin
  LStream := TIdStreamVCL.Create(AStream);
  try
    FThread.Connection.IOHandler.Write(LStream);
  finally
    FreeAndNil(LStream);
  end;
end;

function TIdHTTPAppResponse.Sent: Boolean;
begin
  Result := FSent;
end;

procedure TIdHTTPAppResponse.SetContent(const AValue: string);
begin
  FResponseInfo.ContentText := AValue;
  FResponseInfo.ContentLength := Length(AValue);
end;

procedure TIdHTTPAppResponse.SetLogMessage(const Value: string);
begin
  // logging not supported
end;

procedure TIdHTTPAppResponse.SetStatusCode(AValue: Integer);
begin
  FResponseInfo.ResponseNo := AValue;
end;

procedure TIdHTTPAppResponse.SetContentStream(AValue: TStream);
begin
  inherited;
  FResponseInfo.ContentStream := AValue;
end;

procedure TIdHTTPAppResponse.MoveCookiesAndCustomHeaders;
Var
  i: Integer;
begin
  for i := 0 to Cookies.Count - 1 do begin
    with FResponseInfo.Cookies.Add do begin
      CookieText := Cookies[i].HeaderValue
    end;
  end;
  FResponseInfo.CustomHeaders.Clear;
  for i := 0 to CustomHeaders.Count - 1 do begin
    FResponseInfo.CustomHeaders.Values[CustomHeaders.Names[i]] :=
      CustomHeaders.Values[CustomHeaders.Names[i]];
  end;
end;

{ TIdHTTPWebBrokerBridge }

procedure TIdHTTPWebBrokerBridge.InitComponent;
begin
  inherited;
  FOkToProcessCommand := True;
end;

procedure TIdHTTPWebBrokerBridge.DoCommandGet(AThread: TIdContext;
 ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
  LRequest: TIdHTTPAppRequest;
  LResponse: TIdHTTPAppResponse;
  LWebModule: TCustomWebDispatcher;
begin
  LRequest := TIdHTTPAppRequest.Create(AThread, ARequestInfo, AResponseInfo); try
    LResponse := TIdHTTPAppResponse.Create(LRequest, AThread, ARequestInfo, AResponseInfo); try
      // WebBroker will free it and we cannot change this behaviour
      AResponseInfo.FreeContentStream := False;
      // There are better ways in D6, but this works in D5
      LWebModule := FWebModuleClass.Create(nil) as TCustomWebDispatcher; try
        if TWebDispatcherAccess(LWebModule).DispatchAction(LRequest, LResponse) then begin
          if not LResponse.Sent then begin
            LResponse.SendResponse;
          end;
        end;
      finally FreeAndNil(LWebModule); end;
    finally FreeAndNil(LResponse); end;
  finally FreeAndNil(LRequest); end;
end;

procedure TIdHTTPWebBrokerBridge.RegisterWebModuleClass(AClass: TComponentClass);
begin
  FWebModuleClass := AClass;
end;

end.