BSOne.SFC/Tocsg.Module/ContentSearch/EXE_HecAipHelper/ThdSchFileScan.pas

569 lines
14 KiB
Plaintext

{*******************************************************}
{ }
{ ThdSchFileScan }
{ }
{ Copyright (C) 2022 Sunk }
{ }
{*******************************************************}
unit ThdSchFileScan;
interface
uses
Define,
System.SysUtils, System.Classes, Winapi.Windows, System.SyncObjs,
System.Generics.Collections, Winapi.Messages, Tocsg.Thread,
Tocsg.Files, CttSchDefine, Tocsg.Win32;
const
SIGN_SOFTCAMP_DRM: array [0..15] of Byte =
($53, $43, $44, $53, $41, $30, $30, $34, $00, $00, $52, $00, $20, $88, $F1, $53); // SCDSA004 ½ÃÀÛµÊ
type
TThdSchFileScan = class(TTgThread)
protected
sProcDir_,
sProcSchFile_: String;
FileScanOpt_: TFileScanOpt;
llTotalTgFile_,
llProcTgFile_,
llFound_,
llFoundFile_,
llTotalDir_,
llTotalFile_: LONGLONG;
TgDirList_,
ScanExtList_,
SvFileList_,
SvDirList_,
SvScanList_,
TestCompList_: TStringList;
sWorkDir_: String;
dtBegin_: TDateTime;
evScanSearchEnd_,
evScanSearchBegin_: TNotifyEvent;
sMtx_: String;
TaskMutex_: TTgMutex;
CttSchOpt_: TCttSchOpt;
hKvCttSch_: HWND;
ProcInfo_: TProcessInformation;
dtRecentSch_: TDateTime;
qSchEnt_: TQueue<String>;
bSendEvent_: Boolean;
{$IFDEF _HE_}
CttSchProg_: TCttSchProg;
dwProgTick_: DWORD;
sSchTitle_: String;
{$ENDIF}
dtScan_: TDateTime;
procedure ScanSchFiles;
procedure Execute; override;
public
Constructor Create(sTgDirs: String; aOpt: TFileScanOpt; dtScan: TDateTime; bSendEvent: Boolean = true);
Destructor Destroy; override;
procedure UpdateProgress(sStatus: String; bForce: Boolean = false; sResult: String = 'none');
procedure SetKvCttSchHandle(h: HWND);
function NextSchPath: String;
procedure IncFoundCount(nHits: Integer);
procedure IncFoundFileCount;
procedure IncEncFileCount;
property WorkState: TTgThreadState read GetWorkState;
property TotalDirCount: LONGLONG read llTotalDir_;
property TotalFileCount: LONGLONG read llTotalFile_;
property TotalTgFileCount: LONGLONG read llTotalTgFile_;
property ProcTgFileCount: LONGLONG read llProcTgFile_;
property FoundCount: LONGLONG read llFound_;
property FoundFileCount: LONGLONG read llFoundFile_;
property ProcDir: String read sProcDir_;
property ProcSchFile: String read sProcSchFile_;
property BeginDT: TDateTime read dtBegin_;
property OnScanSearchBegin: TNotifyEvent write evScanSearchBegin_;
property OnScanSearchEnd: TNotifyEvent write evScanSearchEnd_;
property KvCttSchWnd: HWND read hKvCttSch_;
property IsSendEvent: Boolean read bSendEvent_;
property ScanDate: TDateTime read dtScan_;
{$IFDEF _HE_}
property CttSchProg: TCttSchProg read CttSchProg_;
property SchTitle: String read sSchTitle_;
{$ENDIF}
end;
implementation
uses
{$IFDEF _HE_}
ManagerService, GlobalDefine, Condition,
{$ENDIF}
Tocsg.PCRE, Tocsg.Trace, Tocsg.Exception,
Tocsg.Strings, Tocsg.Safe, Tocsg.Path, Tocsg.Process, System.DateUtils,
superobject, Tocsg.Json, Tocsg.WinInfo, Tocsg.DateTime;
{ TThdSchFileScan }
Constructor TThdSchFileScan.Create(sTgDirs: String; aOpt: TFileScanOpt; dtScan: TDateTime; bSendEvent: Boolean = true);
var
i: Integer;
ThdDirWatchEnt: TThdDirWatchEnt;
begin
Inherited Create;
bSendEvent_ := bSendEvent;
hKvCttSch_ := 0;
WorkState_ := tsInit;
{$IFDEF _HE_}
ZeroMemory(@CttSchProg_, SizeOf(CttSchProg_));
dwProgTick_ := 0;
if aOpt.bShowSchTitle then
sSchTitle_ := aOpt.sSchTitle
else
sSchTitle_ := '';
{$ENDIF}
if dtScan <> 0 then
dtScan_ := dtScan
else
dtScan_ := Now;
TgDirList_ := TStringList.Create;
SplitString(sTgDirs, '|', TgDirList_);
FileScanOpt_ := aOpt;
case FileScanOpt_.CttSchOpt.nWorkPriority of
0 : Priority := tpHighest;
1 : Priority := tpHigher;
// 2 : Priority := tpNormal;
3 : Priority := tpLower;
4 : Priority := tpLowest;
else Priority := tpNormal;
end;
llFound_ := 0;
llFoundFile_ := 0;
llTotalTgFile_ := 0;
llProcTgFile_ := 0;
llTotalDir_ := 0;
llTotalFile_ := 0;
sProcSchFile_ := '';
ScanExtList_ := TStringList.Create;
ScanExtList_.CaseSensitive := false;
SplitString(FileScanOpt_.sScanExt, '|', ScanExtList_);
@evScanSearchEnd_ := nil;
@evScanSearchBegin_ := nil;
SvFileList_ := nil;
SvDirList_ := nil;
SvScanList_ := nil;
if FileScanOpt_.bSaveFileList then
SvFileList_ := TStringList.Create;
if FileScanOpt_.bSaveDirList then
SvDirList_ := TStringList.Create;
if FileScanOpt_.bSaveScanList then
SvScanList_ := TStringList.Create;
TestCompList_ := TStringList.Create;
sMtx_ := 'Global\TaskKvCttSch@' + FormatDateTime('yyyymmddhhnnss', Now);
TaskMutex_ := TTgMutex.Create(sMtx_);
CttSchOpt_ := FileScanOpt_.CttSchOpt;
hKvCttSch_ := 0;
dtRecentSch_ := 0;
qSchEnt_ := TQueue<String>.Create;
ZeroMemory(@ProcInfo_, SizeOf(ProcInfo_));
dtBegin_ := Now;
StartThread;
end;
Destructor TThdSchFileScan.Destroy;
begin
if ProcInfo_.dwProcessId <> 0 then
begin
TerminateProcessByPid(ProcInfo_.dwProcessId);
ProcInfo_.dwProcessId := 0;
end;
FreeAndNIl(qSchEnt_);
FreeAndNil(ScanExtList_);
if SvFileList_ <> nil then
FreeAndNil(SvFileList_);
if SvDirList_ <> nil then
FreeAndNil(SvDirList_);
if SvScanList_ <> nil then
FreeAndNil(SvScanList_);
FreeAndNil(TestCompList_);
FreeAndNil(TgDirList_);
FreeAndNil(TaskMutex_);
Inherited;
end;
procedure TThdSchFileScan.ScanSchFiles;
var
sTgDir: String;
IgrWordPaths: TStringList;
i: Integer;
llLimitSize: LONGLONG;
procedure ExtractFiles(sDir: String);
var
wfd: TWin32FindData;
hSc: THandle;
sExt,
sPath: String;
dtModify: TDateTime;
llSize: LONGLONG;
begin
try
if not DirectoryExists(sDir) then
exit;
sDir := IncludeTrailingPathDelimiter(sDir);
if IgrWordPaths.Count > 0 then
begin
var i: Integer;
sPath := UpperCase(sDir);
for i := 0 to IgrWordPaths.Count - 1 do
begin
if Pos(IgrWordPaths[i], sPath) > 0 then
exit;
end;
end;
if SvDirList_ <> nil then
SvDirList_.Add(sDir);
sPath := sDir + '*.*';
hSc := FindFirstFile(PChar(sPath), wfd);
if hSc = INVALID_HANDLE_VALUE then
exit;
try
Repeat
if GetWorkStop or Terminated then
begin
SetWorkState(tsStop);
exit;
end;
{$IFDEF _HE_}
if gMgSvc.IsNewApi then
UpdateProgress('PENDING')
else
{$ENDIF}
UpdateProgress('scan');
if (String(wfd.cFileName) <> '.') and (String(wfd.cFileName) <> '..') then
begin
sPath := sDir + wfd.cFileName;
if ((wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0) then
begin
Inc(llTotalDir_);
ExtractFiles(sPath);
end else begin
Inc(llTotalFile_);
if SvFileList_ <> nil then
SvFileList_.Add(sPath);
sExt := GetFileExt(sPath).ToLower;
if (sExt <> '$KV') and (ScanExtList_.IndexOf(sExt) <> -1) then
begin
if FileScanOpt_.bPartScan and (FileScanOpt_.dtRecent <> 0) then
begin
dtModify := ConvFileTimeToDateTime_Local(wfd.ftLastWriteTime);
if CompareDateTime(FileScanOpt_.dtRecent, dtModify) <> -1 then
continue;
end;
llSize := GetFileSizeHiLow(wfd.nFileSizeHigh, wfd.nFileSizeLow);
if llSize = 0 then
continue;
if (llLimitSize > 0) and (llSize >= llLimitSize) then
continue;
{$IFDEF _HECAIPTOOL_}
if CheckSign(sPath, @SIGN_SOFTCAMP_DRM[0], 16) then
begin
// Inc(CttSchProg_.llEncFileCnt);
continue;
end;
{$ENDIF}
qSchEnt_.Enqueue(sPath);
Inc(llTotalTgFile_);
if SvScanList_ <> nil then
SvScanList_.Add(sPath);
end;
end;
end;
Until not FindNextFile(hSc, wfd);
finally
WinApi.Windows.FindClose(hSc);
end;
except
// ..
end;
end;
begin
llLimitSize := LONGLONG(FileScanOpt_.nLimitSizeMB) * 1048576;
Guard(IgrWordPaths, TStringList.Create);
SplitString(UpperCase(FileScanOpt_.sIgrWordPath), '|', IgrWordPaths);
try
SetWorkState(tsWorking);
for i := 0 to TgDirList_.Count - 1 do
begin
if GetWorkStop or Terminated then
begin
SetWorkState(tsStop);
exit;
end;
sProcDir_ := '?:\';
sTgDir := TgDirList_[i];
if not DirectoryExists(sTgDir) then
continue;
sProcDir_ := sTgDir;
// ´ë»ó ÆÄÀÏ ½ºÄµ
ExtractFiles(sTgDir);
end;
except
SetWorkState(tsFail);
end;
end;
procedure TThdSchFileScan.SetKvCttSchHandle(h: HWND);
begin
hKvCttSch_ := h;
end;
function TThdSchFileScan.NextSchPath: String;
begin
Lock;
try
if qSchEnt_.Count > 0 then
begin
Result := qSchEnt_.Dequeue;
sProcSchFile_ := Result;
dtRecentSch_ := Now;
Inc(llProcTgFile_);
end else
Result := '';
finally
Unlock;
end;
{$IFDEF _HE_}
if gMgSvc.IsNewApi then
UpdateProgress('PROGRESS')
else
{$ENDIF}
UpdateProgress('progress');
if Result = '' then
begin
SetWorkState(tsCompleted);
SetWorkStop(true);
end
end;
procedure TThdSchFileScan.IncFoundCount(nHits: Integer);
begin
Inc(llFound_, nHits);
end;
procedure TThdSchFileScan.IncFoundFileCount;
begin
Inc(llFoundFile_);
end;
procedure TThdSchFileScan.IncEncFileCount;
begin
{$IFDEF _HE_}
Inc(CttSchProg_.llEncFileCnt);
{$ENDIF}
end;
procedure TThdSchFileScan.UpdateProgress(sStatus: String; bForce: Boolean = false; sResult: String = 'none');
begin
{$IFDEF _HE_}
if CttSchProg_.sScanId <> '' then
begin
var dwTick: DWORD := GetTickCount;
if bForce or ((dwTick - dwProgTick_) > 10000) then
begin
dwProgTick_ := dwTick;
CttSchProg_.llProc := llProcTgFile_;
CttSchProg_.llTotal := llTotalTgFile_;
CttSchProg_.sResult := sResult;
CttSchProg_.sStatus := sStatus;
if bSendEvent_ then
begin
if gMgSvc.IsNewApi then
gMgSvc.SendCampnProgInfo(CttSchProg_)
else
gMgSvc.SendCttSchProgInfo(CttSchProg_);
end;
end;
end;
{$ENDIF}
end;
procedure TThdSchFileScan.Execute;
var
sComName,
sKvCsPath: String;
procedure CreateProcessKV;
var
hProcess: THandle;
O: ISuperObject;
sParam: String;
begin
{$IFDEF _HE_}
if MutexExists(MUTEX_KILL) then
begin
SetWorkStop(true);
exit;
end;
{$ENDIF}
if not FileExists(sKvCsPath) then
exit;
try
if ProcInfo_.dwProcessId <> 0 then
TerminateProcessByPid(ProcInfo_.dwProcessId);
ZeroMemory(@ProcInfo_, SizeOf(ProcInfo_));
hKvCttSch_ := 0;
dtRecentSch_ := 0;
O := SO;
O.I['CSTT'] := Integer(csttSchMulti);
O.S['Mtx'] := sMtx_;
O.I['Tasker'] := ULONGLONG(Self);
if FileScanOpt_.nLangId <> 0 then
O.I['LangID'] := FileScanOpt_.nLangId;
if FileScanOpt_.sSchPtrns <> '' then
O.S['SchPtrns'] := FileScanOpt_.sSchPtrns;
O.O['Opt'] := TTgJson.ValueToJsonObject<TCttSchOpt>(CttSchOpt_);
sParam := GetRunExePathDir + '$KvCttSchOpt.dat';
if SaveJsonObjToFile(O, sParam) then
begin
ProcInfo_ := ExecuteApp(sKvCsPath, Format('-p "%s"', [sParam]), SW_SHOWNORMAL);
if ProcInfo_.dwProcessId = 0 then
begin
{$IFDEF DEBUG}
ASSERT(false);
{$ELSE}
_Trace('Fail .. CreateProcessKV() .. ExecuteApp()');
{$ENDIF}
end;
end else
_Trace('Fail .. CreateProcessKV() .. SaveJsonObjToFile()');
except
on E: Exception do
ETgException.TraceException(Self, E, 'Fail .. CreateProcessKV()');
end;
end;
var
nTmSec,
nTaskLenMax: Integer;
begin
if CttSchOpt_.sTaskDir = '' then
begin
sWorkDir_ := GetRunExePathDir + 'STask\';
CttSchOpt_.sTaskDir := sWorkDir_;
end else
sWorkDir_ := CttSchOpt_.sTaskDir;
DeleteDir(sWorkDir_);
if not ForceDirectories(sWorkDir_) then
begin
_Trace('Fail .. CreateWorkDir()');
SetWorkState(tsFail);
exit;
end;
nTmSec := FileScanOpt_.nSchTimeoutSec;
if nTmSec <= 0 then
nTmSec := DEF_TIMEOUT_SEC;
{$IFDEF _HE_}
if gMgSvc.IsNewApi then
nTaskLenMax := 32
else
nTaskLenMax := 24;
CttSchProg_.dtStart := dtBegin_;
CttSchProg_.sScanId := FileScanOpt_.sScanId;
sComName := GetComName;
CttSchProg_.sTaskId := sComName + '\' + FormatDateTime('hhnnss', dtBegin_);
if Length(CttSchProg_.sTaskId) > nTaskLenMax then
begin
SetLength(sComName, Length(sComName) - (Length(CttSchProg_.sTaskId) - nTaskLenMax));
CttSchProg_.sTaskId := sComName + '\' + FormatDateTime('hhnnss', dtBegin_);
end;
{$ENDIF}
if Assigned(evScanSearchBegin_) then
evScanSearchBegin_(Self);
ScanSchFiles;
if SvFileList_ <> nil then
SvFileList_.SaveToFile(FileScanOpt_.sSvFilePath, TEncoding.UTF8);
if SvDirList_ <> nil then
SvDirList_.SaveToFile(FileScanOpt_.sSvDirPath, TEncoding.UTF8);
if SvScanList_ <> nil then
SvScanList_.SaveToFile(FileScanOpt_.sSvScanPath, TEncoding.UTF8);
sKvCsPath := GetRunExePathDir + EXE_KVCTTSCH;
while not Terminated and not GetWorkStop do
begin
try
if (ProcInfo_.dwProcessId = 0) or
(GetProcessNameByPid(ProcInfo_.dwProcessId) = '') or
( (dtRecentSch_ > 0) and
(SecondsBetween(dtRecentSch_, Now) > nTmSec) ) then
CreateProcessKV;
Sleep(1000);
except
on E: Exception do
ETgException.TraceException(Self, E, 'Fail .. Execute()');
end;
end;
if ProcInfo_.dwProcessId <> 0 then
begin
TerminateProcessByPid(ProcInfo_.dwProcessId);
ProcInfo_.dwProcessId := 0;
end;
{$IFDEF _HE_}
if gMgSvc.IsNewApi then
UpdateProgress('DONE', true);
{$ENDIF}
// DeleteDir(sWorkDir_);
if Assigned(evScanSearchEnd_) then
evScanSearchEnd_(Self);
end;
end.