Data commit

Task/Synchronous-concurrency/Delphi/synchronous-concurrency.delphi

@@ -0,0 +1,168 @@
+program Project2;
+
+{$APPTYPE CONSOLE}
+
+uses
+  SysUtils, Classes, Windows;
+
+type
+  EThreadStackFinalized = class(Exception);
+
+  PLine = ^TLine;
+  TLine = record
+    Text: string;
+  end;
+
+  TThreadQueue = class
+  private
+    FFinalized: Boolean;
+    FQueue: THandle;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    procedure Finalize;
+    procedure Push(Data: Pointer);
+    function Pop(var Data: Pointer): Boolean;
+    property Finalized: Boolean read FFinalized;
+  end;
+
+  TPrintThread = class(TThread)
+  private
+    FCount: Integer;
+    FTreminateEvent: THandle;
+    FDoneEvent: THandle;
+    FQueue: TThreadQueue;
+  public
+    constructor Create(aTreminateEvent, aDoneEvent: THandle; aQueue: TThreadQueue);
+    procedure Execute; override;
+
+    property Count: Integer read FCount;
+  end;
+
+{ TThreadQueue }
+
+constructor TThreadQueue.Create;
+begin
+  FQueue := CreateIOCompletionPort(INVALID_HANDLE_VALUE, 0, 0, 0);
+  FFinalized := False;
+end;
+
+destructor TThreadQueue.Destroy;
+begin
+  if FQueue <> 0 then
+    CloseHandle(FQueue);
+  inherited;
+end;
+
+procedure TThreadQueue.Finalize;
+begin
+  PostQueuedCompletionStatus(FQueue, 0, 0, Pointer($FFFFFFFF));
+  FFinalized := True;
+end;
+
+function TThreadQueue.Pop(var Data: Pointer): Boolean;
+var
+  A: Cardinal;
+  OL: POverLapped;
+begin
+  Result := True;
+  if not FFinalized then
+    GetQueuedCompletionStatus(FQueue, A, Cardinal(Data), OL, INFINITE);
+
+  if FFinalized or (OL = Pointer($FFFFFFFF)) then begin
+    Data := nil;
+    Result := False;
+    Finalize;
+  end;
+end;
+
+procedure TThreadQueue.Push(Data: Pointer);
+begin
+  if FFinalized then
+    raise EThreadStackFinalized.Create('Stack is finalized');
+
+  PostQueuedCompletionStatus(FQueue, 0, Cardinal(Data), nil);
+end;
+
+{ TPrintThread }
+
+constructor TPrintThread.Create(aTreminateEvent, aDoneEvent: THandle; aQueue: TThreadQueue);
+begin
+  inherited Create(True);
+  FCount := 0;
+  FreeOnTerminate := True;
+  FTreminateEvent := aTreminateEvent;
+  FDoneEvent := aDoneEvent;
+  FQueue := aQueue;
+end;
+
+procedure TPrintThread.Execute;
+var
+  data: Pointer;
+  line: PLine;
+begin
+  repeat
+    if FQueue.Pop(data) then begin
+      line := data;
+      try
+        Writeln(line^.Text);
+        if line^.Text = #0 then
+          SetEvent(FDoneEvent);
+        Inc(FCount);
+      finally
+        Dispose(line);
+      end;
+    end;
+
+  until False;
+  WaitForSingleObject(FTreminateEvent, INFINITE);
+end;
+
+var
+  PrintThread: TPrintThread;
+  Queue: TThreadQueue;
+  lines: TStrings;
+  i: Integer;
+  line: PLine;
+  TreminateEvent, DoneEvent: THandle;
+begin
+  Queue := TThreadQueue.Create;
+  try
+    TreminateEvent := CreateEvent(nil, False, False, 'TERMINATE_EVENT');
+    DoneEvent := CreateEvent(nil, False, False, 'DONE_EVENT');
+    try
+      PrintThread := TPrintThread.Create(TreminateEvent, DoneEvent, Queue);
+      PrintThread.Start;
+      lines := TStringList.Create;
+      try
+        lines.LoadFromFile('input.txt');
+        for i := 0 to lines.Count - 1 do begin
+          New(line);
+          line^.Text := lines[i];
+          Queue.Push(line);
+        end;
+
+        New(line);
+        line^.Text := #0;
+        Queue.Push(line);
+
+        WaitForSingleObject(DoneEvent, INFINITE);
+
+        New(line);
+        line^.Text := IntToStr(PrintThread.Count);
+        Queue.Push(line);
+
+        SetEvent(TreminateEvent);
+      finally
+        lines.Free;
+      end;
+    finally
+      CloseHandle(TreminateEvent);
+      CloseHandle(DoneEvent)
+    end;
+
+    Readln;
+  finally
+    Queue.Free;
+  end;
+end.