mainunit.pas

《Delphi7经典问题解析》源代码

unit mainunit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons,ShellApi,FileCtrl;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Label2: TLabel;
    BitBtn1: TBitBtn;
    Edit1: TEdit;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    Label1: TLabel;
    BitBtn4: TBitBtn;
    Edit2: TEdit;
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure Edit2Change(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure BitBtn3Click(Sender: TObject);
  private
    { Private declarations }
  public
    function CurrentIsValidDir(SearchRec:TSearchRec):integer;
    procedure RecurSearchFile(CurrentDir:string;SearchFileType:string;SearchResult:TStrings;var Number:integer);
    procedure Xcopy(SourceDir,TargetDir:String);
    { Public declarations }
  end;

var
  Form1: TForm1;
  TotalFileNumbers:Integer;
  SearchFileType:String;
  Copying:Boolean;
implementation

{$R *.dfm}

function TForm1.CurrentIsValidDir(SearchRec:TSearchRec):integer;
begin
if ((SearchRec.Attr <> 16) and
    (SearchRec.Name<>'.')  and
    (SearchRec.Name<>'..')) then
  Result:=0
  else if ((SearchRec.Attr = 16) and
           (SearchRec.Name<>'.') and
           (SearchRec.Name<>'..')) then
  Result:=1
  else
  Result:=2;
end;

Procedure TForm1.RecurSearchFile(CurrentDir:string;SearchFileType:string;SearchResult:TStrings;var Number:integer);
var
 i:integer;
 Subdir:TStringList;
 SearchRec:TsearchRec;
begin
//第一次调用FindFirst和FindNext查找符合要求的文件
 if (FindFirst(CurrentDir+SearchFileType, faAnyFile, SearchRec)=0) then
  begin
   repeat
    if CurrentIsValidDir(SearchRec)=0 then
      begin
       Inc(Number);
       Searchresult.Add(CurrentDir+SearchRec.Name);
      end;
    application.ProcessMessages ;
   until (FindNext(SearchRec) <> 0);
  end;
 FindClose(SearchRec);

//以下是递归部分，查找各子目录。
 Subdir:=TStringList.Create;
 if (FindFirst(CurrentDir+'*.*', faDirectory, SearchRec)=0) then
  begin
   repeat
    if CurrentIsValidDir(SearchRec)=1 then
     begin
      Subdir.Add(SearchRec.Name);
     end;
    application.ProcessMessages ;
   until (FindNext(SearchRec) <> 0);
  end;
 FindClose(SearchRec);
 for i:=0 to Subdir.Count-1 do
  begin
   RecurSearchfile(CurrentDir+Subdir.Strings[i]+'\',SearchFileType,Searchresult,Number);
  end;

//资源释放并返回结果。
 Subdir.Free;
end;

procedure TForm1.Xcopy(SourceDir,TargetDir:String);
var
 OpStruc: TSHFileOpStruct;//声明一个TSHFileOpStruct记录结构
 FromBuf, ToBuf: Array [0..128] of Char;//定义源和目的缓冲区
begin
 FillChar(FromBuf, Sizeof(FromBuf), 0 );
 FillChar(ToBuf, Sizeof(ToBuf), 0 );
 StrPCopy(FromBuf, SourceDir+'*.*' );
 StrPCopy(ToBuf, TargetDir);
 With OpStruc do 
begin
   Wnd:= Handle;//设定句柄为当前Form窗体，因此对话框为系统对话框
   wFunc:= FO_Copy;//操作类型为从源到目的地的拷贝操作
   pFrom:= @FromBuf;
   pTo:=@ ToBuf;
   fFlags:= FOF_NOCONFIRMATION or FOF_RENAMEONCOLLISION;//控制方式为无确认与命名冲突的组合
   fAnyOperationsAborted:= False;
   hNameMappings:= Nil;
   lpszProgressTitle:= Nil;
  end;
 ShFileOperation( OpStruc );//调用Api函数，传入参数完成操作
end;


procedure TForm1.BitBtn1Click(Sender: TObject);
var
 SelectDir:string;
begin
 if SelectDirectory(SelectDir, [sdAllowCreate, sdPerformCreate, sdPrompt],0) then
  begin
   if length(SelectDir) > 3 then
    SelectDir:=SelectDir+'\';
   Edit1.Text:=SelectDir;
  end;
end;

procedure TForm1.BitBtn4Click(Sender: TObject);
var
 SelectDir:string;
begin
 if SelectDirectory(SelectDir, [sdAllowCreate, sdPerformCreate, sdPrompt],0) then
  begin
   if length(SelectDir) > 3 then
    SelectDir:=SelectDir+'\';
   Edit2.Text:=SelectDir;
  end;
end;

procedure TForm1.Edit1Change(Sender: TObject);
begin
 if ((Edit1.Text='')or(Edit2.Text='')) then
  BitBtn2.Enabled:=False
 else
  BitBtn2.Enabled:=True; 
end;

procedure TForm1.Edit2Change(Sender: TObject);
begin
 if ((Edit1.Text='')or(Edit2.Text='')) then
  BitBtn2.Enabled:=False
 else
  BitBtn2.Enabled:=True;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
 BitBtn2.Enabled:=False;
 Copying:=True;
 memo1.lines.Clear ;
 TotalFileNumbers:=0;
 RecurSearchFile(Edit1.Text,SearchFileType,memo1.lines, TotalFileNumbers);
 Xcopy(Edit1.Text,Edit2.Text);
 Copying:=False; 
 Memo1.Lines.Add('拷贝操作全部结束,一共拷贝'+IntToStr(TotalFileNumbers)+'个文件到目标目录.');
 Edit1.Clear;
 Edit2.Clear;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 TotalFileNumbers:=0;
 SearchFileType:='*.*';
 Copying:=False;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
 if Copying then
  CanClose:=False
 else
  CanClose:=True;
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
begin
 Close;
end;

end.