idwebbrooker.pas

C/S方式下的HTTPS安全数据传输控件.控件在INDY9 和delphi7下编译通过.可以很好的使用

    viTitle: Result := ''; // Not implemented
    viRemoteAddr,
    viRemoteHost: Result := FIdRequest.RemoteIP;
    viScriptName: Result := ''; // GetScriptName;
    viContent: Result := FIdRequest.UnparsedParams;
    viConnection: Result := FIdRequest.Connection;
    viCookie: Result:= HeaderValue('Cookie');
    viAuthorization: Result := FIdRequest.Authentication.Authentication;
  else
    Result := '';
  end;
end;

function TIdWebRequest.ReadClient(var Buffer; Count: Integer): Integer;
begin
  Count := Max(Length(FIdRequest.UnparsedParams) - FReadClientIndex, Count);
  if Count > 0 then
  begin
    Move(FIdRequest.UnparsedParams[FReadClientIndex+1], Buffer, Count);
    Inc(FReadClientIndex, Count);
    Result := Count;
  end
  else
    Result := 0;
end;

function TIdWebRequest.ReadString(Count: Integer): string;
var
  Len: Integer;
begin
  SetLength(Result, Count);
  Len := ReadClient(Pointer(Result)^, Count);
  if Len > 0 then
    SetLength(Result, Len)
  else
    Result := '';
end;

function TIdWebRequest.TranslateURI(const URI: string): string;
begin
  Result := URI;
end;

function TIdWebRequest.WriteClient(var Buffer; Count: Integer): Integer;
var
  S: string;
begin
  Result := Count;
  try
    SetString(S, PChar(@Buffer), Count);
    FIdResponse.ContentText := S;
    FIdResponse.WriteContent;
  except
    Result := 0;
  end;
end;

type
  TIdHTTPResponseInfoCracker = class(TIdHTTPResponseInfo)
end;

function TIdWebRequest.WriteHeaders(StatusCode: Integer;
const ReasonString, Headers: string): Boolean;
begin
// Result := True;
  TIdHTTPResponseInfoCracker(FIdResponse).FHeaderHasBeenWritten := True;
  Result := WriteString(Format('HTTP/1.1 %s'#13#10'%s', [ReasonString, Headers]));
end;

function TIdWebRequest.WriteString(const AString: string): Boolean;
begin
  Result := WriteClient(Pointer(AString)^, Length(AString)) = Length(AString);
end;

{ TIdWebResponse }
constructor TIdWebResponse.Create(Request: TWebRequest;
Response: TIdHTTPResponseInfo);
begin
  inherited Create(Request);
  FIdResponse := Response;
  FIdResponse.ContentType:= 'text/xml';
end;

destructor TIdWebResponse.Destroy;
begin
  FIdResponse.ContentStream.Free;
  FIdResponse.ContentStream := nil;
  inherited;
end;

function TIdWebResponse.GetContent: string;
begin
  Result := FIdResponse.ContentText;
end;

procedure TIdWebResponse.SetContent(const Value: string);
begin
  FIdResponse.ContentText := Value;
  FIdResponse.ContentLength := Length(Value);
end;

function TIdWebResponse.GetLogMessage: string;
begin
  Result := ''; // N/A
end;

procedure TIdWebResponse.SetLogMessage(const Value: string);
begin
  // N/A
end;

function TIdWebResponse.GetStatusCode: Integer;
begin
  Result := FIdResponse.ResponseNo;
end;

procedure TIdWebResponse.SetStatusCode(Value: Integer);
begin
  FIdResponse.ResponseNo := Value;
end;

procedure TIdWebResponse.SendRedirect(const URI: string);
begin
  FIdResponse.Redirect(URI);
  SendResponse;
end;

procedure TIdWebResponse.SendResponse;
begin
  FIdResponse.WriteHeader;
  FIdResponse.WriteContent;
{
fIdResponse.FreeContentStream:= True;
ContentStream.Position:= 0;
fIdResponse.ContentStream:= TMemoryStream.Create;
fIdResponse.ContentStream.CopyFrom(ContentStream, ContentStream.Size);}
  FSent := True;
end;

procedure TIdWebResponse.SendStream(AStream: TStream);
begin
  FIdResponse.ContentStream := AStream;
  try
    FIdResponse.WriteContent;
  finally
    FIdResponse.ContentStream := nil;
  end;
end;

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

procedure TIdWebResponse.SetCookieField(Values: TStrings; const ADomain,
APath: string; AExpires: TDateTime; ASecure: Boolean);
begin

end;

const
  vjDate = 0;
  vjExpires = 1;
  vjLastModified = 2;
  vjContentLength = 0;
  vjVersion = 0;
  vjReasonString = 1;
  vjServer = 2;
  vjWWWAuthenticate = 3;
  vjRealm = 4;
  vjAllow = 5;
  vjLocation = 6;
  vjContentEncoding = 7;
  vjContentType = 8;
  vjContentVersion = 9;
  vjDerivedFrom = 10;
  vjTitle = 11;

function TIdWebResponse.GetDateVariable(Index: Integer): TDateTime;
begin
  case Index of
    vjDate: Result:= fIdResponse.Date;
    vjExpires: Result:= fIdResponse.Expires;
    vjLastModified: Result:= fIdResponse.LastModified;
  else
    Result:= 0;
  end;
end;

procedure TIdWebResponse.SetDateVariable(Index: Integer;
const Value: TDateTime);
begin
  inherited;
  case Index of
    vjDate: fIdResponse.Date:= Value;
    vjExpires: fIdResponse.Expires:= Value;
    vjLastModified: fIdResponse.LastModified:= Value;
  end;
end;

function TIdWebResponse.GetIntegerVariable(Index: Integer): Integer;
begin
  case Index of
    vjContentLength: Result:= fIdResponse.ContentLength;
  else
    Result := 0;
  end;
end;

procedure TIdWebResponse.SetIntegerVariable(Index, Value: Integer);
begin
  inherited;
  case Index of
    vjContentLength: fIdResponse.ContentLength:= Value;
  else
  end;
end;

const
  HTTPResponseNames: array[0..11] of string = (
    '',
    '',
    '',
    'WWW-Authenticate',
    '',
    'Allow',
    '',
    '',
    '',
    '',
    'Derived-From',
    'Title'
  );

function TIdWebResponse.GetStringVariable(Index: Integer): string;
begin
  Result := '';
  case Index of
    vjVersion: Result:= '1.1';
    vjReasonString: Result:= fIdResponse.ResponseText;
    vjServer: Result:= fIdResponse.ServerSoftware;
    vjRealm: Result:= fIdResponse.AuthRealm;
    vjLocation: Result:= fIdResponse.Location;
    vjContentEncoding: Result:= fIdResponse.ContentEncoding;
    vjContentType: Result:= fIdResponse.ContentType;
    vjContentVersion: Result:= fIdResponse.ContentVersion;
  else
    if Index in [Low(HTTPResponseNames)..High(HTTPResponseNames)] then
      Result:= FIdResponse.RawHeaders.Values[HTTPResponseNames[Index]];
  end;
end;

procedure TIdWebResponse.SetStringVariable(Index: Integer;
const Value: string);
begin
  case Index of
    vjVersion: ;
    vjReasonString: fIdResponse.ResponseText:= Value;
    vjServer: fIdResponse.ServerSoftware:= Value;
    vjRealm: fIdResponse.AuthRealm:= Value;
    vjLocation: fIdResponse.Location:= Value;
    vjContentEncoding: fIdResponse.ContentEncoding:= Value;
    vjContentType: fIdResponse.ContentType:= Value;
    vjContentVersion: fIdResponse.ContentVersion:= Value;
  else
    if Index in [Low(HTTPResponseNames)..High(HTTPResponseNames)] then
      FIdResponse.RawHeaders.Values[HTTPResponseNames[Index]]:= Value;
  end;
end;

procedure TIdWebResponse.SetContentStream(Value: TStream);
begin
  FIdResponse.ContentStream := Value;
  FIdResponse.ContentLength := Value.Size;
end;

{ TIdWebModule }
constructor TIdWebModule.Create(aOwner: TComponent);
begin
  inherited;
  fSOAPDispatcher:= THTTPSoapDispatcher.Create(Self);
  fSOAPInvoker:= THTTPSoapPascalInvoker.Create(Self);
  TSoapPascalInvokerProvidingInvoker.AdjustSOAPHeaders(fSOAPInvoker);
  fWSDLPublish:= TWSDLHTMLPublish.Create(Self);
  fSOAPDispatcher.Dispatcher:= fSOAPInvoker;
end;

function TIdWebModule.HandleRequest(Request: TWebRequest;
Response: TWebResponse): Boolean;
begin
  if Request is TIdWebRequest then
    fWebApplication:= TIdWebRequest(Request).FIdHttpServer.Owner as TIdWebApplication
  else
    fWebApplication:= nil;
  InitModule;
  Result:= inherited HandleRequest(Request, Response);
end;

procedure TIdWebModule.InitModule;
begin

end;

end.