dxservercore.pas

Well known and usefull component for delphi 7

//               ProcessWindowsMessageQueue;// have to do incase event was GUI based.
            end
            else
               DoSleepEx(1);
         end;
      end;
      ListenerSocket.CloseNow;
      DXClientThread.Client.Free; // 15-Jn-2005
      DXClientThread.Client:=Nil;
      DXClientThread.FreeOnTerminate := True;
      DXClientThread.Terminate;
   end;

   procedure ThreadPool;
   var
      NextThread: Integer;
      LoopCount: Integer;
      Done, Allowed: Boolean;

   begin
      while fThreadPool.Count < fiMaxConn - 1 do begin
         DXClientThread := TDXClientThread.Create(True);
         DXClientThread.FreeOnTerminate := False; // flags "Is ThreadPool".
{$IFNDEF LINUX}
         DXClientThread.Priority := fstPriority;
{$ENDIF}
         DXClientThread.OnNewConnect := feNewConnect;
         DXClientThread.fBlockSizeFlags := fBlockSizeFlags;
         DXClientThread.ListenerThreadObject := Self;
         DXClientThread.Client := nil;
         fThreadPool.Add(DXClientThread);
      end;
      LoopCount := fThreadPool.Count;
      NextThread := 0;
{$WARNINGS OFF}
      while not Terminated do begin
         if fbSuspend then
            DoSleepEx(20)
         else
            if ListenerSocket.Accept(TDXClientThread(fThreadPool[NextThread]).Client) then begin
               if assigned(feAccept) then begin
                  Allowed := True;
                  feAccept(TDXClientThread(fThreadPool[NextThread]).Client.PeerIPAddress,
                     TDXClientThread(fThreadPool[NextThread]).Client.PeerPort,
                     TDXClientThread(fThreadPool[NextThread]).Client, Allowed);
                  if not Allowed then begin
                     TDXClientThread(fThreadPool[NextThread]).Client.CloseNow;
                     Continue;
                  end;
               end;

               TDXClientThread(fThreadPool[NextThread]).Resume;
{$IFDEF LINUX}
               MyCriticalSection.StartingWrite;
               Inc(FActiveConnections);
               MyCriticalSection.FinishedWrite;
{$ELSE}
               InterlockedIncrement(FActiveConnections);
{$ENDIF}
               Inc(NextThread);
               if NextThread >= LoopCount then NextThread := 0;
               Done := False;
               while (not Terminated) and (not fbSuspend) and (not done) do begin
                  if TDXClientThread(fThreadPool[NextThread]).Client = nil then
                     Done := True
                  else
                     if not TDXClientThread(fThreadPool[NextThread]).Client.ValidSocket then
                        Done := True
                     else begin
                        Inc(NextThread);
                        if NextThread >= LoopCount then NextThread := 0;
                     end;
               end;
               toggleSleep := 0;
               if (fbAnnouncedIdle > 0) then begin
                  if Assigned(feWakeUp) then begin
                     feWakeUp(Self);
//                     ProcessWindowsMessageQueue;// have to do incase event was GUI based.
                  end;
               end;
               fbAnnouncedIdle := 0;
            end
            else
               EventsOrSleep;
      end;
      ListenerSocket.CloseNow;
{$WARNINGS ON}
   end;

{$WARNINGS OFF}
   procedure UDPSingleThreaded;
   var
      Data: Pointer;
      DataSize: Integer;

   begin
      if Assigned(feUDPData) then GetMem(Data, TDXMaxSocketBuffer);
      while not Terminated do begin
         if (FActiveConnections < fiMaxConn) then begin
            if fbSuspend then
               DoSleepEx(20)
            else
               if ListenerSocket.Readable then begin
                  if Assigned(feUDPData) then begin
{$IFDEF VER100}
                     DataSize := ListenerSocket.BlockRead(Data, TDXMaxSocketBuffer);
{$ELSE}
                     DataSize := ListenerSocket.Read(Data, TDXMaxSocketBuffer);
{$ENDIF}
                     feUDPData(Data, inet_ntoa(ListenerSocket.SockAddr.sin_addr),
                        ntohs(ListenerSocket.SockAddr.sin_port), DataSize);
                     ProcessWindowsMessageQueue; // have to do incase event was GUI based.
                  end
                  else begin
                     newClient := TDXSock.Create(nil); // RC2
                     newClient.Sock := ListenerSocket.Sock;
                     newClient.IsUDPMode := True;
                     DXClientThread := TDXClientThread.Create(True);
                     DXClientThread.SetSocketLater(newClient);
{$IFNDEF LINUX}
                     DXClientThread.Priority := fstPriority;
{$ENDIF}
                     DXClientThread.OnNewConnect := feNewConnect;
                     DXClientThread.fBlockSizeFlags := fBlockSizeFlags;
                     DXClientThread.ListenerThreadObject := Self;
                     DXClientThread.Resume;
                     DoSleepEx(1);
                  end;
                  if (fbAnnouncedIdle > 0) then begin
                     if Assigned(feWakeUp) then begin
                        feWakeUp(Self);
//                        ProcessWindowsMessageQueue;// have to do incase event was GUI based.
                     end;
                  end;
                  toggleSleep := 0;
                  fbAnnouncedIdle := 0;
               end
               else
                  EventsOrSleep;
         end
         else begin
            if assigned(feMaxConnects) then begin
               feMaxConnects(Self);
//               ProcessWindowsMessageQueue;// have to do incase event was GUI based.
            end
            else begin
               DoSleepEx(1);
            end;
         end;
      end;
      if Assigned(feUDPData) then FreeMem(Data, TDXMaxSocketBuffer);
   end;
{$WARNINGS ON}

begin
   if terminated then exit;
   if not Assigned(ListenerSocket) then begin
      ShowMessageWindow(
         'Developer Trap #2',
         'You must pass the listerner socket. You have coded around ' +
         'our fail-safe routines!');
      Exit;
   end;
   try
      if InitializeThreading(fWhichprotocol = wpUDPOnly) then begin
         if fWhichprotocol = wpUDPOnly then UDPSinglethreaded
         else begin
            If fbBufferCreates=B3False then ThreadAtATime
            Else if fbBufferCreates=B3True then ThreadPool
            Else UseMessageQueue;
         end;
      end;
   finally
      FreeOnTerminate := True;
      if Assigned(feListenerStopped) then begin
         feListenerStopped(Self);
//         ProcessWindowsMessageQueue;// have to do incase event was GUI based.
      end;
//      Terminate;
   end;
end;



constructor TDXServerCore.Create(AOwner: TComponent);
begin
   inherited create(aowner);
   fbActive := False;
   fiMaxConn := 200;
{$IFNDEF LINUX}
   fstPriority := tpNormal;
   fltPriority := tpNormal;
   fbBufferCreates := B3True;
{$ELSE}
   fbBufferCreates := B3False;
{$ENDIF}
   fWhichProtocol := wpTCPOnly;
   fBlockSizeFlags := bsfHuge;
   fServerType := stThreadBlocking;
   fbNagle := True;
   fiTimeout := 120000;
   fEventArray := TList.Create;
   fiListenerQueueSize := 100;
end;

destructor TDXServerCore.Destroy;
begin
   if fbActive then SetActive(False);
   if Assigned(fEventArray) then begin
      fEventArray.Free;
      fEventArray := nil;
   end;
   if Assigned(ListenerThread) then begin
      if ListenerThread.Suspended then begin
         ListenerThread.Terminate;
         ListenerThread.Resume;
      end
      else begin
         ListenerThread.Terminate;
{$IFNDEF I_LOCKUP_WHEN_I_CLOSE_APPLICATION}
         ListenerThread.WaitFor;
{$ENDIF}
      end;
   end;
   ListenerThread := nil;
   inherited destroy;
end;

function TDXServerCore.GetSocket: TDXSock;
begin
   if Assigned(ListenerThread) then
      Result := ListenerThread.ListenerSocket
   else
      Result := nil;
end;

function TDXServerCore.ActiveNumberOfConnections: Integer;
begin
   if Assigned(ListenerThread) then
      Result := ListenerThread.ActiveNumberOfConnections
   else
      Result := 0;
end;

procedure TDXServerCore.SetActive(value: boolean);
begin
{$IFNDEF OBJECTS_ONLY}
   if (csDesigning in ComponentState) then exit;
{$ENDIF}
   fbSuspend := False;
   if Value <> fbActive then begin
      if Value then begin
         if not Assigned(feNewConnect) and not Assigned(feUDPData) then begin
            ShowMessageWindow(
               'Developer Trap #1!',
               'You must specify either OnNewConnect or OnUDPDataNoPool Event!');
            Exit;
         end;
         fbActive := Value;
         fbSuspend := False;
         ListenerThread := TDXServerCoreThread.Create(True);
         ListenerThread.fServerCore := Self;
         ListenerThread.fsBindTo := fsBindTo;
         ListenerThread.fiServerPort := fiServerPort;
         ListenerThread.fiMaxConn := fiMaxConn;
         ListenerThread.feNewConnect := feNewConnect;
         ListenerThread.feMaxConnects := feMaxConnects;
         ListenerThread.feListenerFailed := feListenerFailed;
         ListenerThread.feListenerStarted := fListenerStarted;
         ListenerThread.feListenerStopped := fListenerStopped;
         ListenerThread.feIdle := feIdle;
         ListenerThread.feSleep := feSleep;
         ListenerThread.feWakeUp := feWakeUp;
         ListenerThread.fListenerQueueSize := fiListenerQueueSize; // RC2
         ListenerThread.feAccept := feAccept;
{$IFNDEF LINUX}
         ListenerThread.Priority := fltPriority;
         ListenerThread.SpawnedThreadPriority := fstPriority;
{$ENDIF}
         ListenerThread.fBlockSizeFlags := fBlockSizeFlags;
         ListenerThread.fbSuspend := False;
         ListenerThread.feUDPData := feUDPData;
{$WARNINGS OFF}
         if (DebugHOOK <> 0) and (fbBufferCreates<>B3Other) then
            ListenerThread.fbBufferCreates := B3False
         else
            ListenerThread.fbBufferCreates := fbBufferCreates;
{$WARNINGS ON}
         ListenerThread.fWhichProtocol := fWhichProtocol;
         ListenerThread.NagleListener := fbNagle;
         ListenerThread.BlockingListener := fServerType = stThreadBlocking;
         ListenerThread.Resume;
      end
      else begin
         fbActive := Value;
         if Assigned(ListenerThread) then begin
            if ListenerThread.Suspended then begin
               ListenerThread.Terminate;
               ListenerThread.Resume;
            end
            else begin
               ListenerThread.Terminate;
{$IFNDEF I_LOCKUP_WHEN_I_CLOSE_APPLICATION}
               ListenerThread.WaitFor;
{$ENDIF}
            end;
         end;
         ListenerThread := nil;
      end;
   end;
end;

procedure TDXServerCore.Start;
begin
   SetActive(True);
end;

procedure TDXServerCore.Stop;
begin
   SetActive(False);
end;

procedure TDXServerCore.Open;
begin
   Start;
end;

procedure TDXServerCore.Close;
begin
   Stop;
end;

procedure TDXServerCore.Pause;
begin
   SetSuspend(True);
end;

procedure TDXServerCore.Resume;
begin
   SetSuspend(False);
end;

procedure TDXServerCore.SetSuspend(value: boolean);
begin
   if fbActive then begin
      fbSuspend := Value;
      ListenerThread.SuspendListener := Value;
   end;
end;

{$WARNINGS OFF}

procedure TDXServerCore.SetfiMaxConn(Value: Integer);
begin
   if Value < 1 then begin
      if DebugHOOK <> 0 then Exit; {cant enable this from within DELPHI live!}
      fiMaxConn := -1;
      fbBufferCreates := B3True;
   end
   else
      fiMaxConn := Value;
end;
{$WARNINGS ON}

function TDXServerCore.GetThreadCacheSize: Integer;
begin
   Result := fiMaxConn;
end;

procedure TDXServerCore.SetThreadCacheSize(value: Integer);
begin
   SetfiMaxConn(Value);
end;

function TDXServerCore.InternalSessionTracker: TDXSessionTracker;
begin
   if Assigned(ListenerThread) then
      Result := ListenerThread.fSessionTracker
   else
      Result := nil;
end;

procedure TDXServerCore.ForceAbort;
begin
   fbForceAbort := True;
end;

end.