rtcclimodule.pas

Delphi快速开发Web Server

      When AutoSessions is FALSE, you have to request a new session by calling
      a remote server function to generate a new session and return the session ID. }
    property AutoSessions:boolean read FAutoSessions write SetAutoSessions default false;

    { Set this property to a value other than 0 (zero) if you want the ClientModule to
      auto-repost any request up to "AutoRepost" times, in case the connection gets lost
      while sending data to server or receiving data from server.
      If value is lower than zero, requests will be reposted unlimited number of times. }
    property AutoRepost:integer read FAutoRepost write FAutoRepost default 0;

    { "Request.Host" will be assigned this property before sending the request out. @html(<br>)
      It is not necessary to set this property if your server's ServerModule component
      left its ModuleHost property blank and there's no remote Functions used by that
      ServerModule which would explicitly use the "Request.Host" header. On the other hand,
      for servers which serve multiple hosts, mostly where ServerModule has assigned its
      ModuleHost property, it is very important to set this ClientModule's ModuleHost
      property to the appropriate host name. }
    property ModuleHost:string read GetModuleHost write SetModuleHost;
    { To be able to call remote functions, this ClientModule's ModuleFileName
      property has to be identical to the "ModuleFileName" property of the ServerModule
      which you want to use. "Request.FileName" will be assigned this property before
      sending any request out, so you won't be preparing the Request headers manualy. @html(<br>)
      All data (parameters and function calls) will be passed to the server module through
      request's Content body, so that ServerModule won't need to check the request headers
      for anything else than it's FileName to know if the request is directed to it. }
    property ModuleFileName:string read GetModuleFileName write SetModuleFileName;
    { Set this property to tell the RtcClientModule to use this TRtcFunctionGroup
      component to execute all functions received as a response from server, for
      any request sent from this TRtcClientModule component. }
    property FunctionGroup:TRtcFunctionGroup read GetFunctionGroup write SetFunctionGroup;

    { This event will be called if your SecretKey does not match the SecretKey
      specified by the ServerModule you're connecting to.
      On this event, you can decide not to work with that server (Response.Reject or Disconnect),
      or to update your SecretKey property to mirror the SercetKey of your ServerModule. }
    property OnEncryptWrongKey:TRtcNotifyEvent read FOnWrongEncryption write FOnWrongEncryption;
    { This event will be called if your EncryptionKey>0 and ForceEncryption=TRUE,
      but the Server says it does not support encryption for this ServerModule.
      On this event, you can decide not to work with that server (Response.Reject or Disconnect),
      or to set your ForceEncryption property to False and repost the request. }
    property OnEncryptNotSupported:TRtcNotifyEvent read FOnNoEncryption write FOnNoEncryption;
    { This event will be called if your EncryptionKey=0,
      but the Server wants to ForceEncryption for this ServerModule.
      On this event, you can decide to not work with that server (Response.Reject or Disconnect),
      or to activate encryption by setting the EncryptionKey. }
    property OnEncryptRequired:TRtcNotifyEvent read FOnNeedEncryption write FOnNeedEncryption;

    { This event will be called if we receave invalid response from the Server,
      which could mean that our Client or our Server are not up to date. }
    property OnResponseError:TRtcNotifyEvent read FOnResponseError write FOnResponseError;
    { This event will be called if you have called a remote function with a Session ID that
      has expired. You can choose to clear the local Session object and Repost the request
      with an empty session ID to receive a new session ID, or reject the Request.
      If you do not implement this event, Session ID will be cleared and the request
      will be reposted, so your client will receive a new Session ID. }
    property OnSessionExpired:TRtcNotifyEvent read FOnSessionExpired write FOnSessionExpired;
    { This event will be called after ClientModule component has prepared the request for sending,
      but before the request has been sent out (no writing has been done yet).
      You can use this event to check or update the request object before it is sent out. @html(<br>)
      This event does not have to be defined for the ClientModule to work. }
    property OnBeginRequest:TRtcNotifyEvent read FOnBeginRequest write FOnBeginRequest;
    { This event will be called after the last DataReceived event for this request,
      read after the request has been sent out and a complete response was received (Response.Done). @html(<br>)
      This event does not have to be defined for the ClientModule to work. }
    property OnResponseDone:TRtcNotifyEvent read FOnResponseDone write FOnResponseDone;
    { This event will be called after the OnConnectLost, OnConnectFail and OnConnectError events,
      if the request was NOT marked for reposting. }
    property OnRepostCheck:TRtcNotifyEvent read FOnRepostCheck write FOnRepostCheck;
    { This event will be called after the OnRepostCheck event, if the request was not marked for reposting.
      If this event gets triggered, it means that there is a major problem with the server and
      user has to be notified about that problem and consulted about further actions. }
    property OnResponseAbort:TRtcNotifyEvent read FOnResponseAbort write FOnResponseAbort;
    { This event will be called after the response has been rejected by calling "Response.Reject" }
    property OnResponseReject:TRtcNotifyEvent read FOnResponseReject write FOnResponseReject;

    { This event will be called after a new Session has been opened. }
    property OnSessionOpen:TRtcNotifyEvent read FOnSessionOpen write FOnSessionOpen;
    { This event will be called before an existing Session is going to be closed. }
    property OnSessionClose:TRtcNotifyEvent read FOnSessionClose write FOnSessionClose;

    { This event will be mapped as @Link(TRtcClient.OnConnectLost) event
      to the assigned DataClient component and called if your connection gets
      closed while you are still processing your request. }
    property OnConnectLost:TRtcNotifyEvent read FOnConnectLost write FOnConnectLost;
    end;

{ Call this procedure if user interaction is required anywhere inside your result event.
  When this procedure is called, the event will be posted to the main thread outside of
  the client connection's context, so that the connection can continue functioning
  and receiving new data, without being blocked by a window waiting for user input.
  Without using "PostInteractive" to post the event, the connection would be blocked until
  the event returns. This could take several minutes if user doesn't notice your window,
  which would most likely result in a session timeout on the server, so the user would
  be automaticaly logged out after he responded to your questions. @html(<br><br>)

  Even though events are posted outside of the connection context, a mechanism integrated
  into TRtcClientModule will take care that all events posted interactively from the same
  ClientModule's result event, do not overlap or get called in a different order. So,
  if you need your result events to block any upcoming resuts, you can post all your
  dependent events interactively to ensure they will get called AFTER the user responded,
  while the connection continues receiving new data from the server and keeps the session alive. @html(<br><br>)

  NOTE: This procedure works only when called from inside TRtcResult event
  which was triggered by TRtcClientModule to return a result from a remote function call.
  When a function is called asynchtonously outside of the connection context,
  Sender parameter is NIL. This has two reasons: @html(<br>)
  1. You can check "Sender" to know if your event would block a connection. @html(<br>)
  2. You can not expect the connection to remain in the same state forever and you
     can not use the connection directly from an interactive event. }
procedure PostInteractive;

implementation

procedure PostInteractive;
  begin
  raise EPostInteractive.Create('');
  end;

{ TRtcClientModuleData }

constructor TRtcClientModuleData.Create;
  begin
  inherited;
  FRequest:=nil;
  FData:=nil;
  FCalls:=nil;
  FPostLevel:=0;
  end;

destructor TRtcClientModuleData.Destroy;
  begin
  if assigned(FRequest) then
    begin
    FRequest.Free;
    FRequest:=nil;
    end;
  if assigned(FData) then
    begin
    FData.Free;
    FData:=nil;
    end;
  if assigned(FCalls) then
    begin
    FCalls.Free;
    FCalls:=nil;
    end;
  inherited;
  end;

{ TRtcClientModule }

constructor TRtcClientModule.Create(AOwner: TComponent);
  begin
  inherited Create(AOwner);

  FHyperThreading:=False;

  FIntCS:=TRtcCritSec.Create;
  FIntRes:=TList.Create;
  FIntTimer:=nil;

  FRelease:=False;
  FFunctions:=nil;
  FModuleFileName:='';
  FModuleHost:='';
  FAutoRepost:=0;

  FCS:=TRtcCritSec.Create;
  FMyData:=tObjList.Create(32);
  FMainThrData:=TRtcClientModuleData.Create;
  end;

destructor TRtcClientModule.Destroy;
  begin
  FFunctions:=nil;
  FModuleFileName:='';
  FModuleHost:='';

  if assigned(FMainThrData) then
    begin
    FMainThrData.Free;
    FMainThrData:=nil;
    end;
  if assigned(FMyData) then
    begin
    FMyData.Free;
    FMyData:=nil;
    end;

  FIntRes.Free;
  FIntCS.Free;
  FCS.Free;
  inherited;
  end;

function TRtcClientModule.GetCrypt(Session:TRtcSession): TRtcCryptClient;
  begin
  Result:=TRtcCryptClient(Session.Obj[ModuleHost+ModuleFileName+':$Crypt$']);
  end;

procedure TRtcClientModule.NewCrypt(Session:TRtcSession);
  begin
  if TRtcCryptClient(Session.Obj[ModuleHost+ModuleFileName+':$Crypt$'])<>nil then
    TRtcCryptClient(Session.Obj[ModuleHost+ModuleFileName+':$Crypt$']).Init
  else
    Session.Obj[ModuleHost+ModuleFileName+':$Crypt$']:=TRtcCryptClient.Create;
  end;

procedure TRtcClientModule.DelCrypt(Session:TRtcSession);
  begin
  if TRtcCryptClient(Session.Obj[ModuleHost+ModuleFileName+':$Crypt$'])<>nil then
    begin
    TRtcCryptClient(Session.Obj[ModuleHost+ModuleFileName+':$Crypt$']).Free;
    Session.Obj[ModuleHost+ModuleFileName+':$Crypt$']:=nil;
    end;
  end;

procedure TRtcClientModule.Call_ConnectLost(Sender: TRtcConnection);
  begin
  if assigned(FOnConnectLost) then
    if AutoSyncEvents then
      Sender.Sync(FOnConnectLost)
    else
      FOnConnectLost(Sender);
  end;

function RandomKey(len:integer):string;
  var
    a:integer;
  begin
  SetLength(Result,len);
  for a:=1 to len do
    Result[a]:=Char(random(256));
  end;

procedure CryptRead(Crypt:TRtcCryptClient; var Data:string);
  begin
  if assigned(Crypt) and assigned(Crypt.Read) then
    Crypt.Read.DeCrypt(Data);
  end;

procedure CryptWrite(Crypt:TRtcCryptClient; var Data:string);
  begin
  if assigned(Crypt) and assigned(Crypt.Write) then
    Crypt.Write.Crypt(Data);
  end;

function GenerateControlKey(var Counter:integer):string;
  var
    len,a,b,c:integer;
  begin
  Inc(Counter);
  if Counter>99 then Counter:=1;

  len:=5+random(5);
  SetLength(Result,len+4);
  b:=(10-len)*9+8;
  for a:=5 to len+4 do
    begin
    c:=random(10); Inc(b,c);
    Result[a]:=Char(c+Ord('0'));
    end;
  Result[1]:=Char(b div 10 + Ord('0'));
  Result[2]:=Char(b mod 10 + Ord('0'));
  Result[3]:=Char(Counter div 10 + Ord('0'));
  Result[4]:=Char(Counter mod 10 + Ord('0'));
  end;

procedure TRtcClientModule.Call_BeginRequest(Sender: TRtcConnection);
  var
    idx:integer;
    MyCalls:TRtcClientModuleCallsArray;
    compressed:boolean;
    code,temp:string;
    output:TRtcHugeString;
    crypt:TRtcCryptClient;
    DataReq:TRtcDataRequestInfo;
    MyRequest:TRtcClientRequest;
    obj:TRtcValueObject;
  begin
  if (FDataFormat=fmt_RTC) and (EncryptionKey>0) then
    begin
    with TRtcDataClient(Sender) do
      begin
      crypt:=GetCrypt(Session);
      if (Request.Query['ACTION']='HELLO') then // Sending HELLO to the Server
        begin
        if Session.ID<>'' then
          Request.Query['ID']:=Session.ID
        else
          Request.Query['ID']:='';

        // Initialize encryption for this ClientModule
        NewCrypt(Session);
        crypt:=GetCrypt(Session);

        // Generate Client-Hello
        crypt.ClientHello:=RandomKey(EncryptionKey);

        { Generate randoml control number to add at the end of the request,
          so we can check if the response is correctly encrypted. }
        crypt.ControlKey := GenerateControlKey(crypt.ControlCounter);

        code:=crypt.ClientHello+#13+crypt.ControlKey;

        if SecureKey<>'' then
          begin
          with TRtcCrypt.Create do
            begin
            Key:=SecureKey;
            Crypt(code);
            Free;
            end;
          end;

        // Send ClientHello + ControlKey
        Write(code);
        Exit;
        end
      else if {(Session.ID='') or} (crypt=nil) or not crypt.HaveHello then
        begin
        if ModuleFileName='' then
          raise Exception.Create('Module FileName is undefined. Can not Post the request.');

        if (Request.Reposted>1) and (Session.ID<>'') then
          Session.Init;

        MyRequest:=TRtcClientRequest.Create;
        MyRequest.Method:='POST';
        MyRequest.FileName:=ModuleFileName;
        MyRequest.Query['ACTION']:='HELLO';
        if ModuleHost<>'' then
          MyRequest.Host:=ModuleHost;

        DataReq:=TRtcDataRequestInfo.Create;
        DataReq.Request:=MyRequest;
        DataReq.Events:=Self;
        try
          InsertRequest(DataReq);
        except
          DataReq.Events:=nil;
          DataReq.Free;
          end;
        Exit;
        end
      else if (Request.Query['ACTION']='START') then
        begin
        if Session.ID<>'' then
          Request.Query['ID']:=Session.ID
        else
          Request.Query['ID']:='';

        // Generate Client-Key
        crypt.ClientKey:=RandomKey(EncryptionKey);

        { Generate a random control number to add at the end of the request,
          so we can check if the response is correctly encrypted. }
        crypt.ControlKey := GenerateControlKey(crypt.ControlCounter);

        code:=crypt.ClientKey+#13+crypt.ControlKey;
        CryptWrite(crypt, code);

        // Send ClientKey + ControlKey
        Write( code );
        Exit;
        end
      else if not crypt.HaveStart then
        begin
        if ModuleFileName='' then
          raise Exception.Create('Module FileName is undefined. Can not Post the request.');

        MyRequest:=TRtcClientRequest.Create;
        MyRequest.Method:='POST';
        MyRequest.FileName:=ModuleFileName;
        MyRequest.Query['ACTION']:='START';
        if ModuleHost<>'' then MyRequest.Host:=ModuleHost;

        DataReq:=TRtcDataRequestInfo.Create;
        DataReq.Request:=MyRequest;
        DataReq.Events:=Self;
        try
          InsertRequest(DataReq);
        except
          DataReq.Events:=nil;
          DataReq.Free;
          end;
        Exit;
        end;
      end;
    end;

  with TRtcDataClient(Sender) do
    if Session.ID<>'' then