⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 mainform.pas

📁 文件同步备份工具
💻 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 + -