rtcdatasrv.pas

Delphi快速开发Web Server

      to de-initialize the component before server stops listening. }
    property OnListenStop:TRtcNotifyEvent read FOnListenStop write FOnListenStop;

    { This event will be called after new session has been opened. }
    property OnSessionOpen:TRtcNotifyEvent read FOnSessionOpen write FOnSessionOpen;
    { This event will be called before existing session is about to close. }
    property OnSessionClose:TRtcNotifyEvent read FOnSessionClose write FOnSessionClose;

    { This event will be called when a new Request comes from a client and its
      headers have been read (but not content body). What this event has to do
      is to check the request information available, without reading the request
      body (!do not call 'Read' here) and decide wether it wants to process this
      request or not. If it wants to process the request, it just has to accept it
      here. The processing has to be done from other events defined for this DataProvider.
      @html(<br><br>)
      To accept the request as its own (and so be able to respond to the client),
      DataPrivder has to call "Accept" from it's 'OnCheckRequest' event handler.
      DataProvider has to be able to recognize the Request as it's own,
      simply by checking the Request property of the Sender (as TRtcDataServer),
      without reading the request body (content part).
      @html(<br><br>)

      Example of one OnCheckRequest and OnDataReceived events implementation:
      @longcode(#
        procedure TWebServer.TimeSourceCheckRequest(Sender: TRtcConnection);
          begin
          with TRtcDataServer(Sender) do
            if UpperCase(Request.FileName)='/TIME' then
              Accept; // Accept the request.
          // After accepting the request, all your other events will be mapped
          // to the connection, so you will have complete control over the
          // received data and the art of your response.
          end;
        procedure TWebServer.TimeSourceDataReceived(Sender: TRtcConnection);
          begin
          // If the request body is small or of no special interest to you,
          // You can simply respond to the request after it has been completely loaded.
          with TRtcDataServer(Sender) do
            if Request.Complete then
              Write(FormatDateTime('dddd, dd.mm.yyyy. hh:nn:ss',Now));
          end; #)
      This simple implementation is a complete implementation for a HTML page
      that shows current date and time on the server when user asks for "/TIME".
      To see what the above example does, click here: http://www.realthinclient.com/time
      @html(<br><br>)

      If your component doesn't Accept the request when it first receives
      it in its CheckRequest event, the same request will be passed to the
      next component in the list, until one component accepts the request.
      If the request was not accepted after all CheckRequest events from all
      components assigned to the Server were passed, then Server's
      OnRequestNotAccepted event will be called. If a component accepts a request,
      all furure events regarding this request will be mapped to the
      component which accepted the request.
      @html(<br><br>)

      This means that CheckRequest is the only event which will be called
      for all DataProvider components, until a component is found which
      wants to process the request (the one that Accepts the request).
      All other request-related events (all but OnListenStart and
      OnListenStop) will ONLY be called by the event handlers defined
      by the component which accepted the request. }
    property OnCheckRequest:TRtcNotifyEvent read FOnCheckRequest write FOnCheckRequest;

    { This event will be mapped as TRtcConnection.OnDataReceived event
      to the assigned Server component and called for all DataReceived
      events for the accepted request. This means that, after you
      have accepted a request from your component's CheckRequest event
      handler, all Server's OnDataReceived events will be only mapped to
      your component's OnDataReceived event. No other component, including
      the DataServer, will receive those events. }
    property OnDataReceived:TRtcNotifyEvent read FOnDataReceived write FOnDataReceived;

    { This event will be mapped as @Link(TRtcConnection.OnDataOut) event
      to the assigned Server component and called for all DataOut
      events for the accepted request. After you have accepted a request from
      your component's CheckRequest event handler, all Server's OnDataOut events
      will be mapped to your component's OnDataOut event. No other component,
      except for the DataServer, will receive those events. @html(<br><br>)

      You can use this event to count how many bytes have been written out. }
    property OnDataOut:TRtcNotifyEvent read FOnDataOut write FOnDataOut;

    { This event will be mapped as @Link(TRtcConnection.OnDataIn) event
      to the assigned Server component and called for all DataIn
      events for the accepted request. After you have accepted a request from
      your component's CheckRequest event handler, all Server's OnDataIn events
      will be mapped to your component's OnDataIn event. No other component,
      except for the DataServer, will receive those events.

      You can use this event to count how many bytes have been read in. }
    property OnDataIn:TRtcNotifyEvent read FOnDataIn write FOnDataIn;

    { This event will be mapped as @Link(TRtcConnection.OnDataSent) event
      to the assigned Server component and called for all DataSent
      events for the accepted request. This means that, after you
      have accepted a request from your component's CheckRequest event
      handler, all Server's OnDataSent events will be only mapped to
      your component's OnDataSent event. No other component, including
      the DataServer, will receive those events. }
    property OnDataSent:TRtcNotifyEvent read FOnDataSent write FOnDataSent;
    { This event will be mapped as @Link(TRtcConnection.OnReadyToSend) event
      to the assigned Server component and called for all ReadyToSend
      events for the accepted request. This means that, after you
      have accepted a request from your component's CheckRequest event
      handler, all Server's OnReadyToSend events will be only mapped to
      your component's OnReadyToSend event. No other component, including
      the DataServer, will receive those events, until you process the
      request completely. }
    property OnReadyToSend:TRtcNotifyEvent read FOnReadyToSend write FOnReadyToSend;
    { This event will be mapped as @Link(TRtcConnection.OnDisconnect) event
      to the assigned Server component and called if your connection gets
      closed while you are still processing the request you accepted.
      This means that, after you have accepted a request from your component's
      CheckRequest event handler, if connection closes before your complete result
      has been sent out to the client, your component will be the only one
      to receive this OnDisconnect event. No other component, including the
      DataServer, will receive the Disconnect event if your component did
      not finish processing the request and sending the resulting data.
      @html(<br><br>)

      If you want to react to clients connecting and disconnecting to your
      Data Server regardless of those event mappings, use the OnConnecting and
      OnDisconnecting events instead of OnConnect/OnDisconnect. }
    property OnDisconnect:TRtcNotifyEvent read FOnDisconnect write FOnDisconnect;
    end;

implementation

uses
  memStrObjList,
  SysUtils,
  rtcSyncObjs;

var
  SessCS:TRtcCritSec;
  SessExpList:tStrObjList; // Unlocked Sessions, sorted by Expiring date+time, PeerAddr & Session ID
  SessUnLockList:tStrObjList; // UnLocked Sessions, sorted by Session ID
  SessLockList:tStrObjList; // Locked Sessions, sorted by Session ID

procedure InitSessions;
  begin
  SessCS:=TRtcCritSec.Create;
  SessExpList:=tStrObjList.Create(128);
  SessUnLockList:=tStrObjList.Create(128);
  SessLockList:=tStrObjList.Create(128);
  end;

function GetTotalSessCount:cardinal;
  begin
  SessCS.Enter;
  try
    if assigned(SessUnLockList) then
      Result:=SessUnLockList.Count
    else
      Result:=0;
    if assigned(SessLockList) then
      Result:=Result+SessLockList.Count;
  finally
    SessCS.Leave;
    end;
  end;

function GetTotalLockSessCount:cardinal;
  begin
  SessCS.Enter;
  try
    if assigned(SessLockList) then
      Result:=SessLockList.Count
    else
      Result:=0;
  finally
    SessCS.Leave;
    end;
  end;

function GetTotalUnlockSessCount:cardinal;
  begin
  SessCS.Enter;
  try
    if assigned(SessUnLockList) then
      Result:=SessUnLockList.Count
    else
      Result:=0;
  finally
    SessCS.Leave;
    end;
  end;

procedure DoneSessions;
  var
    o:TObject;
    id:string;
  begin
  SessCS.Enter;
  try
    if assigned(SessUnLockList) then
      begin
      id:=SessUnLockList.search_min(o);
      while id<>'' do
        begin
        o.Free;
        SessUnLockList.remove(id);
        id:=SessUnLockList.search_min(o);
        end;
      SessUnLockList.Free;
      SessUnLockList:=nil;
      end;

    if assigned(SessLockList) then
      begin
      id:=SessLockList.search_min(o);
      while id<>'' do
        begin
        o.Free;
        SessLockList.remove(id);
        id:=SessLockList.search_min(o);
        end;
      SessLockList.Free;
      SessLockList:=nil;
      end;

    if assigned(SessExpList) then
      begin
      SessExpList.Free;
      SessExpList:=nil;
      end;
  finally
    SessCS.Leave;
    end;

  Garbage(SessCS);
  end;

{$IFDEF UseGUIDs}
function NewSessionID:string;
  var
    GUID: TGUID;
  function GuidToStr:string;
    begin
    SetLength(Result, 32);
    StrLFmt(PChar(Result), 32,'%.8x%.4x%.4x%.2x%.2x%.2x%.2x%.2x%.2x%.2x%.2x',   // do not localize
    [GUID.D1, GUID.D2, GUID.D3, GUID.D4[0], GUID.D4[1], GUID.D4[2], GUID.D4[3],
    GUID.D4[4], GUID.D4[5], GUID.D4[6], GUID.D4[7]]);
    end;
  begin
  if CoCreateGuid(GUID) = S_OK then
    Result := GUIDToStr
  else
    Result := '';
  end;
{$ELSE}
function NewSessionID(const OldID:string; const PeerAddr:string):string;
  var
    tmp:string;
  function PeerAddrToSessionID:string;
    const
      code:array[0..15] of char =
                ('a','A','b','B','c','C','d','D','e','E','f','F','g','G','h','H');
    var
      ip,loc:integer;
      myIP:byte;
      st:array[1..4] of string;
    begin
    Result:='';
    for ip:=1 to 4 do
      st[ip]:='';

    // Sort out numbers from the IP address
    ip:=1; loc:=1;
    while length(PeerAddr)>=loc do
      begin
      if PeerAddr[loc] in ['0'..'9'] then
        st[ip]:=st[ip]+PeerAddr[loc]
      else if PeerAddr[loc]='.' then
        Inc(ip);
      Inc(loc);
      end;

    // Convert IP numbers to Hex string
    for ip:=1 to 4 do
      begin
      if st[ip]<>'' then
        begin
        myIP:=StrToIntDef(st[ip],0);
        Result := Result +
                  code[myIP shr 4 and $F]+
                  code[myIP and $F];
        end
      else
        Result:=Result+code[0]+code[0];
      end;

    // Add 10 random letters/numbers
    for loc:=1 to 10 do
      begin
      ip:=random(10+26+26);
      if ip<10 then
        Result:=Result+char(Ord('0')+ip)
      else if ip<36 then
        Result:=Result+char(Ord('A')+ip-10)
      else
        Result:=Result+char(Ord('a')+ip-36)
      end;
    end;
  procedure IncID(var ID:string);
    var
      loc:integer;
      ok:boolean;
    begin
    ok:=False;
    loc:=length(ID);
    while loc>0 do
      begin
      if ID[loc]='9' then
        begin
        ID[loc]:='A';
        ok:=True;
        Break;
        end
      else if ID[loc]='Z' then
        begin
        ID[loc]:='a';
        ok:=True;
        Break;
        end
      else if ID[loc]='z' then
        ID[loc]:='0' // carry 1 forward
      else
        begin
        ID[loc]:=Char(Ord(ID[loc])+1);
        ok:=True;
        Break;
        end;
      Dec(Loc);
      end;
    if not ok then
      ID:='1'+ID;
    end;

  begin
  if OldID='' then
    Result:='1'+PeerAddrToSessionID
  else
    begin
    Result:=PeerAddrToSessionID;
    tmp:=Copy(OldID,1,length(OldID)-length(Result));
    IncID(tmp);
    Result:=tmp+Result;
    end;
  end;
{$ENDIF}

function SessionTimeToStr(v:TDateTime):String;
  var
    y,m,d,hh,mm,ss,ms:word;
    p:integer;
    str:string;
    len:word;
  begin
  Result:='00000000000000000';

  DecodeDate(v, y,m,d);
  DecodeTime(v, hh,mm,ss,ms);

  p:=1;
  str:=IntToStr(y); len:=length(str);
  Inc(p,4-len); Move(str[1],Result[p],len); Inc(p,len);

  str:=IntToStr(m); len:=length(str);
  Inc(p,2-len); Move(str[1],Result[p],len); Inc(p,len);

  str:=IntToStr(d); len:=length(str);
  Inc(p,2-len); Move(str[1],Result[p],len); Inc(p,len);

  str:=IntToStr(hh); len:=length(str);
  Inc(p,2-len); Move(str[1],Result[p],len); Inc(p,len);

  str:=IntToStr(mm); len:=length(str);
  Inc(p,2-len); Move(str[1],Result[p],len); Inc(p,len);

  str:=IntToStr(ss); len:=length(str);
  Inc(p,2-len); Move(str[1],Result[p],len); Inc(p,len);

  str:=IntToStr(ms); len:=length(str);
  Inc(p,3-len); Move(str[1],Result[p],len);
  end;

{function SessionTimeToStr(DT:TDateTime):string;
  begin
  Result:=FormatDateTime('yyyymmddhhnnss',DT);
  end;}

{ Find Session by SessionID and Lock the Session:
   - remove from UnLocked and Expiring list
   - add to Locked list }
function FindSession(const ID,PeerAddr,ForwardedFor: string):TRtcServerSession;
  var