📄 mainform.pas
字号:
unit MainForm;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, bsSkinData, BusinessSkinForm, ComCtrls, bsSkinCtrls, StdCtrls, StrUtils,
AppEvnts, bsTrayIcon;
type
TfrmMain = class(TForm)
bsBusinessSkinForm1: TbsBusinessSkinForm;
bsSkinData1: TbsSkinData;
bsStoredSkin1: TbsStoredSkin;
bsSkinGroupBox1: TbsSkinGroupBox;
lvTask: TbsSkinListView;
bsSkinScrollBar1: TbsSkinScrollBar;
bsSkinScrollBar2: TbsSkinScrollBar;
btnNewTask: TbsSkinButton;
btnEditTask: TbsSkinButton;
btnDelTask: TbsSkinButton;
btnAll: TbsSkinButton;
btnSelected: TbsSkinButton;
ProgressPanel: TbsSkinPanel;
Label1: TLabel;
Label2: TLabel;
lbSourceFile: TLabel;
lbDestFile: TLabel;
Label3: TLabel;
Label4: TLabel;
lbCopyCount: TLabel;
lbJumpCount: TLabel;
Label5: TLabel;
lbAllCount: TLabel;
Gauge: TbsSkinGauge;
ApplicationEvents1: TApplicationEvents;
TrayIcon: TbsTrayIcon;
procedure btnNewTaskClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btnEditTaskClick(Sender: TObject);
procedure btnDelTaskClick(Sender: TObject);
procedure btnAllClick(Sender: TObject);
procedure btnSelectedClick(Sender: TObject);
procedure ApplicationEvents1Exception(Sender: TObject; E: Exception);
private
{ Private declarations }
AllCount, JumpCount, CopyCount: LongWord;
procedure LoadAllTaskFromINI;
function InphaseFiles(const SourceDir, DestDir: String): Boolean;
procedure MyCopyFile(Source, Dest: String);
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
implementation
uses EditTask, MyDefine;
{$R *.dfm}
procedure TfrmMain.btnNewTaskClick(Sender: TObject);
begin
Application.CreateForm(TfrmEditTask, frmEditTask);
with frmEditTask do begin
ThisIndex := GetTaskCount + 1;
isEdit := False;
ShowModal;
end;
LoadAllTaskFromINI;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
LoadAllTaskFromINI;
end;
procedure TfrmMain.btnEditTaskClick(Sender: TObject);
var
Item: TListItem;
begin
Item := lvTask.Selected;
if Item = nil then Exit;
Application.CreateForm(TfrmEditTask, frmEditTask);
with frmEditTask do begin
try SourceDirList.Directory := Item.Caption; except end;
try DestDirList.Directory := Item.SubItems[0]; except end;
ThisIndex := StrToInt(Item.SubItems[1]);
isEdit := True;
ShowModal;
end;
LoadAllTaskFromINI;
end;
procedure TfrmMain.btnDelTaskClick(Sender: TObject);
var
Item: TListItem;
T: String;
begin
Item := lvTask.Selected;
if Item = nil then Exit;
T := 'Task' + Item.SubItems[1];
INI.EraseSection(T);
WriteTaskCount(-1);
LoadAllTaskFromINI;
end;
procedure TfrmMain.LoadAllTaskFromINI;
var
Item: TListItem;
C, I: Word;
ATask: TTaskInfo;
begin
C := GetTaskCount;
lvTask.Items.BeginUpdate;
lvTask.Items.Clear;
for I := 1 to C do begin
ATask := GetATaskInfo(I);
Item := lvTask.Items.Add;
Item.Caption := ATask.SourceDir;
Item.SubItems.Add(ATask.DestDir);
Item.SubItems.Add(IntToStr(ATask.Index));
end;
lvTask.Items.EndUpdate;
end;
function TfrmMain.InphaseFiles(const SourceDir, DestDir: String): Boolean;
function CopyAFileTo(const SourceFile, DestFile: String): Boolean;
var
Size1, Size2: LongInt;
begin
lbSourceFile.Caption := SourceFile;
lbDestFile.Caption := DestFile;
Size1 := GetFileSize(SourceFile);
Size2 := GetFileSize(DestFile);
if Size1 <> Size2 then begin
MyCopyFile(SourceFile, DestFile);
Inc(CopyCount);
end else begin
Inc(JumpCount);
end;
Inc(AllCount);
lbCopyCount.Caption := IntToStr(CopyCount);
lbJumpCount.Caption := IntToStr(JumpCount);
lbAllCount.Caption := IntToStr(AllCount);
TrayIcon.Hint := '已复制文件 ' + lbCopyCount.Caption + ' 个;' + #13 + '已跳过文件 ' +
lbJumpCount.Caption + ' 个;' + #13 + '共处理文件 ' + lbAllCount.Caption + ' 个';
Application.ProcessMessages;
Result := True;
end;
procedure ReadFileName(const AnyFile: String);
var
Found: Integer;
Sr: TSearchRec;
Temp: String;
begin
if RightStr(DestDir, 1) <> '\' then
Temp := DestDir + '\' + Copy(AnyFile, 4, Length(AnyFile))
else
Temp := DestDir + Copy(AnyFile, 4, Length(AnyFile));
if FileGetAttr(AnyFile) = faArchive then CopyAFileTo(AnyFile, Temp)
else ForceDirectories(Temp);
Found := FindFirst(AnyFile + '\*.*', faAnyFile, Sr);
while Found = 0 do begin
if (Sr.Name <> '.') and (Sr.Name <> '..') then
ReadFileName(AnyFile + '\' + Sr.Name);
Found := FindNext(Sr);
end;
if (Sr.Name <> '.') and (Sr.Name <> '..') then
FindClose(Sr);
end;
var
TempStr: String;
begin
TempStr := ReverseString(SourceDir);
TempStr := LeftStr(TempStr, Pos('\', TempStr) - 1);
TempStr := ReverseString(TempStr);
ForceDirectories(DestDir + '\' + TempStr);
ReadFileName(SourceDir);
Result := True;
end;
procedure TfrmMain.btnAllClick(Sender: TObject);
var
Item: TListItem;
I: Word;
begin
AllCount := 0;
JumpCount := 0;
CopyCount := 0;
ProgressPanel.Visible := True;
for I := 0 to lvTask.Items.Count - 1 do begin
Item := lvTask.Items[I];
InphaseFiles(Item.Caption, Item.SubItems[0]);
end;
ProgressPanel.Visible := False;
TrayIcon.Hint := Caption;
end;
procedure TfrmMain.btnSelectedClick(Sender: TObject);
var
Item: TListItem;
I: Word;
begin
AllCount := 0;
JumpCount := 0;
CopyCount := 0;
ProgressPanel.Visible := True;
for I := 0 to lvTask.Items.Count - 1 do begin
Item := lvTask.Items[I];
if Item.Checked then InphaseFiles(Item.Caption, Item.SubItems[0]);
end;
ProgressPanel.Visible := False;
TrayIcon.Hint := Caption;
end;
procedure TfrmMain.MyCopyFile(Source, Dest: String);
var
FromF, ToF: file of Byte;
Buffer: array[0..4096] of Char;
NumRead: Integer;
FileLength: Longint;
begin
try
AssignFile(FromF, Source);
reset(FromF);
AssignFile(ToF, Dest);
rewrite(ToF);
FileLength := FileSize(FromF);
with Gauge do begin
MinValue := 0;
Value := 0;
MaxValue := FileLength;
while FileLength > 0 do begin
BlockRead(FromF, Buffer[0], SizeOf(Buffer), NumRead);
FileLength := FileLength - NumRead;
BlockWrite(ToF, Buffer[0], NumRead);
Value := Value + NumRead;
Application.ProcessMessages;
end;
CloseFile(FromF);
CloseFile(ToF);
end;
except
CopyFile(pChar(Source), pChar(Dest), False);
end;
End;
procedure TfrmMain.ApplicationEvents1Exception(Sender: TObject;
E: Exception);
begin
Caption := E.Message;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -