program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Windows;

type
  PThreadRecord = ^TThreadRecord;
  TThreadRecord = record
  private
    FHandle: THandle;
    FID: Cardinal;
    FNextMessage: Pointer;
    FEvent: THandle;
    FStopping: boolean;
  public
    function Start: boolean;
    function Enqueue(const AMessage: Pointer): boolean;
    function IsRinnung: boolean;
    function Stop: boolean;
  end;

{ TThreadRecord }

function ThreadMainLoop(Instance: Pointer): Integer;
begin
  result := 0;
  with PThreadRecord(Instance)^ do begin
    while not FStopping do begin
      if (WaitForSingleObject(FEvent, INFINITE) = 0) and (not FStopping) then begin
        ResetEvent(FEvent);
        if Integer(FNextMessage) <> -1 then begin
          Sleep(100); // working
        end;
        Integer(FNextMessage) := -1;
      end;
    end;
    CloseHandle(FEvent);
    FEvent := 0;
    CloseHandle(FHandle);
    FHandle := 0;
  end;
end;

function TThreadRecord.Enqueue(const AMessage: Pointer): boolean;
begin
  result := false;
  if LongBool(FHandle) and (not IsRinnung) then begin
    result := InterlockedCompareExchange(Integer(FNextMessage), Integer(AMessage), -1) = -1;
    if result then
      result := SetEvent(FEvent);
  end;
end;

function TThreadRecord.IsRinnung: boolean;
begin
  result := (FHandle > 0) and (not FStopping) and (Integer(FNextMessage) <> -1);
end;

function TThreadRecord.Start: boolean;
begin
  FHandle := 0;
  result := false;
  FEvent := CreateEvent(nil, true, false, '');
  if not LongBool(FEvent) then exit;
  Integer(FNextMessage) := -1;
  FStopping := false;
  FHandle := BeginThread(nil, 2*1024*1024, @ThreadMainLoop, @Self, $10000, FID);
  result := Fhandle > 0;
  if not result then begin
    CloseHandle(FEvent);
    FEvent := 0;
  end;
end;

function TThreadRecord.Stop: boolean;
begin
  FStopping := true;
  SetEvent(FEvent);
  result := true;
end;

var
  thread: TThreadRecord;
  p: integer;
  //m: Pointer;

begin
  ReportMemoryLeaksOnShutdown := true;
  //GetMem(m, 1024); // test for leaks
  try
    if thread.Start then begin
      Writeln('Started');
      p := $10;
      if thread.Enqueue(Pointer(p)) then Writeln('Enqueued ', IntToHex(p, 4));
      p := $12;
      if thread.Enqueue(Pointer(p)) then Writeln('Enqueued ', IntToHex(p, 4));
      p := $20;
      if thread.Enqueue(Pointer(p)) then Writeln('Enqueued ', IntToHex(p, 4));
      sleep(1000);
      p := $30;
      if thread.Enqueue(Pointer(p)) then Writeln('Enqueued ', IntToHex(p, 4));
      sleep(1000);
      if thread.Stop then writeln('Stoped');
    end;
  except
    on E:Exception do
      Writeln(E.Classname, ': ', E.Message);
  end;
  readln;
end.