BSOne.SFC/Tocsg.Module/WndMsgHook/EXE_WndMsgHook/CtrlWndActiveHook.pas

1135 lines
32 KiB
Plaintext
Raw Permalink Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

{*******************************************************}
{ }
{ CtrlWndActiveHook }
{ }
{ Copyright (C) 2022 sunk }
{ }
{*******************************************************}
unit CtrlWndActiveHook;
interface
uses
System.SysUtils, Winapi.Windows, Winapi.Messages, System.Generics.Collections,
Tocsg.Thread, System.SyncObjs, Tocsg.Process, Tocsg.Obj, Tocsg.CommonData,
Tocsg.Win32, Winapi.oleacc, System.Classes;
const
DIR_CAPTURE = 'HookData\Capture\';
WM_WNDHOOK_RELOAD = WM_USER + 9630;
WM_WNDHOOK_NOTIFY = WM_USER + 9633;
WM_MESSAGEHOOK_NOTIFY = WM_USER + 9636;
WND_STATE_ATTACH_HOOK = 1;
WND_STATE_DETACH_HOOK = 2;
WND_STATE_ACTIVATE = 3;
WND_STATE_WINDOW_MIN = 4;
WND_STATE_WINDOW_MAX = 5;
WND_STATE_WINDOW_MOVESIZE = 6;
WND_STATE_REDRAW_TITLE = 7;
WND_STATE_CREATE_MAIN = 8;
WND_STATE_DESTROY_MAIN = 9;
WND_STATE_WINDOW_NORMAL = 10;
WND_STATE_ACTIVATE2 = 11; // for CBT 2014-04-08
MSG_WM_COPY = 21;
MSG_WM_CUT = 22;
MSG_WM_PASTE = 23;
MSG_WM_RENDERFORMAT = 24;
MSG_WM_RENDERALLFORMATS = 25;
MSG_WM_CLOSE = 26;
MSG_WM_QUIT = 27;
MSG_WM_DESTROY = 28;
MSG_WM_SETTEXT = 29;
type
THookState = (hsFree, hsHooking, hsReload, hsFinish);
PSharedData = ^TSharedData;
TSharedData = packed record
hRcvWnd: ULONGLONG;
dwLastInput: DWORD;
// HookState: THookState;
end;
TProcessEntry = class;
TWindowLogState = (wlUnknown, wlCreate, wlDestroy, wlActive, wlMin, wlMax,
wlRestore, wlMoveSize, wlRedrawTitle, wlAttach, wlDetach, wlActive2);
PWindowLogEntry = ^TWindowLogEntry;
TWindowLogEntry = record
dtLog: TDateTime;
WindowLogState: TWindowLogState;
sTitle,
sSubTitle: String;
OwnerWindow: TProcessEntry;
end;
TCtrlWndActiveHook = class;
TProcessEntry = class(TTgProcessInfo)
private
CtrlWndHook_: TCtrlWndActiveHook;
dtDestroy_: TDateTIme;
ullIdleSec_,
ullActiveSec_: ULONGLONG;
hSubTitleHWND_: HWND; // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> URL<52><4C><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>߰<EFBFBD> Ÿ<><C5B8>Ʋ <20><><EFBFBD><EFBFBD> 2012-06-27 sunk
sPreTitle_,
sDescription_: String;
hRecentWnd_: HWND;
lstLog_: TList<PWindowLogEntry>;
lstWndHandle_: TList<HWND>;
AccObj_SubTitle_: IAccessible;
varSubTitle_: OleVariant;
sRecentSub_: String;
dtCapture_: TDateTime;
class var _ActiveWindow: TProcessEntry;
procedure SetDestroyDateTime(dt: TDateTime);
function GetLog(nIndex: Integer): PWindowLogEntry;
function GetCountLog: Integer;
procedure OnWindowLogNotify(Sender: TObject; const Item: PWindowLogEntry; Action: TCollectionNotification);
procedure IncActiveSec(dwSec: DWORD = 1);
procedure IncIdleSec(dwSec: DWORD = 1);
public
Constructor Create(aCtrlWndHook: TCtrlWndActiveHook; dwPid: DWORD);
Destructor Destroy; override;
function IsActive: Boolean;
function AddWindowLog(hWindow: HWND; aWindowLogState: TWindowLogState): TWindowLogEntry;
procedure ActiveEvent;
procedure DeActiveEvent;
property Logs[nIndex: Integer]: PWindowLogEntry read GetLog; default;
property CountLog: Integer read GetCountLog;
property DestroyDateTime: TDateTime read dtDestroy_ write SetDestroyDateTime;
property ActiveSec: ULONGLONG read ullActiveSec_;
property IdleSec: ULONGLONG read ullIdleSec_;
property Description: String read sDescription_;
property RecentHWND: HWND read hRecentWnd_;
end;
TThdIncreaseActiveTime = class(TTgThread)
protected
WndHook_: TCtrlWndActiveHook;
procedure Execute; override;
public
Constructor Create(aWndHook: TCtrlWndActiveHook);
Destructor Destroy; override;
end;
TInstallWindowActiveHook = function: Integer; stdcall;//function(sShareMapFilename: PChar): Integer; stdcall;
TUninstallWindowActiveHook = function: Integer; stdcall;
TActiveWindowNotify = procedure(Sender: TCtrlWndActiveHook; aWindowEntry: TProcessEntry) of object;
TCtrlWndActiveHook = class(TTgObject)
private
hRcvWnd_: HWND;
SharedData_: TTgFileMapping<TSharedData>;
crs_: TCriticalSection;
hHookDLL_: THandle;
DcProcEntry_: TDictionary<DWORD,TProcessEntry>;
lstDestroyWndEntry_: TList<TProcessEntry>;
bUseDestroyWnd_,
bRecordWindowLog_: Boolean;
// ThdIncreaseActiveTime_: TThdIncreaseActiveTime;
evActive_,
evDeActive_: TActiveWindowNotify;
CatchMtx_: TTgMutex;
procedure SetActiveEvent(evActive: TActiveWindowNotify);
procedure SetDeActiveEvent(evDeActive: TActiveWindowNotify);
function GetProcessEntry(dwPid: DWORD): TProcessEntry;
function GetDestroyWindowEntry(nIndex: Integer): TProcessEntry;
procedure OnWindowEntryNotify(Sender: TObject; const Item: TProcessEntry; Action: TCollectionNotification);
procedure ActiveEvent(aWndEntry: TProcessEntry);
procedure DeActiveEvent(aWndEntry: TProcessEntry);
public
Constructor Create(hRcvWnd: HWND; bUseDestroyWnd: Boolean; bRecordWindowLog: Boolean = true);
Destructor Destroy; override;
procedure LoadHookDll;
procedure UnHookDll(bFreeDll: Boolean = false);
procedure Lock;
procedure UnLock;
procedure ClearDestroyWnd;
function AddWindowEntry(dwPid: DWORD): TProcessEntry;
function DeleteWindowEntry(dwPid: DWORD): TProcessEntry;
function CountWndDestroy: Integer;
function ProcessHookNotify(msg: TMessage): TWindowLogEntry;
property WndEntry[dwPid: DWORD]: TProcessEntry read GetProcessEntry; default;
property WndDestroy[nIndex: Integer]: TProcessEntry read GetDestroyWindowEntry;
property OnActive: TActiveWindowNotify read evActive_ write SetActiveEvent;
property OnDeActive: TActiveWindowNotify read evDeActive_ write SetDeActiveEvent;
property SharedData: TTgFileMapping<TSharedData> read SharedData_;
property RecordWindowLog: Boolean read bRecordWindowLog_;
end;
implementation
uses
// Tocsg.USER32,
Winapi.TlHelp32, Winapi.PsAPI, Tocsg.Trace, Tocsg.Safe, Tocsg.Shell,
Tocsg.Files, Tocsg.WinInfo, Tocsg.Path, System.DateUtils, Tocsg.Capture,
Vcl.Imaging.jpeg, Tocsg.WndUtil, Winapi.ActiveX, Tocsg.MSAA, System.Variants, Tocsg.Strings, DefineWndMon,
Tocsg.FileInfo;
{ TProcessEntry }
Constructor TProcessEntry.Create(aCtrlWndHook: TCtrlWndActiveHook; dwPid: DWORD);
procedure InitEntry;
var
FileInfo: TTgFileInfo;
begin
Guard(FileInfo, TTgFileInfo.Create(sProcPath_));
sDescription_ := FileInfo.Description;
end;
begin
ASSERT(dwPid > 0);
Inherited Create(dwPid);
dtCapture_ := 0;
hRecentWnd_ := 0;
CtrlWndHook_ := aCtrlWndHook;
sPreTitle_ := '';
ullIdleSec_ := 0;
ullActiveSec_ := 0;
lstWndHandle_ := TList<HWND>.Create;
lstLog_ := TList<PWindowLogEntry>.Create;
lstLog_.OnNotify := OnWindowLogNotify;
AccObj_SubTitle_ := nil;
VariantClear(varSubTitle_);
sRecentSub_ := '';
hSubTitleHWND_ := 0;
InitEntry;
end;
Destructor TProcessEntry.Destroy;
begin
AccObj_SubTitle_ := nil;
VariantClear(varSubTitle_);
if Self = _ActiveWindow then
begin
CtrlWndHook_.DeActiveEvent(Self);
_ActiveWindow := nil;
end;
FreeAndNil(lstLog_);
FreeAndNil(lstWndHandle_);
Inherited;
end;
function TProcessEntry.IsActive: Boolean;
begin
Result := _ActiveWindow = self;
end;
procedure TProcessEntry.OnWindowLogNotify(Sender: TObject;
const Item: PWindowLogEntry; Action: TCollectionNotification);
begin
case Action of
cnAdded: ;
cnRemoved:
begin
Finalize(Item^);
Dispose(Item);
end;
cnExtracted: ;
end;
end;
procedure TProcessEntry.IncActiveSec(dwSec: DWORD = 1);
begin
Inc(ullActiveSec_, dwSec);
end;
procedure TProcessEntry.IncIdleSec(dwSec: DWORD = 1);
begin
Inc(ullIdleSec_, dwSec);
end;
function TProcessEntry.AddWindowLog(hWindow: HWND; aWindowLogState: TWindowLogState): TWindowLogEntry;
function GetWndChildClassCustom(h: HWND; const sClassName: String; hPreChild: HWND = 0): HWND;
var
hChild: HWND;
arrClassName: array [0..255] of Char;
begin
Result := 0;
if hPreChild <> 0 then
hChild := GetWindow(hPreChild, GW_HWNDNEXT)
else
hChild := GetWindow(h, GW_CHILD);
while hChild <> 0 do
begin
if GetClassName(hChild, arrClassName, SizeOf(arrClassName)) > 0 then
begin
if (arrClassName = sClassName) and (GetEditText(hChild) <> '') then
// if arrClassName = sClassName then
begin
Result := hChild;
exit;
end;
end;
if GetWindow(hChild, GW_CHILD) <> 0 then
begin
Result := GetWndChildClassCustom(hChild, sClassName);
if Result <> 0 then
exit;
end;
hChild := GetWindow(hChild, GW_HWNDNEXT);
end;
end;
function GetSubTitle: String; // <20>ͽ<EFBFBD><CDBD>÷η<C3B7><CEB7><EFBFBD> <20><><EFBFBD><EFBFBD> URL <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD>ܶ<EFBFBD><DCB6><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>.. 14_1111 09:54:30 sunk
var
h: HWND;
ProcEnumAccessible: TProcessEnumAccessible;
sAccResult,
sProcName,
sAddressBarName,
sAddressBarRole: String;
bRetry: Boolean;
WndList: TStringList;
nHandleIdx, nHandleCnt: Integer;
arrRoleStr: array [0..300] of Char;
Label
LB_RETRY, LB_EnumAccessible;
begin
bRetry := false;
Result := '';
WndList := nil;
nHandleIdx := 0;
nHandleCnt := 0;
if (AccObj_SubTitle_ <> nil) and not VarIsNull(varSubTitle_) then
begin
// IE 11 <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD>س<EFBFBD><D8B3><EFBFBD> <20>ν<EFBFBD><CEBD>Ͻ<EFBFBD><CFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EEB3BB> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>ʱ<EFBFBD>ȭ <20><><EFBFBD>ֵ<EFBFBD><D6B5><EFBFBD> <20><><EFBFBD><EFBFBD>... 18_0201 17:16:41 sunk
Result := GetObjectValue(AccObj_SubTitle_, varSubTitle_);
// _Trace('11 .. GetSubTitle .. "%s"', [Result]);
if sRecentSub_ <> Result then
begin
sRecentSub_ := Result;
exit;
end;
// _Trace('11 .. GetSubTitle .. old = new .. "%s"', [Result]);
AccObj_SubTitle_ := nil;
VariantClear(varSubTitle_);
end else
if hSubTitleHWND_ <> 0 then
begin
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> 18_0201 17:16:50 sunk
Result := GetEditText(hSubTitleHWND_);
// _Trace('22 .. GetSubTitle .. "%s"', [Result]);
if sRecentSub_ <> Result then
begin
sRecentSub_ := Result;
exit;
end;
// _Trace('22 .. GetSubTitle .. old = new .. "%s"', [Result]);
hSubTitleHWND_ := 0;
end;
LB_RETRY :
sAccResult := '';
sProcName := LowerCase(sProcName_);
if (hWindow <> 0) then
begin
ProcEnumAccessible :=
procedure(aAccObj: IAccessible; varChild: OleVariant; h: HWND; nLevel: Integer; var bContinue: Boolean)
var
sName,
sRole: String;
begin
// _Trace('Name = %s', [GetObjectName(aAccObj, varChild)]);
// _Trace('RoleString = %s', [GetObjectRoleString(aAccObj, varChild)]);
sName := Trim(LowerCase(GetObjectName(aAccObj, varChild)));
// sRole := Trim(LowerCase(GetObjectRoleString(aAccObj, varChild)));
sRole := '';
ZeroMemory(@arrRoleStr, SizeOf(arrRoleStr));
if GetObjectRoleString(aAccObj, varChild, @arrRoleStr) then
sRole := DeleteNullTail(String(@arrRoleStr));
// <20>Ʒ<EFBFBD>ó<EFBFBD><C3B3> <20≯<EFBFBD><CCB8><EFBFBD><EFBFBD><EFBFBD> Ȯ<><C8AE> <20>ؼ<EFBFBD> <20>ּ<EFBFBD> <20><>Ʈ<EFBFBD><C6AE><EFBFBD><EFBFBD> ã<>´<EFBFBD>.
// <20>ѱ<EFBFBD><D1B1><EFBFBD> ũ<><C5A9><EFBFBD><EFBFBD> <20≯<EFBFBD><CCB8><EFBFBD><EFBFBD><EFBFBD> "<22>ּ<EFBFBD>â <20><> <20>˻<EFBFBD>â"<22><> ã<><C3A3><EFBFBD><EFBFBD> <20>Ǵµ<C7B4> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><EFBFBD><EEB6B2> Ȯ<><C8AE><EFBFBD>غ<EFBFBD><D8BA><EFBFBD> <20><><EFBFBD>ߴ<EFBFBD>.
// <20><EFBFBD><EBB7AB><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>޾<DEBE>ɷ<EFBFBD> <20>ϴ<EFBFBD> <20>ֱ<EFBFBD><D6B1><EFBFBD> 14_1112 10:41:12 sunk
if (Pos(sName, sAddressBarName) > 0) and (Pos(sRole, sAddressBarRole) > 0) then
begin
bContinue := false;
AccObj_SubTitle_ := aAccObj;
varSubTitle_ := varChild;
sAccResult := GetObjectValue(aAccObj, varChild);
end else
bContinue := true;
end;
sAddressBarRole := '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20>ִ<EFBFBD> <20>ؽ<EFBFBD>Ʈ:editable text'; // <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> 17_0207 10:20:06 sunk
if sProcName = 'iexplore.exe' then
begin
// _Trace('AddWindowLog() >> GetSubTitle() .. ProcName = %s', [sProcName]);
h := GetWndChildClassCustom(hWindow, 'Address Band Root');
if h <> 0 then
begin
// _Trace('AddWindowLog() >> GetSubTitle() .. ProcName = %s, "Address Band Root" .. ok', [sProcName]);
hSubTitleHWND_ := GetWndChildClassCustom(h, 'Edit');
if hSubTitleHWND_ = 0 then
begin
{$IFDEF TRACE_WM}
_Trace('AddWindowLog() >> GetSubTitle() .. ProcName = %s, "Address Band Root" .. ok .. class not found .. "Edit" .. TrayAcc', [sProcName]);
{$ENDIF}
sAddressBarName := 'bing<6E><67>(<28><>) <20><><EFBFBD><EFBFBD><EFBFBD>Ͽ<EFBFBD> <20>ּ<EFBFBD> <20><><EFBFBD><EFBFBD> <20><> <20>˻<EFBFBD>:bing <20>˻<EFBFBD><CBBB><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>Ͽ<EFBFBD> <20>ּ<EFBFBD> <20><><EFBFBD><EFBFBD> <20><> <20>˻<EFBFBD>';
goto LB_EnumAccessible;
end else
Result := GetEditText(hSubTitleHWND_);
end else begin
{$IFDEF TRACE_WM}
_Trace('AddWindowLog() >> GetSubTitle() .. ProcName = %s, class not found .. "Address Band Root" .. TrayAcc', [sProcName]);
{$ENDIF}
// 11<31><31><EFBFBD><EFBFBD> <20><><EFBFBD>Ŀ<EFBFBD> <20><> <20>ڵ<EFBFBD><DAB5><EFBFBD> <20>ɷ<EFBFBD><C9B7><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20>ȵǴ<C8B5> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>߻<EFBFBD><DFBB>ߴ<EFBFBD>...
// <20>׷<EFBFBD><D7B7><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>ֻ<EFBFBD><D6BB><EFBFBD> <20>ڵ<EFBFBD><DAB5><EFBFBD> <20><><EFBFBD>°ɷ<C2B0> <20><><EFBFBD><EFBFBD> 18_0201 15:54:50 sunk
// h := GetWndHandleFromPid(dwPid_);
// if (h <> 0) and (h <> hWindow) then
// begin
// hWindow := h;
// _Trace('AddWindowLog() >> GetSubTitle() .. ProcName = %s, class not found .. "Address Band Root" .. TrayAcc .. change .. handle', [sProcName]);
// end;
// <20><><EFBFBD><EFBFBD> <20><> ã<><C3A3> <20><><EFBFBD><EFBFBD> <20>ϳ<EFBFBD> <20><> <20>߰<EFBFBD> 18_0116 15:40:27 sunk
// sAddressBarName<6D><65> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>ؼ<EFBFBD> <20><> <20>߰<EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>ʿ<EFBFBD><CABF>ϰ<EFBFBD>
// <20≯<EFBFBD><CCB8><EFBFBD> OS <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><20>˻<EFBFBD><CBBB><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>ٸ<EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD>Ƿ<EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>ʿ<EFBFBD><CABF>ϴ<EFBFBD>
sAddressBarName := 'bing<6E><67>(<28><>) <20><><EFBFBD><EFBFBD><EFBFBD>Ͽ<EFBFBD> <20>ּ<EFBFBD> <20><><EFBFBD><EFBFBD> <20><> <20>˻<EFBFBD>:bing <20>˻<EFBFBD><CBBB><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>Ͽ<EFBFBD> <20>ּ<EFBFBD> <20><><EFBFBD><EFBFBD> <20><> <20>˻<EFBFBD>';
goto LB_EnumAccessible;
end;
end else
if sProcName = 'msedge.exe' then
begin
// <20><><EFBFBD><EFBFBD> ũ<>ι̿<CEB9> <20>߰<EFBFBD> 20_0608 08:25:07 sunk
sAddressBarName := '<27>ּ<EFBFBD> ǥ<><C7A5><EFBFBD><EFBFBD> <20><> <20>˻<EFBFBD> â:address and search bar';
goto LB_EnumAccessible;
end else
if sProcName = 'whale.exe' then
begin
// <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>߰<EFBFBD> 20_0713 08:45:00 sunk
sAddressBarName := '<27>ּ<EFBFBD>â <20><> <20>˻<EFBFBD>â:address and search bar';
goto LB_EnumAccessible;
end else
if sProcName = 'chrome.exe' then
begin
hSubTitleHWND_ := GetWndChildClassCustom(hWindow, 'Chrome_OmniboxView');
if hSubTitleHWND_ = 0 then
begin
// ũ<><C5A9> 28<32><38><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD>ʹ<EFBFBD> <20>ٸ<EFBFBD><D9B8><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>Ѵ<EFBFBD>.. 14_1111 10:29:37 sunk
sAddressBarName := '<27>ּ<EFBFBD>â <20><> <20>˻<EFBFBD>â:address and search bar';
goto LB_EnumAccessible;
end else
Result := GetEditText(hSubTitleHWND_);
end else
if sProcName = 'firefox.exe' then
begin
sAddressBarName := 'google<6C><65> <20>˻<EFBFBD><CBBB>ϰų<CFB0> <20>ּ<EFBFBD> <20>Է<EFBFBD>:<3A>˻<EFBFBD><CBBB><20>ּ<EFBFBD> <20>Է<EFBFBD>:search or enter address';
// EnumAccessible(hWindow, ProcEnumAccessible);
goto LB_EnumAccessible;
end else
if sProcName = 'opera.exe' then
begin
sAddressBarName := '<27>ּ<EFBFBD> <20>ʵ<EFBFBD>:address field';
// EnumAccessible(hWindow, ProcEnumAccessible);
goto LB_EnumAccessible;
end;
exit; // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> ------------------------------------------------
LB_EnumAccessible :
// <20><><EFBFBD><EFBFBD> ó<><C3B3><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> 18_0117 09:26:19 sunk
EnumAccessible(hWindow, ProcEnumAccessible);
if (AccObj_SubTitle_ <> nil) and not VarIsNull(varSubTitle_) then
begin
Result := sAccResult;
// _Trace('AddWindowLog() >> GetSubTitle() .. ProcName = %s, AccResult = %s', [sProcName, sAccResult]);
end else begin
{$IFDEF TRACE_WM}
_Trace('AddWindowLog() >> GetSubTitle() .. ProcName = %s, EnumAccName not found ..', [sProcName]);
{$ENDIF}
if (dwPid_ <> 0) and not bRetry then
begin
// if WndList <> nil then
// begin
// if nHandleIdx < WndList.Count then
// begin
// hWindow := StrToIntDef(WndList[nHandleIdx], 0);
// Inc(nHandleIdx);
// goto LB_RETRY;
// end;
// end else begin
// Safer(WndList, TStringList.Create);
// nHandleCnt := GetWndHandlesFromPID(dwPID_, WndList);
// if nHandleCnt > 0 then
// begin
// hWindow := StrToIntDef(WndList[nHandleIdx], 0);
// Inc(nHandleIdx);
// goto LB_RETRY;
// end;
// end;
{$IFDEF TRACE_WM}
_Trace('AddWindowLog() >> GetSubTitle() .. ProcName = %s, init retry ..', [sProcName]);
{$ENDIF}
bRetry := true;
h := GetWndHandleFromPid(dwPid_);
if (h <> 0) and (h <> hWindow) then
begin
hWindow := h;
{$IFDEF TRACE_WM}
_Trace('AddWindowLog() >> GetSubTitle() .. ProcName = %s, init retry .. ok', [sProcName]);
{$ENDIF}
goto LB_RETRY;
end else begin
{$IFDEF TRACE_WM}
_Trace('AddWindowLog() >> GetSubTitle() .. ProcName = %s, init retry .. cancel ..', [sProcName]);
{$ENDIF}
end;
end;
end;
if sRecentSub_ = Result then
begin
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD>ٸ<EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><>ȯ<EFBFBD><C8AF><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20>ʱ<EFBFBD>ȭ<EFBFBD><C8AD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> 18_0201 17:12:37 sunk
sRecentSub_ := '';
Result := '';
end;
end;
end;
procedure CaptureWindow;
var
jpg: TJPEGImage;
dtNow: TDateTime;
sPath: String;
RT: TRect;
begin
dtNow := now;
if (hRecentWnd_ <> 0) and (MinutesBetween(dtNow, dtCapture_) > 5) then
begin
if not GetWindowRect(hRecentWnd_, RT) then
exit;
if (RT.Width = 0) or (RT.Height = 0) then
exit;
jpg := CaptureWindowClientAsJPEG(hRecentWnd_);
if jpg <> nil then
begin
sPath := ExtractFilePath(GetRunExePath) + DIR_CAPTURE + ModuleName;
if ForceDirectories(sPath) then
begin
sPath := sPath + FormatDateTime('\yyyy-mm-dd hh.nn.ss', dtNow) + '.jpg';
jpg.SaveToFile(sPath);
end;
FreeAndNil(jpg);
dtCapture_ := dtNow;
end;
end;
end;
var
nIndex, nTO: Integer;
sTitle,
sSubTitle: String;
pWndLogEntry: PWindowLogEntry;
begin
ZeroMemory(@Result, SizeOf(Result));
if (hWindow <> 0) and (lstWndHandle_.IndexOf(hWindow) < 0) then
lstWndHandle_.Add(hWindow);
sTitle := GetWindowCaption(hWindow);
sSubTitle := GetSubTitle;
// nTO := 0;
// while sSubTitle = '' do
// begin
// Sleep(100);
// sSubTitle := GetSubTitle;
// Inc(nTO);
// if nTO >= 10 then
// break;
// end;
case aWindowLogState of
wlUnknown : ;
wlCreate : ;
wlDestroy :
begin
nIndex := lstWndHandle_.IndexOf(hWindow);
if nIndex >= 0 then
lstWndHandle_.Delete(nIndex);
hRecentWnd_ := 0;
end;
wlRestore,
wlActive,
wlActive2 :
begin
if Self <> _ActiveWindow then
begin
if Assigned(_ActiveWindow) then
_ActiveWindow.DeActiveEvent;
_ActiveWindow := Self;
_ActiveWindow.ActiveEvent;
end;
end;
wlMin : ;
wlMax : ;
wlMoveSize : ;
wlRedrawTitle : if sPreTitle_ = sTitle then exit;
wlAttach : ;
wlDetach : ;
end;
hRecentWnd_ := hWindow;
sPreTitle_ := sTitle;
Result.dtLog := now;
Result.WindowLogState := aWindowLogState;
Result.sTitle := sTitle;
if sSubTitle <> '' then
Result.sSubTitle := sSubTitle;
Result.OwnerWindow := Self;
if CtrlWndHook_.bRecordWindowLog_ then
begin
New(pWndLogEntry);
pWndLogEntry^ := Result;
lstLog_.Add(pWndLogEntry);
end;
// CaptureWindow;
end;
procedure TProcessEntry.ActiveEvent;
begin
CtrlWndHook_.ActiveEvent(Self);
end;
procedure TProcessEntry.DeActiveEvent;
begin
CtrlWndHook_.DeActiveEvent(Self);
end;
procedure TProcessEntry.SetDestroyDateTime(dt: TDateTime);
begin
if (dtDestroy_ = 0) and (dt > 0) then
dtDestroy_ := dt;
end;
function TProcessEntry.GetLog(nIndex: Integer): PWindowLogEntry;
begin
Result := nil;
if (nIndex >= 0) and (lstLog_.Count > nIndex) then
Result := lstLog_[nIndex];
end;
function TProcessEntry.GetCountLog: Integer;
begin
Result := lstLog_.Count;
end;
{ TThdIncreaseActiveTime }
Constructor TThdIncreaseActiveTime.Create(aWndHook: TCtrlWndActiveHook);
begin
Inherited Create;
WndHook_ := aWndHook;
StartThread;
end;
Destructor TThdIncreaseActiveTime.Destroy;
begin
Inherited;
end;
procedure TThdIncreaseActiveTime.Execute;
function IsForegroundWindow: Boolean;
begin
Result := false;
if Assigned(TProcessEntry._ActiveWindow) then
Result := TProcessEntry._ActiveWindow.lstWndHandle_.IndexOf(GetForegroundWindow) > -1;
// Repeat
// Result := hForegroundWindow = TWindowEntry._ActiveWindow.Handle;
// if Result then break;
// hForegroundWindow := GetParent(hForegroundWindow);
// Until hForegroundWindow = 0;
end;
procedure CheckInvalidProcess;
var
hSnapProc: THandle;
ProcEntry: TProcessEntry32;
lstProc: TList<DWORD>;
enum: TEnumerator<TProcessEntry>;
WndEntry: TProcessEntry;
begin
hSnapProc := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if hSnapProc = INVALID_HANDLE_VALUE then
exit;
Guard(lstProc, TList<DWORD>.Create);
try
ProcEntry.dwSize := SizeOf(TProcessEntry32);
Process32First(hSnapProc, ProcEntry); // first = "system"
while Process32Next(hSnapProc, ProcEntry) do
lstProc.Add(ProcEntry.th32ProcessID);
finally
CloseHandle(hSnapProc);
end;
WndHook_.Lock;
try
Guard(enum, WndHook_.DcProcEntry_.Values.GetEnumerator);
while enum.MoveNext do
begin
WndEntry := enum.Current;
if lstProc.IndexOf(WndEntry.PID) < 0 then
begin
if WndEntry.RecentHWND <> 0 then
PostMessage(WndHook_.hRcvWnd_, WM_WNDHOOK_NOTIFY, MakeWParam(WND_STATE_DESTROY_MAIN, WndEntry.PID), WndEntry.RecentHWND);
PostMessage(WndHook_.hRcvWnd_, WM_WNDHOOK_NOTIFY, MakeWParam(WND_STATE_DETACH_HOOK, WndEntry.PID), 0);
end;
end;
finally
WndHook_.UnLock;
end;
end;
var
dwSec,
dwProcTick,
dwIdleTick,
dwTickCount,
dwInputIdelSec: DWORD;
begin
dwIdleTick := GetTickCount;
dwProcTick := dwIdleTick;
while not Terminated do
begin
Sleep(50);
dwTickCount := GetTickCount;
dwSec := (dwTickCount - dwIdleTick) div 1000;
if Assigned(TProcessEntry._ActiveWindow) and (dwSec >= 1) then
begin
if (WndHook_.SharedData <> nil) and (WndHook_.SharedData.Data.dwLastInput > 0) then
dwInputIdelSec := (dwTickCount - WndHook_.SharedData.Data.dwLastInput) div 1000
else
dwInputIdelSec := 0;
if IsForegroundWindow then
begin
if dwInputIdelSec < 60 then
TProcessEntry._ActiveWindow.IncActiveSec(dwSec)
else
TProcessEntry._ActiveWindow.IncIdleSec(dwSec);
end else begin
Synchronize(TProcessEntry._ActiveWindow.DeActiveEvent);
TProcessEntry._ActiveWindow := nil;
end;
dwIdleTick := dwTickCount;
end;
dwSec := (dwTickCount - dwProcTick) div 1000;
if dwSec > 3 then
begin
CheckInvalidProcess;
dwProcTick := dwTickCount;
end;
end;
end;
{ TCtrlWndActiveHook }
Constructor TCtrlWndActiveHook.Create(hRcvWnd: HWND; bUseDestroyWnd: Boolean; bRecordWindowLog: Boolean = true);
procedure InitMessageFilter;
begin
ChangeWindowMessageFilter(WM_WNDHOOK_RELOAD, MSGFLT_ADD);
ChangeWindowMessageFilter(WM_WNDHOOK_NOTIFY, MSGFLT_ADD);
ChangeWindowMessageFilter(WM_MESSAGEHOOK_NOTIFY, MSGFLT_ADD);
end;
begin
crs_ := TCriticalSection.Create;
Inherited Create;
CatchMtx_ := nil;
hRcvWnd_ := hRcvWnd;
evActive_ := nil;
evDeActive_ := nil;
bUseDestroyWnd_ := bUseDestroyWnd;
bRecordWindowLog_ := bRecordWindowLog;
DcProcEntry_ := TDictionary<DWORD,TProcessEntry>.Create;
DcProcEntry_.OnValueNotify := OnWindowEntryNotify;
if bUseDestroyWnd_ then
begin
lstDestroyWndEntry_ := TList<TProcessEntry>.Create;
lstDestroyWndEntry_.OnNotify := OnWindowEntryNotify;
end;
hHookDLL_ := 0;
InitMessageFilter;
SharedData_ := TTgFileMapping<TSharedData>.Create(MAP_FILENAME_WM + DLL_NAME_N_EXT, SizeOf(TSharedData));
if SharedData_.LastError = ERROR_SUCCESS then
begin
SharedData_.Data.hRcvWnd := hRcvWnd;
LoadHookDLL;
end;
// ThdIncreaseActiveTime_ := TThdIncreaseActiveTime.Create(self);
end;
Destructor TCtrlWndActiveHook.Destroy;
begin
if CatchMtx_ <> nil then
FreeAndNil(CatchMtx_);
// FreeAndNil(ThdIncreaseActiveTime_);
UnHookDll(true);
FreeAndNil(SharedData_);
FreeAndNil(DcProcEntry_);
if Assigned(lstDestroyWndEntry_) then
FreeAndNil(lstDestroyWndEntry_);
TProcessEntry._ActiveWindow := nil;
Inherited;
FreeAndNil(crs_);
end;
procedure TCtrlWndActiveHook.LoadHookDLL;
var
sPath: String;
fnInstallWindowActiveHook: TInstallWindowActiveHook;
h64: HWND;
begin
_Trace('TCtrlWndActiveHook >> LoadHookDLL()');
if not SharedData_.IsAvailable then
begin
{$IFDEF DEBUG}
ASSERT(false);
{$ENDIF}
exit;
end;
CatchMtx_ := TTgMutex.Create(IntToStr(GetCurrentProcessId) + IntToStr(NativeInt(Self)));
if CatchMtx_.MutexState = msAlreadyExist then
begin
_Trace('Load .. msAlreadyExist ..');
exit;
end;
sPath := GetRunExePathDir + DLL_NAME_N_EXT;
if FileExists(sPath) then
begin
// if SharedData_.Data.HookState = hsHooking then
// SharedData_.Data.HookState := hsReload;
_Trace('TCtrlWndActiveHook >> LoadHookDLL() >> DLL Exist..');
if hHookDLL_ = 0 then
begin
hHookDLL_ := LoadLibrary(PChar(sPath));
_Trace('TCtrlWndActiveHook >> LoadHookDLL() >> DLL LoadLibrary()..');
end;
if hHookDLL_ <> 0 then
begin
@fnInstallWindowActiveHook := nil;
@fnInstallWindowActiveHook := GetProcAddress(hHookDLL_, 'InstallWindowActiveHook');
if @fnInstallWindowActiveHook <> nil then
begin
_Trace('TCtrlWndActiveHook >> LoadHookDLL() >> DLL InstallWindowActiveHook()..');
if fnInstallWindowActiveHook = 0 then
begin
_Trace('TCtrlWndActiveHook >> LoadHookDLL() >> DLL InstallWindowActiveHook().. OK');
// SharedData_.Data.HookState := hsHooking;
end;
end;
end;
end else exit;
if IsWow64 then
begin
// if DebugHook = 0 then
begin
// 64bit <20><><EFBFBD>ý<EFBFBD><C3BD>Ͱ<EFBFBD> DLL <20>ε<EFBFBD><CEB5>ϸ鼭 <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>.
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><> <20><><EFBFBD><20>̷<EFBFBD><CCB7><EFBFBD> ó<><C3B3> 2012-06-01 sunk
sPath := ExtractFilePath(GetRunExePath) + EXE_LOADER64;
if FileExists(sPath) then
ExecutePath_hide(sPath, Format('/mutex %s /dllname %s64.dll', [CatchMtx_.MutexName, DLL_NAME]));
end;
end;
end;
procedure TCtrlWndActiveHook.UnHookDll(bFreeDll: Boolean = false);
var
fnUnInstallWindowActiveHook: TUninstallWindowActiveHook;
begin
if hHookDLL_ <> 0 then
begin
@fnUnInstallWindowActiveHook := nil;
@fnUnInstallWindowActiveHook := GetProcAddress(hHookDLL_, 'UnInstallWindowActiveHook');
if @fnUnInstallWindowActiveHook <> nil then
fnUnInstallWindowActiveHook;
if bFreeDll then
begin
FreeLibrary(hHookDLL_);
hHookDLL_ := 0;
end;
end;
if CatchMtx_ <> nil then
FreeAndNil(CatchMtx_);
end;
procedure TCtrlWndActiveHook.Lock;
begin
crs_.Acquire;
end;
procedure TCtrlWndActiveHook.UnLock;
begin
crs_.Release;
end;
procedure TCtrlWndActiveHook.SetActiveEvent(evActive: TActiveWindowNotify);
begin
if @evActive_ <> @evActive then
evActive_ := evActive;
end;
procedure TCtrlWndActiveHook.SetDeActiveEvent(evDeActive: TActiveWindowNotify);
begin
if @evDeActive_ <> @evDeActive then
evDeActive_ := evDeActive;
end;
procedure TCtrlWndActiveHook.ClearDestroyWnd;
begin
if bUseDestroyWnd_ then
lstDestroyWndEntry_.Clear;
end;
procedure TCtrlWndActiveHook.OnWindowEntryNotify(Sender: TObject; const Item: TProcessEntry; Action: TCollectionNotification);
begin
case Action of
cnAdded : ;
cnRemoved : Item.Free;
cnExtracted : ;
end;
end;
procedure TCtrlWndActiveHook.ActiveEvent(aWndEntry: TProcessEntry);
begin
if Assigned(evActive_) then
evActive_(Self, aWndEntry);
end;
procedure TCtrlWndActiveHook.DeActiveEvent(aWndEntry: TProcessEntry);
begin
if Assigned(evDeActive_) then
evDeActive_(Self, aWndEntry);
end;
function TCtrlWndActiveHook.AddWindowEntry(dwPid: DWORD): TProcessEntry;
var
TempEntry: TProcessEntry;
sOldProcName: String;
begin
TempEntry := GetProcessEntry(dwPid);
if TempEntry <> nil then
begin
sOldProcName := TempEntry.ModuleName;
DeleteWindowEntry(dwPid);
end else
sOldProcName := '';
Lock;
try
Result := TProcessEntry.Create(Self, dwPid);
DcProcEntry_.Add(dwPid, Result);
finally
UnLock;
end;
if sOldProcName <> '' then
_Trace('AddWindowEntry() - already pid=%d .. OldName=%s, NewName=%s', [dwPid, sOldProcName, Result.ModuleName]);
end;
function TCtrlWndActiveHook.DeleteWindowEntry(dwPid: DWORD): TProcessEntry;
begin
Result := nil;
Lock;
try
if DcProcEntry_.ContainsKey(dwPid) then
begin
if bUseDestroyWnd_ then
begin
Result := GetProcessEntry(dwPid);
if Assigned(Result) then
begin
Result.DestroyDateTime := now;
lstDestroyWndEntry_.Add(Result);
end;
DcProcEntry_.OnValueNotify := nil;
end;
try
DcProcEntry_.Remove(dwPid);
finally
if not Assigned(DcProcEntry_.OnValueNotify) then
DcProcEntry_.OnValueNotify := OnWindowEntryNotify;
end;
end;
finally
UnLock;
end;
end;
function TCtrlWndActiveHook.CountWndDestroy: Integer;
begin
Result := 0;
if bUseDestroyWnd_ then
Result := lstDestroyWndEntry_.Count;
end;
function TCtrlWndActiveHook.GetProcessEntry(dwPid: DWORD): TProcessEntry;
begin
Result := nil;
Lock;
try
if DcProcEntry_.ContainsKey(dwPid) then
Result := DcProcEntry_[dwPid];
finally
UnLock;
end;
end;
function TCtrlWndActiveHook.ProcessHookNotify(msg: TMessage): TWindowLogEntry;
var
WndEntry: TProcessEntry;
WndLogEntry: PWindowLogEntry;
dwPid: DWORD;
begin
ZeroMemory(@Result, SizeOf(Result));
if msg.WParamLo = WND_STATE_ATTACH_HOOK then
begin
// WND_STATE_ATTACH_HOOK<4F><4B> msg.LParam<61><6D> Window<6F>ڵ<EFBFBD><DAB5><EFBFBD> <20>ƴϰ<C6B4> PID<49>̴<EFBFBD>. 22_0520 13:44:24 kku
// AddWindowEntry(msg.WParamHi);
AddWindowEntry(msg.LParam);
exit;
end;
// msg.WParamHi Ÿ<><C5B8><EFBFBD><EFBFBD> WORD <20>ε<EFBFBD>...
// <20><> 10<31><30><EFBFBD>ʹ<EFBFBD> 65535 <20>̻<EFBFBD><CCBB><EFBFBD> <20><><EFBFBD>μ<EFBFBD><CEBC><EFBFBD> <20><><EFBFBD>̵<EFBFBD> <20><><EFBFBD><EFBFBD> <20>Ѿ<EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>տ<EFBFBD> <20>ִ<EFBFBD>.
// <20>׷<EFBFBD><D7B7><EFBFBD> <20><><EFBFBD>μ<EFBFBD><CEBC><EFBFBD> <20><><EFBFBD>̵<EFBFBD><CCB5><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>ִ°ɷ<C2B0> <20><><EFBFBD><EFBFBD> 22_0520 13:38:11 kku
dwPid := GetProcessPIDFromWndHandle(msg.LParam);
if dwPid = 0 then
exit;
WndEntry := GetProcessEntry(dwPid);
if not Assigned(WndEntry) then
begin
AddWindowEntry(dwPid);
end else
begin
case msg.WParamLo of
WND_STATE_DETACH_HOOK :
begin
Result := WndEntry.AddWindowLog(msg.LParam, wlDetach);
if not Assigned(DeleteWindowEntry(WndEntry.PID)) then
exit;
end;
WND_STATE_ACTIVATE : Result := WndEntry.AddWindowLog(msg.LParam, wlActive);
WND_STATE_WINDOW_MIN : Result := WndEntry.AddWindowLog(msg.LParam, wlMin);
WND_STATE_WINDOW_MAX : Result := WndEntry.AddWindowLog(msg.LParam, wlMax);
WND_STATE_WINDOW_MOVESIZE : Result := WndEntry.AddWindowLog(msg.LParam, wlMoveSize);
WND_STATE_REDRAW_TITLE : Result := WndEntry.AddWindowLog(msg.LParam, wlRedrawTitle);
WND_STATE_CREATE_MAIN : Result := WndEntry.AddWindowLog(msg.LParam, wlCreate);
WND_STATE_DESTROY_MAIN : Result := WndEntry.AddWindowLog(msg.LParam, wlDestroy);
WND_STATE_WINDOW_NORMAL : Result := WndEntry.AddWindowLog(msg.LParam, wlRestore);
WND_STATE_ACTIVATE2 : Result := WndEntry.AddWindowLog(msg.LParam, wlActive2); // <20>߰<EFBFBD> 14_0408 23:58 sunk
end;
end;
end;
function TCtrlWndActiveHook.GetDestroyWindowEntry(nIndex: Integer): TProcessEntry;
begin
Result := nil;
if bUseDestroyWnd_ and (nIndex >= 0) and (nIndex < lstDestroyWndEntry_.Count) then
Result := lstDestroyWndEntry_[nIndex];
end;
initialization
TProcessEntry._ActiveWindow := nil;
finalization
TProcessEntry._ActiveWindow := nil;
end.