519 lines
13 KiB
Plaintext
519 lines
13 KiB
Plaintext
{*******************************************************}
|
||
{ }
|
||
{ ManagerMonInfo }
|
||
{ }
|
||
{ Copyright (C) 2022 kku }
|
||
{ }
|
||
{*******************************************************}
|
||
|
||
unit ManagerMonInfo;
|
||
|
||
interface
|
||
|
||
uses
|
||
Tocsg.Obj, System.SysUtils, System.Classes, Winapi.Windows,
|
||
System.Generics.Collections, superobject;
|
||
|
||
const
|
||
EXE_OCR = 'Windows.Media.Ocr.Cli.exe';
|
||
|
||
type
|
||
TCollectPathInfo = record
|
||
sTempDir,
|
||
sSaveDir,
|
||
sLogPath: String;
|
||
end;
|
||
|
||
PWinInfo = ^TWinInfo;
|
||
TWinInfo = record
|
||
sPPath,
|
||
sTitle,
|
||
sImgTxt,
|
||
sImgFName: String;
|
||
bActive: Boolean;
|
||
dtStart: TDateTime;
|
||
end;
|
||
TWinInfoList = TList<PWinInfo>;
|
||
|
||
TMonInfo = class(TTgObject)
|
||
private
|
||
dtLog_: TDateTime;
|
||
sMonTxt_,
|
||
sImgFName_: String;
|
||
WinInfoList_: TWinInfoList;
|
||
|
||
procedure OnWinInfoNotify(Sender: TObject; const Item: PWinInfo; Action: TCollectionNotification);
|
||
public
|
||
Constructor Create; overload;
|
||
Constructor Create(aPathInfo: TCollectPathInfo; bSaveMonImg: Boolean); overload;
|
||
Constructor Create(aO: ISuperObject); overload;
|
||
Destructor Destroy; override;
|
||
|
||
procedure AddWinInfo(pInfo: PWinInfo);
|
||
procedure WriteLogToFileTail(sPath: String);
|
||
|
||
property LogDT: TDateTime read dtLog_;
|
||
property MonText: String read sMonTxt_;
|
||
property ImageFileName: String read sImgFName_;
|
||
property WinInfoList: TWinInfoList read WinInfoList_;
|
||
end;
|
||
TMonInfoList = TList<TMonInfo>;
|
||
|
||
TManagerMonInfo = class(TTgObject)
|
||
private
|
||
MonInfoList_: TMonInfoList;
|
||
RecentDocList_: TStringList;
|
||
procedure OnMonInfoNotify(Sender: TObject; const Item: TMonInfo; Action: TCollectionNotification);
|
||
public
|
||
Constructor Create;
|
||
Destructor Destroy; override;
|
||
|
||
procedure Clear;
|
||
procedure LoadFromFile(sPath: String);
|
||
|
||
property MonInfoList: TMonInfoList read MonInfoList_;
|
||
property RecentDocList: TStringList read RecentDocList_;
|
||
end;
|
||
|
||
function RefineSearchText(sStr: String): String;
|
||
procedure SearchMonText(sMonTxt, sSearchTxt: String; var nHitWordCnt: Integer;
|
||
var nHitCnt: Integer; var nTotalWordCnt: Integer;
|
||
var sHitResults: String);
|
||
|
||
implementation
|
||
|
||
uses
|
||
Tocsg.Exception, Tocsg.Capture, Tocsg.Process, Tocsg.Path, Tocsg.Safe,
|
||
Tocsg.WndUtil, Tocsg.Strings, Tocsg.Json, Tocsg.Trace, Tocsg.PCRE,
|
||
System.RegularExpressions;
|
||
|
||
var
|
||
_hRcentSaveWnd: HWND;
|
||
|
||
function RefineSearchText(sStr: String): String;
|
||
begin
|
||
// Result := DeleteChars(sStr, '^|[]()*\-$?+');
|
||
Result := AppendChars(sStr, '^|[]()*\-$?+', '\');
|
||
Result := StringReplace(Result, #13#10, ' ', [rfReplaceAll]);
|
||
end;
|
||
|
||
function RefineCollectText(sStr: String): String;
|
||
var
|
||
ComList,
|
||
OverlWordList: TStringList;
|
||
i, nLastIdx,
|
||
nOverlCnt: Integer;
|
||
sCheck: String;
|
||
begin
|
||
Result := '';
|
||
if sStr = '' then
|
||
exit;
|
||
|
||
sStr := StringReplace(sStr, #13#10, ' ', [rfReplaceAll]);
|
||
|
||
Guard(ComList, TStringList.Create);
|
||
Guard(OverlWordList, TStringList.Create);
|
||
SplitString(sStr, ' ', ComList);
|
||
while ComList.Count > 0 do
|
||
begin
|
||
nLastIdx := ComList.Count - 1;
|
||
sCheck := ComList[nLastIdx];
|
||
ComList.Delete(nLastIdx);
|
||
|
||
nOverlCnt := 0;
|
||
for i := nLastIdx - 1 downto 0 do
|
||
begin
|
||
if sCheck = ComList[i] then
|
||
begin
|
||
Inc(nOverlCnt);
|
||
ComList.Delete(i);
|
||
end;
|
||
end;
|
||
|
||
if nOverlCnt > 0 then
|
||
sCheck := Format('%s-x%d', [sCheck, nOverlCnt + 1]);
|
||
OverlWordList.Add(sCheck);
|
||
end;
|
||
|
||
for i := 0 to OverlWordList.Count - 1 do
|
||
SumString(Result, OverlWordList[i], ' ');
|
||
end;
|
||
|
||
function CollectTextToStrList(sColtStr: String; aList: TStringList): Integer;
|
||
var
|
||
ColtList: TStringList;
|
||
i, nPos, nCnt: Integer;
|
||
sWord, sTemp: String;
|
||
begin
|
||
aList.Clear;
|
||
if sColtStr = '' then
|
||
exit;
|
||
|
||
Guard(ColtList, TStringList.Create);
|
||
SplitString(sColtStr, ' ', ColtList);
|
||
for i := 0 to ColtList.Count - 1 do
|
||
begin
|
||
sWord := ColtList[i];
|
||
nPos := sWord.LastIndexOf('-x');
|
||
if nPos > -1 then
|
||
begin
|
||
sTemp := Copy(ColtList[i], nPos + 3, Length(sWord) - nPos + 3);
|
||
nCnt := StrToIntDef(sTemp, -1);
|
||
if nCnt > 0 then
|
||
Delete(sWord, nPos + 1, Length(sWord) - nPos + 1)
|
||
else
|
||
nCnt := 1;
|
||
end else
|
||
nCnt := 1;
|
||
aList.AddObject(sWord, TObject(nCnt));
|
||
end;
|
||
Result := aList.Count;
|
||
end;
|
||
|
||
procedure SearchMonText(sMonTxt, sSearchTxt: String; var nHitWordCnt: Integer;
|
||
var nHitCnt: Integer; var nTotalWordCnt: Integer;
|
||
var sHitResults: String);
|
||
var
|
||
StrList,
|
||
FndList: TStringList;
|
||
i, n: Integer;
|
||
begin
|
||
sHitResults := '';
|
||
|
||
Guard(StrList, TStringList.Create);
|
||
|
||
nTotalWordCnt := CollectTextToStrList(sMonTxt, StrList);
|
||
sMonTxt := StrList.Text;
|
||
|
||
nHitCnt := TTgPcre.GetMatchValues(sMonTxt, sSearchTxt, sHitResults, false, [roMultiLine]);
|
||
// sHitReuslts_ := GetCountOverlapWords(sHitReuslts_);
|
||
|
||
Guard(FndList, TStringList.Create);
|
||
SplitString2(sHitResults, ',', FndList, false, true);
|
||
nHitWordCnt := FndList.Count;
|
||
nHitCnt := 0;
|
||
for i := 0 to FndList.Count - 1 do
|
||
begin
|
||
n := StrList.IndexOf(FndList[i]);
|
||
if n <> -1 then
|
||
begin
|
||
n := NativeInt(StrList.Objects[n]);
|
||
if n > 1 then
|
||
FndList[i] := Format('%s(x%d)', [FndList[i], n]);
|
||
Inc(nHitCnt, n);
|
||
end else
|
||
Inc(nHitCnt);
|
||
end;
|
||
sHitResults := FndList.CommaText;
|
||
end;
|
||
|
||
{ TMonInfo }
|
||
|
||
Constructor TMonInfo.Create;
|
||
begin
|
||
Inherited Create;
|
||
WinInfoList_ := TWinInfoList.Create;
|
||
WinInfoList_.OnNotify := OnWinInfoNotify;
|
||
end;
|
||
|
||
Constructor TMonInfo.Create(aPathInfo: TCollectPathInfo; bSaveMonImg: Boolean);
|
||
|
||
function GetDesktopText: String;
|
||
var
|
||
sCurDir,
|
||
sImgFName,
|
||
sImgPath,
|
||
sTxtPath: String;
|
||
StrList: TStringList;
|
||
begin
|
||
Result := '';
|
||
sCurDir := GetRunExePathDir;
|
||
if FileExists(sCurDir + EXE_OCR) and
|
||
ForceDirectories(aPathInfo.sSaveDir) and
|
||
ForceDirectories(aPathInfo.sTempDir) then
|
||
begin
|
||
sImgFName := FormatDateTime('yyyymmhhnnss', dtLog_) + '.jpg';
|
||
sImgPath := aPathInfo.sSaveDir + sImgFName;
|
||
try
|
||
if CaptureDesktopAsJpegFile(sImgPath) then
|
||
begin
|
||
sTxtPath := aPathInfo.sTempDir + sImgFName + '.txt';
|
||
ExecuteAppWaitUntilTerminate(sCurDir + EXE_OCR, Format('"%s" "%s"', [sImgPath, sTxtPath]), SW_HIDE, 60000);
|
||
if FileExists(sTxtPath) then
|
||
begin
|
||
Guard(StrList, TStringList.Create);
|
||
StrList.LoadFromFile(sTxtPath, TEncoding.UTF8);
|
||
Result := RefineCollectText(StrList.Text);
|
||
DeleteFile(PChar(sTxtPath));
|
||
end;
|
||
// if bSaveMonImg then
|
||
sImgFName_ := sImgFName;
|
||
// else
|
||
// DeleteFile(PChar(sImgPath));
|
||
end;
|
||
except
|
||
on E: Exception do
|
||
ETgException.TraceException(E, 'Fail .. GetDesktopText()');
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure ExtrWindowInfo;
|
||
var
|
||
HwndList: TStringList;
|
||
PList: TTgProcessList;
|
||
i, c: Integer;
|
||
sPName, sTitle,
|
||
sTitles, sImgFName,
|
||
sCurDir, sTxtPath, sImgTxt: String;
|
||
h, hActive: HWND;
|
||
bActive: Boolean;
|
||
pInfo: PWinInfo;
|
||
StrList: TStringList;
|
||
begin
|
||
Guard(HwndList, TStringList.Create);
|
||
Guard(PList, TTgProcessList.Create);
|
||
PList.UpdateProcessList;
|
||
|
||
hActive := GetForegroundWindow;
|
||
for i := 0 to PList.Count - 1 do
|
||
begin
|
||
bActive := false;
|
||
|
||
sTitles := '';
|
||
sImgFName := '';
|
||
sImgTxt := '';
|
||
if GetWndHandlesFromPID(PList[i].dwProcessID, HwndList) > 0 then
|
||
begin
|
||
for c := 0 to HwndList.Count - 1 do
|
||
begin
|
||
h := StrToInt64Def(HwndList[c], 0);
|
||
if IsWindowVisible(h) then
|
||
begin
|
||
bActive := bActive or (h = hActive);
|
||
sTitle := GetWindowCaption(h);
|
||
if sTitle <> '' then
|
||
SumString(sTitles, sTitle, '|');
|
||
|
||
if bActive and (_hRcentSaveWnd <> h) and (sTitle <> '') and
|
||
(CompareText(sTitle, 'Program Manager') <> 0) and // explorer.exe <20><><EFBFBD><EFBFBD>ȭ<EFBFBD><C8AD>
|
||
ForceDirectories(aPathInfo.sSaveDir) then
|
||
begin
|
||
sCurDir := GetRunExePathDir;
|
||
if FileExists(sCurDir + EXE_OCR) then
|
||
begin
|
||
sImgFName := FormatDateTime('yyyymmhhnnss', dtLog_) + Format('_%s.jpg', [PList[i].sModuleBaseName]);
|
||
CaptureWindowAsJpegFile(h, aPathInfo.sSaveDir + sImgFName);
|
||
|
||
sTxtPath := aPathInfo.sTempDir + sImgFName + '.txt';
|
||
ExecuteAppWaitUntilTerminate(sCurDir + EXE_OCR,
|
||
Format('"%s" "%s"', [aPathInfo.sSaveDir + sImgFName, sTxtPath]), SW_HIDE, 60000);
|
||
if FileExists(sTxtPath) then
|
||
begin
|
||
Guard(StrList, TStringList.Create);
|
||
StrList.LoadFromFile(sTxtPath, TEncoding.UTF8);
|
||
sImgTxt := RefineCollectText(StrList.Text);
|
||
DeleteFile(PChar(sTxtPath));
|
||
end;
|
||
|
||
_hRcentSaveWnd := h;
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
if sTitles <> '' then
|
||
begin
|
||
New(pInfo);
|
||
// ZeroMemory(pInfo, SizeOf(TWinInfo));
|
||
pInfo.sPPath := PList[i].sModuleFileName;
|
||
if pInfo.sPPath = '' then
|
||
pInfo.sPPath := PList[i].sModuleBaseName;
|
||
pInfo.sTitle := sTitles;
|
||
pInfo.dtStart := PList[i].dtStart;
|
||
pInfo.bActive := bActive;
|
||
pInfo.sImgFName := sImgFName;
|
||
pInfo.sImgTxt := sImgTxt;
|
||
AddWinInfo(pInfo);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
begin
|
||
Create;
|
||
dtLog_ := Now;
|
||
sImgFName_ := '';
|
||
sMonTxt_ := GetDesktopText;
|
||
ExtrWindowInfo;
|
||
end;
|
||
|
||
Constructor TMonInfo.Create(aO: ISuperObject);
|
||
var
|
||
q: Integer;
|
||
pInfo: PWinInfo;
|
||
begin
|
||
Create;
|
||
|
||
dtLog_ := aO.D['Date'];
|
||
sMonTxt_ := aO.S['MTxt'];
|
||
sImgFName_ := aO.S['FImg'];
|
||
|
||
if (aO.O['List'] <> nil) and (aO.O['List'].DataType = stArray) then
|
||
begin
|
||
for q := 0 to aO.A['List'].Length - 1 do
|
||
begin
|
||
New(pInfo);
|
||
pInfo^ := TTgJson.GetDataAsType<TWinInfo>(aO.A['List'][q]);
|
||
WinInfoList_.Add(pInfo);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
Destructor TMonInfo.Destroy;
|
||
begin
|
||
FreeAndNil(WinInfoList_);
|
||
Inherited;
|
||
end;
|
||
|
||
procedure TMonInfo.OnWinInfoNotify(Sender: TObject;
|
||
const Item: PWinInfo; Action: TCollectionNotification);
|
||
begin
|
||
if Action = cnRemoved then
|
||
Dispose(Item);
|
||
end;
|
||
|
||
procedure TMonInfo.AddWinInfo(pInfo: PWinInfo);
|
||
begin
|
||
WinInfoList_.Add(pInfo);
|
||
end;
|
||
|
||
procedure TMonInfo.WriteLogToFileTail(sPath: String);
|
||
var
|
||
O, OA: ISuperObject;
|
||
i: Integer;
|
||
begin
|
||
OA := TSuperObject.Create(stArray);
|
||
for i := 0 to WinInfoList_.Count - 1 do
|
||
OA.AsArray.Add(TTgJson.ValueToJsonObject<TWinInfo>(WinInfoList_[i]^));
|
||
|
||
O := SO;
|
||
O.D['Date'] := dtLog_;
|
||
O.S['MTxt'] := sMonTxt_;
|
||
O.S['FImg'] := sImgFName_;
|
||
O.O['List'] := OA;
|
||
|
||
WriteLnFileEndUTF8(sPath, O.AsString);
|
||
end;
|
||
|
||
{ TManagerMonInfo }
|
||
|
||
Constructor TManagerMonInfo.Create;
|
||
begin
|
||
Inherited Create;
|
||
MonInfoList_ := TMonInfoList.Create;
|
||
MonInfoList_.OnNotify := OnMonInfoNotify;
|
||
RecentDocList_ := TStringList.Create;
|
||
end;
|
||
|
||
Destructor TManagerMonInfo.Destroy;
|
||
begin
|
||
FreeAndNil(RecentDocList_);
|
||
FreeAndNil(MonInfoList_);
|
||
Inherited;
|
||
end;
|
||
|
||
procedure TManagerMonInfo.OnMonInfoNotify(Sender: TObject;
|
||
const Item: TMonInfo; Action: TCollectionNotification);
|
||
begin
|
||
if Action = cnRemoved then
|
||
Item.Free;
|
||
end;
|
||
|
||
procedure TManagerMonInfo.Clear;
|
||
begin
|
||
MonInfoList_.Clear;
|
||
RecentDocList_.Clear;
|
||
end;
|
||
|
||
procedure TManagerMonInfo.LoadFromFile(sPath: String);
|
||
|
||
procedure ExtrRecentDocTxtFiles;
|
||
var
|
||
wfd: TWin32FindData;
|
||
hSc: THandle;
|
||
sDir,
|
||
sPath: String;
|
||
begin
|
||
sDir := GetRunExePathDir + 'Data\RecentDoc\';
|
||
sPath := sDir + '*.*';
|
||
|
||
hSc := FindFirstFile(PChar(sPath), wfd);
|
||
if hSc = INVALID_HANDLE_VALUE then
|
||
exit;
|
||
|
||
try
|
||
Repeat
|
||
if (String(wfd.cFileName) <> '.') and (String(wfd.cFileName) <> '..') then
|
||
if ((wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0) then
|
||
begin
|
||
RecentDocList_.Add(sDir + wfd.cFileName);
|
||
end;
|
||
Until not FindNextFile(hSc, wfd);
|
||
finally
|
||
WinApi.Windows.FindClose(hSc);
|
||
end;
|
||
end;
|
||
|
||
var
|
||
InfoList: TStringList;
|
||
i, nLen: Integer;
|
||
sJsonStr: String;
|
||
O: ISuperObject;
|
||
begin
|
||
Clear;
|
||
if not FileExists(sPath) then
|
||
exit;
|
||
|
||
Guard(InfoList, TStringList.Create);
|
||
try
|
||
InfoList.LoadFromFile(sPath, TEncoding.UTF8);
|
||
|
||
sJsonStr := '';
|
||
for i := 0 to InfoList.Count - 1 do
|
||
begin
|
||
if sJsonStr = '' then
|
||
sJsonStr := InfoList[i]
|
||
else
|
||
sJsonStr := sJsonStr + #13#10 + InfoList[i];
|
||
|
||
nLen := Length(sJsonStr);
|
||
if ((sJsonStr[nLen-1] <> '"') and (sJsonStr[nLen] <> '}')) then
|
||
continue;
|
||
|
||
if ((i <> InfoList.Count - 1) and (Copy(InfoList[i+1], 1, 7) <> '{"MTxt"')) then
|
||
continue;
|
||
|
||
try
|
||
O := SO(sJsonStr);
|
||
except
|
||
continue;
|
||
end;
|
||
sJsonStr := '';
|
||
|
||
if O <> nil then
|
||
MonInfoList_.Add(TMonInfo.Create(O));
|
||
end;
|
||
|
||
ExtrRecentDocTxtFiles;
|
||
except
|
||
on E: Exception do
|
||
ETgException.TraceException(Self, E, 'Fail .. LoadFromFile()');
|
||
end;
|
||
end;
|
||
|
||
Initialization
|
||
_hRcentSaveWnd := 0;
|
||
|
||
end.
|