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

📄 ssmainfrm.pas

📁 文件同步
💻 PAS
📖 第 1 页 / 共 2 页
字号:
{******************************************************************************}
{                       CnPack For Delphi/C++Builder                           }
{                     中国人自己的开放源码第三方开发包                         }
{                   (C)Copyright 2001-2008 CnPack 开发组                       }
{                   ------------------------------------                       }
{                                                                              }
{            本开发包是开源的自由软件,您可以遵照 CnPack 的发布协议来修        }
{        改和重新发布这一程序。                                                }
{                                                                              }
{            发布这一开发包的目的是希望它有用,但没有任何担保。甚至没有        }
{        适合特定目的而隐含的担保。更详细的情况请参阅 CnPack 发布协议。        }
{                                                                              }
{            您应该已经和开发包一起收到一份 CnPack 发布协议的副本。如果        }
{        还没有,可访问我们的网站:                                            }
{                                                                              }
{            网站地址:http://www.cnpack.org                                   }
{            电子邮件:master@cnpack.org                                       }
{                                                                              }
{******************************************************************************}

unit SSMainFrm;
{ |<PRE>
================================================================================
* 软件名称:游戏智能同步工具
* 单元名称:主窗体单元
* 单元作者:李齐 (newlq@qq.com)
* 备    注:
* 开发平台:PWinXP SP3 + Delphi 7.1
* 兼容测试:
* 本 地 化:该单元中的字符串暂不符合本地化处理方式
* 单元标识:$Id: $
* 修改记录:2008.10.24 V1.0
*               创建单元
================================================================================
|</PRE>}

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ShellCtrls, ExtCtrls, IniFiles, Buttons, XPMan,
  CnCommon, DB, ADODB,StrUtils, RzTray;

type
  TSSMainForm = class(TForm)
    StatusBar: TStatusBar;
    pnl1: TPanel;
    lbl3: TLabel;
    ListView: TListView;
    btnUp: TButton;
    btnDown: TButton;
    btnImport: TButton;
    btnExport: TButton;
    btnExecute: TButton;
    pb1: TProgressBar;
    lbl4: TLabel;
    dlgOpen: TOpenDialog;
    dlgSave: TSaveDialog;
    tmr1: TTimer;
    Edit1: TEdit;
    Label1: TLabel;
    Button2: TButton;
    Button3: TButton;
    Acon: TADOConnection;
    AdoQry: TADOQuery;
    btnClear: TButton;
    ListView3: TListView;
    Button4: TButton;
    Button5: TButton;
    Button1: TButton;
    btnAbout: TButton;
    btnExit: TButton;
    Timer1: TTimer;
    CheckBox1: TCheckBox;
    RzTrayIcon1: TRzTrayIcon;
    memo1: TMemo;
    procedure btnDelClick(Sender: TObject);
    procedure btnClearClick(Sender: TObject);
    procedure btnUpClick(Sender: TObject);
    procedure btnDownClick(Sender: TObject);
    procedure btnImportClick(Sender: TObject);
    procedure btnExportClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnExecuteClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure tmr1Timer(Sender: TObject);
    procedure btnExitClick(Sender: TObject);
    procedure btnAboutClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
  private
    { Private declarations }
    FFileCnt: Integer;
    FExecuting: Boolean;
    FAbort: Boolean;
    FCurrMsg: string;
    FStartTick: Cardinal;
    FProcTick: Cardinal;
    FProcCnt: Integer;
    FCopyCnt: Integer;
    FDelCnt: Integer;
    FSrcDir, FDstDir: string;
    procedure SaveToFile(const FileName: string);
    procedure LoadFromFile(const FileName: string);
    procedure UpdateIndex;
    procedure FileCntProc(const FileName: string; const Info: TSearchRec;
      var Abort: Boolean);
    procedure FileSyncProc(const FileName: string; const Info: TSearchRec;
      var Abort: Boolean);
    procedure FileDelProc(const FileName: string; const Info: TSearchRec;
      var Abort: Boolean);
    procedure DirDelProc(const SubDir: string);
  public
    { Public declarations }
  end;

var
  SSMainForm: TSSMainForm;

implementation

uses filesyn;

{$R *.dfm}

{ TSSMainForm }

procedure TSSMainForm.FormCreate(Sender: TObject);
begin
  Application.Title := Caption;
  memo1.Clear;
  LoadFromFile(ChangeFileExt(Application.ExeName, '.ssb'));
end;

procedure TSSMainForm.FormDestroy(Sender: TObject);
begin
  SaveToFile(ChangeFileExt(Application.ExeName, '.ssb'));
end;

procedure TSSMainForm.btnDelClick(Sender: TObject);
begin
  ListViewDeleteSelected(ListView);
  UpdateIndex;
end;

procedure TSSMainForm.btnClearClick(Sender: TObject);
begin
  if QueryDlg('确认要清空吗?') then
    ListView.Clear;
end;

procedure TSSMainForm.btnUpClick(Sender: TObject);
begin
  ListViewMoveUpSelected(ListView);
  UpdateIndex;
end;

procedure TSSMainForm.btnDownClick(Sender: TObject);
begin
  ListViewMoveDownSelected(ListView);
  UpdateIndex;
end;

procedure TSSMainForm.UpdateIndex;
var
  i: Integer;
begin
  for i := 0 to ListView.Items.Count - 1 do
    ListView.Items[i].Caption := IntToStr(i + 1);
end;

procedure TSSMainForm.LoadFromFile(const FileName: string);
var
  i: Integer;
begin
  ListView.Clear;
  with TMemIniFile.Create(FileName) do
  try
    i := 1;
    while SectionExists(IntToStr(i)) do
    begin
      with ListView.Items.Add do
      begin
        Caption := IntToStr(i);
        SubItems.Add(ReadString(IntToStr(i), 'SrcDir', ''));
        SubItems.Add(ReadString(IntToStr(i), 'DstDir', ''));
        SubItems.Add(ReadString(IntToStr(i), 'IncSub', ''));
        SubItems.Add(ReadString(IntToStr(i), 'SrcTime', ''));
        SubItems.Add(ReadString(IntToStr(i), 'DstTime', ''));
      end;
      Inc(i);
    end;
  finally
    Free;
  end;
end;

procedure TSSMainForm.SaveToFile(const FileName: string);
var
  i: Integer;
begin
  DeleteFile(FileName);
  with TMemIniFile.Create(FileName) do
  try
    for i := 0 to ListView.Items.Count - 1 do
    begin
      WriteString(ListView.Items[i].Caption, 'SrcDir', ListView.Items[i].SubItems[0]);
      WriteString(ListView.Items[i].Caption, 'DstDir', ListView.Items[i].SubItems[1]);
      WriteString(ListView.Items[i].Caption, 'IncSub', ListView.Items[i].SubItems[2]);
      WriteString(ListView.Items[i].Caption, 'SrcTime', ListView.Items[i].SubItems[3]);
      WriteString(ListView.Items[i].Caption, 'DstTime', ListView.Items[i].SubItems[4]);
    end;
  finally
    UpdateFile;
    Free;
  end;
end;

procedure TSSMainForm.btnImportClick(Sender: TObject);
begin
  if dlgOpen.Execute then
  begin
    LoadFromFile(dlgOpen.FileName);
  end;
end;

procedure TSSMainForm.btnExportClick(Sender: TObject);
begin
  if (ListView.Items.Count > 0) and dlgSave.Execute then
  begin
    SaveToFile(dlgSave.FileName);
  end;
end;

procedure TSSMainForm.btnExecuteClick(Sender: TObject);
var
  i,h: Integer;
  
  procedure ControlSetEnabled(AEnabled: Boolean);
  var
    i: Integer;
  begin
    for i := 0 to ComponentCount - 1 do
      if (Components[i] is TControl) and (Components[i].Tag = 1) then
        TControl(Components[i]).Enabled := AEnabled;
  end;
begin
  if FExecuting then
  begin
    FAbort := QueryDlg('是否中断处理?');
  end
  else
  begin
    ControlSetEnabled(False);
    FExecuting := True;
    FAbort := False;
    pb1.Position := 0;
    btnExecute.Caption := '中断(&I)';
    try
      pb1.Position := 0;
      FFileCnt := 0;
      FCopyCnt := 0;
      FDelCnt := 0;
      FProcCnt := 0;
      FStartTick := GetTickCount;
      FProcTick := 0;
      tmr1.Enabled := True;
      for i := 0 to ListView.Items.Count - 1 do
      begin
        if (ListView.Items[i].SubItems[3] <> ListView.Items[i].SubItems[4] ) and (ListView.Items[i].SubItems[3] <>'')  then
        begin
              FSrcDir := MakePath(ListView.Items[i].SubItems[0]);
              FCurrMsg := '正在统计: ' + FSrcDir;
              FindFile(FSrcDir, '*.*', FileCntProc, nil,
                ListView.Items[i].SubItems[2] <> '', True);
              if FAbort then
                Exit;
          end;
      end;
      pb1.Max := FFileCnt;

      FProcTick := GetTickCount;
      for i := 0 to ListView.Items.Count - 1 do

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -