请问怎么把硬盘中所有相同的文件搜索出来?哪位大侠知道。(100分)

Y

yxzyxz

Unregistered / Unconfirmed
GUEST, unregistred user!
请问怎么把硬盘中所有相同的文件搜索出来,最好有源代码。
 
···搜索?
 
就是有相同的文件就找出来,比如有两个或多个readme.tex,文件一样,就找出来,这样相同
的可能有多组。
 
是不是只要文件名相同,不管大小和内容是不是相同。

http://www.delphibbs.com/delphibbs/dispq.asp?lid=1313570

自己完善一下:
procedure TForm1.Button2Click(Sender: TObject);
var
SR:TSearchRec;
filter:TStrings;
s:string;
begin
filter:=TStringList.create;
filter.add('BMP');
filter.add('SCR');
filter.add('EXE');
if FindFirst('c:/windows/system/*.*', $3f, sr)=0 then
begin
while FindNext(sr)=0 do
begin
s:=trim(UpperCase(extractFileExt(sr.Name)));
if length(s)=0 then continue;
if s[1]='.' then s:=copy(s,2,length(s)-1);
if filter.IndexOf(s)>=0 then showmessage(sr.Name);
end;
FindClose(sr);
end;
filter.free;
end;
 
看看这个吧,http://vcl.vclxx.org/DELPHI/D32SAMPL/FNDUP142.ZIP
能够显示同一文件却在磁碟机中重复出现的工具,能够帮
您找寻出来并删除之 ( 1.4.2 版 ) ,附源码,作者: David J. Taylor 。
 
全自动化的哦,找所有盘符,我没加盘符的错误处理,你自己加一下吧
unit FIndFileFrm;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls;

type
TFindFileForm = class(TForm)
ButtonFind: TButton;
GroupBox1: TGroupBox;
ListBoxFileFind: TListBox;
GroupBox2: TGroupBox;
EditFileName: TEdit;
ListBoxFileName: TListBox;
ButtonAddFileName: TButton;
ButtonDelFileName: TButton;
ButtonClearFileName: TButton;
ButtonExit: TButton;
StatusBar: TStatusBar;
ButtonCancelFind: TButton;
procedure ButtonFindClick(Sender: TObject);
procedure ButtonAddFileNameClick(Sender: TObject);
procedure ButtonDelFileNameClick(Sender: TObject);
procedure ButtonClearFileNameClick(Sender: TObject);
procedure ButtonCancelFindClick(Sender: TObject);
procedure ButtonExitClick(Sender: TObject);
private
{ Private declarations }
procedure FindFile(Directory: string; FileNameLst: TStrings);
procedure GetDriverInfo;
public
{ Public declarations }
end;

var
FindFileForm: TFindFileForm;
DriverLst: TStrings;
CancelFind: Boolean;
implementation

{$R *.DFM}


procedure tfindfileform.GetDriverInfo;
var
DriveLetter: char;
begin
for DriveLetter := 'A' to 'Z' do
if (GetDriveType(PChar(DriveLetter + ':/')) = DRIVE_REMOVABLE) or (GetDriveType(PChar(DriveLetter + ':/')) = DRIVE_FIXED) or (GetDriveType(PChar(DriveLetter + ':/')) = DRIVE_REMOTE) then
DriverLst.Add(DriveLetter + ':/');
end;

procedure tfindfileform.FindFile(Directory: string; FileNameLst: TStrings);
var
Search, Src: TSearchRec;
RootDirectory: string;
FCount: Integer;
begin
Application.ProcessMessages;
if CancelFind then Exit;
//查找文件
RootDirectory := Directory;
if RootDirectory[Length(RootDirectory)] <> '/' then RootDirectory := RootDirectory + '/';
//先查找文件
for Fcount := 0 to filenamelst.Count - 1 do
if FindFirst(RootDirectory + FileNameLst[FCount], faArchive, Src) = 0 then
ListBoxFileFind.Items.Add(RootDirectory + FileNameLst[FCount]);

//再查目录
if FindFirst(RootDirectory + '*.*', faDirectory, Search) = 0 then
repeat
if (Search.Name <> '.') and (Search.Name <> '..') then
if (Search.Attr and fadirectory) = fadirectory then
begin
StatusBar.Panels[1].Text := '正在查找...' + RootDirectory + Search.Name;
FindFile(RootDirectory + Search.Name, FileNameLst);
end;
until FindNext(Search) <> 0;
FindClose(Search);
end;

procedure TFindFileForm.ButtonFindClick(Sender: TObject);
var
i: Integer;
begin
ButtonCancelFind.Enabled := True;
CancelFind := False;
if ListBoxFileName.Items.Count <> 0 then
begin
DriverLst := TStringList.Create;
try
//查找文件,并添加到ListboxFindFile
GetDriverinfo;
for i := 0 to DriverLst.Count - 1 do
FindFile(DriverLst, ListBoxFileName.Items);
finally
DriverLst.Free;
end;
end;
ButtonCancelFind.Enabled := False;
end;

procedure TFindFileForm.ButtonAddFileNameClick(Sender: TObject);
begin
if EditFileName.Text <> '' then
ListBoxFileName.Items.Add(EditFileName.Text);
end;

procedure TFindFileForm.ButtonDelFileNameClick(Sender: TObject);
begin
if ListBoxFileName.ItemIndex <> -1 then
ListBoxFileName.Items.Delete(ListBoxFileName.ItemIndex);
end;

procedure TFindFileForm.ButtonClearFileNameClick(Sender: TObject);
begin
ListBoxFileName.Items.Clear;
end;

procedure TFindFileForm.ButtonCancelFindClick(Sender: TObject);
begin
CancelFind := True;
end;

procedure TFindFileForm.ButtonExitClick(Sender: TObject);
begin
Close;
end;

end.

 
多人接受答案了。
 

Similar threads

S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
顶部