249 lines
6.1 KiB
Plaintext
249 lines
6.1 KiB
Plaintext
{*******************************************************}
|
|
{ }
|
|
{ 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.
|