rtcclimodule.pas

Delphi快速开发Web Server

                SetLength(code, length(code)-length(crypt.ControlKey));
              {$ELSE}
              // There is #0 before the Control Key, data is compressed
              if Copy(code,length(code)-length(crypt.ControlKey),1)=#0 then
                begin
                Call_WrongResponse(Sender);
                Exit;
                end
              else
                SetLength(code, length(code)-length(crypt.ControlKey));
              {$ENDIF}
              end;
            end;
          end
        else if ForceEncryption and (EncryptionKey>0) then
          begin
          Call_NoEncryption(Sender);
          Exit;
          end
        else if Copy(code,length(code),1)=#0 then // compressed data
          begin
          {$IFDEF COMPRESS}
          try
            code:=ZDecompress_Str(code, length(code)-1);
          except
            on E:Exception do
              begin
              Call_WrongResponse(Sender);
              Exit;
              end;
            end;
          {$ELSE}
          Call_WrongResponse(Sender);
          Exit;
          {$ENDIF}
          end;
        end;

      idx:=0;
      at:=0;
      try
        if Code='' then
          raise Exception.Create('No data received.')
        else while at<length(Code) do
          begin
          case FDataFormat of
            fmt_XMLRPC: MyData:=TRtcValue.FromXMLrpc(code,at);
            else        MyData:=TRtcValue.FromCode(code,at);
            end;
          try
            if not isSimpleValue(MyData) then
              begin
              if assigned(FFunctions) then
                begin
                MyResult:=FFunctions.ExecuteData(Sender, MyData);
                if MyData<>MyResult then
                  begin
                  MyData.Free;
                  MyData:=MyResult;
                  end;
                end;
              end;
            if MyData<>nil then
              begin
              if idx<MyCalls.Count then
                begin
                if assigned(MyCalls.Event[idx]) then
                  begin
                  if not (MyData is TRtcValue) then
                    begin
                    MyTemp:=TRtcValue.Create;
                    MyTemp.asObject:=MyData;
                    MyData:=MyTemp;
                    end;
                  try
                    MyCalls.Event[idx].
                        Call_Return(Sender,
                                    TRtcValue(MyCalls.asObject[idx]),
                                    TRtcValue(MyData));
                  except
                    on E:EPostInteractive do
                      begin
                      PostInteractiveResult(MyCalls.Event[idx],
                                            TRtcValue(MyCalls.asObject[idx]),
                                            TRtcValue(MyData));
                      MyCalls.asObject[idx]:=nil;
                      MyData:=nil;
                      end;
                    end;
                  end;
                end
              else
                raise Exception.Create('More Results received than Calls sent.');
              end
            else
              raise Exception.Create('Response missing a result.');
            Inc(idx);
          finally
            if assigned(MyData) then
              MyData.Free;
            end;
          end;
      except
        on E:Exception do
          begin
          Response.StatusCode:=0; // Internal exception
          Response.StatusText:=E.Message;
          Call_WrongResponse(Sender);
          end;
        end;
      end;
  end;

{$IFDEF COMPRESS}
procedure TRtcClientModule.SetCompress(const Value: TRtcCompressLevel);
  begin
  FCompress := Value;
  end;
{$ENDIF}

procedure TRtcClientModule.Call_DataOut(Sender: TRtcConnection);
  begin
  // empty
  end;

procedure TRtcClientModule.Call_DataIn(Sender: TRtcConnection);
  begin
  // empty
  end;

procedure TRtcClientModule.Call_DataSent(Sender: TRtcConnection);
  begin
  // empty
  end;

procedure TRtcClientModule.Call_ReadyToSend(Sender: TRtcConnection);
  begin
  // empty
  end;

procedure TRtcClientModule.Call_ResponseData(Sender: TRtcConnection);
  begin
  if not TRtcDataClient(Sender).Request.Skipped and
     not TRtcDataClient(Sender).Response.Rejected then
    if assigned(Link) then
      Link.Call_ResponseData(Sender)
    else if assigned(Client) then
      Client.CallResponseData;
  end;

procedure TRtcClientModule.Call_ResponseDone(Sender: TRtcConnection);
  begin
  if assigned(FOnResponseDone) then
    if AutoSyncEvents then
      Sender.Sync(FOnResponseDone)
    else
      FOnResponseDone(Sender);

  if not TRtcDataClient(Sender).Request.Skipped and
     not TRtcDataClient(Sender).Response.Rejected then
    if assigned(Link) then
      Link.Call_ResponseDone(Sender)
    else if assigned(Client) then
      Client.CallResponseDone;
  end;

procedure TRtcClientModule.Call_RepostCheck(Sender: TRtcConnection);
  begin
  if ((AutoRepost<0) or (TRtcDataClient(Sender).Request.Reposted<AutoRepost)) then
    TRtcDataClient(Sender).Request.Repost;

  if not TRtcDataClient(Sender).Request.Reposting then
    begin
    if assigned(FOnRepostCheck) then
      FOnRepostCheck(Sender);

    if not TRtcDataClient(Sender).Request.Reposting then
      begin
      if assigned(Link) then
        Link.Call_RepostCheck(Sender)
      else if assigned(Client) then
        Client.CallRepostCheck;
      end;
    end;
  end;

procedure TRtcClientModule.Call_ResponseAbort(Sender: TRtcConnection);
  begin
  if IsRemoteCallRequest(Sender) then
    begin
    if assigned(FOnResponseAbort) then
      if AutoSyncEvents then
        Sender.Sync(FOnResponseAbort)
      else
        FOnResponseAbort(Sender);

    if not TRtcDataClient(Sender).Request.Reposting then
      begin
      if assigned(Link) then
        Link.Call_ResponseAbort(Sender)
      else if assigned(Client) then
        Client.CallResponseAbort;

      if not TRtcDataClient(Sender).Request.Reposting then
        if AutoSyncEvents then
          Sender.Sync(NotifyResultAborted)
        else
          NotifyResultAborted(Sender);
      end;
    end
  else
    begin
    if assigned(Link) then
      Link.Call_ResponseAbort(Sender)
    else if assigned(Client) then
      Client.CallResponseAbort;
    end;
  end;

procedure TRtcClientModule.Call_ResponseReject(Sender: TRtcConnection);
  begin
  if assigned(FOnResponseReject) then
    if AutoSyncEvents then
      Sender.Sync(FOnResponseReject)
    else
      FOnResponseReject(Sender);

  if assigned(Link) then
    Link.Call_ResponseReject(Sender)
  else if assigned(Client) then
    Client.CallResponseReject;
  end;

procedure TRtcClientModule.Call_SessionClose(Sender: TRtcConnection);
  begin
  if assigned(FOnSessionClose) then
    if AutoSyncEvents then
      Sender.Sync(FOnSessionClose)
    else
      FOnSessionClose(Sender);

  if assigned(Link) then
    Link.Call_SessionClose(Sender)
  else if assigned(Client) then
    Client.CallSessionClose;
  end;

procedure TRtcClientModule.Call_SessionOpen(Sender: TRtcConnection);
  begin
  if assigned(FOnSessionOpen) then
    if AutoSyncEvents then
      Sender.Sync(FOnSessionOpen)
    else
      FOnSessionOpen(Sender);

  if assigned(Link) then
    Link.Call_SessionOpen(Sender)
  else if assigned(Client) then
    Client.CallSessionOpen;
  end;

procedure TRtcClientModule.Call(ResultHandler: TRtcResult; FromInsideEvent:boolean=False);
  var
    idx:integer;
    myData:TRtcClientModuleData;
  begin
  myData:=CheckMyData;

  if myData=nil then
    raise Exception.Create('No data defined. Use the Data property before "Call".');
  if myData.FData=nil then
    raise Exception.Create('No data defined. Use the Data property before "Call".');
  if myData.FData.isNull then
    raise Exception.Create('No data defined. Use the Data property before "Call".');

  {if not assigned(ResultHandler) then
    raise Exception.Create('Can not use "Call" with NIL as parameter.');
  if not assigned(ResultHandler.OnReturn) then
    raise Exception.Create('OnReturn event undefined for given TRtcResult component.'); }

  with myData do
    begin
    if not assigned(FCalls) then
      FCalls:=TRtcClientModuleCallsArray.Create;

    // Add Data and ResultHandler to our list of calls
    idx:=FCalls.Count;
    FCalls.asObject[idx]:=FData;
    FCalls.Event[idx]:=ResultHandler;
    // set to NIL
    FData:=nil;

    if FPostLevel=0 then
      begin
      Inc(FPostLevel);
      Post(FromInsideEvent);
      end;
    end;
  end;

procedure TRtcClientModule.StartCalls;
  begin
  with GetMyData do
    begin
    Inc(FPostLevel);
    if assigned(FData) then FData.Clear;
    end;
  end;

procedure TRtcClientModule.ClearMyData;
  var
    id:longword;
    obj:TObject;
    cli:TRtcClientModuleData;
  begin
  if FHyperThreading then
    begin
    id:=GetCurrentThreadId;
    if id<>MainThreadID then
      begin
      FCS.Enter;
      try
        obj:=FMyData.search(id);
        if obj<>nil then
          begin
          cli:=TRtcClientModuleData(obj);
          cli.Free;
          FMyData.remove(id);
          end;
      finally
        FCS.Leave;
        end;
      end;
    end;
  end;

function TRtcClientModule.CheckMyData: TRtcClientModuleData;
  var
    id:longword;
    obj:TObject;
  begin
  if not FHyperThreading then
    Result:=FMainThrData
  else
    begin
    id:=GetCurrentThreadId;
    if id=MainThreadID then
      Result:=FMainThrData
    else
      begin
      FCS.Enter;
      try
        obj:=FMyData.search(id);
        if obj<>nil then
          Result:=TRtcClientModuleData(obj)
        else
          Result:=nil;
      finally
        FCS.Leave;
        end;
      end;
    end;
  end;

function TRtcClientModule.GetMyData: TRtcClientModuleData;
  var
    id:longword;
    obj:TObject;
  begin
  if not FHyperThreading then
    Result:=FMainThrData
  else
    begin
    id:=GetCurrentThreadId;
    if id=MainThreadID then
      Result:=FMainThrData
    else
      begin
      FCS.Enter;
      try
        obj:=FMyData.search(id);
        if obj=nil then
          begin
          obj:=TRtcClientModuleData.Create;
          FMyData.insert(id, obj);
          end;
        Result:=TRtcClientModuleData(obj);
      finally
        FCS.Leave;
        end;
      end;
    end;
  end;