BSOne.SFC/Tocsg.Module/MonSecu/DMonSecuMain.pas

567 lines
15 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 DMonSecuMain;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Menus,
Vcl.ExtCtrls, ThdCollectMonInfo, ManagerMonInfo, VirtualTrees, Vcl.ComCtrls;
const
DAT_COLLECT = 'MonInfo.dat';
EXE_EXTR_TXT = 'sxlib\wingsx2.exe';
type
PMonInfoEnt = ^TMonInfoEnt;
TMonInfoEnt = record
MonInfo: TMonInfo;
end;
PWinInfoEnt = ^TWinInfoEnt;
TWinInfoEnt = record
Wininfo: PWinInfo;
end;
PDocInfoEnt = ^TDocInfoEnt;
TDocInfoEnt = record
sPath: String;
end;
TDlgMonSecuMain = class(TForm)
MainMenu: TMainMenu;
miCollect: TMenuItem;
miCollectStart: TMenuItem;
miCollectStop: TMenuItem;
N1: TMenuItem;
miExit: TMenuItem;
miView: TMenuItem;
miLoadData: TMenuItem;
N2: TMenuItem;
miTrackingInfo: TMenuItem;
TrayIcon: TTrayIcon;
popTray: TPopupMenu;
miOpen: TMenuItem;
N4: TMenuItem;
miCollectStart2: TMenuItem;
miCollectStop2: TMenuItem;
N5: TMenuItem;
miExit2: TMenuItem;
pcMain: TPageControl;
tabMonInfo: TTabSheet;
vtLog: TVirtualStringTree;
SP1: TSplitter;
pnColClient: TPanel;
mmMonTxt: TMemo;
SP2: TSplitter;
vtWin: TVirtualStringTree;
mmWInfo: TMemo;
Splitter1: TSplitter;
N3: TMenuItem;
miCollectRecentDoc: TMenuItem;
tabDoc: TTabSheet;
vtDoc: TVirtualStringTree;
SP4: TSplitter;
mmTxt: TMemo;
procedure miExitClick(Sender: TObject);
procedure miCollectStartClick(Sender: TObject);
procedure miCollectClick(Sender: TObject);
procedure popTrayPopup(Sender: TObject);
procedure miCollectStopClick(Sender: TObject);
procedure miOpenClick(Sender: TObject);
procedure miLoadDataClick(Sender: TObject);
procedure vtLogGetNodeDataSize(Sender: TBaseVirtualTree;
var NodeDataSize: Integer);
procedure vtLogFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure vtLogGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
procedure vtLogFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex);
procedure vtWinGetNodeDataSize(Sender: TBaseVirtualTree;
var NodeDataSize: Integer);
procedure vtWinFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure vtWinGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
procedure vtWinFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex);
procedure vtLogGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle;
var HintText: string);
procedure vtWinGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle;
var HintText: string);
procedure vtWinPaintText(Sender: TBaseVirtualTree;
const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
TextType: TVSTTextType);
procedure miViewClick(Sender: TObject);
procedure miTrackingInfoClick(Sender: TObject);
procedure miCollectRecentDocClick(Sender: TObject);
procedure vtDocGetNodeDataSize(Sender: TBaseVirtualTree;
var NodeDataSize: Integer);
procedure vtDocFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure vtDocGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
procedure vtDocGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle;
var HintText: string);
procedure vtDocFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex);
private
{ Private declarations }
ThdCollect_: TThdCollectMonInfo;
MgMonInfo_: TManagerMonInfo;
procedure VisibleForm(bVal: Boolean);
procedure Clear;
public
{ Public declarations }
Constructor Create(aOwner: TComponent); override;
Destructor Destroy; override;
procedure process_WM_SYSCOMMAND(var msg: TWMSysCommand); Message WM_SYSCOMMAND;
end;
var
DlgMonSecuMain: TDlgMonSecuMain;
implementation
uses
Tocsg.Path, Tocsg.VirtualTreeViewUtil, Tocsg.Strings, Tocsg.Convert,
DWizTracking, Tocsg.Safe, Tocsg.Capture, Tocsg.Files, Tocsg.WTS,
ParserLinkFile, superobject, Tocsg.Process;
{$R *.dfm}
Constructor TDlgMonSecuMain.Create(aOwner: TComponent);
begin
Inherited Create(aOwner);
MgMonInfo_ := TManagerMonInfo.Create;
ThdCollect_ := nil;
pcMain.ActivePage := tabMonInfo;
end;
Destructor TDlgMonSecuMain.Destroy;
begin
if ThdCollect_ <> nil then
FreeAndNil(ThdCollect_);
FreeAndNil(MgMonInfo_);
Inherited;
end;
procedure TDlgMonSecuMain.miCollectClick(Sender: TObject);
begin
miCollectStart.Enabled := ThdCollect_ = nil;
miCollectStop.Enabled := not miCollectStart.Enabled;
end;
procedure TDlgMonSecuMain.miViewClick(Sender: TObject);
begin
miTrackingInfo.Enabled := MgMonInfo_.MonInfoList.Count > 0;
end;
procedure TDlgMonSecuMain.miCollectRecentDocClick(Sender: TObject);
var
sOutDir,
sRecentDir,
sExtrTxtExe: String;
procedure ExtrRecentDoc;
var
wfd: TWin32FindData;
hSc: THandle;
sPath,
sOrgPath: String;
Plf: TParserLinkFile;
O: ISuperObject;
begin
sPath := sRecentDir + '*.*';
hSc := FindFirstFile(PChar(sPath), wfd);
if hSc = INVALID_HANDLE_VALUE then
exit;
Guard(Plf, TParserLinkFile.Create);
try
Repeat
if (String(wfd.cFileName) <> '.') and (String(wfd.cFileName) <> '..') then
if ((wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0) then
begin
if Plf.LoadFromFile(sRecentDir + wfd.cFileName) then
begin
sOrgPath := GetLfiValueFromCaption(Plf.LfiEntList, 'Base Path');
if FileExists(sOrgPath) then
begin
sPath := sOutDir + wfd.cFileName + '.txt';
O := SO;
O.S['ExtrTxtPath'] := sPath;
O.S['InstTgPath'] := sOrgPath;
sPath := sOutDir + 'RqExtrInfo.json';
if SaveJsonObjToFile(O, sPath, TEncoding.UTF8) then
begin
if ExecuteAppWaitUntilTerminate(sExtrTxtExe,
Format('/ProcInst "%s"', [sPath]), SW_HIDE, 120000) then
begin
end;
end;
end;
end;
end;
Until not FindNextFile(hSc, wfd);
finally
WinApi.Windows.FindClose(hSc);
end;
end;
begin
sExtrTxtExe := GetRunExePathDir + EXE_EXTR_TXT;
if not FileExists(sExtrTxtExe) then
begin
MessageBox(Handle, PChar('<27>ؽ<EFBFBD>Ʈ <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);
exit;
end;
if MessageBox(Handle, PChar('<27>ֱ<EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>Ͻðڽ<C3B0><DABD>ϱ<EFBFBD>?'),
PChar(Caption), MB_ICONQUESTION or MB_YESNO) = IDNO then exit;
sOutDir := GetRunExePathDir + 'Data\RecentDoc\';
DeleteDir(sOutDir);
if not ForceDirectories(sOutDir) then
exit;
sRecentDir := Format('C:\Users\%s\AppData\Roaming\Microsoft\Windows\Recent\', [WTS_GetCurrentUserName]);
if not DirectoryExists(sRecentDir) then
exit;
ExtrRecentDoc;
end;
procedure TDlgMonSecuMain.VisibleForm(bVal: Boolean);
begin
if Visible <> bVal then
begin
if bVal then
begin
Visible := bVal;
if WindowState = TWindowState.wsMinimized then
WindowState := TWindowState.wsNormal;
end else begin
if WindowState = TWindowState.wsNormal then
WindowState := TWindowState.wsMinimized;
Visible := bVal;
end;
end;
if Visible then
begin
FormStyle := fsStayOnTop;
FormStyle := fsNormal;
end;
end;
procedure TDlgMonSecuMain.vtDocFocusChanged(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex);
var
pData: PDocInfoEnt;
begin
if Node = nil then
exit;
pData := vtDoc.GetNodeData(Node);
mmTxt.Lines.LoadFromFile(pData.sPath, TEncoding.UTF8);
end;
procedure TDlgMonSecuMain.vtDocFreeNode(Sender: TBaseVirtualTree;
Node: PVirtualNode);
var
pData: PDocInfoEnt;
begin
pData := Sender.GetNodeData(Node);
Finalize(pData^);
end;
procedure TDlgMonSecuMain.vtDocGetHint(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex;
var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: string);
begin
HintText := vtDoc.Text[Node, Column];
end;
procedure TDlgMonSecuMain.vtDocGetNodeDataSize(Sender: TBaseVirtualTree;
var NodeDataSize: Integer);
begin
NodeDataSize := SizeOf(TDocInfoEnt);
end;
procedure TDlgMonSecuMain.vtDocGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: string);
var
pData: PDocInfoEnt;
begin
pData := Sender.GetNodeData(Node);
case Column of
0 : CellText := IntToStr(Node.Index + 1);
1 : CellText := CutFileExt(CutFileExt(ExtractFileName(pData.sPath)));
end;
end;
procedure TDlgMonSecuMain.vtLogFocusChanged(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex);
var
pData: PMonInfoEnt;
i: Integer;
pWData: PWinInfoEnt;
begin
if Node = nil then
exit;
pData := Sender.GetNodeData(Node);
mmMonTxt.Text := pData.MonInfo.MonText;
vtWin.BeginUpdate;
try
mmWInfo.Clear;
VT_Clear(vtWin);
for i := 0 to pData.MonInfo.WinInfoList.Count - 1 do
begin
pWData := VT_AddChildData(vtWin);
pWData.Wininfo := pData.MonInfo.WinInfoList[i];
end;
finally
vtWin.EndUpdate;
end;
end;
procedure TDlgMonSecuMain.vtLogFreeNode(Sender: TBaseVirtualTree;
Node: PVirtualNode);
var
pData: PMonInfoEnt;
begin
pData := Sender.GetNodeData(Node);
Finalize(pData^);
end;
procedure TDlgMonSecuMain.vtLogGetHint(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex;
var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: string);
begin
HintText := vtLog.Text[Node, Column];
end;
procedure TDlgMonSecuMain.vtLogGetNodeDataSize(Sender: TBaseVirtualTree;
var NodeDataSize: Integer);
begin
NodeDataSize := SizeOf(TMonInfoEnt);
end;
procedure TDlgMonSecuMain.vtLogGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: string);
var
pData: PMonInfoEnt;
begin
pData := Sender.GetNodeData(Node);
case Column of
0 : CellText := IntToStr(Node.Index + 1);
1 : CellText := DateTimeToStr(pData.MonInfo.LogDT);
end;
end;
procedure TDlgMonSecuMain.vtWinFocusChanged(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex);
var
pData: PWinInfoEnt;
begin
if Node = nil then
exit;
pData := Sender.GetNodeData(Node);
mmWInfo.Text := pData.Wininfo.sImgTxt;
end;
procedure TDlgMonSecuMain.vtWinFreeNode(Sender: TBaseVirtualTree;
Node: PVirtualNode);
var
pData: PWinInfoEnt;
begin
pData := Sender.GetNodeData(Node);
Finalize(pData^);
end;
procedure TDlgMonSecuMain.vtWinGetHint(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex;
var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: string);
begin
HintText := vtWin.Text[Node, Column];
end;
procedure TDlgMonSecuMain.vtWinGetNodeDataSize(Sender: TBaseVirtualTree;
var NodeDataSize: Integer);
begin
NodeDataSize := SizeOf(TWinInfoEnt);
end;
procedure TDlgMonSecuMain.vtWinGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: string);
var
pData: PWinInfoEnt;
begin
pData := Sender.GetNodeData(Node);
case Column of
0 : CellText := IntToStr(Node.Index + 1);
1 : CellText := DateTimeToStr(pData.Wininfo.dtStart);
2 : CellText := ExtractFileName(pData.Wininfo.sPPath);
3 : CellText := BooleanToStr(pData.Wininfo.bActive, 'O', 'X');
4 : CellText := pData.Wininfo.sTitle;
5 : CellText := ExtractFilePath(pData.Wininfo.sPPath);
end;
end;
procedure TDlgMonSecuMain.vtWinPaintText(Sender: TBaseVirtualTree;
const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
TextType: TVSTTextType);
var
pData: PWinInfoEnt;
begin
pData := Sender.GetNodeData(Node);
if pData.Wininfo.bActive then
TargetCanvas.Font.Style := TargetCanvas.Font.Style + [fsBold];
end;
procedure TDlgMonSecuMain.miCollectStartClick(Sender: TObject);
var
sCurDir: String;
PathInfo: TCollectPathInfo;
begin
if ThdCollect_ <> nil then
exit;
if MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>Ͻðڽ<C3B0><DABD>ϱ<EFBFBD>?'),
PChar(Caption), MB_ICONQUESTION or MB_YESNO) = IDNO then exit;
VisibleForm(false);
sCurDir := GetRunExePathDir;
PathInfo.sTempDir := sCurDir + 'Temp\';
ASSERT(ForceDirectories(PathInfo.sTempDir));
PathInfo.sSaveDir := sCurDir + 'Data\Img\';
ASSERT(ForceDirectories(PathInfo.sSaveDir));
PathInfo.sLogPath := sCurDir + 'Data\' + DAT_COLLECT;
Clear;
ThdCollect_ := TThdCollectMonInfo.Create(PathInfo);
ThdCollect_.StartThread;
end;
procedure TDlgMonSecuMain.miCollectStopClick(Sender: TObject);
begin
if ThdCollect_ = nil then
exit;
if MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>Ͻðڽ<C3B0><DABD>ϱ<EFBFBD>?'),
PChar(Caption), MB_ICONQUESTION or MB_YESNO) = IDNO then exit;
if ThdCollect_ <> nil then
FreeAndNil(ThdCollect_);
VisibleForm(true);
end;
procedure TDlgMonSecuMain.miExitClick(Sender: TObject);
begin
if MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD><EFBFBD>Ͻðڽ<C3B0><DABD>ϱ<EFBFBD>?'), PChar(Caption),
MB_ICONQUESTION or MB_YESNO) = IDNO then exit;
Close;
end;
procedure TDlgMonSecuMain.Clear;
begin
mmMonTxt.Clear;
VT_Clear(vtWin);
VT_Clear(vtLog);
VT_Clear(vtDoc);
MgMonInfo_.Clear;
end;
procedure TDlgMonSecuMain.miLoadDataClick(Sender: TObject);
var
sLogPath: String;
i: Integer;
pData: PMonInfoEnt;
pDataD: PDocInfoEnt;
begin
if ThdCollect_ <> nil then
begin
MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Դϴ<D4B4>. <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>ߴ<EFBFBD><DFB4><EFBFBD><EFBFBD>ֽʽÿ<CABD>.'),
PChar(Caption), MB_ICONWARNING or MB_OK);
exit;
end;
Clear;
pcMain.ActivePage := tabMonInfo;
sLogPath := GetRunExePathDir + 'Data\' + DAT_COLLECT;
if FileExists(sLogPath) then
begin
MgMonInfo_.LoadFromFile(sLogPath);
vtLog.BeginUpdate;
try
for i := 0 to MgMonInfo_.MonInfoList.Count - 1 do
begin
pData := VT_AddChildData(vtLog);
pData.MonInfo := MgMonInfo_.MonInfoList[i];
end;
finally
vtLog.EndUpdate;
end;
vtDoc.BeginUpdate;
try
for i := 0 to MgMonInfo_.RecentDocList.Count - 1 do
begin
pDataD := VT_AddChildData(vtDoc);
pDataD.sPath := MgMonInfo_.RecentDocList[i];
end;
finally
vtDoc.EndUpdate;
end;
end;
end;
procedure TDlgMonSecuMain.miOpenClick(Sender: TObject);
begin
VisibleForm(true);
end;
procedure TDlgMonSecuMain.miTrackingInfoClick(Sender: TObject);
var
dlg: TDlgWizTracking;
begin
Guard(dlg, TDlgWizTracking.Create(Self, MgMonInfo_));
dlg.ShowModal;
end;
procedure TDlgMonSecuMain.popTrayPopup(Sender: TObject);
begin
miCollectStart2.Enabled := ThdCollect_ = nil;
miCollectStop2.Enabled := not miCollectStart2.Enabled;
end;
procedure TDlgMonSecuMain.process_WM_SYSCOMMAND(var msg: TWMSysCommand);
begin
if msg.CmdType = SC_CLOSE then
begin
if ThdCollect_ <> nil then
VisibleForm(false)
else
miExit.Click;
exit;
end;
Inherited;
end;
end.