rtcwsocksrvprov.pas

Delphi快速开发Web Server

  begin
  Enter;
  try
    repeat
      if FClientList.Count>0 then
        begin
        cl:=TRtcWSockServerProvider(FClientList.search_min(i));
        FClientList.Remove(longword(cl));
        end
      else
        cl:=nil;
      if assigned(cl) then
        try
          if assigned(cl.Client_Thread) then
            begin
            if Silent then
              TRtcThread.PostJob(cl.Client_Thread, Message_WSRelease_Silent, True)
            else;
              TRtcThread.PostJob(cl.Client_Thread, Message_WSRelease_Normal, True);
            end
          else
            begin
            cl.Silent:=Silent;
            cl.InternalDisconnect;
            end;
        except
          on E:Exception do
            if LOG_AV_ERRORS then
              Log('KillClients cl.Stop/Disconnect',E);
          end;
      until cl=nil;
  finally
    Leave;
    end;
  end;

procedure TRtcWSockServerProvider.Check;
  var
    addr:string;
  begin
  if assigned(Conn) then
    begin
    addr:=Conn.GetXAddr;
    if addr='0.0.0.0' then
      begin
      if LOG_SOCKET_ERRORS then
        Log('CLOSING from Check. Socket not connected to local address.');
      Conn.Close;
      raise EWinSockException.Create('Socket not connected to local address.');
      end;
    addr:=Conn.GetPeerAddr;
    if addr='0.0.0.0' then
      begin
      if LOG_SOCKET_ERRORS then
        Log('CLOSING from Check. Socket not connected to peer address.');
      Conn.Close;
      raise EWinSockException.Create('Socket not connected to peer address.');
      end;
    end;
  end;

function TRtcWSockServerProvider.GetClientThread: TRtcThread;
  begin
  Result:=Client_Thread;
  end;

function TRtcWSockServerProvider.GetServerThread: TRtcThread;
  begin
  Result:=Server_Thread;
  end;

procedure TRtcWSockServerProvider.StartListener;
  var
    MyCon:TWSocketServer;
    MyPort:string;
  begin
  if (State=conListening) or (State=conActivating) then
    Exit; // already listening !!!

  if State<>conInactive then
    raise Exception.Create('Can not start listener again. Connection in use.');

  if assigned(Conn) then
    Error('Can not start listener. Connection in use.');

  try
    if Proto=proUDP then
      FReadBuff:='';

    FListenerUp:=False;
    Closing:=False;
    Silent:=False;
    Lost:=True;

    MyPort:=Trim(GetPort);
    if length(MyPort)=0 then
      Error('Port undefined.');

    State:=conActivating;
    try
      if assigned(Server_Thread) then
        begin
        Conn:=TRtcWSocketServer.Create(nil);
        TRtcWSocketServer(Conn).Thr:=Server_Thread;
        end
      else
        Conn:=TWSocketServer.Create(nil);

      with Conn as TWSocketServer do
        begin
        case Proto of
          proTCP:Protocol:=spTcp;
          proUDP:
            begin
            Protocol:=spUdp;
            UdpMultiCast:=Self.UdpMultiCast;
            UdpMultiCastAddrStr:=Self.UdpMultiCastAddr;
            UdpReuseAddr:=Self.UdpReuseAddr;

            {$IFDEF FPC}
            OnDataReceived:=@wsOnDataReceived;
            OnDataSent:=@wsOnDataSent;
            OnDataOut:=@wsOnDataOut;
            OnDataIn:=@wsOnDataIn;
            {$ELSE}
            OnDataReceived:=wsOnDataReceived;
            OnDataSent:=wsOnDataSent;
            OnDataOut:=wsOnDataOut;
            OnDataIn:=wsOnDataIn;
            {$ENDIF}
            end;
          end;

        if self.GetAddr='' then
          Addr:='0.0.0.0'
        else
          Addr:=self.GetAddr;

        MultiThreaded:=assigned(Server_Thread);

        Port:=MyPort;

        {$IFDEF FPC}
        OnBgException:=@wsOnBgException;
        OnChangeState:=@wsOnChangeState;
        OnSessionAvailable:=@wsOnSessionAvailable;
        {$ELSE}
        OnBgException:=wsOnBgException;
        OnChangeState:=wsOnChangeState;
        OnSessionAvailable:=wsOnSessionAvailable;
        {$ENDIF}
        end;

      State:=conListening;

      Conn.Listen;

    except
      on E:Exception do
        begin
        State:=conInactive;
        try
          if assigned(Conn) then
            begin
            MyCon:=Conn as TWSocketServer;
            Conn:=nil;

            with MyCon do
              begin
              OnBgException:=nil;
              OnChangeState:=nil;
              end;

            MyCon.Free;
            end;
        except
          on E:Exception do
            if LOG_AV_ERRORS then
              Log('Listen.except For',E);
          end;
        raise;
        end;
      end;

  except
    on E:EClientLimitReached do // connection limit reached
      begin
      TriggerListenError(E);
      TriggerReadyToRelease;
      end;
    on E:EThreadLimitReached do // connection limit reached
      begin
      TriggerListenError(E);
      TriggerReadyToRelease;
      end;
    on E:EWinSockException do // any kind of socket error
      begin
      TriggerListenError(E);
      TriggerReadyToRelease;
      end;
    on E:Exception do
      begin
      TriggerReadyToRelease;
      raise;
      end;
    end;
  end;

function TRtcWSockServerProvider.PostWrite(HighPriority:boolean=False):boolean;
  begin
  if assigned(Client_Thread) then
    begin
    TRtcThread.PostJob(Client_Thread,Message_WSWrite,HighPriority);
    Result:=True;
    end
  else
    Result:=False;
  end;

function TRtcWSockServerProvider.PostRead(HighPriority:boolean=False):boolean;
  begin
  if assigned(Client_Thread) then
    begin
    TRtcThread.PostJob(Client_Thread,Message_WSRead,HighPriority);
    Result:=True;
    end
  else
    Result:=False;
  end;

constructor TRtcWSockClientThread.Create;
  begin
  inherited;
  _Silent:=False;
  RtcConn:=nil;
  Par:=nil;
  end;

destructor TRtcWSockClientThread.Destroy;
  begin
  if RTC_LIMIT_CONN then
    rtcCloseAction(self);

  if assigned(Par) then
    Par.RemoveThread(self);

  if assigned(RtcConn) then
    try
      if _Silent then
        begin
        RtcConn.Closing:=True;
        RtcConn.Silent:=True;
        RtcConn.FParent:=nil;
        end
      else
        RtcConn.InternalDisconnect;
      RtcConn.Free;
    except
      on E:Exception do
        if LOG_SOCKET_ERRORS then
          Log('CliThread.Destroy RtcConn.Free',E);
    end;

  try
    if H_Sock<>0 then
      WSocket_closesocket(H_Sock);
  except
    on E:Exception do
      if LOG_SOCKET_ERRORS then
        Log('CliThread.Destroy WSock_Close',E);
    end;

  inherited;
  end;

procedure TRtcWSockClientThread.Init;
  begin
  with RtcConn do
    begin
    Conn := TRtcWSocketClient.Create(nil);
    TRtcWSocketClient(Conn).Thr:=self;
    Conn.MultiThreaded:=True;

    CopyFrom(Par); // initialize connection object
    State:=conActivating;
    Conn.HSocket := H_Sock;
    H_Sock := 0;

    TriggerConnectionAccepted; // if we are over connection limit, EConnectionLimitReached exception will be triggered.
    end;
  end;

function TRtcWSockClientThread.Work(Job: TObject):boolean;
  begin
  Result:=False;
  try
    if Job=Message_WSRead then
      begin
      if not assigned(RtcConn) or
         not assigned(RtcConn.Conn) then Exit;

      if RTC_LIMIT_CONN and not rtcStartAction(self, RTC_ACTION_READ) then
        TRtcThread.PostJob(self,Job,True)
      else
        RtcConn.Conn.Do_FD_READ;
      end
    else if Job=Message_WSWrite then
      begin
      if not assigned(RtcConn) or
         not assigned(RtcConn.Conn) then Exit;

      if RTC_LIMIT_CONN then
        if not RtcConn.Conn.AllSent then // data waiting to be sent
          begin
          if not rtcStartAction(self, RTC_ACTION_WRITE) then
            begin
            TRtcThread.PostJob(self,Job,True);
            Exit;
            end;
          end
        else
          rtcCloseAction(self);

      RtcConn.Conn.Do_FD_WRITE;
      end
    else if Job=Message_WSClose then
      begin
      if not assigned(RtcConn) or
         not assigned(RtcConn.Conn) then Exit;

      if RTC_LIMIT_CONN then
        rtcCloseAction(self);

      RtcConn.Conn.Do_FD_CLOSE(1);
      end
    else if Job=Message_WSInit then
      begin
      if RTC_LIMIT_CONN and not rtcStartAction(self, RTC_ACTION_ACCEPT) then
        TRtcThread.PostJob(self,Job,True)
      else
        Init;
      end
    else if Job=Message_WSRelease_Silent then
      begin
      Par:=nil;
      _Silent:=True;
      Result:=True;

      Free;
      end
    else if Job=Message_WSRelease_Normal then
      begin
      Par:=nil;
      _Silent:=False;
      Result:=True;

      Free;
      end
    else if Job=Message_WSRelease then
      begin
      Result:=True;

      Free;
      end
    else if Job=Message_WSStop then
      begin
      Par:=nil;
      RtcConn:=nil;
      Result:=True;

      Free;
      end
    else if Job is TRtcCloseMessage then
      begin
      try
        if not assigned(RtcConn) or
           not assigned(RtcConn.Conn) then Exit;

        if RTC_LIMIT_CONN then
          rtcCloseAction(self);

        RtcConn.Conn.Do_FD_CLOSE(TRtcCloseMessage(Job).Error);
      finally
        Job.Free;
        end;
      end
    else
      Result:=inherited Work(Job);
  except
    on E:Exception do
      begin
      if LOG_AV_ERRORS then
        Log('ClientThread.Work',E);
      raise;
      end;
    end;
  end;

procedure TRtcWSockClientThread.Kill(Job: TObject);
  begin
  if Job is TRtcCloseMessage then
    Job.Free
  else
    inherited Kill(Job);
  end;

{ TRtcWSocketClient }

procedure TRtcWSocketClient.Call_FD_READ;
  begin
  try
    TRtcThread.PostJob(Thr,Message_WSRead);
  except
    on E:Exception do
      if LOG_AV_ERRORS then
        Log('Client.Call_FD_READ',E);
    end;
  end;

procedure TRtcWSocketClient.Call_FD_WRITE;
  begin
  try
    TRtcThread.PostJob(Thr,Message_WSWrite);
  except
    on E:Exception do
      if LOG_AV_ERRORS then
        Log('Client.Call_FD_WRITE',E);
    end;
  end;

procedure TRtcWSocketClient.Call_FD_CLOSE(Err: word);
  var
    cjob:TObject;
  begin
  try
    if Err=0 then
      TRtcThread.PostJob(Thr,Message_WSClose,True,True)
    else
      begin
      cjob:=TRtcCloseMessage.Create(Err);
      if not TRtcThread.PostJob(Thr,cjob,True,True) then
        cjob.Free;
      end;
  except
    on E:Exception do
      if LOG_AV_ERRORS then
        Log('Client.Call_FD_CLOSE',E);
    end;
  end;

{ TRtcInfoMessage }

constructor TRtcInfoMessage.Create(Value: word);
  begin
  inherited Create;
  Error:=Value;
  end;

{ TRtcWSockServerThread }

constructor TRtcWSockServerThread.Create;
  begin
  inherited;
  Releasing:=False;
  RtcConn:=nil;
  end;

destructor TRtcWSockServerThread.Destroy;
  begin
  if assigned(RtcConn) then
    begin
    try
      StopListen;
      if Releasing then
        RtcConn.Free
      else if assigned(RtcConn.Server_Thread) then
        RtcConn.Server_Thread:=nil;
    except
      on E:Exception do
        if LOG_AV_ERRORS then
          Log('WSockServerThread.Destroy',E);
        // ignore exceptions
      end;
    RtcConn:=nil;
    end;
  inherited;
  end;

procedure TRtcWSockServerThread.StartListen;
  begin
  RtcConn.StartListener;
  end;

procedure TRtcWSockServerThread.StopListen;
  begin
  if assigned(RtcConn) then
    begin
    try
      RtcConn.Lost:=False;
      RtcConn.InternalDisconnect;
    except
      on E:Exception do
        if LOG_SOCKET_ERRORS then
          Log('WSockServerThread.StopListen : RtConn.InternalDisconnect',E);
        // ignore exceptions
      end;
    end;
  end;

function TRtcWSockServerThread.Work(Job: TObject):boolean;
  begin
  Result:=False;
  try
    if Job=Message_WSRead then
      begin
      if not assigned(RtcConn) or
         not assigned(RtcConn.Conn) then Exit;

      RtcConn.Conn.Do_FD_READ;
      end
    else if Job=Message_WSWrite then
      begin
      if not assigned(RtcConn) or
         not assigned(RtcConn.Conn) then Exit;

      RtcConn.Conn.Do_FD_WRITE;
      end
    else if Job=Message_WSAccept then
      begin
      if not assigned(RtcConn) or
         not assigned(RtcConn.Conn) then Exit;

      RtcConn.Conn.Do_FD_ACCEPT;
      end
    else if Job=Message_WSInit then
      StartListen
    else if Job=Message_WSCloseConn then
      StopListen
    else if Job=Message_WSRelease then
      begin
      Releasing:=True;
      Result:=True;

      Free;
      end
    else if Job=Message_WSStop then
      begin
      RtcConn:=nil;
      Result:=True;

      Free;
      end
    else
      Result:=inherited Work(Job);
  except
    on E:Exception do
      begin
      if LOG_AV_ERRORS then
        Log('ServerThread.Work',E);
      raise;
      end;
    end;
  end;

procedure TRtcWSockServerThread.Kill(Job: TObject);
  begin
  inherited Kill(Job);
  end;

{ TRtcWSocketServer }

procedure TRtcWSocketServer.Call_FD_ACCEPT;
  begin
  try
    TRtcThread.PostJob(Thr,Message_WSAccept);
  except
    on E:Exception do
      if LOG_SOCKET_ERRORS then
        Log('Server.Call_FD_ACCEPT',E);
    end;
  end;

procedure TRtcWSocketServer.Call_FD_READ;
  begin
  try
    TRtcThread.PostJob(Thr,Message_WSRead);
  except
    on E:Exception do
      if LOG_SOCKET_ERRORS then
        Log('Server.Call_FD_READ',E);
    end;
  end;

procedure TRtcWSocketServer.Call_FD_WRITE;
  begin
  try
    TRtcThread.PostJob(Thr,Message_WSWrite);
  except
    on E:Exception do
      if LOG_SOCKET_ERRORS then
        Log('Server.Call_FD_WRITE',E);
    end;
  end;

initialization
Message_WSAccept:=TRtcBaseMessage.Create;
Message_WSInit:=TRtcBaseMessage.Create;
Message_WSStop:=TRtcBaseMessage.Create;
Message_WSRead:=TRtcBaseMessage.Create;
Message_WSWrite:=TRtcBaseMessage.Create;
Message_WSClose:=TRtcBaseMessage.Create;
Message_WSCloseConn:=TRtcBaseMessage.Create;
Message_WSRelease:=TRtcBaseMessage.Create;
Message_WSRelease_Silent:=TRtcBaseMessage.Create;
Message_WSRelease_Normal:=TRtcBaseMessage.Create;

finalization
Garbage(Message_WSAccept);
Garbage(Message_WSInit);
Garbage(Message_WSStop);
Garbage(Message_WSRead);
Garbage(Message_WSWrite);
Garbage(Message_WSClose);
Garbage(Message_WSCloseConn);
Garbage(Message_WSRelease);
Garbage(Message_WSRelease_Silent);
Garbage(Message_WSRelease_Normal);
end.