[xirosima]

задачку дали в универе, нужно написать прогу которая ищет файлы с необходимым заданным расширением в каталоге(и всех подкаталогах) и "переэнтеривает" все строки. кто нить если сталкивался с подобной задачей или знает как ето сделать помогите пожалуйсто - киньте код....
очень надо(

[moo2k]

Код:

{ Public declarations }
sc:TScan;
procedure onscan(path:string;Dan:TSearchRec;f:boolean);
....
procedure TForm1.FormCreate(Sender: TObject);
begin
sc:=TScan.Create;
sc.Path:='Путь';
sc.Mask:=''; // здесь указываешь нужное тебе расширение
sc.RescueDir:=true;//сканировать вложенные папки
sc.FirstDir:=true;//сначала ищутся папки
sc.ShowFile:=true;//находить файлы
sc.OnFound:=onscan;
sc.Scan:=true;//начать поиск, в любой момент изменяешь на ложь и поиск прекращается
sc.Destroy;
end;

procedure TForm1.onscan(path: string; Dan: TSearchRec; f: boolean);
begin
path-путь
f-файл или нет
dan - инфа о файле
end;

а вот и самое главное:

unit Scan;
interface
uses SysUtils,str,Dialogs;
const
faOnlyFile = $1 or $2 or $4 or $8 or $20;

Type
procStringSearcrecBool = procedure(path:string;
DN:tsearchrec;Fil:boolean) of object;
searchrec=tsearchrec;
TScan = class
private
FScan,fd,frd,sf:boolean;
FPath: string;
Ffound: procStringSearcrecBool;
FMask: string;
procedure SetScan(const Value: boolean);
procedure SSS(ph:string);
procedure SetMask(const Value: string);
procedure Setpath(const Value: string);
public
property Path:string read FPath write setPath;
property Mask:string read FMask write SetMask;
property Scan:boolean read FScan write SetScan;
property RescueDir:boolean read Frd write frd;
property FirstDir:boolean read fd write fd;
property ShowFile:boolean read sf write sf;
property OnFound:procStringSearcrecbool read Ffound write Ffound;
constructor Create;
destructor Destroy; override;
end;

implementation
{ TScan }
constructor TScan.Create;
begin inherited;
mask:='*.*';sf:=true;end;
destructor TScan.Destroy;
begin inherited;end;

procedure TScan.SetMask(const Value: string);
begin if FScan then exit;
FMask := Value;
if Str_EndPos(FMask)<>';'then
FMask:=FMask+';';
if(FMask=';')or(pos('*.*',fmask)>0)then FMask:='*.*;';end;
procedure TScan.Setpath(const Value: string);
begin FPath:=Str_Replacement(value+'\','\\','\');end;
procedure TScan.SetScan(const Value: boolean);
begin FScan := Value;
if value then sss(path);
fScan:=false;
end;
procedure TScan.SSS;
var r:tsearchrec;m:string;
function delm:string;{Следующая маска}
begin result:=Str_CopyToFirst(m,';');
if result=''then exit;
m:=Str_DelToFirst(m,';');
delete(m,1,1);end;{Delm}
procedure sfile(pah:string);{Поиск файлов}
var mm:string;
Begin if not sf then exit;
m:=mask;mm:=delm;
while(mm<>'')and(FScan)do begin
if FindFirst(ph+mm,FAonlyfile,r)=0then
repeat if Assigned(ffound)then
ffound(pah,r,true);
until(FindNext(r)<>0)or not FScan;
mm:=delm;end;End;{sfile}
procedure sdir(pah:string);{Поиск дирректорий}
const pp=faanyfile;
var d:string;
Begin if FindFirst(pah+'*.*',pp,r)=0then
repeat if not FScan then exit;
if((r.Attr and fadirectory)<>0)
and(r.Name<>'.')and(r.Name<>'..')then begin
if Assigned(ffound)then Ffound(pah,r,false);
if RescueDir then sss(pah+r.Name);end;
until (FindNext(r)<>0);End;{sdir}
begin if not FScan then exit;
if Str_EndPos(ph)<>'\'then
ph:=ph+'\';
if fd then sdir(ph);
sfile(Ph);
if not fd then sdir(ph);
FindClose(r);
end;
end.

[xirosima]

спасибо большое:thumbs up:=)