rtcwsocksrvprov.pas

Delphi快速开发Web Server

    Error('Not connected.');

  if assigned(FCryptPlugin) then
    begin
    FCryptPlugin.DataToSend(FConnID,s,s_out);
    Inc(FPlainOut, length(s));
    if s_out<>'' then
      DirectWrite(s_out);
    end
  else if SendNow then
    DirectWrite(s)
  else
    BufferWrite(s);
  end;

procedure TRtcWSockServerProvider.DirectWrite(const s: string);
  var
    len:integer;
  begin
  if Conn is TWSocketServer then // Server will send to all connected clients
    begin
    { This implementation is for test purposes only.
      Data should be only sent to clients using the appropriate connection objects. }

    if Proto=proUDP then
      begin
      len:=Conn.SendStr(s);
      if len<0 then
        Error('Error #'+IntToStr(Conn.LastError)+': '+WSocketErrorDesc(Conn.LastError))
      else if len<length(s) then
        Error('Wanted to write '+IntToStr(length(s))+' bytes, written only '+IntToStr(len)+' bytes.');
      end;
    end
  else
    begin
    if RTC_LIMIT_CONN and assigned(Client_Thread) then
      if not rtcStartAction(Client_Thread, RTC_ACTION_WRITE) then
        begin
        if assigned(FCryptPlugin) then
          Inc(FRawOut, length(s));
        len:=Conn.BuffStr(s);
        if len<0 then
          Error('Error #'+IntToStr(Conn.LastError)+': '+WSocketErrorDesc(Conn.LastError))
        else if len<length(s) then
          Error('Wanted to write '+IntToStr(length(s))+' bytes, written only '+IntToStr(len)+' bytes.');

        PostWrite(True);
        Exit;
        end;

    if assigned(FCryptPlugin) then
      Inc(FRawOut, length(s));
    len:=Conn.SendStr(s);
    if len<0 then
      Error('Error #'+IntToStr(Conn.LastError)+': '+WSocketErrorDesc(Conn.LastError))
    else if len<>length(s) then
      Error('Wanted to write '+IntToStr(length(s))+' bytes, written only '+IntToStr(len)+' bytes.');
    end;
  end;

procedure TRtcWSockServerProvider.BufferWrite(const s: string);
  var
    len:integer;
  begin
  if assigned(FCryptPlugin) then
    Inc(FRawOut, length(s));
  len:=Conn.BuffStr(s);
  if len<0 then
    Error('Error #'+IntToStr(Conn.LastError)+': '+WSocketErrorDesc(Conn.LastError))
  else if len<>length(s) then
    Error('Wanted to write '+IntToStr(length(s))+' bytes, written only '+IntToStr(len)+' bytes.');
  end;

procedure TRtcWSockServerProvider.wsOnChangeState(Sender: TObject;
    OldState, NewState: TSocketState);
  begin
  if Closing then Exit;

  if assigned(Conn) then
    begin
    if (Sender is TWSocketServer) then
      begin
      if NewState=wsListening then
        begin
        FListenerUp:=True;
        try
          FLocalAddr:=Conn.GetXAddr;
          FLocalPort:=Conn.GetXPort;
          FPeerAddr:='';
          FPeerPort:='';
        except
          on E:Exception do
            if LOG_SOCKET_ERRORS then
              Log('ChangeState.GetXAddr',E);
          end;

        TriggerListenStart;
        TriggerReadyToRelease;
        end
      else if NewState=wsClosed then
        begin
        { This is important, so we catch the case
          where Listener gets cut off by the OS. }
        InternalDisconnect;
        end;
      end
    else
      begin
      if NewState=wsConnected then
        begin
        FLocalAddr:=Conn.GetXAddr;
        if FLocalAddr<>'0.0.0.0' then
          begin
          FLocalPort:=Conn.GetXPort;
          FPeerAddr:=Conn.GetPeerAddr;
          FPeerPort:=Conn.GetPeerPort;

          TriggerConnecting;
          end;
        end
      else if NewState=wsClosed then
        wsOnSessionClosed(Sender,0);
      end;
    end;
  end;

procedure TRtcWSockServerProvider.wsOnSessionAvailable(Sender: TObject; ErrCode:Word);
  var
    cl: TRtcWSockServerProvider;
    obj: TObject;
    _Client: TWSocketClient;
    HSock: TSocket;
  begin
  if Closing then Exit;

  HSock:=TWSocketServer(Sender).Accept;
  if HSock=INVALID_SOCKET then Exit; // not a socket

  try
    TriggerConnectionAccepting;
  except
    on E:Exception do
      begin
      if LOG_REFUSED_CONNECTIONS then
        Log('Connection refused with Message: '+E.Message);
      WSocket_closesocket(HSock);
      Exit; // connection refused.
      end;
    end;

  if Closing then
    begin
    WSocket_closesocket(HSock);
    if LOG_REFUSED_CONNECTIONS then
      Log('Connection refused: Server closing.');
    Exit; // connection refused.
    end;

  if GetMultiThreaded then
    begin
    cl:=nil;
    try
      TriggerNewProvider(obj); // create new connection provider
      if obj=nil then
        raise Exception.Create('Connection provider not created.')
      else if obj is TRtcWSockServerProvider then
        cl:=TRtcWSockServerProvider(obj)
      else
        raise Exception.Create('Wrong connection provider class created.');

      cl.FParent:=self;

      cl.Client_Thread := TRtcWSockClientThread.Create;
      with cl.Client_Thread do
        begin
        Par:=self;
        _Silent:=False;
        H_Sock:=HSock;
        HSock:=0;
        RtcConn:= cl;
        end;

    except
      on E:Exception do
        begin
        if LOG_AV_ERRORS then
          Log('SesAvail(MultiThreaded)',E);

        if assigned(cl) then
          begin
          try
            cl.InternalDisconnect;
          except
            on E:Exception do
              if LOG_SOCKET_ERRORS then
                Log('SesAvail cl.Disconnect',E);
            end;
          {try
            cl.Free;
          except
            on E:Exception do
              Log('SesAvail cl.Free',E);
            end;}
          end;

        try
          if HSock<>0 then
            WSocket_closesocket(HSock);
        except
          on E:Exception do
            if LOG_SOCKET_ERRORS then
              Log('SesAvail WSocket_close',E);
          end;

        Exit;
        end;
      end;

    AddThread(cl.Client_Thread); // make sure we remove this thread on Disconnect.
    TRtcThread.PostJob(cl.Client_Thread, Message_WSInit);
    end
  else // NOT MULTI-THREADED!
    begin
    cl:=nil;
    try
      // Create Provider object
      TriggerNewProvider(obj); // create new connection provider
      if obj=nil then
        raise Exception.Create('Connection provider not created.')
      else if obj is TRtcWSockServerProvider then
        cl:=TRtcWSockServerProvider(obj)
      else
        raise Exception.Create('Wrong connection provider class created.');

      cl.FParent:=self;
      _Client:=TWSocketClient.Create(nil);

      cl.Conn:=_Client;
      cl.CopyFrom(self); // initialize connection object
      cl.State:=conActivating;

      cl.TriggerConnectionAccepted;

      _Client.HSocket:=HSock;

      HSock:=0;
    except
      on E:Exception do
        begin
        if LOG_SOCKET_ERRORS then
          Log('SesAvail(not MultiThreaded)',E);

        if assigned(cl) then
          begin
          try
            cl.InternalDisconnect;
          except
            on E:Exception do
              if LOG_SOCKET_ERRORS then
                Log('SesAvail cl.Disconnect',E);
            end;
          try
            cl.Free;
          except
            on E:Exception do
              if LOG_AV_ERRORS then
                Log('SesAvail cl.Free',E);
            end;
          end;

        try
          if HSock<>0 then
            WSocket_closesocket(HSock);
        except
          on E:Exception do
            if LOG_SOCKET_ERRORS then
              Log('SesAvail WSock_Close',E);
          end;
        end;
      end;
    end;
  end;

procedure TRtcWSockServerProvider.wsOnSessionClosed(Sender: TObject; ErrCode:Word);
  var
    myParent:TRtcWSockServerProvider;
    myCon:TWSocket;
  begin
  { Client connection closed.

    This method is called when one of the active connections get closed.
    It handles connections closing for all active connection types
    (incomming and outgoing connections). }

  if not Silent then
    if not assigned(FParent) then
      TriggerDisconnecting
    else if not FParent.Silent then
      TriggerDisconnecting;

  if assigned(Conn) and not Closing then // Connection object still here ?
    begin
    Closing:=True; // Let everyone know we are closing now ...

    myParent:=nil;
    try
      myParent:=FParent;

      if (State in [conActive,conClosing]) and assigned(myParent) then // Connection was activated.
        begin
        myParent.RemoveClient(self);
        if not MyParent.Silent then
          begin
          if assigned(FCryptPlugin) then
            FCryptPlugin.AfterDisconnect(FConnID);

          TriggerDisconnect;
          end;
        end;

    finally
      try
        if assigned(myParent) and not myParent.Silent then
          TriggerConnectionLost;
      except
        on E:Exception do
          if LOG_EVENT_ERRORS then
            Log('Server.OnSessionClosed.TriggerConnectionLost',E);
        end;

      State:=conInactive;

      { We need to remove all events from this connection
        before we can actually destroy our own connection object. }
      with Conn do
        begin
        OnBgException:=nil;
        OnChangeState:=nil;

        OnDataReceived:=nil;
        OnDataSent:=nil;
        OnDataOut:=nil;
        OnDataIn:=nil;
        end;

      myCon:=Conn;
      Conn:=nil;

      try
        MyCon.Close;
      except
        on E:Exception do
          if LOG_SOCKET_ERRORS then
            Log('SesClosed MyCon.Close',E);
        end;
      try
        MyCon.Release;
      except
        on E:Exception do
          if LOG_AV_ERRORS then
            Log('SesClosed MyCon.Release',E);
        end;
      end;

    if not Silent then
      if assigned(Client_Thread) then
        TRtcThread.PostJob(Client_Thread, Message_WSRelease)
      else
        Free;
    end;
  end;

procedure TRtcWSockServerProvider.wsOnDataReceived(Sender: TObject; ErrCode: Word);
  var
    len:integer;
    s_out:string;
  begin
  if _Visible then
    begin
    if (State=conListening) and (Proto=proUDP) then // UDP Server
      begin
      FPeerPort:='';
      FPeerAddr:='';

      len:=Conn.GetRcvdCount;
      if len>=0 then
        begin
        SetLength(FReadBuff,len);
        len:=Conn.Receive(FReadBuff[1], length(FReadBuff));

        FPeerPort:=Conn.GetSrcPort;
        FPeerAddr:=Conn.GetSrcAddr;

        if len<0 then
          begin
          FReadBuff:='';
          TriggerDataLost;
          TriggerReadyToRelease;
          end
        else
          begin
          if len<>length(FReadBuff) then
            SetLength(FReadBuff,len);
          TriggerDataReceived;
          TriggerReadyToRelease;
          end;
        end
      else
        begin
        FReadBuff:='';
        TriggerDataLost;
        TriggerReadyToRelease;
        end;
      end
    else
      begin
      if State=conActivating then
        begin
        if FLocalAddr<>'0.0.0.0' then
          begin
          State:=conActive;
          FParent.AddClient(self);

          if assigned(FCryptPlugin) then
            begin
            s_out:='';
            FCryptPlugin.AfterConnect(FConnID,s_out);
            if s_out<>'' then
              begin
              DirectWrite(s_out);
              s_out:='';
              end;
            end;
          TriggerConnect;
          end;
        end;

      if State=conActive then
        begin
        TriggerDataReceived;
        TriggerReadyToRelease;
        end;
      end;
    end;
  end;

procedure TRtcWSockServerProvider.wsOnDataSent(Sender: TObject; ErrCode: Word);
  var
    s_out:string;
  begin
  if _Visible then
    begin
    if (State=conListening) and (Proto=proUDP) then
      begin
      TriggerDataSent;
      TriggerReadyToRelease;
      end
    else
      begin
      if State=conActivating then
        begin
        if FLocalAddr<>'0.0.0.0' then
          begin
          State:=conActive;
          FParent.AddClient(self);

          if assigned(FCryptPlugin) then
            begin
            s_out:='';
            FCryptPlugin.AfterConnect(FConnID,s_out);
            if s_out<>'' then
              begin
              DirectWrite(s_out);
              s_out:='';
              end;
            end;
          TriggerConnect;
          end;
        end;

      if State=conActive then
        begin
        TriggerDataSent;
        TriggerReadyToRelease;
        end;
      end;
    end;
  end;

procedure TRtcWSockServerProvider.wsOnBgException(Sender: TObject; E: Exception;
    var CanClose: Boolean);
  begin
  if (E is EClientLimitReached) or
     (E is EThreadLimitReached) then // ignore those exceptions
    CanClose:=False
  else
    begin
    CanClose:=True;
    try
      TriggerException(E);
    except
      on E:Exception do
        if LOG_SOCKET_ERRORS then
          Log('BgExcept Trigger',E);
      // ignore all exceptions here
      end;
    end;
  end;

function TRtcWSockServerProvider.GetParent: TRtcConnectionProvider;
  begin
  Result:=FParent;
  end;

function TRtcWSockServerProvider._Active: boolean;
  begin
  Result:=not Closing and assigned(Conn) and
         (FState in [conActive,conActivating,conListening]);
  end;

function TRtcWSockServerProvider._Visible: boolean;
  begin
  Result:=not Closing and (FState in [conActive,conActivating,conListening]) and
          ((FParent=nil) or not FParent.Silent) and assigned(Conn);
  end;

procedure TRtcWSockServerProvider.Release;
  begin
  if assigned(Client_Thread) then
    TRtcThread.PostJob(Client_Thread, Message_WSRelease)
  else if assigned(Server_Thread) then
    TRtcThread.PostJob(Server_Thread, Message_WSRelease)
  else
    inherited;
  end;

procedure TRtcWSockServerProvider.AddClient(Client: TRtcWSockServerProvider);
  begin
  Enter;
  try
    FClientList.insert(longword(Client),1);
  finally
    Leave;
    end;
  end;

procedure TRtcWSockServerProvider.RemoveClient(Client: TRtcWSockServerProvider);
  begin
  Enter;
  try
    if FClientList.search(longword(Client))>0 then
      FClientList.Remove(longword(Client));
  finally
    Leave;
    end;
  end;

procedure TRtcWSockServerProvider.AddThread(Thr: TRtcThread);
  begin
  Enter;
  try
    FThrList.insert(longword(Thr),1);
  finally
    Leave;
    end;
  end;

procedure TRtcWSockServerProvider.RemoveThread(Thr: TRtcThread);
  begin
  Enter;
  try
    if FThrList.search(longword(Thr))>0 then
      FThrList.Remove(longword(Thr));
  finally
    Leave;
    end;
  end;

{function TRtcWSockServerProvider.Client( a: integer): TRtcWSockServerProvider;
  begin
  Enter;
  try
    if (a>=0) and (a<FClientList.Count) then
      Result:=TRtcWSockServerProvider(FClientList.Items[a])
    else
      Result:=nil;
  finally
    Leave;
    end;
  end;}

function TRtcWSockServerProvider.ClientCount: integer;
  begin
  Enter;
  try
    Result:=FClientList.Count;
  finally
    Leave;
    end;
  end;

procedure TRtcWSockServerProvider.KillThreads;
  var
    Thr:TRtcWSockClientThread;
    i:longword;
  begin
  Enter;
  try
    repeat
      if FThrList.Count>0 then
        begin
        Thr:=TRtcWSockClientThread(FThrList.search_min(i));
        FThrList.Remove(longword(Thr));
        end
      else
        Thr:=nil;
      if assigned(Thr) then
        if Silent then
          TRtcThread.PostJob(Thr, Message_WSRelease_Silent, True)
        else;
          TRtcThread.PostJob(Thr, Message_WSRelease_Normal, True);
      until Thr=nil;
  finally
    Leave;
    end;
  end;

procedure TRtcWSockServerProvider.KillClients;
  var
    cl:TRtcWSockServerProvider;
    i:longword;