Разыскивание файлов на винчестере в Delphi - Программирование в Delphi - Каталог статей

Главная » Статьи » Программирование в Delphi

Разыскивание файлов на винчестере в Delphi

Жаждая я и не ужасно хороший "Делфер", да я смертельно люблю программировать в Delphi, ладить маленькие здоровые программки ради себя и своего компьютера. Недавно я навидался как вырабатывать поиск файлов на компьютере, причем поиск файлов производится не в кой-котором каталоге, а на полным винчестере и в процессе поиска возможно следить за поиском. сделке поиска я нашел здорово широкое употребление , например, у меня на компьютере есть папка с исходниками по Delphi и в настоящею папки смертельно много ненужных файлов, которые занимают участок на винчестере и при помощи сделки поиска я удаляю бесполезные файлы (.cfg; .~dfm; .~pas и др.). активизируем с показа процедуры 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. Источник: http://www.yandex.ru
1 2 3 4 5 Категория: Программирование в Delphi \| Добавил: Nikol05 (10.11.2010)
Просмотров: 1063 \| Рейтинг: 0.0/0