TIdTCPServer requires the TIdTCPServer event handler. To get around this, you must get a new class from TIdTCPServer and override its virtual CheckOkToBeActive() method, as well as override the virtual DoExecute() to call Sleep() . Otherwise, just assign an event handler and call it Sleep() .
This is not an effective use of TIdTCPServer . It’s best not to write outgoing data to clients directly from your SendMessage() method. Not only is it error-prone (you do not catch exceptions from WriteBuffer() ) and block SendMessage() while writing, but you also serialize your messages (client 2 cannot receive data until client 1 does this earlier). A more efficient design is to provide each client with its own inbound outbound queue, and then SendMessage() place data in each client queue as necessary. You can then use the OnExecute event to check each client queue and perform the actual recording. Thus, SendMessage() no longer blocked, less error prone, and clients can be written in parallel (as it should be).
Try something like this:
uses ..., IdThreadSafe; type TMyContext = class(TIdServerContext) private FQueue: TIdThreadSafeStringList; FEvent: TEvent; public constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TThreadList = nil); override; destructor Destroy; override; procedure AddMsgToQueue(const Msg: String); function GetQueuedMsgs: TStrings; end; constructor TMyContext.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TThreadList = nil); begin inherited; FQueue := TIdThreadSafeStringList.Create; FEvent := TEvent.Create(nil, True, False, ''); end; destructor TMyContext.Destroy; begin FQueue.Free; FEvent.Free; inherited; end; procedure TMyContext.AddMsgToQueue(const Msg: String); begin with FQueue.Lock do try Add(Msg); FEvent.SetEvent; finally FQueue.Unlock; end; end; function TMyContext.GetQueuedMsgs: TStrings; var List: TStringList; begin Result := nil; if FEvent.WaitFor(1000) <> wrSignaled then Exit; List := FQueue.Lock; try if List.Count > 0 then begin Result := TStringList.Create; try Result.Assign(List); List.Clear; except Result.Free; raise; end; end; FEvent.ResetEvent; finally FQueue.Unlock; end; end; procedure TFormMain.FormCreate(Sender: TObject); begin TCPServer.ContextClass := TMyContext; end; procedure TFormMain.TCPServerExecute(AContext: TIdContext); var List: TStrings; I: Integer; begin List := TMyContext(AContext).GetQueuedMsgs; if List = nil then Exit; try for I := 0 to List.Count-1 do AContext.Connection.IOHandler.Write(List[I]); finally List.Free; end; end; procedure TFormMain.SendMessage(const IP, Msg: string); var I: Integer; begin with TCPServer.Contexts.LockList do try for I := 0 to Count-1 do begin with TMyContext(Items[I]) do begin if Binding.PeerIP = IP then begin AddMsgToQueue(Msg); Break; end; end; end; finally TCPServer.Contexts.UnlockList; end; end;