BSOne.SFC/Tocsg.Lib/VCL/Tocsg.Thread.pas

{*******************************************************}
{                                                       }
{       Tocsg.Thread                                    }
{                                                       }
{       Copyright (C) 2022 kkuzil                       }
{                                                       }
{*******************************************************}

unit Tocsg.Thread;

interface

uses
  System.Classes, System.SysUtils, System.SyncObjs, Winapi.Windows,
  Winapi.Messages, System.Generics.Collections;

type
  TTgThreadState = (tsInit, tsWorking, tsPause, tsStop, tsCompleted, tsFail);
  TTgThread = class(TThread)
  private
    CS_: TCriticalSection;
  protected
    nLastError_: Integer;
    bWorkStop_,
    bWorkCancel_: Boolean; // 사용자가 수동으로 작업을 중지한건지 판단하는게.. bWorkStop_ 만으로는 부족해서 추가 13_1213 13:51:54 kku
    WorkState_: TTgThreadState; // 범용적으로 사용될 스레드 상태값. 이전부터 쓰던건 스레드마다 직접 지정해서 사용했다... 기본으로 추가함 18_0416 22:50:16 kku

    procedure _Trace(const sLog: String; nLevel: Integer = 0); overload;
    procedure _Trace(const sFormat: String; const aArgs: array of const; nLevel: Integer = 0); overload;

    property LastError: Integer read nLastError_;

    procedure Lock;
    procedure Unlock;
    procedure SetWorkStop(bVal: Boolean); virtual;
    function GetWorkStop: Boolean;
    function GetWorkCancel: Boolean;

    procedure SetWorkState(aKind: TTgThreadState);
    function GetWorkState: TTgThreadState;

//  {$IF CompilerVersion > 21}
    procedure TerminatedSet; override;
//  {$IFEND}
  public
    Constructor Create;
    Destructor Destroy; override;

    procedure TerminateWaitUntilEnd;

    procedure StartThread; virtual;
    procedure PauseThread; virtual;
    procedure StopThread; virtual;
    procedure CancelWork;

    property IsCancel: Boolean read GetWorkCancel;
    property WorkStop: Boolean read GetWorkStop;
  end;

  TTgEventThread = class(TTgThread)
  private
    hEvent_: THandle;
    bSync_: Boolean;
    sEvtName_: String;
  protected
    bUseActiveX_: Boolean; // 스레드 내부에서 ConInit..쓸일이 있다.
    procedure DoEvent;
    procedure Execute; override;
    procedure ProcessWorkEvent; virtual; abstract;
  public
    Constructor Create(const sEventName: String = 'TTgEventThread'; bSync: Boolean = false);
    Destructor Destroy; override;

    procedure StartThread; override;
    procedure StopThread; override;

    property EventName: String read sEvtName_;
    property EventHandle: THandle read hEvent_;
  end;

  PCloseFormEnt = ^TCloseFormEnt;
  TCloseFormEnt = record
    sClassName,
    sCaption: String;
  end;

  TThdCloseForm = class(TTgThread)
  private
    CloseFromEnt_: TList<PCloseFormEnt>;
    procedure OnEntryNotify(Sender: TObject; const Item: PCloseFormEnt; Action: TCollectionNotification);
  protected
    procedure Execute; override;
  public
    Constructor Create;
    Destructor Destroy; override;

    procedure ClearEntry;

    procedure AddEntry(const sClassName, sCaption: String);
  end;

  TTaskTimerEnt = class(TObject)
  private
    fnEvent_: TNotifyEvent;
    fnEvent2_: TThreadMethod;
    dwTick_,
    dwInterval_: DWORD;
    bDefaultActive_: Boolean;
    OwnerThread_: TTgThread;
  public
    Constructor Create(fnEvent: TNotifyEvent; dwInterval: DWORD; bDefaultActive: Boolean); overload;
    Constructor Create(aOwnerThread: TTgThread; fnEvent: TThreadMethod; dwInterval: DWORD; bDefaultActive: Boolean); overload; // 추가 15_1022 15:57:14 sunk
    Destructor Destroy; override;

    procedure InitTask(dwTick: DWORD);
    procedure ProcessTask(dwTick: DWORD);

    property DefaultActive: Boolean read bDefaultActive_;
    property Tick: DWORD read dwTick_;
    property Interval: DWORD read dwInterval_;
    property Event: TNotifyEvent read fnEvent_;
  end;

  TTimerEntEnumerator = TEnumerator<TTaskTimerEnt>;

  TThdTaskTimer = class(TTgThread)
  private
    bTimerOn_,
    bUseActiveX_: Boolean;
    dwSleep_: DWORD;
    TimerEntList_: TList<TTaskTimerEnt>;

    procedure OnEventNotifyTaskEntry(Sender: TObject; const Item: TTaskTimerEnt;
                                        Action: TCollectionNotification);
  protected
    procedure Execute; override;
  public
    Constructor Create(dwSleep: DWORD = 1000; bUseActiveX: Boolean = false);
    Destructor Destroy; override;

    procedure AddTask(fnEvent: TNotifyEvent; dwInterval: DWORD; bActive: Boolean;
                          bInitProcess: Boolean = false{인터벌 전에 최초실행 할건지}); overload;
    procedure AddTask(fnEvent: TThreadMethod; dwInterval: DWORD; bActive: Boolean;
                          bInitProcess: Boolean = false{인터벌 전에 최초실행 할건지}); overload;
    procedure SetTask(fnEvent: TNotifyEvent; dwInterval: DWORD; bActive: Boolean);
    function GetTaskActiveState(fnEvent: TNotifyEvent): Boolean;

    procedure StartTimerThread;
    procedure StopTimerThread;
  end;

implementation

uses
  Tocsg.Trace, Winapi.ActiveX;

{ TTgThread }

Constructor TTgThread.Create;
begin
  Inherited Create(true);

  WorkState_ := tsInit;

  CS_ := TCriticalSection.Create;

  nLastError_ := ERROR_SUCCESS;
  bWorkStop_ := false;
  bWorkCancel_ := false;
end;

Destructor TTgThread.Destroy;
begin
  StopThread;
  Inherited;
  FreeAndNil(CS_);
end;

procedure TTgThread.Lock;
begin
  CS_.Acquire;
end;

procedure TTgThread.Unlock;
begin
  CS_.Release;
end;

procedure TTgThread.SetWorkStop(bVal: Boolean);
begin
  Lock;
  try
    bWorkStop_ := bVal;
  finally
    Unlock;
  end;
end;

function TTgThread.GetWorkStop: Boolean;
begin
  Lock;
  try
    Result := bWorkStop_;
  finally
    Unlock;
  end;
end;

function TTgThread.GetWorkCancel: Boolean;
begin
  Lock;
  try
    Result := bWorkCancel_;
  finally
    Unlock;
  end;
end;

procedure TTgThread.SetWorkState(aKind: TTgThreadState);
begin
  Lock;
  try
    WorkState_ := aKind;
  finally
    Unlock;
  end;
end;

function TTgThread.GetWorkState: TTgThreadState;
begin
  Lock;
  try
    Result := WorkState_;
  finally
    Unlock;
  end;
end;

procedure TTgThread.TerminatedSet;
begin
  if Suspended then
    Suspended := false; // 이게 true로 되어 있으면 제대로 Terminate가 되지 않아서 일케 체크 13_0911 14:56:28 kku

  SetWorkStop(true);
end;

procedure TTgThread._Trace(const sLog: String; nLevel: Integer = 0);
begin
{$IFDEF TRACE_OBJ}
  if Self <> nil then
    TTgTrace.T(Format('%s :: %s', [ClassName, sLog]), nLevel);
{$ENDIF}
end;

procedure TTgThread._Trace(const sFormat: String; const aArgs: array of const; nLevel: Integer = 0);
begin
{$IFDEF TRACE_OBJ}
  TTgTrace.T(Format('%s :: %s', [ClassName, sFormat]), aArgs, nLevel);
{$ENDIF}
end;

procedure TTgThread.TerminateWaitUntilEnd;
begin
  Terminate;
  if FreeOnTerminate then
    exit;

  WaitFor;
end;

procedure TTgThread.StartThread;
begin
  SetWorkStop(false);

  if Suspended then
    Suspended := false;
end;

procedure TTgThread.PauseThread;
begin
  if not Suspended then
    Suspended := true;
end;

procedure TTgThread.StopThread;
begin
  SetWorkStop(true);
end;

procedure TTgThread.CancelWork;
begin
  Lock;
  try
    bWorkCancel_ := true;
  finally
    Unlock;
  end;
  StopThread;
end;

{ TTgEventThread }

Constructor TTgEventThread.Create(const sEventName: String = 'TTgEventThread'; bSync: Boolean = false);
begin
  Inherited Create;

  hEvent_ := 0;

//  sEventName_ := sEventName;
// 기존 단순 이벤트 이름 계속 사용하면...
// 이벤트 핸들이 제대로 닫히지 않거나 중복되면 GetLastError = 5(액세스 거부) 가 일어날 수 있다.
// 이런 현상을 최대한 줄이기 위해서 이벤트 이름을 유니크 하게 추가 보완 17_0330 10:25:24 sunk
  sEvtName_ := sEventName + IntToStr(GetCurrentProcessId) + IntToStr(LONGLONG(Self));

  bSync_ := bSync;
  bUseActiveX_ := false;
end;

Destructor TTgEventThread.Destroy;
begin
  Terminate;
  if hEvent_ <> 0 then SetEvent(hEvent_);
  WaitFor;
  if hEvent_ <> 0 then
    CloseHandle(hEvent_);
  inherited;
end;

procedure TTgEventThread.DoEvent;
begin
  if not GetWorkStop and (hEvent_ <> 0) then
  begin
    SetEvent(hEvent_);
  end;
end;

procedure TTgEventThread.StartThread;
begin
  if hEvent_ = 0 then
  begin
    hEvent_ := CreateEvent(nil, true, false, PChar(sEvtName_));
    if hEvent_ = 0 then
    begin
      _Trace('StartThread() .. hEvent_ is 0 .., sEventName_ = %s, LastError = %d', [sEvtName_, GetLastError]);
    end;
  end;

  Inherited;
end;

procedure TTgEventThread.StopThread;
begin
  Inherited;

  if hEvent_ <> 0 then
  begin
    SetEvent(hEvent_);
  end;
end;

procedure TTgEventThread.Execute;
begin
  if bUseActiveX_ then CoInitialize(nil);
  try
    while not Terminated do
    begin
      if hEvent_ <> 0 then
      begin
        case WaitForSingleObject(hEvent_, INFINITE) of
          WAIT_TIMEOUT : ;
          WAIT_OBJECT_0 :
          begin
            ResetEvent(hEvent_);
            if not GetWorkStop then
              if bSync_ then
                Synchronize(ProcessWorkEvent)
              else
                ProcessWorkEvent;
          end;
        end;
      end;
      Sleep(50);
    end;
  finally
    if bUseActiveX_ then CoUninitialize;
  end;
end;

{ TThdCloseForm }

Constructor TThdCloseForm.Create;
begin
  Inherited Create;
  CloseFromEnt_ := TList<PCloseFormEnt>.Create;
  CloseFromEnt_.OnNotify := OnEntryNotify;
  StartThread;
end;

Destructor TThdCloseForm.Destroy;
begin
  Terminate;
  WaitFor;
  CloseFromEnt_.Clear;
  FreeAndNil(CloseFromEnt_);
  Inherited;
end;

procedure TThdCloseForm.OnEntryNotify(Sender: TObject; const Item: PCloseFormEnt; Action: TCollectionNotification);
begin
  case Action of
    cnAdded: ;
    cnRemoved:
    begin
//      Finalize(Item^);
      Dispose(Item);
    end;
    cnExtracted: ;
  end;
end;

procedure TThdCloseForm.ClearEntry;
begin
  CloseFromEnt_.Clear;
end;

procedure TThdCloseForm.AddEntry(const sClassName, sCaption: String);
var
  p: PCloseFormEnt;
begin
  New(p);
  p.sClassName := sClassName;
  p.sCaption := sCaption;

  Lock;
  try
    CloseFromEnt_.Add(p);
  finally
    Unlock;
  end;
end;

procedure TThdCloseForm.Execute;
var
  hWindow: HWND;
  enum: TEnumerator<PCloseFormEnt>;
begin
  while not Terminated do
  begin
    Lock;
    try
      enum := CloseFromEnt_.GetEnumerator;
    finally
      Unlock;
    end;

    try
      while enum.MoveNext do
      begin
        hWindow := FindWindow(PChar(enum.Current.sClassName), PChar(enum.Current.sCaption));
        if hWindow <> 0 then
        begin
  //        ShowWindow(hWindow, SW_HIDE);
          SendMessage(hWindow, WM_CLOSE, 0, 0);
        end;
      end;
    finally
      enum.Free;
    end;
    Sleep(50);
  end;
end;

{ TTaskTimerEnt }

Constructor TTaskTimerEnt.Create(fnEvent: TNotifyEvent; dwInterval: DWORD; bDefaultActive: Boolean);
begin
  Inherited Create;

  OwnerThread_    := nil;
  fnEvent_        := fnEvent;
  fnEvent2_       := nil;
  dwTick_         := 0;
  dwInterval_     := dwInterval;
  bDefaultActive_ := bDefaultActive;
end;

Constructor TTaskTimerEnt.Create(aOwnerThread: TTgThread; fnEvent: TThreadMethod; dwInterval: DWORD; bDefaultActive: Boolean);
begin
  Inherited Create;

  OwnerThread_    := aOwnerThread;
  fnEvent_        := nil;
  fnEvent2_       := fnEvent;
  dwTick_         := 0;
  dwInterval_     := dwInterval;
  bDefaultActive_ := bDefaultActive;
end;

Destructor TTaskTimerEnt.Destroy;
begin
  Inherited;
end;

procedure TTaskTimerEnt.InitTask(dwTick: DWORD);
begin
  if dwTick_ <> dwTick then
    dwTick_ := dwTick;
end;

procedure TTaskTimerEnt.ProcessTask(dwTick: DWORD);
var
  dwMilliSec: DWORD;
begin
  if dwTick_ = 0 then
    exit;

  dwMilliSec := dwTick - dwTick_;
  if dwMilliSec > dwInterval_ then
  begin
    if Assigned(fnEvent_) then
      fnEvent_(Self);
    if Assigned(fnEvent2_) and Assigned(OwnerThread_) then
      OwnerThread_.Synchronize(fnEvent2_);
  // fnEvent_ 수행중 dwTick_ 이걸 0으로 초기화 할 경우가 있다. (내부에서 타이머 끄기등)
    if dwTick_ > 0 then
      dwTick_ := dwTick;
  end;
end;

{ TThdTaskTimer }

Constructor TThdTaskTimer.Create(dwSleep: DWORD = 1000; bUseActiveX: Boolean = false);
begin
  Inherited Create;

  bTimerOn_ := false;
  bUseActiveX_ := bUseActiveX;

  TimerEntList_ := TList<TTaskTimerEnt>.Create;
  TimerEntList_.OnNotify := OnEventNotifyTaskEntry;

  dwSleep_ := dwSleep;
end;

Destructor TThdTaskTimer.Destroy;
begin
  Terminate;
  if Suspended then
    Suspended := false;
  WaitFor;
  TimerEntList_.Clear;
  FreeAndNil(TimerEntList_);
  Inherited;
end;

procedure TThdTaskTimer.OnEventNotifyTaskEntry(Sender: TObject; const Item: TTaskTimerEnt;
                                    Action: TCollectionNotification);
begin
  case Action of
    cnAdded     : ;
    cnRemoved   : Item.Free;
    cnExtracted : ;
  end;
end;

procedure TThdTaskTimer.AddTask(fnEvent: TNotifyEvent; dwInterval: DWORD; bActive: Boolean; bInitProcess: Boolean = false);
var
  TaskTimerEntry: TTaskTimerEnt;
begin
  TaskTimerEntry := TTaskTimerEnt.Create(fnEvent, dwInterval, bActive);
  Lock;
  try
    TimerEntList_.Add(TaskTimerEntry);
  finally
    Unlock;
  end;
  if bInitProcess and Assigned(fnEvent) then
    fnEvent(TaskTimerEntry);
end;

procedure TThdTaskTimer.AddTask(fnEvent: TThreadMethod; dwInterval: DWORD; bActive: Boolean; bInitProcess: Boolean = false);
var
  TaskTimerEntry: TTaskTimerEnt;
begin
  TaskTimerEntry := TTaskTimerEnt.Create(Self, fnEvent, dwInterval, bActive);
  Lock;
  try
    TimerEntList_.Add(TaskTimerEntry);
  finally
    Unlock;
  end;
  if bInitProcess and Assigned(fnEvent) then
    Synchronize(fnEvent);
end;

procedure TThdTaskTimer.SetTask(fnEvent: TNotifyEvent; dwInterval: DWORD; bActive: Boolean);
var
  enum: TTimerEntEnumerator;
begin
  Lock;
  try
    enum := TimerEntList_.GetEnumerator;
  finally
    Unlock;
  end;

  try
    while enum.MoveNext do
      if @enum.Current.Event = @fnEvent then
      begin
        if bActive then
          enum.Current.InitTask(GetTickCount)
        else
          enum.Current.InitTask(0);
        enum.Current.dwInterval_ := dwInterval;
        exit;
      end;
  finally
    enum.Free;
  end;
end;

function TThdTaskTimer.GetTaskActiveState(fnEvent: TNotifyEvent): Boolean;
var
  enum: TTimerEntEnumerator;
begin
  Result := false;
  Lock;
  try
    enum := TimerEntList_.GetEnumerator;
  finally
    Unlock;
  end;

  try
    while enum.MoveNext do
      if @enum.Current.Event = @fnEvent then
      begin
        Result := enum.Current.Tick <> 0;
        exit;
      end;
  finally
    enum.Free;
  end;
end;

procedure TThdTaskTimer.StartTimerThread;
var
  enum: TTimerEntEnumerator;
  dwTick: DWORD;
begin
  if bTimerOn_ then
    exit;

  bTimerOn_ := true;

  Lock;
  try
    enum := TimerEntList_.GetEnumerator;
  finally
    Unlock;
  end;

  try
    dwTick := GetTickCount;
    while enum.MoveNext do
      if enum.Current.DefaultActive then
        enum.Current.InitTask(dwTick);
  finally
    enum.Free;
  end;

  StartThread;
end;

procedure TThdTaskTimer.StopTimerThread;
var
  enum: TTimerEntEnumerator;
begin
  if not bTimerOn_ then
    exit;

  bTimerOn_ := false;

  StopThread;

  Lock;
  try
    enum := TimerEntList_.GetEnumerator;
  finally
    Unlock;
  end;

  try
    while enum.MoveNext do
      enum.Current.InitTask(0);
  finally
    enum.Free;
  end;

  PauseThread;
end;

procedure TThdTaskTimer.Execute;
var
  dwTick: DWORD;
  enum: TTimerEntEnumerator;
begin
  if bUseActiveX_ then CoInitialize(nil);
  try
    while not Terminated do
    begin
      Sleep(dwSleep_);

      try
        if not GetWorkStop then
        begin
          dwTick := GetTickCount;

          Lock;
          try
            enum := TimerEntList_.GetEnumerator;
            try
              while enum.MoveNext do
                enum.Current.ProcessTask(dwTick);
            finally
              enum.Free;
            end;
          finally
            Unlock;
          end;
        end;
      except
      //
      end;
    end;
  finally
    if bUseActiveX_ then CoUninitialize;
  end;
end;

end.