{*******************************************************} { } { ThdRecordWait } { } { Copyright (C) 2025 kku } { } {*******************************************************} unit ThdRecordWait; interface uses Tocsg.Thread, System.SysUtils, Winapi.Windows, Define, Winapi.Messages, System.Classes, Tocsg.Win32; const WM_START_RECORD = WM_USER + 5487; WM_STOP_RECORD = WM_USER + 5488; type TRcdState = (rsIdle, rsRecording, rsStop); TThdRecordWait = class(TTgThread) protected Mtx_: TTgMutex; hMain_: HWND; TaskInfo_: TTaskInfo; sOwMtx_, sReason_, sOutPath_: String; RcdState_: TRcdState; llRcdTick_: LONGLONG; sChkApps_: String; ChkAppList_: TStringList; function IsUseProcess(sChkProc: String; var sOldProc: String; OldProcList: TStringList; var bDetectProc: String): Boolean; procedure SetRcdState(aState: TRcdState); function GetRcdState: TRcdState; procedure SetTaskInfo(aInfo: TTaskInfo); function GetTaskInfo: TTaskInfo; procedure Execute; override; public Constructor Create(hMain: HWND; sOwMtx:String; aTaskInfo: TTaskInfo); Destructor Destroy; override; procedure InitRecord; property Reason: String read sReason_; property OutPath: String read sOutPath_; property RcdTick: LONGLONG read llRcdTick_; property TaskInfo: TTaskInfo read GetTaskInfo write SetTaskInfo; end; implementation uses Tocsg.Strings, Tocsg.WndUtil, Tocsg.Process, Tocsg.Exception, Tocsg.Registry, GlobalDefine; { TThdRecordWait } Constructor TThdRecordWait.Create(hMain: HWND; sOwMtx:String; aTaskInfo: TTaskInfo); begin Inherited Create; hMain_ := hMain; sOwMtx_ := sOwMtx; TaskInfo_ := aTaskInfo; sChkApps_ := ''; ChkAppList_ := TStringList.Create;; ChkAppList_.CaseSensitive := false; SetRegValueString(HKEY_LOCAL_MACHINE, REG_HE, 'bs1rcd', IntToStr(hMain_), true); // SetRegValueInteger(HKEY_LOCAL_MACHINE, REG_HE, 'bs1rcd', hMain_, true); Mtx_ := TTgMutex.Create(MUTEX_NAME); if Mtx_.MutexState = msAlreadyExist then begin _Trace('Create() .. Fail .. AlreadyExist mutex'); TerminateProcess(GetCurrentProcess, 9); end; InitRecord; end; Destructor TThdRecordWait.Destroy; begin FreeAndNil(ChkAppList_); Inherited; end; procedure TThdRecordWait.InitRecord; begin sReason_ := ''; sOutPath_ := ''; RcdState_ := rsIdle; llRcdTick_ := 0; end; function TThdRecordWait.IsUseProcess(sChkProc: String; var sOldProc: String; OldProcList: TStringList; var bDetectProc: String): Boolean; var h: HWND; sCap, sPName: String; llStyle: LONGLONG; begin Result := false; try bDetectProc := 'N/A'; if sChkProc = '' then exit; if sChkProc <> sOldProc then begin sOldProc := sChkProc; SplitString(sOldProc, '|', OldProcList); end; h := FindWindow(nil, nil); while h <> 0 do begin llStyle := GetWindowStyle(h); if ((llStyle and WS_VISIBLE) <> 0) and ((llStyle and WS_MINIMIZE) = 0) then begin sCap := GetWindowCaption(h); if sCap <> '' then begin sPName := GetProcessNameFromWndHandle(h); if (sPName <> '') and (OldProcList.IndexOf(sPName) <> -1) then begin bDetectProc := sPName; Result := true; exit; end; end; end; h := GetWindow(h, GW_HWNDNEXT); end; except on E: Exception do ETgException.TraceException(Self, E, 'Fail .. IsUseProcess()'); end; end; procedure TThdRecordWait.SetRcdState(aState: TRcdState); begin Lock; try RcdState_ := aState; finally Unlock; end; end; function TThdRecordWait.GetRcdState: TRcdState; begin Lock; try Result := RcdState_; finally Unlock; end; end; procedure TThdRecordWait.SetTaskInfo(aInfo: TTaskInfo); begin Lock; try TaskInfo_ := aInfo; finally Unlock; end; end; function TThdRecordWait.GetTaskInfo: TTaskInfo; begin Lock; try Result := TaskInfo_; finally Unlock; end; end; procedure TThdRecordWait.Execute; var TInfo: TTaskInfo; llTick: LONGLONG; sNone: String; begin while not Terminated and not GetWorkStop do begin TInfo := GetTaskInfo; case GetRcdState of rsIdle : begin if IsUseProcess(TInfo.sApps, sChkApps_, ChkAppList_, sReason_) then begin _Trace('rsIdle : Detect .. %s', [sReason_]); if ForceDirectories(TInfo.sTaskDir) then begin sOutPath_ := TInfo.sTaskDir + FormatDateTime('yyyymmddhhnnss', Now) + '.mp4'; SetRcdState(rsRecording); SendMessage(hMain_, WM_START_RECORD, 0, 0); llRcdTick_ := GetTickCount64; _Trace('rsIdle : START_RECORD'); end else _Trace('Execute() .. Fail .. createDir, Path=%s', [TInfo.sTaskDir]); end; end; rsRecording : begin llTick := GetTickCount64 - llRcdTick_; if IsUseProcess(TInfo.sApps, sChkApps_, ChkAppList_, sNone) then begin if llTick >= (60000 * TInfo.nMaxMain) then begin SetRcdState(rsStop); SendMessage(hMain_, WM_STOP_RECORD, 0, 0); _Trace('rsRecording : Record time end, MilSec=%d', [llTick]); end; end else begin // 3초까지 기다렸다가 녹화 중지 한다. if llTick >= 3000 then begin SetRcdState(rsStop); SendMessage(hMain_, WM_STOP_RECORD, 0, 0); _Trace('rsRecording : Record stop, MilSec=%d', [llTick]); end; end; end; rsStop : ; end; if sOwMtx_ <> '' then if not MutexExists(sOwMtx_) then begin SetRcdState(rsStop); SendMessage(hMain_, WM_STOP_RECORD, 0, 0); _Trace('rsRecording : no mutex .. terminate .. Record stop, MilSec=%d', [llTick]); TerminateProcess(GetCurrentProcess, 9); end; Sleep(500); end; end; end.