📄 ssmainfrm.pas
字号:
{******************************************************************************}
{ 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 + -