394 lines
9.0 KiB
Plaintext
394 lines
9.0 KiB
Plaintext
unit DFileTossMain;
|
||
|
||
interface
|
||
|
||
uses
|
||
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
|
||
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, Vcl.StdCtrls, Vcl.Buttons,
|
||
Vcl.ExtCtrls, Tocsg.Trace, Tocsg.Files, Tocsg.Controls, Tocsg.Thread,
|
||
System.Generics.Collections;
|
||
|
||
type
|
||
TWatchDirTossFile = class(TTgDirWatchBase)
|
||
protected
|
||
procedure ProcessDirWatchEnt(Sender: TObject; pInfo: PDirWatchEnt); override;
|
||
end;
|
||
|
||
TThdFileToss = class(TTgThread)
|
||
protected
|
||
sTargetDir_: String;
|
||
qFiles_: TQueue<String>;
|
||
procedure Execute; override;
|
||
public
|
||
Constructor Create(sTargetDir: String);
|
||
Destructor Destroy; override;
|
||
|
||
procedure AddFile(sPath: String);
|
||
end;
|
||
|
||
TDlgFileTossMain = class(TForm)
|
||
MainMenu: TMainMenu;
|
||
miWatch: TMenuItem;
|
||
miConfig: TMenuItem;
|
||
miSetting: TMenuItem;
|
||
miStart: TMenuItem;
|
||
miStop: TMenuItem;
|
||
N1: TMenuItem;
|
||
miExit: TMenuItem;
|
||
mmLog: TMemo;
|
||
pnTop: TPanel;
|
||
Label1: TLabel;
|
||
Label2: TLabel;
|
||
edWPath: TEdit;
|
||
edTPath: TEdit;
|
||
miWopen: TSpeedButton;
|
||
btnTopen: TSpeedButton;
|
||
FileOpenDialog: TFileOpenDialog;
|
||
chOnlyCopy: TCheckBox;
|
||
chBackupFile: TCheckBox;
|
||
procedure miWopenClick(Sender: TObject);
|
||
procedure btnTopenClick(Sender: TObject);
|
||
procedure miStartClick(Sender: TObject);
|
||
procedure miWatchClick(Sender: TObject);
|
||
procedure miStopClick(Sender: TObject);
|
||
procedure miSettingClick(Sender: TObject);
|
||
procedure miExitClick(Sender: TObject);
|
||
private
|
||
{ Private declarations }
|
||
Trace_: TTgTrace;
|
||
WatchDir_: TWatchDirTossFile;
|
||
ThdToss_: TThdFileToss;
|
||
MgCtrl_: TManagerInputControlsData;
|
||
|
||
sWatchDir_,
|
||
sTargetDir_: String;
|
||
bIsOnlyCopy_,
|
||
bIsBacupFile_: Boolean;
|
||
|
||
procedure EnableCtrls(bVal: Boolean);
|
||
public
|
||
{ Public declarations }
|
||
Constructor Create(aOwner: TComponent); override;
|
||
Destructor Destroy; override;
|
||
procedure Log(const sFormat: String; const Args: array of const); overload;
|
||
procedure Log(const sLog: String); overload;
|
||
|
||
procedure process_WM_SYSCOMMAND(var msg: TWMSysCommand); Message WM_SYSCOMMAND;
|
||
end;
|
||
|
||
var
|
||
gMain: TDlgFileTossMain = nil;
|
||
DlgFileTossMain: TDlgFileTossMain;
|
||
|
||
implementation
|
||
|
||
uses
|
||
Tocsg.Path, Tocsg.Exception, System.IniFiles, Tocsg.Safe, DSetting;
|
||
|
||
{$R *.dfm}
|
||
|
||
{ TWatchDirTossFile }
|
||
|
||
procedure TWatchDirTossFile.ProcessDirWatchEnt(Sender: TObject; pInfo: PDirWatchEnt);
|
||
begin
|
||
if pInfo.dwAction <> 1 then
|
||
exit;
|
||
|
||
if gMain = nil then
|
||
exit;
|
||
|
||
gMain.Log('<27><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>. Path=%s', [pInfo.sPath]);
|
||
gMain.ThdToss_.AddFile(pInfo.sPath);
|
||
end;
|
||
|
||
{ TThdFileToss }
|
||
|
||
Constructor TThdFileToss.Create(sTargetDir: String);
|
||
begin
|
||
Inherited Create;
|
||
qFiles_ := TQueue<String>.Create;
|
||
sTargetDir_ := sTargetDir;
|
||
end;
|
||
|
||
Destructor TThdFileToss.Destroy;
|
||
begin
|
||
FreeAndNil(qFiles_);
|
||
Inherited;
|
||
end;
|
||
|
||
procedure TThdFileToss.AddFile(sPath: String);
|
||
begin
|
||
Lock;
|
||
try
|
||
qFiles_.Enqueue(sPath);
|
||
finally
|
||
Unlock;
|
||
end;
|
||
end;
|
||
|
||
procedure TThdFileToss.Execute;
|
||
var
|
||
sPath, sDestPath, sBackDir: String;
|
||
fs: TFileStream;
|
||
begin
|
||
sBackDir := gMain.sWatchDir_ + 'Backup\';
|
||
while not Terminated and not GetWorkStop do
|
||
begin
|
||
Lock;
|
||
try
|
||
if qFiles_.Count > 0 then
|
||
sPath := qFiles_.Dequeue
|
||
else
|
||
sPath := '';
|
||
finally
|
||
Unlock;
|
||
end;
|
||
|
||
if (sPath = '') or not FileExists(sPath) then
|
||
begin
|
||
Sleep(200);
|
||
continue;
|
||
end;
|
||
|
||
try
|
||
fs := TFileStream.Create(sPath, fmOpenRead);
|
||
fs.Free;
|
||
except
|
||
AddFile(sPath);
|
||
sPath := '';
|
||
end;
|
||
|
||
if sPath <> '' then
|
||
begin
|
||
sDestPath := sTargetDir_ + ExtractFileName(sPath);
|
||
if FileExists(sDestPath) then
|
||
DeleteFile(sDestPath);
|
||
|
||
if CopyFile(PChar(sPath), PChar(sDestPath), false) then
|
||
begin
|
||
if gMain.bIsBacupFile_ and ForceDirectories(sBackDir) then
|
||
begin
|
||
CopyFile(PChar(sPath),
|
||
PChar(sBackDir + Format('%s_%s',
|
||
[FormatDateTime('yyyymmddhhnnss', Now), ExtractFileName(sPath)])), false);
|
||
end;
|
||
|
||
if not gMain.bIsOnlyCopy_ then
|
||
DeleteFile(sPath);
|
||
end else begin
|
||
AddFile(sPath);
|
||
gMain.Log('<27><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>.. <20><><EFBFBD>õ<EFBFBD>. Path=%s', [sPath]);
|
||
end;
|
||
end;
|
||
|
||
Sleep(10);
|
||
end;
|
||
end;
|
||
|
||
{ TDlgFileTossMain }
|
||
|
||
Constructor TDlgFileTossMain.Create(aOwner: TComponent);
|
||
|
||
procedure InitCtrls;
|
||
var
|
||
ini: TIniFile;
|
||
begin
|
||
MgCtrl_ := TManagerInputControlsData.Create(CutFileExt(GetRunExePath) + '.ini');
|
||
MgCtrl_.RegInputCtrl(edWPath);
|
||
MgCtrl_.RegInputCtrl(edTPath);
|
||
MgCtrl_.RegInputCtrl(chOnlyCopy);
|
||
MgCtrl_.RegInputCtrl(chBackupFile);
|
||
MgCtrl_.Load(true);
|
||
|
||
Guard(ini, TIniFile.Create(CutFileExt(GetRunExePath) + '.ini'));
|
||
if ini.ReadBool('Setting', 'AutoWatch', false) then
|
||
miStart.Click;
|
||
end;
|
||
|
||
begin
|
||
Inherited Create(aOwner);
|
||
gMain := Self;
|
||
Trace_ := TTgTrace.Create(GetRunExePathDir + 'Log\', CutFileExt(GetRunExeName) + '.log', true);
|
||
WatchDir_ := nil;
|
||
ThdToss_ := nil;
|
||
sWatchDir_ := '';
|
||
sTargetDir_ := '';
|
||
bIsOnlyCopy_ := false;
|
||
bIsBacupFile_ := false;
|
||
InitCtrls;
|
||
end;
|
||
|
||
Destructor TDlgFileTossMain.Destroy;
|
||
begin
|
||
gMain := nil;
|
||
FreeAndNil(MgCtrl_);
|
||
if WatchDir_ <> nil then
|
||
FreeAndNil(WatchDir_);
|
||
if ThdToss_ <> nil then
|
||
FreeAndNil(ThdToss_);
|
||
FreeAndNil(Trace_);
|
||
Inherited;
|
||
end;
|
||
|
||
procedure TDlgFileTossMain.Log(const sFormat: String; const Args: array of const);
|
||
var
|
||
str: String;
|
||
begin
|
||
FmtStr(str, sFormat, Args);
|
||
Log(str);
|
||
end;
|
||
|
||
procedure TDlgFileTossMain.Log(const sLog: String);
|
||
begin
|
||
try
|
||
if mmLog.Lines.Count >= 10000 then
|
||
mmLog.Lines.Delete(0);
|
||
|
||
Trace_.T(sLog);
|
||
mmLog.Lines.Add(Format('[%s] %s', [DateTimeToStr(Now), sLog]));
|
||
|
||
Application.ProcessMessages;
|
||
except
|
||
on E: Exception do
|
||
ETgException.TraceException(Self, E, 'Fail .. Log()');
|
||
end;
|
||
end;
|
||
|
||
procedure TDlgFileTossMain.btnTopenClick(Sender: TObject);
|
||
begin
|
||
FileOpenDialog.FileName := '';
|
||
if FileOpenDialog.Execute then
|
||
edTPath.Text := FileOpenDialog.FileName;
|
||
end;
|
||
|
||
procedure TDlgFileTossMain.miWatchClick(Sender: TObject);
|
||
begin
|
||
miStart.Enabled := WatchDir_ = nil;
|
||
miStart.Checked := not miStart.Enabled;
|
||
miStop.Enabled := miStart.Checked;
|
||
end;
|
||
|
||
procedure TDlgFileTossMain.miWopenClick(Sender: TObject);
|
||
begin
|
||
FileOpenDialog.FileName := '';
|
||
if FileOpenDialog.Execute then
|
||
edWPath.Text := FileOpenDialog.FileName;
|
||
end;
|
||
|
||
procedure TDlgFileTossMain.EnableCtrls(bVal: Boolean);
|
||
begin
|
||
Label1.Enabled := bVal;
|
||
Label2.Enabled := bVal;
|
||
edWPath.Enabled := bVal;
|
||
edTPath.Enabled := bVal;
|
||
chOnlyCopy.Enabled := bVal;
|
||
chBackupFile.Enabled := bVal;
|
||
end;
|
||
|
||
procedure TDlgFileTossMain.miExitClick(Sender: TObject);
|
||
begin
|
||
if WatchDir_ <> nil then
|
||
begin
|
||
if MessageBox(Handle, PChar('<27><><EFBFBD>ø<EFBFBD> <20>ߴ<EFBFBD><DFB4>ϰ<EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>Ͻðڽ<C3B0><DABD>ϱ<EFBFBD>?'),
|
||
PChar(Caption), MB_ICONQUESTION or MB_YESNO) = IDNO then exit;
|
||
end;
|
||
|
||
Close;
|
||
end;
|
||
|
||
procedure TDlgFileTossMain.miSettingClick(Sender: TObject);
|
||
var
|
||
dlg: TDlgSetting;
|
||
begin
|
||
Guard(dlg, TDlgSetting.Create(Self));
|
||
dlg.ShowModal;
|
||
end;
|
||
|
||
procedure TDlgFileTossMain.miStartClick(Sender: TObject);
|
||
begin
|
||
if WatchDir_ <> nil then
|
||
exit;
|
||
|
||
edWPath.Text := Trim(edWPath.Text);
|
||
edTPath.Text := Trim(edTPath.Text);
|
||
|
||
if edWPath.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);
|
||
edWPath.SetFocus;
|
||
exit;
|
||
end;
|
||
|
||
if edTPath.Text = '' then
|
||
begin
|
||
MessageBox(Handle, PChar('<27>̵<EFBFBD> <20><><EFBFBD>θ<EFBFBD> <20>Է<EFBFBD><D4B7><EFBFBD> <20>ֽʽÿ<CABD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
|
||
edTPath.SetFocus;
|
||
exit;
|
||
end;
|
||
|
||
if not DirectoryExists(edWPath.Text) then
|
||
begin
|
||
MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD> <20><><EFBFBD>ΰ<EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>ʽ<EFBFBD><CABD>ϴ<EFBFBD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
|
||
edWPath.SetFocus;
|
||
exit;
|
||
end;
|
||
|
||
if not DirectoryExists(edTPath.Text) then
|
||
begin
|
||
MessageBox(Handle, PChar('<27>̵<EFBFBD> <20><><EFBFBD>ΰ<EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>ʽ<EFBFBD><CABD>ϴ<EFBFBD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
|
||
edTPath.SetFocus;
|
||
exit;
|
||
end;
|
||
|
||
sWatchDir_ := IncludeTrailingPathDelimiter(edWPath.Text);
|
||
sTargetDir_ := IncludeTrailingPathDelimiter(edTPath.Text);
|
||
if CompareText(sWatchDir_, sTargetDir_) = 0 then
|
||
begin
|
||
sWatchDir_ := '';
|
||
sTargetDir_ := '';
|
||
Log('<27><><EFBFBD><EFBFBD> <20><><EFBFBD>ο<EFBFBD> <20>̵<EFBFBD> <20><><EFBFBD>ΰ<EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>ϴ<EFBFBD>.');
|
||
exit;
|
||
end;
|
||
|
||
bIsOnlyCopy_ := chOnlyCopy.Checked;
|
||
bIsBacupFile_ := chBackupFile.Checked;
|
||
|
||
ThdToss_ := TThdFileToss.Create(sTargetDir_);
|
||
ThdToss_.StartThread;
|
||
|
||
WatchDir_ := TWatchDirTossFile.Create(false, true);
|
||
WatchDir_.AddDirWatch(sWatchDir_);
|
||
WatchDir_.StartWatch;
|
||
|
||
MgCtrl_.Save;
|
||
|
||
mmLog.Clear;
|
||
Log('<27><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD>ð<EFBFBD> <20><><EFBFBD><EFBFBD> <20>Ǿ<EFBFBD><C7BE><EFBFBD><EFBFBD>ϴ<EFBFBD>.');
|
||
EnableCtrls(false);
|
||
end;
|
||
|
||
procedure TDlgFileTossMain.miStopClick(Sender: TObject);
|
||
begin
|
||
if WatchDir_ = nil then
|
||
exit;
|
||
FreeAndNil(WatchDir_);
|
||
if ThdToss_ <> nil then
|
||
FreeAndNil(ThdToss_);
|
||
sWatchDir_ := '';
|
||
sTargetDir_ := '';
|
||
Log('<27><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD>ð<EFBFBD> <20><><EFBFBD><EFBFBD> <20>Ǿ<EFBFBD><C7BE><EFBFBD><EFBFBD>ϴ<EFBFBD>.');
|
||
EnableCtrls(true);
|
||
end;
|
||
|
||
procedure TDlgFileTossMain.process_WM_SYSCOMMAND(var msg: TWMSysCommand);
|
||
begin
|
||
if msg.CmdType = SC_CLOSE then
|
||
begin
|
||
miExit.Click;
|
||
exit;
|
||
end;
|
||
Inherited;
|
||
end;
|
||
|
||
end.
|