rtcdatasrv.pas

Delphi快速开发Web Server

    id2:string;
    o:TObject;
  begin
  if ID='' then
    Result:=nil
  else
    begin
    SessCS.Enter;
    try
      if assigned(SessUnLockList) then
        begin
        id2:=ID;
        {$IFNDEF UseGUIDs}
        // Set ID to desired length, so it will be sorted as a numeric value.
        while length(id2)<RTC_SESSIONID_LENGTH do
          id2:=' '+id2;
        {$ENDIF}

        // Find Session with Session ID
        o:=SessUnLockList.search(id2);
        if o<>nil then
          begin
          Result:=TRtcServerSession(o);

          // Check if we have the right to access this session
          if Result.DenyAccess(PeerAddr,ForwardedFor) then
            Result:=nil
          else
            begin
            // Remove from UnLocked list
            SessUnLockList.remove(id2);
            // Add to Locked list
            SessLockList.insert(id2,Result);

            // Remove from Expiring list
            SessExpList.remove(SessionTimeToStr(Result.ExpireTime)+Result.ID);
            end;
          end
        else
          Result:=nil;
        end
      else
        Result:=nil;
    finally
      SessCS.Leave;
      end;
    end;
  end;

{ Check if Session with SessionID exists }
function HaveSession(const ID,PeerAddr,ForwardedFor: string):boolean;
  var
    id2:string;
    o:TObject;
    sess:TRtcServerSession;
  begin
  if ID='' then
    Result:=false
  else
    begin
    SessCS.Enter;
    try
      if assigned(SessUnLockList) then
        begin
        id2:=ID;
        {$IFNDEF UseGUIDs}
        // Set ID to desired length, so it will be sorted as a numeric value.
        while length(id2)<RTC_SESSIONID_LENGTH do
          id2:=' '+id2;
        {$ENDIF}

        // Find Session with Session ID inside unlocked sessions list
        o:=SessUnLockList.search(id2);
        if o<>nil then
          begin
          sess:=TRtcServerSession(o);
          // Check if we have the right to access this session
          Result:=not sess.DenyAccess(PeerAddr,ForwardedFor);
          end
        else
          begin
          // Find Session with Session ID inside Locked Sessions list
          o:=SessLockList.search(id2);
          if o<>nil then
            begin
            sess:=TRtcServerSession(o);
            // Check if we have the right to access this session
            Result:=not sess.DenyAccess(PeerAddr,ForwardedFor);
            end
          else
            Result:=False;
          end;
        end
      else
        Result:=False;
    finally
      SessCS.Leave;
      end;
    end;
  end;

{ Find Session by SessionID and Close the Session }
function CloseSessionID(const ID,PeerAddr,ForwardedFor: string; _Event:TRtcSimpleEvent):boolean;
  var
    id2:string;
    o:TObject;
    sess:TRtcServerSession;
  begin
  if ID='' then
    Result:=false
  else
    begin
    SessCS.Enter;
    try
      if assigned(SessUnLockList) then
        begin
        id2:=ID;
        {$IFNDEF UseGUIDs}
        // Set ID to desired length, so it will be sorted as a numeric value.
        while length(id2)<RTC_SESSIONID_LENGTH do
          id2:=' '+id2;
        {$ENDIF}

        // Find Session with Session ID inside unlocked sessions list
        o:=SessUnLockList.search(id2);
        if o<>nil then
          begin
          sess:=TRtcServerSession(o);
          // Check if we have the right to access this session
          if sess.DenyAccess(PeerAddr,ForwardedFor) then
            Result:=False
          else
            begin
            // Remove from UnLocked list
            SessUnLockList.remove(id2);
            // Remove from Expiring list
            SessExpList.remove(SessionTimeToStr(sess.ExpireTime)+sess.ID);
            // Call SessionClose event.
            if assigned(_Event) then
              _Event(sess);
            // Free session object
            sess.Free;
            Result:=True;
            end;
          end
        else
          begin
          // Find Session with Session ID inside Locked Sessions list
          o:=SessLockList.search(id2);
          if o<>nil then
            begin
            sess:=TRtcServerSession(o);
            // Check if we have the right to access this session
            if sess.DenyAccess(PeerAddr,ForwardedFor) then
              Result:=False
            else
              begin
              sess.FinalExpire:=Now;
              Result:=True;
              end;
            end
          else
            Result:=False;
          end;
        end
      else
        Result:=False;
    finally
      SessCS.Leave;
      end;
    end;
  end;

{ TRtcDataServer }

class function TRtcDataServer.New: TRtcDataServer;
  begin
  Result:=Create(nil);
  end;

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

  FMyRequest:=TRtcServerRequest.Create;
  FMyResponse:=TRtcServerResponse.Create;

  FRequest:=FMyRequest;
  FResponse:=FMyResponse;

  FActiveLink:=nil;
  FDataServerLinks:=nil;
  FDataServerLinks_Owner:=False;
  FSession:=nil;
  end;

destructor TRtcDataServer.Destroy;
  begin
  if FDataServerLinks_Owner and assigned(FDataServerLinks) then
    begin
    RemoveAllDataServerLinks;
    FDataServerLinks_Owner:=False;
    FDataServerLinks.Free;
    FDataServerLinks:=nil;
    end;
  InitSession;
  FActiveLink:=nil;

  FMyRequest.Free; FRequest:=nil;
  FMyResponse.Free; FResponse:=nil;
  inherited;
  end;

procedure TRtcDataServer.CopyFrom(Dup: TRtcServer);
  begin
  inherited CopyFrom(Dup);

  FActiveLink:=nil;
  InitSession;

  OnRequestAccepted:=TRtcDataServer(Dup).OnRequestAccepted;
  OnRequestNotAccepted:=TRtcDataServer(Dup).OnRequestNotAccepted;
  OnResponseDone:=TRtcDataServer(Dup).OnResponseDone;
  OnSessionOpen:=TRtcDataServer(Dup).OnSessionOpen;
  OnSessionClose:=TRtcDataServer(Dup).OnSessionClose;

  if assigned(FDataServerLinks) and FDataServerLinks_Owner then
    begin
    FDataServerLinks.Free;
    FDataServerLinks:=nil;
    end;
  FDataServerLinks_Owner:=False;
  FDataServerLinks:=TRtcDataServer(Dup).FDataServerLinks;
  end;

procedure TRtcDataServer.CallListenStart;
  var
    idx:integer;
    FMyLink:TRtcAbsDataServerLink;
  begin
  inherited;
  FActiveLink:=nil;
  InitSession;
  if assigned(FDataServerLinks) then
    for idx:=0 to FDataServerLinks.Count-1 do
      begin
      FMyLink:=FDataServerLinks.GetLink(idx);
      FMyLink.Call_ListenStart(self);
      end;
  end;

procedure TRtcDataServer.CallListenStop;
  var
    idx:integer;
    FMyLink:TRtcAbsDataServerLink;
  begin
  if assigned(FDataServerLinks) then
    for idx:=0 to FDataServerLinks.Count-1 do
      begin
      FMyLink:=FDataServerLinks.GetLink(idx);
      FMyLink.Call_ListenStop(self);
      end;
  inherited;
  end;

{ DataServer.OnDataReceived event will be called only if
  there is no DataServerLink component to accept the request. }
procedure TRtcDataServer.CallDataReceived;
  var
    idx:integer;
    FMyLink:TRtcAbsDataServerLink;
  begin
  if Request.Accepted then
    begin
    if assigned(FActiveLink) then
      FActiveLink.Call_DataReceived(self)
    else
      CallRequestNotAccepted;
    Flush;
    end
  else
    begin
    FActiveLink:=nil;
    InitSession;

    if assigned(FDataServerLinks) then
      for idx:=0 to FDataServerLinks.Count-1 do
        begin
        FMyLink:=FDataServerLinks.GetLink(idx);
        FMyLink.Call_CheckRequest(self);
        if Request.Accepted or not Request.Active then
          Break;
        end;

    if Request.Active then
      if not Request.Accepted then
        begin
        InitSession;
        FActiveLink:=nil;
        CallRequestNotAccepted;
        Flush;
        end
      else if not Response.Sent then
        begin
        if assigned(FActiveLink) then
          FActiveLink.Call_DataReceived(self)
        else
          CallRequestNotAccepted;
        Flush;
        end;
    end;
  end;

{ DataServer.OnDataOut event will be called only if
  the request was not accepted by any DataServerLink component
  (DataServer is probably sending the response). }
procedure TRtcDataServer.CallDataOut;
  begin
  if assigned(FActiveLink) then
    FActiveLink.Call_DataOut(self);

  inherited;

  Flush;
  end;

{ DataServer.OnDataIn event will be called only if
  the request was not accepted by any DataServerLink component
  (DataServer is probably receiving a request). }
procedure TRtcDataServer.CallDataIn;
  begin
  if assigned(FActiveLink) then
    FActiveLink.Call_DataIn(self);

  inherited;
  end;

{ DataServer.OnDataSent event will be called only if
  the request was not accepted by any DataServerLink component
  (DataServer is probably sending the response). }
procedure TRtcDataServer.CallDataSent;
  begin
  if assigned(FActiveLink) then
    FActiveLink.Call_DataSent(self)
  else
    inherited;
  Flush;

  // Moved here from CallDataSent !!!!
  if Response.Done then
    begin
    CallResponseDone;

    Request.Accepted:=False;
    Request.Active:=False;
    FActiveLink:=nil;
    InitSession;
    end;
  end;

{ DataServer.OnReadyToSend event will be called if:
  1. DataServer.OnDataSent event was just triggered,
     which means that DataServer is processing a request, or
  2. Response just sent out for the last Request being processed. }
procedure TRtcDataServer.CallReadyToSend;
  begin
  if assigned(FActiveLink) then
    FActiveLink.Call_ReadyToSend(self)
  else
    inherited;
  Flush;
  end;

{ DataServer.OnDisconnect event will ONLY be called if
  DataServer was the one processing a request when
  conncetion got lost. This event means that data
  sent out was most likely not delivered.
  DataServer.OnDisconnect event will NOT be called
  if the request was not accepted.
  To catch all connect and disconnect events for DataServer,
  use OnClientConnect and onClientDisconnect. }
procedure TRtcDataServer.CallDisconnect;
  begin
  if Request.Accepted then
    begin
    if assigned(FActiveLink) then
      FActiveLink.Call_Disconnect(self);
    end;

  inherited; // call DataServer's OnDisconnect event

  FActiveLink:=nil;
  InitSession;
  end;

procedure TRtcDataServer.AddDataServerLink(Value: TRtcAbsDataServerLink);
  begin
  if not assigned(FDataServerLinks) then