rtcclimodule.pas

Delphi快速开发Web Server

function TRtcClientModule.GetData: TRtcValue;
  var
    myData:TRtcClientModuleData;
  begin
  myData:=GetMyData;
  if not assigned(myData.FData) then
    myData.FData:=TRtcValue.Create;
  Result:=myData.FData;
  end;

function TRtcClientModule.GetPostLevel: integer;
  var
    myData:TRtcClientModuleData;
  begin
  myData:=GetMyData;
  Result:=myData.FPostLevel;
  end;

function TRtcClientModule.GetRequest: TRtcClientRequest;
  var
    myData:TRtcClientModuleData;
  begin
  myData:=GetMyData;
  if not assigned(myData.FRequest) then
    myData.FRequest:=TRtcClientRequest.Create;
  Result:=myData.FRequest;
  end;

procedure TRtcClientModule.Post(FromInsideEvent:boolean=False);
  var
    DataReq:TRtcDataRequestInfo;
    myData:TRtcClientModuleData;
  begin
  myData:=CheckMyData;

  if myData=nil then
    raise Exception.Create('Have to use "StartCalls" before "Post",'#13#10+
                           'to post multiple calls in one request.');

  if myData.FPostLevel<=0 then
    raise Exception.Create('Have to use "StartCalls" before "Post",'#13#10+
                           'to post multiple calls in one request.');

  with myData do
    begin
    Dec(FPostLevel);
    if FPostLevel>0 then Exit;

    if assigned(FCalls) then
      begin
      if not assigned(FRequest) then
        FRequest:=TRtcClientRequest.Create;

      if ModuleFileName<>'' then
        FRequest.FileName:=ModuleFileName;
      if FRequest.FileName='' then
        raise Exception.Create('Module FileName is undefined. Can not Post the request.');
      if ModuleHost<>'' then
        FRequest.Host:=ModuleHost;

      FRequest.Method:='POST';

      if FDataFormat=fmt_XMLRPC then // need to send more info in header
        begin
        if FRequest.Host='' then
          FRequest.Host:=Client.ServerAddr;
        if FRequest.Agent='' then
          FRequest.Agent:='RTC Client';
        FRequest.ContentType:='text/xml';
        end;

      // Assign our Calls to the Request object, so we can access it after we post it.
      FRequest.Info.Obj['ClientModule.Call$']:=FCalls;
      FCalls:=nil;

      DataReq:=TRtcDataRequestInfo.Create;
      DataReq.Request:=FRequest;
      DataReq.Events:=Self;
      FRequest:=nil;

      try
        PostRequest(DataReq,FromInsideEvent);
      except
        DataReq.Free;
        raise;
        end;
      end;
    end;

  // Free ClientModuleData and remove it from the list
  ClearMyData;
  end;

function TRtcClientModule.GetFunctionGroup: TRtcFunctionGroup;
  begin
  try
    Result:=FFunctions;
    if not (Result is TRtcFunctionGroup) then
      Result:=nil;
  except
    Result:=nil;
    end;
  end;

procedure TRtcClientModule.SetFunctionGroup(const Value: TRtcFunctionGroup);
  begin
  FFunctions:=Value;
  end;

function TRtcClientModule.GetModuleFileName: string;
  begin
  Result:=FModuleFileName;
  end;

procedure TRtcClientModule.SetModuleFileName(const Value: string);
  begin
  if FModuleFileName<>Value then
    begin
    FModuleFileName:=Value;
    if FModuleFileName<>'' then
      begin
      // FileName has to start with '/'
      if Copy(FModuleFileName,1,1)<>'/' then
        FModuleFileName:='/'+FModuleFileName;
      end;
    end;
  end;

function TRtcClientModule.GetModuleHost: string;
  begin
  Result:=FModuleHost;
  end;

procedure TRtcClientModule.SetModuleHost(const Value: string);
  begin
  if FModuleHost<>Value then
    // Convert to uppercase now, so we don't have to do it on every request.
    FModuleHost:=UpperCase(Value);
  end;

procedure TRtcClientModule.Response_Problem(Sender: TRtcConnection);
  begin
  with TRtcDataClient(Sender) do
    begin
    if not Request.Reposting and not Response.Rejected then
      begin
      Call_RepostCheck(Sender);
      if not Request.Reposting and not Response.Rejected then
        Call_ResponseAbort(Sender);
      end;
    end;
  end;

procedure TRtcClientModule.Call_SessionExpired(Sender: TRtcConnection);
  begin
  DelCrypt(TRtcDataClient(Sender).Session);
  if assigned(FOnSessionExpired) then
    FOnSessionExpired(Sender);
  with TRtcDataClient(Sender) do
    begin
    Session.Init;
    Request.Query['ID']:='';
    if not Request.Reposting and not Response.Rejected then
      if Request.Reposted<1 then // if Session expires, we will try to repost 1 time ...
        Request.Repost
      else // ... and leave all other decisions to the user
        Response_Problem(Sender);
    end;
  end;

procedure TRtcClientModule.Call_WrongResponse(Sender: TRtcConnection);
  begin
  DelCrypt(TRtcDataClient(Sender).Session);
  if assigned(FOnResponseError) then
    FOnResponseError(Sender);
  Response_Problem(Sender);
  end;

procedure TRtcClientModule.Call_WrongEncryption(Sender: TRtcConnection);
  begin
  DelCrypt(TRtcDataClient(Sender).Session);
  if assigned(FOnWrongEncryption) then
    FOnWrongEncryption(Sender);
  Response_Problem(Sender);
  end;

procedure TRtcClientModule.Call_NoEncryption(Sender: TRtcConnection);
  begin
  DelCrypt(TRtcDataClient(Sender).Session);
  if assigned(FOnNoEncryption) then
    FOnNoEncryption(Sender);
  Response_Problem(Sender);
  end;

procedure TRtcClientModule.Call_NeedEncryption(Sender: TRtcConnection);
  begin
  DelCrypt(TRtcDataClient(Sender).Session);
  if assigned(FOnNeedEncryption) then
    FOnNeedEncryption(Sender);
  Response_Problem(Sender);
  end;

procedure TRtcClientModule.SetAutoEncrypt(const Value: integer);
  begin
  if Value<0 then
    raise Exception.Create('Negative values not allowed for EncryptionKey.');
  FAutoEncrypt := Value;
  if FAutoEncrypt > 0 then
    FAutoSessions:=True
  else
    FForceEncrypt:=False;
  end;

procedure TRtcClientModule.SetAutoSessions(const Value: boolean);
  begin
  FAutoSessions := Value;
  if not FAutoSessions then
    begin
    FAutoEncrypt:=0;
    FForceEncrypt:=False;
    end;
  end;

procedure TRtcClientModule.SetForceEncrypt(const Value: boolean);
  begin
  FForceEncrypt := Value;
  if FForceEncrypt then
    begin
    FAutoSessions:=True;
    if FAutoEncrypt=0 then
      FAutoEncrypt:=16;
    end;
  end;

procedure TRtcClientModule.PostInteractiveResult(Event: TRtcResult; Data, Result: TRtcValue);
  var
    res:TRtcInteractiveResult;
  begin
  FIntCS.Enter;
  try
    res:=TRtcInteractiveResult.Create;
    res.FEvent:=Event;
    res.Data:=Data;
    res.Result:=Result;

    FIntRes.Add(res);

    if not assigned(FIntTimer) then
      begin
      FIntTimer:=TRtcTimer.Create(False);
      {$IFDEF FPC}
      TRtcTimer.Enable(FIntTimer,1,@DoInteractiveResult,True);
      {$ELSE}
      TRtcTimer.Enable(FIntTimer,1,DoInteractiveResult,True);
      {$ENDIF}
      end;
  finally
    FIntCS.Leave;
    end;
  end;

procedure TRtcClientModule.DoInteractiveResult;
  var
    res:TRtcInteractiveResult;
  begin
  FIntCS.Enter;
  try
    res:=TRtcInteractiveResult(FIntRes.Items[0]);
    FIntRes.Delete(0);
  finally
    FIntCS.Leave;
    end;

  try
    res.FEvent.Call_Return(nil, res.Data, res.Result);
  finally
    res.Free;

    FIntCS.Enter;
    try
      if FIntRes.Count>0 then
      {$IFDEF FPC}
        TRtcTimer.Enable(FIntTimer,1,@DoInteractiveResult,True)
      {$ELSE}
        TRtcTimer.Enable(FIntTimer,1,DoInteractiveResult,True)
      {$ENDIF}
      else
        begin
        TRtcTimer.Stop(FIntTimer);
        FIntTimer:=nil;
        end;
    finally
      FIntCS.Leave;
      end;
    end;
  if FRelease then
    Free;
  end;

procedure TRtcClientModule.Release;
  begin
  FRelease:=True;
  end;

procedure TRtcClientModule.NotifyResultAborted(Sender: TRtcConnection);
  var
    MyCalls:TRtcClientModuleCallsArray;
    event:TRtcResult;
    data:TRtcValue;
    a:integer;
  begin
  MyCalls:=TRtcClientModuleCallsArray(TRtcDataClient(Sender).Request.Info.Obj['ClientModule.Call$']);
  if assigned(MyCalls) then
    begin
    for a:=0 to MyCalls.Count-1 do
      begin
      event:=MyCalls.Event[a];
      if assigned(event) then
        begin
        data:=TRtcValue(MyCalls.AsObject[a]);
        event.Call_Aborted(Sender,data,nil);
        end;
      end;
    end;
  end;

function TRtcClientModule.IsRemoteCallRequest(Sender:TRtcConnection): boolean;
  begin
  Result:= assigned(TRtcClientModuleCallsArray(TRtcDataClient(Sender).Request.Info.Obj['ClientModule.Call$']));
  end;

procedure TRtcClientModule.SetDataFormat(const Value: TRtcDataFormat);
  begin
  FDataFormat := Value;
  end;

{ TRtcInteractiveResult }

destructor TRtcInteractiveResult.Destroy;
  begin
  Data.Free;
  Result.Free;
  inherited;
  end;

{ TRtcClientModuleCallsArray }

constructor TRtcClientModuleCallsArray.Create;
  begin
  inherited;
  SetLength(FEvents,0);
  end;

destructor TRtcClientModuleCallsArray.Destroy;
  begin
  SetLength(FEvents,0);
  inherited;
  end;

function TRtcClientModuleCallsArray.GetEvent(index: integer): TRtcResult;
  begin
  if (index>=0) and (index<=length(FEvents)) then
    Result:=FEvents[index]
  else
    Result:=nil;
  end;

procedure TRtcClientModuleCallsArray.SetEvent(index: integer; const _Value: TRtcResult);
  begin
  if length(FEvents)<index+1 then
    SetLength(FEvents, index+1);
  FEvents[index]:=_Value;
  end;

{ TRtcCryptClient }

destructor TRtcCryptClient.Destroy;
  begin
  Init;
  inherited;
  end;

procedure TRtcCryptClient.Kill;
  begin
  Free;
  end;

procedure TRtcCryptClient.Init;
  begin
  HaveHello:=False;
  H