BSOne.SFC/Tocsg.Module/ContentSearch/EXE_ContentSearch/DCttSchMain.pas

1011 lines
30 KiB
Plaintext
Raw 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.

unit DCttSchMain;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Buttons, Vcl.ComCtrls,
Vcl.ExtCtrls, Tocsg.Trace, VirtualTrees, ManagerPattern,
Vcl.Menus, CttSchDefine, ThdSchFileScan;
type
TTimeInfoRec = record
ftKernelTime,
ftUserTime: TFileTime;
end;
PFndInfo = ^TFndInfo;
TFndInfo = record
Ent: TFndEnt;
end;
PFndFile = ^TFndFile;
TFndFile = record
sFName,
sFPath,
sFndType,
sFndStr: String;
nHits, nImgIdx: Integer;
llSize: LONGLONG;
bDrm: Boolean;
end;
TProcessResMon = class(TObject)
private
dwPid_: DWORD;
hProcess_: THandle;
LastSystemTimes_,
LastProcessTimes_: TTimeInfoRec;
public
Constructor Create(dwPid: DWORD);
Destructor Destroy; override;
function GetProcessMemSize: LONGLONG;
function GetProcessCpuPercent: Byte;
end;
TDlgFssMain = class(TForm)
pcMain: TPageControl;
tabWork: TTabSheet;
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
btnScan: TSpeedButton;
Label4: TLabel;
Label5: TLabel;
cbScanType: TComboBox;
cbPriority: TComboBox;
edTgDirs: TEdit;
edScanExt: TEdit;
chSaveFileList: TCheckBox;
chSaveDirList: TCheckBox;
chSaveScanList: TCheckBox;
edSvFilePath: TEdit;
edSvDirPath: TEdit;
edSvScanPath: TEdit;
GroupBox2: TGroupBox;
lbMsg: TLabel;
lbRes: TLabel;
lbWorkTime: TLabel;
lbInfo: TLabel;
pg: TProgressBar;
tProg: TTimer;
tResMon: TTimer;
tabResult: TTabSheet;
Label6: TLabel;
edKvPath: TEdit;
Label3: TLabel;
edSchTxt: TEdit;
chSaveContent: TCheckBox;
edSvContentPath: TEdit;
Label7: TLabel;
edPatterns: TEdit;
btnSetPatterns: TSpeedButton;
vtFnd: TVirtualStringTree;
SP1: TSplitter;
vtList: TVirtualStringTree;
popFun: TPopupMenu;
miCopyCB: TMenuItem;
N2: TMenuItem;
miFilter: TMenuItem;
miPathGo: TMenuItem;
procedure btnScanClick(Sender: TObject);
procedure tProgTimer(Sender: TObject);
procedure tResMonTimer(Sender: TObject);
procedure chSaveFileListClick(Sender: TObject);
procedure chSaveDirListClick(Sender: TObject);
procedure chSaveScanListClick(Sender: TObject);
procedure chSaveContentClick(Sender: TObject);
procedure btnSetPatternsClick(Sender: TObject);
procedure vtFndGetNodeDataSize(Sender: TBaseVirtualTree;
var NodeDataSize: Integer);
procedure vtFndGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
procedure vtFndGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle;
var HintText: string);
procedure vtListGetNodeDataSize(Sender: TBaseVirtualTree;
var NodeDataSize: Integer);
procedure vtListFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure vtListGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle;
var HintText: string);
procedure vtListGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
procedure vtListGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode;
Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean;
var ImageIndex: TImageIndex);
procedure vtListCompareNodes(Sender: TBaseVirtualTree; Node1,
Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
procedure vtListHeaderClick(Sender: TVTHeader; HitInfo: TVTHeaderHitInfo);
procedure vtListContextPopup(Sender: TObject; MousePos: TPoint;
var Handled: Boolean);
procedure miFilterClick(Sender: TObject);
procedure popFunPopup(Sender: TObject);
procedure miCopyCBClick(Sender: TObject);
procedure vtFndFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex);
procedure miPathGoClick(Sender: TObject);
private
{ Private declarations }
ThdFileScan_: TThdSchFileScan;
dtWorkBegin_: TDateTime;
ResMon_: TProcessResMon;
Trace_: TTgTrace;
MgFnd_: TManagerFound;
FileImageList_: TImageList;
procedure SaveInput;
procedure LoadInput;
procedure SetControl(bWork: Boolean);
procedure StopWork;
procedure UpdatePatternInfo;
procedure UpdateFoundInfo;
procedure ClearFoundInfo;
public
{ Public declarations }
Constructor Create(aOwner: TComponent); override;
Destructor Destroy; override;
procedure process_WM_CTTSCH_INIT(var msg: TMessage); Message WM_CTTSCH_INIT;
procedure process_WM_CTTSCH_REQUEST(var msg: TMessage); Message WM_CTTSCH_REQUEST;
procedure process_WM_COPYDATA(var msg: TMessage); Message WM_COPYDATA;
end;
var
DlgFssMain: TDlgFssMain;
implementation
uses
System.IniFiles, Winapi.PsAPI, Define, DSelectPattern,
Tocsg.Strings, Tocsg.Safe, Tocsg.Path, Tocsg.DateTime, Tocsg.Thread,
Tocsg.Convert, Tocsg.VTUtil, Tocsg.Files, Tocsg.Shell,
System.Math, VirtualTrees.Types, VirtualTrees.Filter,
Tocsg.Exception, superobject, Tocsg.Json, Tocsg.PCRE;
{$R *.dfm}
{ TProcessResMon }
Constructor TProcessResMon.Create(dwPid: DWORD);
begin
Inherited Create;
ZeroMemory(@LastSystemTimes_, SizeOf(LastSystemTimes_));
ZeroMemory(@LastProcessTimes_, SizeOf(LastProcessTimes_));
dwPid_ := dwPid;
hProcess_ := OpenProcess(PROCESS_ALL_ACCESS, false, dwPid_);
end;
Destructor TProcessResMon.Destroy;
begin
if hProcess_ <> 0 then
begin
CloseHandle(hProcess_);
hProcess_ := 0;
end;
Inherited;
end;
function TProcessResMon.GetProcessMemSize: LONGLONG;
var
ProcMemCnts: TProcessMemoryCounters;
begin
if GetProcessMemoryInfo(hProcess_, @ProcMemCnts, SizeOf(ProcMemCnts)) then
Result := ProcMemCnts.WorkingSetSize
else
Result := -1;
end;
function TProcessResMon.GetProcessCpuPercent: Byte;
function SubtFileTime(ft1: TFileTIme; ft2: TFileTIme): TFileTIme;
begin
Result := TFileTIme(LONGLONG(ft1) - LONGLONG(ft2));
end;
var
SystemTimes,
SystemDiffTimes,
ProcessDiffTimes,
ProcessTimes: TTimeInfoRec;
SystemTimesIdleTime,
ProcessTimesCreationTime,
ProcessTimesExitTime: TFileTime;
begin
Result := 0;
if hProcess_ <> 0 then
begin
if GetSystemTimes(SystemTimesIdleTime, SystemTimes.ftKernelTime, SystemTimes.ftUserTime) then
begin
SystemDiffTimes.ftKernelTime := SubtFileTime(SystemTimes.ftKernelTime, LastSystemTimes_.ftKernelTime);
SystemDiffTimes.ftUserTime := SubtFileTime(SystemTimes.ftUserTime, LastSystemTimes_.ftUserTime);
LastSystemTimes_ := SystemTimes;
if GetProcessTimes(hProcess_, ProcessTimesCreationTime, ProcessTimesExitTime, ProcessTimes.ftKernelTime, ProcessTimes.ftUserTime) then
begin
ProcessDiffTimes.ftKernelTime := SubtFileTime(ProcessTimes.ftKernelTime, LastProcessTimes_.ftKernelTime);
ProcessDiffTimes.ftUserTime := SubtFileTime(ProcessTimes.ftUserTime, LastProcessTimes_.ftUserTime);
LastProcessTimes_ := ProcessTimes;
if (Int64(SystemDiffTimes.ftKernelTime) + Int64(SystemDiffTimes.ftUserTime)) > 0 then
Result := Round((Int64(ProcessDiffTimes.ftKernelTime) + Int64(ProcessDiffTimes.ftUserTime)) / (Int64(SystemDiffTimes.ftKernelTime) + Int64(SystemDiffTimes.ftUserTime)) * 100);
end;
end;
end;
end;
{ TDlgFssMain }
Constructor TDlgFssMain.Create(aOwner: TComponent);
var
hSysIcons: THandle;
begin
Inherited Create(aOwner);
Caption := APP_TITLE;
ChangeWindowMessageFilter(WM_COPYDATA, MSGFLT_ADD);
ThdFileScan_ := nil;
dtWorkBegin_ := 0;
FileImageList_ := TImageList.Create(Self);
FileImageList_.ShareImages := true;
FileImageList_.BlendColor := clHighlight;
hSysIcons := GetShellImageHandle;
if hSysIcons <> 0 then
begin
FileImageList_.Handle := hSysIcons;
vtList.Images := FileImageList_;
end;
Trace_ := TTgTrace.Create(GetRunExePathDir + 'Log\',
ExtractFileName(CutFileExt(GetRunExePath)) + '.log', true);
MgFnd_ := TManagerFound.Create;
edScanExt.Text := DOC_EXTS;
ResMon_ := TProcessResMon.Create(GetCurrentProcessId);
LoadInput;
pcMain.ActivePageIndex := 0;
tResMon.Enabled := true;
end;
Destructor TDlgFssMain.Destroy;
begin
StopWork;
tResMon.Enabled := false;
FreeAndNil(ResMon_);
FreeAndNil(MgFnd_);
if ThdFileScan_ <> nil then
FreeAndNil(ThdFileScan_);
Inherited;
FreeAndNil(Trace_);
end;
procedure TDlgFssMain.UpdatePatternInfo;
var
MgPtn: TManagerPattern;
sInfo: String;
i: Integer;
begin
sInfo := '';
Guard(MgPtn, TManagerPattern.Create);
for i := 0 to MgPtn.EntList.Count - 1 do
if MgPtn.EntList[i].Use then
SumString(sInfo, MgPtn.EntList[i].Name, ', ');
edPatterns.Text := sInfo;
end;
procedure TDlgFssMain.vtFndFocusChanged(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex);
var
pData, pPData: PFndInfo;
VtFilterEdit: TVtFilterEdit;
sFilter: String;
pNode: PVirtualNode;
i: Integer;
begin
if Node = nil then
exit;
if ThdFileScan_ <> nil then
exit;
vtList.BeginUpdate;
try
pData := Sender.GetNodeData(Node);
if vtList.GetFilterEditCtrl = nil then
VtFilterEdit := vtList.CreateFilterEdit
else
VtFilterEdit := vtList.GetFilterEditCtrl;
for i := 0 to vtList.Header.Columns.Count - 1 do
VtFilterEdit.Dict.Filter[i] := '';
if Node.Parent = Sender.RootNode then
begin
if pData.Ent.Name <> 'Ű<><C5B0><EFBFBD><EFBFBD>' then
begin
sFilter := '';
pNode := Node.FirstChild;
while pNode <> nil do
begin
pData := Sender.GetNodeData(pNode);
SumString(sFilter, pData.Ent.Name, ';');
pNode := pNode.NextSibling;
end;
end else
sFilter := pData.Ent.Name;
VtFilterEdit.Dict.Filter[1] := sFilter;
end else begin
pPData := Sender.GetNodeData(Node.Parent);
if pPData.Ent.Name = 'Ű<><C5B0><EFBFBD><EFBFBD>' then
VtFilterEdit.Dict.Filter[2] := pData.Ent.Name
else
VtFilterEdit.Dict.Filter[1] := pData.Ent.Name;
end;
VtFilterEdit.ApplyFilter;
finally
vtList.EndUpdate;
end;
end;
procedure TDlgFssMain.vtFndGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle;
var HintText: string);
begin
HintText := vtFnd.Text[Node, Column];
end;
procedure TDlgFssMain.vtFndGetNodeDataSize(Sender: TBaseVirtualTree;
var NodeDataSize: Integer);
begin
NodeDataSize := SizeOf(TFndInfo);
end;
procedure TDlgFssMain.vtFndGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
var
pData: PFndInfo;
begin
if Column = 0 then
begin
pData := Sender.GetNodeData(Node);
CellText := Format('%s (%d)', [pData.Ent.Name, pData.Ent.HitCount]);
end;
end;
procedure TDlgFssMain.vtListCompareNodes(Sender: TBaseVirtualTree; Node1,
Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
var
pData1, pData2: PFndFile;
begin
pData1 := Sender.GetNodeData(Node1);
pData2 := Sender.GetNodeData(Node2);
case Column of
1, 2, 4, 5, 7 : Result := CompareText(vtList.Text[Node1, Column], vtList.Text[Node2, Column]);
3 : Result := CompareValue(pData1.nHits, pData2.nHits);
6 : Result := CompareValue(pData1.llSize, pData2.llSize);
end;
end;
procedure TDlgFssMain.vtListContextPopup(Sender: TObject; MousePos: TPoint;
var Handled: Boolean);
begin
miCopyCB.Visible := vtList.GetNodeAt(MousePos) <> nil;
miPathGo.Visible := miCopyCB.Visible;
end;
procedure TDlgFssMain.vtListFreeNode(Sender: TBaseVirtualTree;
Node: PVirtualNode);
var
pData: PFndFile;
begin
pData := Sender.GetNodeData(Node);
Finalize(pData^);
end;
procedure TDlgFssMain.vtListGetHint(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex;
var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: string);
begin
HintText := vtList.Text[Node, Column];
end;
procedure TDlgFssMain.vtListGetImageIndex(Sender: TBaseVirtualTree;
Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
var Ghosted: Boolean; var ImageIndex: TImageIndex);
var
pData: PFndFile;
begin
if Column = 4 then
case Kind of
ikNormal,
ikSelected:
begin
pData := Sender.GetNodeData(Node);
if pData.nImgIdx = -1 then
pData.nImgIdx := GetShellImageIndex_path(pData.sFPath);
ImageIndex := pData.nImgIdx;
end;
end;
end;
procedure TDlgFssMain.vtListGetNodeDataSize(Sender: TBaseVirtualTree;
var NodeDataSize: Integer);
begin
NodeDataSize := SizeOf(TFndFile);
end;
procedure TDlgFssMain.vtListGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: string);
var
pData: PFndFile;
begin
pData := Sender.GetNodeData(Node);
case Column of
0 : CellText := IntToStr(Node.Index + 1);
1 : CellText := pData.sFndType;
2 : CellText := pData.sFndStr;
3 : CellText := IntToStr(pData.nHits);
4 : CellText := pData.sFName;
5 : CellText := GetFileExt(pData.sFName).ToUpper;
6 : CellText := BooleanToStr(pData.bDrm, 'O', 'X');
7 : CellText := ByteSizeToStr(pData.llSize);
8 : CellText := ExtractFilePath(pData.sFPath);
end;
end;
procedure TDlgFssMain.vtListHeaderClick(Sender: TVTHeader;
HitInfo: TVTHeaderHitInfo);
begin
if HitInfo.Button = mbLeft then
begin
if HitInfo.Column < 0 then
exit;
with Sender, Treeview do
begin
if SortColumn > NoColumn then
Columns[SortColumn].Options := Columns[SortColumn].Options + [coParentColor];
if HitInfo.Column = 0 then
SortColumn := NoColumn
else
begin
if (SortColumn = NoColumn) or (SortColumn <> HitInfo.Column) then
begin
SortColumn := HitInfo.Column;
SortDirection := sdAscending;
end else
if SortDirection = sdAscending then
SortDirection := sdDescending
else
SortDirection := sdAscending;
Columns[SortColumn].Color := $00EFEFEF;
vtList.BeginUpdate;
try
vtList.SortTree(SortColumn, SortDirection, False);
finally
vtList.EndUpdate;
end;
end;
end;
end;
end;
procedure TDlgFssMain.UpdateFoundInfo;
function AddFndEnt(pParentNode: PVirtualNode; aEnt: TFndEnt): Boolean;
var
pNode: PVirtualNode;
pData: PFndInfo;
i: Integer;
begin
if aEnt.pNode = nil then
begin
pData := VT_AddChildDataN(vtFnd, pNode, pParentNode);
pData.Ent := aEnt;
pData.Ent.pNode := pNode;
Result := true;
end else
Result := false;
if (pParentNode = nil) and (aEnt.Name = 'Ű<><C5B0><EFBFBD><EFBFBD>') and
(PVirtualNode(aEnt.pNode).Index <> (vtFnd.RootNode.ChildCount - 1)) then
begin
vtFnd.MoveTo(aEnt.pNode, vtFnd.RootNode.LastChild, amInsertAfter, false);
end;
for i := 0 to aEnt.ChildList.Count - 1 do
if AddFndEnt(aEnt.pNode, aEnt.ChildList[i]) then
vtFnd.Expanded[aEnt.pNode] := true;
end;
var
i: Integer;
begin
vtFnd.BeginUpdate;
try
// VT_Clear(vtFnd);
for i := 0 to MgFnd_.EntList.Count - 1 do
AddFndEnt(nil, MgFnd_.EntList[i]);
// VT_ExpandAll(vtFnd, true);
finally
vtFnd.EndUpdate;
end;
end;
procedure TDlgFssMain.ClearFoundInfo;
begin
vtFnd.BeginUpdate;
vtList.BeginUpdate;
try
VT_Clear(vtFnd);
VT_Clear(vtList);
MgFnd_.Clear;
finally
vtList.EndUpdate;
vtFnd.EndUpdate;
end;
end;
procedure TDlgFssMain.btnSetPatternsClick(Sender: TObject);
var
dlg: TDlgSelectPattern;
begin
Guard(dlg, TDlgSelectPattern.Create(Self));
if dlg.ShowModal = mrOk then
UpdatePatternInfo;
end;
procedure TDlgFssMain.chSaveContentClick(Sender: TObject);
begin
edSvContentPath.Enabled := chSaveContent.Checked;
end;
procedure TDlgFssMain.chSaveDirListClick(Sender: TObject);
begin
edSvDirPath.Enabled := chSaveDirList.Checked;
end;
procedure TDlgFssMain.chSaveFileListClick(Sender: TObject);
begin
edSvFilePath.Enabled := chSaveFileList.Checked;
end;
procedure TDlgFssMain.chSaveScanListClick(Sender: TObject);
begin
edSvScanPath.Enabled := chSaveScanList.Checked;
end;
procedure TDlgFssMain.SaveInput;
var
ini: TIniFile;
begin
Guard(ini, TIniFile.Create(CutFileExt(GetRunExePath) + '.ini'));
ini.WriteString('Input', 'TgDir', edTgDirs.Text);
ini.WriteString('Input', 'KvMdDir', edKvPath.Text);
ini.WriteString('Input', 'ScanExt', edScanExt.Text);
ini.WriteString('Input', 'SchTxt', edSchTxt.Text);
ini.WriteInteger('Input', 'ScanType', cbScanType.ItemIndex);
ini.WriteInteger('Input', 'WorkPriority', cbPriority.ItemIndex);
ini.WriteBool('Input', 'SaveContent', chSaveContent.Checked);
ini.WriteString('Input', 'SvContentPath', edSvContentPath.Text);
ini.WriteBool('Input', 'SaveFileList', chSaveFileList.Checked);
ini.WriteString('Input', 'SvFilePath', edSvFilePath.Text);
ini.WriteBool('Input', 'SaveDirList', chSaveDirList.Checked);
ini.WriteString('Input', 'SvDirPath', edSvDirPath.Text);
ini.WriteBool('Input', 'SaveScanList', chSaveScanList.Checked);
ini.WriteString('Input', 'SvScanPath', edSvScanPath.Text);
end;
procedure TDlgFssMain.LoadInput;
var
ini: TIniFile;
begin
Guard(ini, TIniFile.Create(CutFileExt(GetRunExePath) + '.ini'));
edTgDirs.Text := ini.ReadString('Input', 'TgDir', 'C:\');
edScanExt.Text := ini.ReadString('Input', 'ScanExt', DOC_EXTS);
edSchTxt.Text := ini.ReadString('Input', 'SchTxt', '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>|<7C><EFBFBD><E8B1B8>|<7C><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>|<7C><><EFBFBD><EFBFBD>ȣ|<7C><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>|<7C><><EFBFBD><EFBFBD>ȣ|<7C><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>');
edKvPath.Text := ini.ReadString('Input', 'KvMdDir', '.\bin');
cbScanType.ItemIndex := ini.ReadInteger('Input', 'ScanType', 1);
cbPriority.ItemIndex := ini.ReadInteger('Input', 'WorkPriority', 2);
chSaveContent.Checked := ini.ReadBool('Input', 'SaveContent', false);
edSvContentPath.Text := ini.ReadString('Input', 'SvContentPath', '');
chSaveFileList.Checked := ini.ReadBool('Input', 'SaveFileList', false);
edSvFilePath.Text := ini.ReadString('Input', 'SvFilePath', '');
chSaveDirList.Checked := ini.ReadBool('Input', 'SaveDirList', false);
edSvDirPath.Text := ini.ReadString('Input', 'SvDirPath', '');
chSaveScanList.Checked := ini.ReadBool('Input', 'SaveScanList', false);
edSvScanPath.Text := ini.ReadString('Input', 'SvScanPath', '');
UpdatePatternInfo;
end;
procedure TDlgFssMain.miCopyCBClick(Sender: TObject);
begin
if VT_CopyToClipboardSelectedInfo(vtList) = 0 then
MessageBox(Handle, PChar('Ŭ<><C5AC><EFBFBD><EFBFBD><EFBFBD><20><><EFBFBD><EFBFBD> <20>Ǿ<EFBFBD><C7BE><EFBFBD><EFBFBD>ϴ<EFBFBD>.'), PChar(Caption), MB_ICONINFORMATION or MB_OK);
end;
procedure TDlgFssMain.miFilterClick(Sender: TObject);
begin
if miFilter.Checked then
vtList.DestroyFilterEdit
else if ThdFileScan_ = nil then
vtList.CreateFilterEdit;
end;
procedure TDlgFssMain.miPathGoClick(Sender: TObject);
var
pData: PFndFile;
begin
pData := VT_Get1SelNodeData(vtList);
if pData = nil then
exit;
if not FileExists(pData.sFPath) then
begin
MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>ʴ<EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>Դϴ<D4B4>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
exit;
end;
ExplorerSelectedPath(pData.sFPath);
end;
procedure TDlgFssMain.SetControl(bWork: Boolean);
begin
edTgDirs.Enabled := not bWork;
edKvPath.Enabled := edTgDirs.Enabled;
edScanExt.Enabled := edTgDirs.Enabled;
edSchTxt.Enabled := edTgDirs.Enabled;
edPatterns.Enabled := edTgDirs.Enabled;
btnSetPatterns.Enabled := edTgDirs.Enabled;
cbScanType.Enabled := edTgDirs.Enabled;
cbPriority.Enabled := edTgDirs.Enabled;
chSaveFileList.Enabled := edTgDirs.Enabled;
chSaveDirList.Enabled := edTgDirs.Enabled;
chSaveContent.Enabled := edTgDirs.Enabled;
edSvContentPath.Enabled := edTgDirs.Enabled;
chSaveScanList.Enabled := edTgDirs.Enabled;
edSvFilePath.Enabled := edTgDirs.Enabled;
edSvDirPath.Enabled := edTgDirs.Enabled;
edSvScanPath.Enabled := edTgDirs.Enabled;
edSvFilePath.Enabled := chSaveFileList.Checked and edTgDirs.Enabled;
edSvDirPath.Enabled := chSaveDirList.Checked and edTgDirs.Enabled;
edSvScanPath.Enabled := chSaveScanList.Checked and edTgDirs.Enabled;
if bWork then
begin
tabResult.Caption := '<27>˻<EFBFBD> <20><><EFBFBD><EFBFBD>';
btnScan.Caption := '<27><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>˻<EFBFBD> <20><><EFBFBD><EFBFBD>';
pg.Position := 0;
pg.Style := pbstMarquee;
end else
btnScan.Caption := '<27><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>˻<EFBFBD> <20><><EFBFBD><EFBFBD>';
Application.ProcessMessages;
end;
procedure TDlgFssMain.StopWork;
begin
tProg.Enabled := false;
if ThdFileScan_ <> nil then
FreeAndNil(ThdFileScan_);
SetControl(false);
pg.Style := pbstNormal;
btnScan.Enabled := true;
end;
procedure TDlgFssMain.tProgTimer(Sender: TObject);
var
WorkState: TTgThreadState;
begin
if ThdFileScan_ <> nil then
begin
WorkState := ThdFileScan_.WorkState;
case WorkState of
tsInit : ;
tsWorking :
begin
var sProcFile := ThdFileScan_.ProcSchFile;
if sProcFile <> '' then
begin
if cbScanType.ItemIndex <> 0 then
begin
if pg.Style <> pbstNormal then
pg.Style := pbstNormal;
pg.Position := (ThdFileScan_.ProcTgFileCount * 100) div ThdFileScan_.TotalTgFileCount;
end;
lbMsg.Caption := Format('<27>˻<EFBFBD><CBBB><EFBFBD> .. "%s"', [ThdFileScan_.ProcSchFile])
end else
lbMsg.Caption := '<27>˻<EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> ã<><C3A3> <20>ֽ<EFBFBD><D6BD>ϴ<EFBFBD>...';
end;
tsCompleted :
begin
pg.Position := pg.Max;
lbMsg.Caption := '<27>۾<EFBFBD><DBBE><EFBFBD> <20>Ϸ<EFBFBD><CFB7>߽<EFBFBD><DFBD>ϴ<EFBFBD>.';
end;
tsStop : lbMsg.Caption := '<27>۾<EFBFBD><DBBE><EFBFBD> <20>ߴܵǾ<DCB5><C7BE><EFBFBD><EFBFBD>ϴ<EFBFBD>.';
tsFail : lbMsg.Caption := '<27>۾<EFBFBD><DBBE><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>߽<EFBFBD><DFBD>ϴ<EFBFBD>.';
end;
lbWorkTime.Caption := ConvSecBetweenToProgTime(dtWorkBegin_, Now);
with ThdFileScan_ do
lbInfo.Caption := Format('<27><><EFBFBD><EFBFBD> : %s <20><><EFBFBD><EFBFBD> : %s <20>߰ߵ<DFB0> : %s <20>˻<EFBFBD><CBBB><EFBFBD> : %s',
[InsertPointComma(TotalFileCount, 3), InsertPointComma(TotalDirCount, 3),
InsertPointComma(TotalTgFileCount, 3), InsertPointComma(ProcTgFileCount, 3)]);
case WorkState of
tsCompleted,
tsStop, tsFail: StopWork;
end;
end else
StopWork;
Application.ProcessMessages;
end;
procedure TDlgFssMain.tResMonTimer(Sender: TObject);
begin
lbRes.Caption := Format('CPU : %d%% Memory : %s',
[ResMon_.GetProcessCpuPercent, ByteSizeToStr(ResMon_.GetProcessMemSize)]);
Application.ProcessMessages;
end;
procedure TDlgFssMain.btnScanClick(Sender: TObject);
var
ScanOpt: TFileScanOpt;
TgDirList: TStringList;
i: Integer;
begin
if ThdFileScan_ <> nil then
begin
MessageBox(Handle, PChar('<27>۾<EFBFBD><DBBE><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>Ͻðڽ<C3B0><DABD>ϱ<EFBFBD>?'), PChar(Caption), MB_ICONQUESTION or MB_YESNO);
btnScan.Enabled := false;
if ThdFileScan_ <> nil then
FreeAndNil(ThdFileScan_);
SetControl(false);
exit;
end;
edTgDirs.Text := Trim(edTgDirs.Text);
edKvPath.Text := Trim(edKvPath.Text);
edScanExt.Text := Trim(edScanExt.Text);
edSchTxt.Text := Trim(edSchTxt.Text);
edSvContentPath.Text := Trim(edSvContentPath.Text);
edSvFilePath.Text := Trim(edSvFilePath.Text);
edSvDirPath.Text := Trim(edSvDirPath.Text);
edSvScanPath.Text := Trim(edSvScanPath.Text);
if edTgDirs.Text = '' then
begin
MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>̺<EFBFBD> <20>Ǵ<EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>Է<EFBFBD><D4B7><EFBFBD> <20>ֽʽÿ<CABD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
edTgDirs.SetFocus;
exit;
end;
Guard(TgDirList, TStringList.Create);
SplitString(edTgDirs.Text, '|', TgDirList);
for i := 0 to TgDirList.Count - 1 do
begin
if not DirectoryExists(TgDirList[i]) then
begin
MessageBox(Handle, PChar(Format('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>ʴ<EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>Դϴ<D4B4>. Path="%s"', [TgDirList[i]])),
PChar(Caption), MB_ICONWARNING or MB_OK);
edTgDirs.SetFocus;
exit;
end;
end;
if edKvPath.Text = '' then
begin
MessageBox(Handle, PChar('Ű<><C5B0> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>Է<EFBFBD><D4B7><EFBFBD> <20>ֽʽÿ<CABD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
edKvPath.SetFocus;
exit;
end;
if not DirectoryExists(edKvPath.Text) then
begin
MessageBox(Handle, PChar('<27>Է<EFBFBD><D4B7><EFBFBD> Ű<><C5B0> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>ʽ<EFBFBD><CABD>ϴ<EFBFBD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
edKvPath.SetFocus;
exit;
end;
if edScanExt.Text = '' then
begin
MessageBox(Handle, PChar('<27>˻<EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> Ȯ<><C8AE><EFBFBD>ڸ<EFBFBD> <20>ϳ<EFBFBD> <20>̻<EFBFBD> <20>Է<EFBFBD><D4B7><EFBFBD> <20>ֽʽÿ<CABD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
edScanExt.SetFocus;
exit;
end;
if chSaveContent.Checked and (edSvContentPath.Text = '') then
begin
MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD> <20><><EFBFBD>θ<EFBFBD> <20>Է<EFBFBD><D4B7><EFBFBD> <20>ֽʽÿ<CABD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
edSvContentPath.SetFocus;
exit;
end;
if chSaveFileList.Checked and (edSvFilePath.Text = '') then
begin
MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD> <20><><EFBFBD>θ<EFBFBD> <20>Է<EFBFBD><D4B7><EFBFBD> <20>ֽʽÿ<CABD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
edSvFilePath.SetFocus;
exit;
end;
if chSaveDirList.Checked and (edSvDirPath.Text = '') then
begin
MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD> <20><><EFBFBD>θ<EFBFBD> <20>Է<EFBFBD><D4B7><EFBFBD> <20>ֽʽÿ<CABD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
edSvDirPath.SetFocus;
exit;
end;
if chSaveScanList.Checked and (edSvScanPath.Text = '') then
begin
MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD> <20><><EFBFBD>θ<EFBFBD> <20>Է<EFBFBD><D4B7><EFBFBD> <20>ֽʽÿ<CABD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
edSvScanPath.SetFocus;
exit;
end;
SaveInput;
ZeroMemory(@ScanOpt, SizeOf(ScanOpt));
ScanOpt.CttSchOpt.hRcvHwnd := Handle;
ScanOpt.CttSchOpt.sKvMdPath := edKvPath.Text;
ScanOpt.CttSchOpt.sSchTxt := edSchTxt.Text;
ScanOpt.CttSchOpt.nWorkPriority := cbPriority.ItemIndex;
ScanOpt.CttSchOpt.bSaveContent := chSaveContent.Checked;
ScanOpt.CttSchOpt.nKvTimeoutSec := 5;
ScanOpt.CttSchOpt.bIncDrm := true;
ScanOpt.CttSchOpt.bIncZip := true;
ScanOpt.CttSchOpt.sMK := ':0A2CCABB38C8AD80963A5B1A668ECF9D99270819F1EEE2045B554E81043CCEC3E1E11851D7DE9C65F73F327E3E9585DA'; // PASS_DEV
ScanOpt.CttSchOpt.sAipMdPath := 'C:\taskToCSG\Tocsg.Module\BSOne-AIP-Decrypt\bin\x64\Release\BSOne-AIP-Decrypt.exe';
// ScanOpt.CttSchOpt.sAipExt := 'docx|pdf';
ScanOpt.CttSchOpt.bMakeDrm := true;
ScanOpt.sScanExt := edScanExt.Text;
if ScanOpt.CttSchOpt.bIncZip then
ScanOpt.sScanExt := ScanOpt.sScanExt + '|' + COMPRESS_EXTS;
ScanOpt.bSaveFileList := chSaveFileList.Checked;
ScanOpt.bSaveDirList := chSaveDirList.Checked;
ScanOpt.bSaveScanList := chSaveScanList.Checked;
if edSvContentPath.Text <> '' then
ScanOpt.CttSchOpt.sSvContentPath := IncludeTrailingPathDelimiter(edSvContentPath.Text);
ScanOpt.sSvFilePath := edSvFilePath.Text;
ScanOpt.sSvDirPath := edSvDirPath.Text;
ScanOpt.sSvScanPath := edSvScanPath.Text;
ClearFoundInfo;
// mmResult.Clear;
dtWorkBegin_ := Now;
SetControl(true);
ThdFileScan_ := TThdSchFileScan.Create(edTgDirs.Text, ScanOpt, 0);
ThdFileScan_.StartThread;
tProg.Enabled := true;
end;
procedure TDlgFssMain.popFunPopup(Sender: TObject);
begin
miFilter.Checked := vtList.GetFilterEditCtrl <> nil;
miFilter.Enabled := ThdFileScan_ = nil;
end;
procedure TDlgFssMain.process_WM_CTTSCH_INIT(var msg: TMessage);
begin
try
TThdSchFileScan(msg.LParam).SetKvCttSchHandle(msg.WParam);
except
on E: Exception do
ETgException.TraceException(Self, E, 'Fail .. process_WM_CTTSCH_INIT()');
end;
end;
procedure TDlgFssMain.process_WM_CTTSCH_REQUEST(var msg: TMessage);
var
ThdSch: TThdSchFileScan;
sData: String;
CpData: TCopyDataStruct;
begin
try
if msg.LParam = 0 then
exit;
// if ThdFileScan_ = nil then
// exit;
ThdSch := TThdSchFileScan(msg.LParam);
ZeroMemory(@CpData, SizeOf(CpData));
case msg.WParam of
KV_REQUEST_SEARCH_PATH :
begin
sData := ThdSch.NextSchPath;
if sData = '' then
exit;
CpData.dwData := KV_RESPONSE_SEARCH_PATH;
end;
end;
CpData.cbData := (Length(sData)+1)*2;
CpData.lpData := PChar(sData);
SendMessage(ThdSch.KvCttSchWnd, WM_COPYDATA, 0, NativeInt(@CpData));
except
on E: Exception do
ETgException.TraceException(Self, E, 'Fail .. process_WM_CTTSCH_REQUEST()');
end;
end;
procedure TDlgFssMain.process_WM_COPYDATA(var msg: TMessage);
var
pCpData: PCopyDataStruct;
SchResult: TSchResult;
pData: PFndFile;
O: ISuperObject;
StrList,
RstList: TStringList;
i: Integer;
begin
try
if ThdFileScan_ = nil then
exit;
pCpData := PCopyDataStruct(msg.LParam);
if pCpData.cbData = 0 then
exit;
case pCpData.dwData of
KV_SEARCH_RESULT :
begin
O := SO(Copy(PChar(pCpData.lpData), 1, pCpData.cbData));
SchResult := TTgJson.GetDataAsType<TSchResult>(O);
pData := VT_AddChildData(vtList);
pData.sFName := SchResult.sFName;
pData.sFPath := SchResult.sPath;
pData.sFndStr := StringReplace(SchResult.sResultStr, '|', ',', [rfReplaceAll]);
pData.nHits := SchResult.nHitCnt;
pData.llSize := GetFileSize_path(SchResult.sPath);
pData.nImgIdx := -1;
pData.bDrm := SchResult.bDrm;
if msg.WParam <> 0 then
TThdSchFileScan(msg.WParam).IncFoundFileCount;
Guard(StrList, TStringList.Create);
SplitString(SchResult.sSchName, RESULT_SEPARATOR, StrList);
Guard(RstList, TStringList.Create);
SplitString(SchResult.sResultStr, RESULT_SEPARATOR, RstList);
ASSERT(StrList.Count = RstList.Count);
// if StrList.Count <> RstList.Count then
// pData.sFndType := '';
pData.sFndType := '';
for i := 0 to StrList.Count - 1 do
begin
if (i = 0) and (StrList[i] = '*KWD*') then
begin
MgFnd_.PushFoundKeyword(RstList[i]);
pData.sFndType := 'Ű<><C5B0><EFBFBD><EFBFBD>';
end else begin
MgFnd_.PushFoundPattern(StrList[i], GetCountOverlapWordsCount(RstList[i]));
SumString(pData.sFndType, ExtractFileName(StrList[i]), ', ');
end;
end;
tabResult.Caption := Format('<27>˻<EFBFBD> <20><><EFBFBD><EFBFBD> (%d)', [ThdFileScan_.FoundFileCount]);
UpdateFoundInfo;
Application.ProcessMessages;
end;
end;
except
on E: Exception do
ETgException.TraceException(Self, E, 'Fail .. process_WM_COPYDATA()');
end;
end;
end.