511 lines
14 KiB
Plaintext
511 lines
14 KiB
Plaintext
unit DCustomCttSch;
|
|
|
|
interface
|
|
|
|
uses
|
|
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
|
|
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Buttons, VirtualTrees,
|
|
Vcl.Imaging.pngimage, Vcl.ExtCtrls, System.ImageList, Vcl.ImgList,
|
|
PngImageList;
|
|
|
|
type
|
|
PDirEnt = ^TDirEnt;
|
|
TDirEnt = record
|
|
sDir: String;
|
|
end;
|
|
|
|
TDlgCustomCttSch = class(TForm)
|
|
FileOpenDialog: TFileOpenDialog;
|
|
imgBack: TImage;
|
|
mmExt: TMemo;
|
|
edLimitSize: TEdit;
|
|
Label4: TLabel;
|
|
Label1: TLabel;
|
|
cbTarget: TComboBox;
|
|
Label3: TLabel;
|
|
Label2: TLabel;
|
|
vtPath: TVirtualStringTree;
|
|
sbPatterns: TScrollBox;
|
|
chJumin: TCheckBox;
|
|
chPhone: TCheckBox;
|
|
chEmail: TCheckBox;
|
|
chIp: TCheckBox;
|
|
chCarNum: TCheckBox;
|
|
chAddr: TCheckBox;
|
|
chGlobalId: TCheckBox;
|
|
chHospiNum: TCheckBox;
|
|
chFantaDrug: TCheckBox;
|
|
chNoDrug: TCheckBox;
|
|
Shape1: TShape;
|
|
Shape2: TShape;
|
|
Label5: TLabel;
|
|
Label6: TLabel;
|
|
lbTitle: TLabel;
|
|
imgClose: TImage;
|
|
imgBtnList2: TPngImageList;
|
|
lbOk: TLabel;
|
|
imgOk: TImage;
|
|
imgCancel: TImage;
|
|
lbCancel: TLabel;
|
|
imgBtnList: TPngImageCollection;
|
|
Label7: TLabel;
|
|
Shape3: TShape;
|
|
imgAddDir: TImage;
|
|
Shape4: TShape;
|
|
imgListX: TPngImageList;
|
|
lbAddDir: TLabel;
|
|
procedure vtPathGetNodeDataSize(Sender: TBaseVirtualTree;
|
|
var NodeDataSize: Integer);
|
|
procedure vtPathFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
|
|
procedure vtPathGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
|
|
Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
|
|
procedure imgBackMouseDown(Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
procedure imgCloseMouseLeave(Sender: TObject);
|
|
procedure imgCloseMouseEnter(Sender: TObject);
|
|
procedure imgCloseMouseDown(Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
procedure imgCloseClick(Sender: TObject);
|
|
procedure imgOkClick(Sender: TObject);
|
|
procedure imgOkMouseLeave(Sender: TObject);
|
|
procedure imgOkMouseEnter(Sender: TObject);
|
|
procedure imgOkMouseDown(Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
procedure vtPathGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode;
|
|
Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean;
|
|
var ImageIndex: TImageIndex);
|
|
procedure vtPathNodeClick(Sender: TBaseVirtualTree;
|
|
const HitInfo: THitInfo);
|
|
procedure imgAddDirClick(Sender: TObject);
|
|
private
|
|
{ Private declarations }
|
|
sPtrns_,
|
|
sPaths_: String;
|
|
nLimitSizeMB_: Integer;
|
|
function CheckDir(sDir: String): Integer;
|
|
procedure AddDir(sDir: String);
|
|
procedure SetImgBtn(nImgIdx: Integer);
|
|
procedure SetImgBtn2(aImg: TImage; nImgIdx: Integer);
|
|
public
|
|
{ Public declarations }
|
|
Constructor Create(aOwner: TComponent); override;
|
|
|
|
procedure process_WM_COPYDATA(var msg: TMessage); Message WM_COPYDATA;
|
|
|
|
property Patterns: String read sPtrns_;
|
|
property Paths: String read sPaths_;
|
|
property LimitSizeMB: Integer read nLimitSizeMB_;
|
|
end;
|
|
|
|
var
|
|
DlgCustomCttSch: TDlgCustomCttSch;
|
|
|
|
implementation
|
|
|
|
uses
|
|
System.IniFiles, Tocsg.Safe, GlobalDefine, Tocsg.Path, Tocsg.Disk,
|
|
Tocsg.Strings, Tocsg.VTUtil, ManagerService, superobject,
|
|
DefineHelper, Tocsg.Process, Tocsg.Exception, CttSchDefine;
|
|
|
|
resourcestring
|
|
RS_Q_Delete = '삭제하시겠습니까?';
|
|
RS_AlreadyFolder = '이미 동일한 폴더가 존재합니다.';
|
|
RS_ExistUpper = '해당 폴더의 상위 폴더가 존재합니다..';
|
|
RS_ExistLower = '해당 폴더의 하위 폴더가 존재합니다..';
|
|
RS_MsgAddPtrn = '검사 패턴을 하나이상 체크해 주십시오.';
|
|
RS_MsgAddPath = '검사 위치를 하나이상 추가해 주십시오.';
|
|
RS_MsgAddExt = '검사 확장자를 하나 이상 입력해 주십시오.';
|
|
|
|
{$R *.dfm}
|
|
|
|
Constructor TDlgCustomCttSch.Create(aOwner: TComponent);
|
|
|
|
procedure InitCtrls;
|
|
var
|
|
ini: TIniFile;
|
|
sTemp: String;
|
|
StrList: TStringList;
|
|
i: Integer;
|
|
pDataD: PDirEnt;
|
|
begin
|
|
Guard(ini, TIniFile.Create(GetRunExePathDir + INI_HE));
|
|
mmExt.Text := ini.ReadString('CttSch', 'IncExt', DOC_EXTS);
|
|
edLimitSize.Text := IntToStr(ini.ReadInteger('CttSch', 'LimitSize', 50));
|
|
cbTarget.ItemIndex := ini.ReadInteger('CttSch', 'Target', 0);
|
|
if cbTarget.ItemIndex < 0 then
|
|
cbTarget.ItemIndex := 0;
|
|
|
|
sTemp := ini.ReadString('CttSch', 'TgPaths', '');
|
|
if sTemp = '' then
|
|
sTemp := StringReplace(GetDrivesFromMask(GetLogicalDrives), ',', '|', [rfReplaceAll]);
|
|
|
|
Guard(StrList, TStringList.Create);
|
|
SplitString(sTemp, '|', StrList);
|
|
vtPath.BeginUpdate;
|
|
try
|
|
for i := 0 to StrList.Count - 1 do
|
|
if CheckDir(StrList[i]) = 0 then
|
|
AddDir(StrList[i]);
|
|
finally
|
|
vtPath.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
Inherited Create(aOwner);
|
|
ChangeWindowMessageFilter(WM_COPYDATA, MSGFLT_ADD);
|
|
SetImgBtn(0);
|
|
SetImgBtn2(imgOk, 0);
|
|
SetImgBtn2(imgCancel, 3);
|
|
SetImgBtn2(imgAddDir, 6);
|
|
|
|
InitCtrls;
|
|
end;
|
|
|
|
procedure TDlgCustomCttSch.SetImgBtn(nImgIdx: Integer);
|
|
begin
|
|
imgBtnList2.GetIcon(nImgIdx, imgClose.Picture.Icon);
|
|
imgClose.Repaint
|
|
end;
|
|
|
|
procedure TDlgCustomCttSch.SetImgBtn2(aImg: TImage; nImgIdx: Integer);
|
|
begin
|
|
aImg.Picture.Assign(imgBtnList.Items[nImgIdx].PngImage)
|
|
end;
|
|
|
|
procedure TDlgCustomCttSch.imgAddDirClick(Sender: TObject);
|
|
var
|
|
sExe: String;
|
|
O: ISuperObject;
|
|
ProcInfo: TProcessInformation;
|
|
Label
|
|
LB_Direct;
|
|
begin
|
|
sExe := GetRunExePathDir + DIR_CONF + EXE_HLP;
|
|
if FileExists(sExe) then
|
|
begin
|
|
O := SO;
|
|
O.I['RcvWnd'] := Handle;
|
|
O.I['Cmd'] := HPCMD_SELECT_FOLDER;
|
|
O.I['Ctrl'] := 1;
|
|
SaveJsonObjToFile(O, GetRunExePathDir + DIR_CONF + DAT_PARAM);
|
|
// ProcInfo := ExecuteApp(sExe, '', SW_SHOWNORMAL);
|
|
ProcInfo := ExecuteAppAsUser('explorer.exe', sExe, '', SW_SHOWNORMAL);
|
|
if ProcInfo.dwProcessId = 0 then
|
|
goto LB_Direct;
|
|
end else begin
|
|
LB_Direct :
|
|
FileOpenDialog.FileName := '';
|
|
if gMgSvc.Domain <> '' then
|
|
begin
|
|
var sPath: String := 'C:\Users\' + ExtractFileName(gMgSvc.Domain) + '\Desktop';
|
|
if DirectoryExists(sPath) then
|
|
FileOpenDialog.DefaultFolder := sPath;
|
|
end;
|
|
|
|
if FileOpenDialog.Execute then
|
|
begin
|
|
case CheckDir(FileOpenDialog.FileName) of
|
|
0 : AddDir(FileOpenDialog.FileName);
|
|
1 : MessageBox(Handle, PChar(RS_AlreadyFolder), PChar(Caption), MB_ICONWARNING or MB_OK);
|
|
2 : MessageBox(Handle, PChar(RS_ExistUpper), PChar(Caption), MB_ICONWARNING or MB_OK);
|
|
3 : MessageBox(Handle, PChar(RS_ExistLower), PChar(Caption), MB_ICONWARNING or MB_OK);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TDlgCustomCttSch.imgBackMouseDown(Sender: TObject;
|
|
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
ReleaseCapture;
|
|
SendMessage(Handle, WM_NCLBUTTONDOWN, HTCAPTION, 0);
|
|
end;
|
|
|
|
procedure TDlgCustomCttSch.imgCloseClick(Sender: TObject);
|
|
begin
|
|
Close;
|
|
end;
|
|
|
|
procedure TDlgCustomCttSch.imgCloseMouseDown(Sender: TObject;
|
|
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
SetImgBtn(2);
|
|
end;
|
|
|
|
procedure TDlgCustomCttSch.imgCloseMouseEnter(Sender: TObject);
|
|
begin
|
|
SetImgBtn(1);
|
|
end;
|
|
|
|
procedure TDlgCustomCttSch.imgCloseMouseLeave(Sender: TObject);
|
|
begin
|
|
SetImgBtn(0);
|
|
end;
|
|
|
|
procedure TDlgCustomCttSch.imgOkClick(Sender: TObject);
|
|
var
|
|
pNode: PVirtualNode;
|
|
pDataD: PDirEnt;
|
|
ini: TIniFile;
|
|
begin
|
|
sPtrns_ := '';
|
|
sPaths_ := '';
|
|
|
|
if chJumin.Checked then
|
|
SumString(sPtrns_, IntToStr(chJumin.Tag), '|');
|
|
if chPhone.Checked then
|
|
SumString(sPtrns_, IntToStr(chPhone.Tag), '|');
|
|
if chEmail.Checked then
|
|
SumString(sPtrns_, IntToStr(chEmail.Tag), '|');
|
|
if chIp.Checked then
|
|
SumString(sPtrns_, IntToStr(chIp.Tag), '|');
|
|
if chCarNum.Checked then
|
|
SumString(sPtrns_, IntToStr(chCarNum.Tag), '|');
|
|
if chAddr.Checked then
|
|
SumString(sPtrns_, IntToStr(chAddr.Tag), '|');
|
|
if chGlobalId.Checked then
|
|
SumString(sPtrns_, IntToStr(chGlobalId.Tag), '|');
|
|
if chHospiNum.Checked then
|
|
SumString(sPtrns_, IntToStr(chHospiNum.Tag), '|');
|
|
if chFantaDrug.Checked then
|
|
SumString(sPtrns_, IntToStr(chFantaDrug.Tag), '|');
|
|
if chNoDrug.Checked then
|
|
SumString(sPtrns_, IntToStr(chNoDrug.Tag), '|');
|
|
|
|
if sPtrns_ = '' then
|
|
begin
|
|
MessageBox(Handle, PChar(RS_MsgAddPtrn), PChar(Caption), MB_ICONWARNING or MB_OK);
|
|
exit;
|
|
end;
|
|
|
|
if vtPath.RootNodeCount = 0 then
|
|
begin
|
|
MessageBox(Handle, PChar(RS_MsgAddPath), PChar(Caption), MB_ICONWARNING or MB_OK);
|
|
exit;
|
|
end;
|
|
|
|
mmExt.Text := Trim(mmExt.Text);
|
|
if mmExt.Text = '' then
|
|
begin
|
|
MessageBox(Handle, PChar(RS_MsgAddExt), PChar(Caption), MB_ICONWARNING or MB_OK);
|
|
exit;
|
|
end;
|
|
|
|
edLimitSize.Text := Trim(edLimitSize.Text);
|
|
if edLimitSize.Text = '' then
|
|
edLimitSize.Text := '50';
|
|
|
|
vtPath.BeginUpdate;
|
|
try
|
|
pNode := vtPath.GetFirst;
|
|
while pNode <> nil do
|
|
begin
|
|
pDataD := vtPath.GetNodeData(pNode);
|
|
SumString(sPaths_, pDataD.sDir, '|');
|
|
pNode := vtPath.GetNext(pNode);
|
|
end;
|
|
finally
|
|
vtPath.EndUpdate;
|
|
end;
|
|
nLimitSizeMB_ := StrToIntDef(edLimitSize.Text, 50);
|
|
|
|
Guard(ini, TIniFile.Create(GetRunExePathDir + INI_HE));
|
|
ini.WriteString('CttSch', 'TgPtrns', sPtrns_);
|
|
ini.WriteString('CttSch', 'TgPaths', sPaths_);
|
|
ini.WriteString('CttSch', 'IncExt', mmExt.Text);
|
|
ini.WriteInteger('CttSch', 'LimitSize', nLimitSizeMB_);
|
|
ini.WriteInteger('CttSch', 'Target', cbTarget.ItemIndex);
|
|
|
|
ModalResult := mrOk;
|
|
end;
|
|
|
|
procedure TDlgCustomCttSch.imgOkMouseDown(Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
img: TImage;
|
|
begin
|
|
if Sender = nil then
|
|
exit;
|
|
|
|
if Sender is TImage then
|
|
img := TImage(Sender)
|
|
else if Sender = lbOk then
|
|
img := imgOk
|
|
else
|
|
img := imgCancel;
|
|
|
|
SetImgBtn2(img, img.Tag + 2);
|
|
end;
|
|
|
|
procedure TDlgCustomCttSch.imgOkMouseEnter(Sender: TObject);
|
|
var
|
|
img: TImage;
|
|
begin
|
|
if Sender = nil then
|
|
exit;
|
|
|
|
if Sender is TImage then
|
|
img := TImage(Sender)
|
|
else if Sender = lbOk then
|
|
img := imgOk
|
|
else if sender = lbAddDir then
|
|
img := imgAddDir
|
|
else
|
|
img := imgCancel;
|
|
|
|
if img = imgAddDir then
|
|
lbAddDir.Font.Color := clBlack;
|
|
|
|
SetImgBtn2(img, img.Tag + 1);
|
|
end;
|
|
|
|
procedure TDlgCustomCttSch.imgOkMouseLeave(Sender: TObject);
|
|
var
|
|
img: TImage;
|
|
begin
|
|
if Sender = nil then
|
|
exit;
|
|
|
|
if Sender is TImage then
|
|
img := TImage(Sender)
|
|
else if Sender = lbOk then
|
|
img := imgOk
|
|
else if sender = lbAddDir then
|
|
img := imgAddDir
|
|
else
|
|
img := imgCancel;
|
|
|
|
if img = imgAddDir then
|
|
lbAddDir.Font.Color := $00DB6646;
|
|
|
|
SetImgBtn2(img, img.Tag);
|
|
end;
|
|
|
|
function TDlgCustomCttSch.CheckDir(sDir: String): Integer;
|
|
var
|
|
pNode: PVirtualNode;
|
|
pData: PDirEnt;
|
|
sCheckDir: String;
|
|
begin
|
|
Result := 0;
|
|
|
|
sDir := IncludeTrailingPathDelimiter(sDir.ToUpper);
|
|
pNode := vtPath.GetFirst;
|
|
while pNode <> nil do
|
|
begin
|
|
pData := vtPath.GetNodeData(pNode);
|
|
sCheckDir := pData.sDir.ToUpper;
|
|
|
|
if sCheckDir = sDir then
|
|
Exit(1);
|
|
|
|
if Pos(pData.sDir, sDir) > 0 then
|
|
Exit(2);
|
|
|
|
if Pos(sDir, pData.sDir) > 0 then
|
|
Exit(3);
|
|
|
|
pNode := vtPath.GetNext(pNode);
|
|
end;
|
|
end;
|
|
|
|
procedure TDlgCustomCttSch.AddDir(sDir: String);
|
|
var
|
|
pData: PDirEnt;
|
|
begin
|
|
if not DirectoryExists(sDir) then
|
|
exit;
|
|
pData := VT_AddChildData(vtPath);
|
|
pData.sDir := IncludeTrailingPathDelimiter(sDir);
|
|
end;
|
|
|
|
procedure TDlgCustomCttSch.vtPathFreeNode(Sender: TBaseVirtualTree;
|
|
Node: PVirtualNode);
|
|
var
|
|
pData: PDirEnt;
|
|
begin
|
|
pData := Sender.GetNodeData(Node);
|
|
Finalize(pData^);
|
|
end;
|
|
|
|
procedure TDlgCustomCttSch.vtPathGetImageIndex(Sender: TBaseVirtualTree;
|
|
Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
|
|
var Ghosted: Boolean; var ImageIndex: TImageIndex);
|
|
begin
|
|
if Column = 1 then
|
|
case Kind of
|
|
ikNormal,
|
|
ikSelected: ImageIndex := 0;
|
|
end;
|
|
end;
|
|
|
|
procedure TDlgCustomCttSch.vtPathGetNodeDataSize(Sender: TBaseVirtualTree;
|
|
var NodeDataSize: Integer);
|
|
begin
|
|
NodeDataSize := SizeOf(TDirEnt);
|
|
end;
|
|
|
|
procedure TDlgCustomCttSch.vtPathGetText(Sender: TBaseVirtualTree;
|
|
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
|
|
var CellText: string);
|
|
var
|
|
pData: PDirEnt;
|
|
begin
|
|
pData := Sender.GetNodeData(Node);
|
|
case Column of
|
|
0 : CellText := pData.sDir;
|
|
end;
|
|
end;
|
|
|
|
procedure TDlgCustomCttSch.vtPathNodeClick(Sender: TBaseVirtualTree;
|
|
const HitInfo: THitInfo);
|
|
begin
|
|
if hiOnNormalIcon in HitInfo.HitPositions then
|
|
begin
|
|
if HitInfo.HitNode <> nil then
|
|
begin
|
|
if MessageBox(Handle, PChar(RS_Q_Delete), PChar(Caption),
|
|
MB_ICONQUESTION or MB_YESNO) = IDNO then exit;
|
|
|
|
vtPath.DeleteNode(HitInfo.HitNode);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TDlgCustomCttSch.process_WM_COPYDATA(var msg: TMessage);
|
|
var
|
|
dwData: DWORD;
|
|
pCpData: PCopyDataStruct;
|
|
O: ISuperObject;
|
|
begin
|
|
dwData := 0;
|
|
pCpData := PCopyDataStruct(msg.LParam);
|
|
try
|
|
dwData := pCpData.dwData;
|
|
case dwData of
|
|
HPCMD_SELECT_FOLDER :
|
|
begin
|
|
O := SO(Copy(PChar(pCpData.lpData), 1, pCpData.cbData));
|
|
var sPath: String := O.S['Path'];
|
|
case CheckDir(sPath) of
|
|
0 : AddDir(sPath);
|
|
1 : MessageBox(Handle, PChar(RS_AlreadyFolder), PChar(Caption), MB_ICONWARNING or MB_OK);
|
|
2 : MessageBox(Handle, PChar(RS_ExistUpper), PChar(Caption), MB_ICONWARNING or MB_OK);
|
|
3 : MessageBox(Handle, PChar(RS_ExistLower), PChar(Caption), MB_ICONWARNING or MB_OK);
|
|
end;
|
|
|
|
// 일반권한으로 실행해서 안 지워진다.. 그래서 후처리 추가 22_0614 12:40:00 kku
|
|
sPath := GetRunExePathDir + DIR_CONF + DAT_PARAM;
|
|
if FileExists(sPath) then
|
|
DeleteFile(sPath);
|
|
end;
|
|
end;
|
|
except
|
|
on E: Exception do
|
|
ETgException.TraceException(Self, E, Format('Fail .. process_WM_COPYDATA(), dwData=%d', [dwData]));
|
|
end;
|
|
end;
|
|
|
|
end.
|