{*******************************************************} { } { 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; 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; TThdTaskTimer = class(TTgThread) private bTimerOn_, bUseActiveX_: Boolean; dwSleep_: DWORD; TimerEntList_: TList; 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.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; 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.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.