rtcdatasrv.pas

Delphi快速开发Web Server

    begin
    FDataServerLinks:=TRtcDataServerLinkList.Create;
    FDataServerLinks_Owner:=True;
    end;
  FDataServerLinks.Add(Value);
  end;

procedure TRtcDataServer.RemoveDataServerLink(Value: TRtcAbsDataServerLink);
  begin
  if assigned(FDataServerLinks) then
    FDataServerLinks.Remove(Value);
  end;

procedure TRtcDataServer.RemoveAllDataServerLinks;
  var
    Link:TRtcAbsDataServerLink;
  begin
  if FDataServerLinks_Owner then
    if assigned(FDataServerLinks) then
      while FDataServerLinks.Count>0 do
        begin
        Link:=TRtcAbsDataServerLink(FDataServerLinks.Get(0));
        Link.RemoveServer(self);
        end;
  end;

procedure TRtcDataServer.SetActiveLink(Link: TRtcAbsDataServerLink);
  begin
  FActiveLink:=Link;
  end;

{ TRtcDataServer }

procedure TRtcDataServer.Accept;
  begin
  if not Request.Accepted then
    begin
    Request.Accepted:=True;

    CallRequestAccepted;
    Flush;
    end;
  end;

procedure TRtcDataServer.CallRequestAccepted;
  begin
  if assigned(FActiveLink) then
    FActiveLink.Call_RequestAccepted(self);
  if assigned(FOnRequestAccepted) then
    FOnRequestAccepted(self);
  end;

procedure TRtcDataServer.CallResponseDone;
  begin
  if assigned(FActiveLink) then
    FActiveLink.Call_ResponseDone(self);
  if assigned(FOnResponseDone) then
    FOnResponseDone(self);
  end;

procedure TRtcDataServer.CallRequestNotAccepted;
  begin
  if assigned(FOnRequestNotAccepted) then
    FOnRequestNotAccepted(self)
  else
    Disconnect;
  end;

procedure TRtcDataServer.InitSession;
  begin
  if assigned(FSession) then
    begin
    {$IFDEF FPC}
    FSession.UnLock(@CallSessionClose);
    {$ELSE}
    FSession.UnLock(CallSessionClose);
    {$ENDIF}
    FSession:=nil;
    end;
  end;

function TRtcDataServer.HaveSession(const ID: string): boolean;
  begin
  Result:=TRtcServerSession.Have(ID,PeerAddr,Request.ForwardedFor);
  end;

function TRtcDataServer.CloseSession(const ID: string): boolean;
  begin
  {$IFDEF FPC}
  Result:=TRtcServerSession.CloseID(ID,PeerAddr,Request.ForwardedFor,@CallSessionClose);
  {$ELSE}
  Result:=TRtcServerSession.CloseID(ID,PeerAddr,Request.ForwardedFor,CallSessionClose);
  {$ENDIF}
  end;

function TRtcDataServer.FindSession(const ID: string): boolean;
  begin
  InitSession;
  FSession:=TRtcServerSession.Find(ID,PeerAddr,Request.ForwardedFor);
  Result:=assigned(FSession);
  end;

procedure TRtcDataServer.OpenSession(LockType:TRtcSessionLockType);
  begin
  InitSession;
  FSession:=TRtcServerSession.Open(LockType,PeerAddr,Request.ForwardedFor);
  if assigned(FSession) then
    CallSessionOpen;
  end;

procedure TRtcDataServer.CallSessionClose(Sender: TObject);
  var
    idx:integer;
    FMyLink:TRtcAbsDataServerLink;
    FOldSess:TRtcServerSession;
  begin
  FOldSess:=FSession;
  EnterEvent;
  try
    FSession:=TRtcServerSession(Sender);

    if assigned(FDataServerLinks) then
      for idx:=0 to FDataServerLinks.Count-1 do
        begin
        FMyLink:=FDataServerLinks.GetLink(idx);
        FMyLink.Call_SessionClose(self);
        end;

    if assigned(FOnSessionClose) then
      FOnSessionClose(self);
  finally
    FSession:=FOldSess;
    LeaveEvent;
    end;
  end;

procedure TRtcDataServer.CallSessionOpen;
  var
    idx:integer;
    FMyLink:TRtcAbsDataServerLink;
  begin
  EnterEvent;
  try
    if assigned(FOnSessionOpen) then
      FOnSessionOpen(self);

    if assigned(FDataServerLinks) then
      for idx:=0 to FDataServerLinks.Count-1 do
        begin
        FMyLink:=FDataServerLinks.GetLink(idx);
        FMyLink.Call_SessionOpen(self);
        end;
  finally
    LeaveEvent;
    end;
  end;

procedure TRtcDataServer.SetRequest(const Value: TRtcServerRequest);
  begin
  FRequest := Value;
  end;

procedure TRtcDataServer.SetResponse(const Value: TRtcServerResponse);
  begin
  FResponse := Value;
  end;

procedure TRtcDataServer.CallLastWrite;
  begin
  inherited;
  InitSession;
  end;

function TRtcDataServer.TotalSessionsCount: cardinal;
  begin
  Result:=GetTotalSessCount;
  end;

function TRtcDataServer.TotalSessionsLocked: cardinal;
  begin
  Result:=GetTotalLockSessCount;
  end;

function TRtcDataServer.TotalSessionsUnlocked: cardinal;
  begin
  Result:=GetTotalUnlockSessCount;
  end;

procedure TRtcDataServer.UnLockSession;
  begin
  InitSession;
  end;

{ TRtcServerComponentList }

constructor TRtcServerComponentList.Create;
  begin
  inherited;
  FList:=TList.Create;
  end;

destructor TRtcServerComponentList.Destroy;
  begin
  FList.Free;
  inherited;
  end;

procedure TRtcServerComponentList.Add(Value: TRtcServerComponent);
  var
    idx:integer;
  begin
  idx:=FList.IndexOf(Value);
  if idx>=0 then
    FList.Delete(idx);

  idx:=0;
  while idx<FList.Count do
    if Get(idx).GetOrder>=Value.GetOrder then
      Break // insert here!
    else
      Inc(idx);

  FList.Insert(idx, Value);
  end;

function TRtcServerComponentList.Count: integer;
  begin
  Result:=FList.Count;
  end;

procedure TRtcServerComponentList.Remove(Value: TRtcServerComponent);
  var
    idx:integer;
  begin
  idx:=FList.IndexOf(Value);
  if idx>=0 then
    FList.Delete(idx);
  end;

procedure TRtcServerComponentList.RemoveAll;
  begin
  FList.Clear;
  end;

function TRtcServerComponentList.Get(index:integer): TRtcServerComponent;
  begin
  if (index>=0) and (index<FList.Count) then
    Result:=TRtcServerComponent(FList.Items[index])
  else
    Result:=nil;
  end;

{ TRtcDataServerLinkList }

function TRtcDataServerLinkList.GetLink(index:integer): TRtcAbsDataServerLink;
  begin
  if (index>=0) and (index<Count) then
    Result:=TRtcAbsDataServerLink(Get(index))
  else
    Result:=nil;
  end;

{ TRtcAbsDataServerLink }

constructor TRtcAbsDataServerLink.Create(AOwner: TComponent);
  begin
  inherited Create(AOwner);
  FServer:=nil;
  FLink:=nil;
  FOrder:=0;
  end;

destructor TRtcAbsDataServerLink.Destroy;
  begin
  Server:=nil; // remove from DataServer
  Link:=nil; // remove from parent DataServerLink
  inherited;
  end;

procedure TRtcAbsDataServerLink.SetLink(const Value: TRtcDataServerLink);
  begin
  if Value<>FLink then
    begin
    if assigned(FLink) then
      begin
      FLink.RemoveChildLink(self);
      FLink:=nil;
      end;

    if assigned(Value) then
      begin
      Server:=nil; // can not be maped to DataServer and to DataServerLink at the same time.

      // Check for circular reference before assigning!
      if Value=self then
        raise Exception.Create('Circular DataServerLink reference!');
      if Value.CheckLink(self) then
        raise Exception.Create('Circular DataServerLink reference!');
      if CheckLink(Value) then
        raise Exception.Create('Circular DataServerLink reference!');

      FLink:=Value;
      FLink.AddChildLink(self);
      end;
    end;
  end;

function TRtcAbsDataServerLink.GetLink: TRtcDataServerLink;
  begin
  Result:=FLink;
  end;

procedure TRtcAbsDataServerLink.SetServer(const Value: TRtcDataServer);
  begin
  if Value<>FServer then
    begin
    if assigned(FServer) then
      begin
      FServer.RemoveDataServerLink(self);
      FServer:=nil;
      end;

    if assigned(Value) then
      begin
      Link:=nil; // can not be linked to DataServerLink and DataServer at the same time.
      FServer:=Value;
      FServer.AddDataServerLink(self);
      end;
    end;
  end;

function TRtcAbsDataServerLink.GetServer: TRtcDataServer;
  begin
  Result:=FServer;
  end;

procedure TRtcAbsDataServerLink.SetOrder(const Value: integer);
  begin
  if Value<>FOrder then
    begin
    FOrder:=Value;
    // Update order
    if assigned(FLink) then
      FLink.AddChildLink(self)
    else if assigned(FServer) then
      FServer.AddDataServerLink(self);
    end;
  end;

function TRtcAbsDataServerLink.GetOrder: integer;
  begin
  Result:=FOrder;
  end;

procedure TRtcAbsDataServerLink.RemoveLink(Value: TRtcAbsDataServerLink);
  begin
  if Value=FLink then Link:=nil;
  end;

procedure TRtcAbsDataServerLink.RemoveServer(Value: TRtcDataServer);
  begin
  if Value=FServer then Server:=nil;
  end;

function TRtcAbsDataServerLink.CheckLink(Value: TRtcAbsDataServerLink):boolean;
  begin
  if Value=FLink then
    Result:=True
  else if assigned(FLink) then
    Result:=FLink.CheckLink(Value)
  else
    Result:=False;
  end;

{ TRtcDataServerLink }

constructor TRtcDataServerLink.Create(AOwner: TComponent);
  begin
  inherited Create(AOwner);
  FDataServerLinks:=TRtcDataServerLinkList.Create;
  end;

destructor TRtcDataServerLink.Destroy;
  begin
  RemoveAllChildLinks;
  FDataServerLinks.Free;
  FDataServerLinks:=nil;
  inherited;
  end;

procedure TRtcDataServerLink.AddChildLink(Value: TRtcAbsDataServerLink);
  begin
  FDataServerLinks.Add(Value);
  end;

procedure TRtcDataSer