Вторник, 28.01.2025, 23:02
AMAR Inc.
Приветствую Вас Гость | RSS
Главная Программирование Регистрация Вход
Меню сайта

Категории каталога
Разные статьи [48]
Система [62]

Главная » Статьи » Delphi » Разные статьи

Поиск файлов на винчестере
   Хотя я и не очень хороший "Делфер", но я очень люблю программировать в Delphi, делать маленькие полезные программки для себя и своего компьютера. Недавно я узнал как производить поиск файлов на компьютере, причем поиск файлов производится не в отдельном каталоге, а на всем винчестере и в процессе поиска возможно следить за поиском. Процедуре поиска я нашел очень широкое применение, например, у меня на компьютере имеется папка с исходниками по Delphi и в этой папки очень много лишних файлов, которые занимают место на винчестере и при помощи процедуры поиска я удаляю ненужные файлы (*.cfg; *.~dfm; *.~pas и др.).

   Начнем с описания процедуры FindResursive( Const path: String; Const mask: String) где переменная Path - каталог в котором будет производится поиск ('c:'), а Mask - название файла или его часть ('*.exe' или '*.*' или 'project.dpr').

   В самой процедуре будем использовать только одну (не считая вложенные функции)переменную, которая будет носить полное название найденного файла. А найденные файлы будем записывать в ListBox. Данную процедуру будем вызывать при нажатии кнопки.

 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.

Категория: Разные статьи | Добавил: amar-runyak (18.01.2008)
Просмотров: 1000 | Рейтинг: 0.0/0 |

Всего комментариев: 0
Имя *:
Email *:
Код *:
Форма входа

Поиск

Друзья сайта

Статистика

Copyright AMAR Inc. © 2025