Yes, it can be adapted. Try something like this:
type
TMyContext = class(TIdServerContext)
Events: TIdThreadSafeObjectList;
Signal: TEvent;
constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil); override;
destructor Destroy;
procedure AddEvent(AStrings: TStrings);
end;
constructor TMyContext.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil);
begin
inherited Create(AConnection, AYarn, AList);
Events := TIdThreadSafeObjectList.Create;
Events.OwnsObjects := True;
Signal := TEvent.Create;
end;
destructor TMyContext.Destroy;
begin
Events.Free;
Signal.Free;
inherited;
end;
procedure TMyContext.AddEvent(AStrings: TStrings);
var
Event: TStringList;
List: TList;
begin
Event := TStringList.Create;
try
Event.Assign(AStrings);
List := Events.LockList;
try
List.Add(Event);
Signal.SetEvent;
finally
Events.UnlockList;
end;
except
Event.Free;
raise;
end;
end;
procedure TForm1.Form1Create(Sender: TObject);
begin
IdHTTPServer1.ContextClass := TMyContext;
...
end;
procedure TForm1.IdHTTPServer1CommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
List: TList;
Event: TStringList;
I: Integer;
begin
if ARequestInfo.Document <> '/' then
begin
AResponseInfo.ResponseNo := 404;
Exit;
end;
AResponseInfo.ResponseNo := 200;
AResponseInfo.ContentType := 'text/event-stream';
AResponseInfo.CloseConnection := False;
AResponseInfo.WriteHeader;
AContext.Connection.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
repeat
case TMyContext(AContext).Signal.WaitFor(10000) of
wrTimeOut:
begin
AContext.Connection.IOHandler.WriteLn(':');
AContext.Connection.IOHandler.WriteLn;
end;
wrSignaled:
begin
List := TMyContext(AContext).Events.LockList;
try
while List.Count > 0 do
begin
Event := TStringList(List[0]);
List.Delete(0);
try
for I := 0 to Event.Count-1 do
AContext.Connection.IOHandler.WriteLn(Event.Names[I] + ': ' + Event.ValueFromIndex[I]);
AContext.Connection.IOHandler.WriteLn;
finally
Event.Free;
end;
end;
finally
if List.Count = 0 then
TMyContext(AContext).Signal.ResetEvent;
TMyContext(AContext).Events.UnlockList;
end;
end;
end;
until False;
end;
Then you can simply call TMyContext.AddEvent()
on any connected client when needed to send an event of name=value
pairs to that client.