Главная » Статьи » Программирование » Delphi, Pascal, ObjectPascal » Поиск файлов на винчестере в Delphi
|
Поиск файлов на винчестере в Delphi
[ Поделиться ]
[ Спасибо! ]
|
Начнем с описания процедуры FindResursive( Const path: String; Const mask: String) где переменная Path - каталог в котором будет производится поиск ('c:\'), а Mask - название файла или его часть ('*.exe' или '*.*' или 'project.dpr').
В самой процедуре будем использовать только одну (не считая вложенные функции)переменную, которая будет носить полное название найденного файла. А найденные файлы будем записывать в ListBox. Данную процедуру будем вызывать при нажатии кнопки. Процедура FindRecursive выглядит следующим образом:
Procedure FindRecursive( Const path: String; Const mask: String);
Var
fullpath: String;
Function Recurse( Var path: String; Const mask: String ): Boolean;
Var
SRec: TSearchRec;
retval: Integer;
oldlen: Integer;
Begin
Recurse := True;
oldlen := Length( path );
retval := FindFirst( path+mask, faAnyFile, SRec );
While retval = 0 Do Begin
If (SRec.Attr and (faDirectory or faVolumeID)) = 0 Then
form1.ListBox1.items.Add(path+srec.name);
retval := FindNext( SRec );
End;
FindClose( SRec );
If not Result Then Exit;
retval := FindFirst( path+'*.*', faDirectory, SRec );
While retval = 0 Do Begin
If (SRec.Attr and faDirectory) 0 Then
If (SRec.Name '.') and (SRec.Name '..') Then Begin
path := path + SRec.Name + '\';
If not Recurse( path, mask ) Then Begin
Result := False;
Break;
End;
Delete( path, oldlen+1, 255 );
End;
retval := FindNext( SRec );
End;
FindClose( SRec );
End; { Recurse }
Begin
If path = '' Then
GetDir(0, fullpath)
Else
fullpath := path;
If fullpath[Length(fullpath)] '\' Then
fullpath := fullpath + '\';
If mask = '' Then
Recurse( fullpath, '*.*' )
Else
Recurse( fullpath, mask );
End;
В целом же программа выглядит так:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
ListBox1: TListBox;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
Procedure FindRecursive( Const path: String; Const mask: String);
Var
fullpath: String;
Function Recurse( Var path: String; Const mask: String ): Boolean;
Var
SRec: TSearchRec;
retval: Integer;
oldlen: Integer;
Begin
Recurse := True;
oldlen := Length( path );
retval := FindFirst( path+mask, faAnyFile, SRec );
While retval = 0 Do Begin
If (SRec.Attr and (faDirectory or faVolumeID)) = 0 Then
form1.ListBox1.items.Add(path+srec.name); {добавление}
{очередного найденного файла в ListBox}
{-------------------------------------}
{здесь можно производить слежением за выполнение процедуры}
{например, поставить ProgressBar}
retval := FindNext( SRec );
End;
FindClose( SRec );
If not Result Then Exit;
retval := FindFirst( path+'*.*', faDirectory, SRec );
While retval = 0 Do Begin
If (SRec.Attr and faDirectory) 0 Then
If (SRec.Name '.') and (SRec.Name '..') Then Begin
path := path + SRec.Name + '\';
If not Recurse( path, mask ) Then Begin
Result := False;
Break;
End;
Delete( path, oldlen+1, 255 );
End;
retval := FindNext( SRec );
End;
FindClose( SRec );
End; { Recurse }
Begin
If path = '' Then
GetDir(0, fullpath)
Else
fullpath := path;
If fullpath[Length(fullpath)] '\' Then
fullpath := fullpath + '\';
If mask = '' Then
Recurse( fullpath, '*.*' )
Else
Recurse( fullpath, mask );
End;
procedure TForm1.Button1Click(Sender: TObject);
begin
FindRecursive('d:\','*.*'); {вместо 'd:\' можно написать лубой каталог}
end;
end.
Категория: Delphi, Pascal, ObjectPascal |
Просмотров: 3738 |
Добавил: ДядяВолк (11.08.2010)
| Рейтинг: 0.0/0
Теги: Источник: http://delphid.dax.ru | |
HTML ссылка на материал: BB ссылка на материал: |
Всего комментариев: 0 | |