idhttpwebbrokerbridge.pas

一个老外写的P2P例子...有点简单

    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 VCL6ORABOVE}
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
  WriteClient(PChar(AString)^, Length(AString));
  Result := True;
end;

function TIdHTTPAppRequest.WriteClient(var ABuffer; ACount: Integer): Integer;
begin
  FThread.Connection.WriteBuffer(ABuffer, ACount);
  Result := ACount;
end;

{ TIdHTTPAppResponse }

constructor TIdHTTPAppResponse.Create(AHTTPRequest: TWebRequest; AThread: TIdPeerThread; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
  FThread := AThread;
  FRequestInfo := ARequestInfo;
  FResponseInfo := AResponseInfo;
  inherited Create(AHTTPRequest);
  if Length(FHTTPRequest.ProtocolVersion) = 0 then begin
    Version := '1.0';
  end;
  StatusCode := 200;
  LastModified := -1;
  Expires := -1;
  Date := -1;
  ContentType := 'text/html';
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');
  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');
  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');
  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');
  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'];
    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'];
    INDEX_RESP_Title             :Result := FResponseInfo.CustomHeaders.Values['Title'];
  else
    raise EIdException.Create('Invalid Index ' + IntToStr(Index)
     + ' in TIdHTTPAppResponse.GetStringVariable');
  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');
    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;
    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;
    INDEX_RESP_Title             :FResponseInfo.CustomHeaders.Values['Title'] := Value;
  else
    raise EIdException.Create('Invalid Index ' + IntToStr(Index)
     + ' in TIdHTTPAppResponse.SetStringVariable');
  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);
begin
  FThread.Connection.WriteStream(AStream);
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 }

constructor TIdHTTPWebBrokerBridge.Create;
begin
  inherited;
  FOkToProcessCommand := True;
end;

procedure TIdHTTPWebBrokerBridge.DoCommandGet(AThread: TIdPeerThread;
 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.