Merhaba arkadaşlar,
Benim sorum. C:\ veya D:\ dizinlerinde girdiğim dosya adı ve/veya uzantısını sistemde arayabileceğim klasörler ve altklasörleri de kapsayan bir arama programı yapmam lazım yanlız bu işi nasıl başlayıp nasıl yapacağımı bi türlü çıkartamadım. yardımcı olursanız veya örnek program varsa çok makbule geçecek çünkü 2 günüm var ve durum acil.
dizinlerde dosya arama
Forum kuralları
Forum kurallarını okuyup, uyunuz!
Forum kurallarını okuyup, uyunuz!
dosya arama
selam. aşağıdaki kod sanırım işinizi görecektir. bende sorun çıkartmadı.
Form1'in üzerindeki Memo1'e bulunan dosyalari ekler.
Not: Kod recursion kullanmakta. Cok fazla (Binlerce)
dosya bulundugunda Stack Overflow hatasi verebilir. iyi çalışmalar.
----------
procedure TForm1.FindFiles(StartDir, FileMask: string);
var
SR: TSearchRec;
DirList: TStringList;
IsFound: Boolean;
i: integer;
begin
if StartDir[length(StartDir)] <> '\' then
StartDir := StartDir + '\';
IsFound :=
FindFirst(StartDir+FileMask, faAnyFile-faDirectory, SR) = 0;
while IsFound do begin
Memo1.Lines.Add(StartDir + SR.Name);
IsFound := FindNext(SR) = 0;
end;
FindClose(SR);
DirList := TStringList.Create;
IsFound := FindFirst(StartDir+'*.*', faAnyFile, SR) = 0;
while IsFound do begin
if ((SR.Attr and faDirectory) <> 0) and
(SR.Name[1] <> '.') then
DirList.Add(StartDir + SR.Name);
IsFound := FindNext(SR) = 0;
end;
FindClose(SR);
for i := 0 to DirList.Count-1 do
FindFiles(DirList, FileMask);
DirList.Free;
end;
------------
kullanımı:
FindFiles('C:\windows\', '*.txt');
Form1'in üzerindeki Memo1'e bulunan dosyalari ekler.
Not: Kod recursion kullanmakta. Cok fazla (Binlerce)
dosya bulundugunda Stack Overflow hatasi verebilir. iyi çalışmalar.
----------
procedure TForm1.FindFiles(StartDir, FileMask: string);
var
SR: TSearchRec;
DirList: TStringList;
IsFound: Boolean;
i: integer;
begin
if StartDir[length(StartDir)] <> '\' then
StartDir := StartDir + '\';
IsFound :=
FindFirst(StartDir+FileMask, faAnyFile-faDirectory, SR) = 0;
while IsFound do begin
Memo1.Lines.Add(StartDir + SR.Name);
IsFound := FindNext(SR) = 0;
end;
FindClose(SR);
DirList := TStringList.Create;
IsFound := FindFirst(StartDir+'*.*', faAnyFile, SR) = 0;
while IsFound do begin
if ((SR.Attr and faDirectory) <> 0) and
(SR.Name[1] <> '.') then
DirList.Add(StartDir + SR.Name);
IsFound := FindNext(SR) = 0;
end;
FindClose(SR);
for i := 0 to DirList.Count-1 do
FindFiles(DirList, FileMask);
DirList.Free;
end;
------------
kullanımı:
FindFiles('C:\windows\', '*.txt');
Makale bölümünde de aynı kod var sanırım... benim sorum şu olacak...
FindFiles'ı loopa sokarak ayrı türler için arama yapmaktan ziyade
belirttiğimiz n tane uzantıyı bir seferde aratmak için ne yapmam gerekiyor... (Loop'a illa girecek ama benim yaptığım LOOP gibi değil. çünkü çok salak bi kod, acayip yavaş çalışıyo...)
Kod: Tümünü seç
procedure FindFiles(StartDir, FileMask: string);
var
SR: TSearchRec;
DirList: TStringList;
IsFound: Boolean;
i: integer;
begin
if StartDir[length(StartDir)] <> '\' then
StartDir := StartDir + '\';
IsFound :=
FindFirst(StartDir+FileMask, faAnyFile-faDirectory, SR) = 0;
while IsFound do begin
begin
form1.list2.items.Add(StartDir + SR.Name);
end;
IsFound := FindNext(SR) = 0;
end;
FindClose(SR);
DirList := TStringList.Create;
IsFound := FindFirst(StartDir+'*.*', faAnyFile, SR) = 0;
while IsFound do begin
if ((SR.Attr and faDirectory) <> 0) and
(SR.Name[1] <> '.') then
DirList.Add(StartDir + SR.Name);
IsFound := FindNext(SR) = 0;
end;
FindClose(SR);
for i := 0 to DirList.Count-1 do
FindFiles(DirList[i], FileMask);
DirList.Free;
end;
procedure TForm1.FormCreate(Sender: TObject);
var i:integer;
begin
for i:=0 to list.items.Count-1 do
begin
FindFiles(list.items[i],'*.doc');
FindFiles(list.items[i],'*.jpg');
FindFiles(list.items[i],'*.xls');
FindFiles(list.items[i],'*.txt');
FindFiles(list.items[i],'*.xml');
end;
end;
belirttiğimiz n tane uzantıyı bir seferde aratmak için ne yapmam gerekiyor... (Loop'a illa girecek ama benim yaptığım LOOP gibi değil. çünkü çok salak bi kod, acayip yavaş çalışıyo...)
Merhaba
Far manager 1.80 open source sürümü yayınlanıyor. onun içinde c++ ile de olsa bu işi yapan çokta kapsamlı bir kod var. yapısı sana bir fikir verebilir. araya virgl koymak şartıyla onlarca uzantıyı arayabiliyorsunuz onda.
Far manager 1.80 open source sürümü yayınlanıyor. onun içinde c++ ile de olsa bu işi yapan çokta kapsamlı bir kod var. yapısı sana bir fikir verebilir. araya virgl koymak şartıyla onlarca uzantıyı arayabiliyorsunuz onda.
Kişi odur ki, koyar dünyada bir eser. Eseri olmayanın yerinde yeller eser./Muhammed Hadimi
http://www.ibrahimkutluay.net
http://www.ibrahimkutluay.net/blog
http://www.ibrahimkutluay.net
http://www.ibrahimkutluay.net/blog
http://www.delphi-library.de/topic_nach ... 8dd6effbf9
İngilizce arayıp da bulamamak bi de almanca arayıp da tam hedefe gitmek
Bu da kullanılışı
istersek sadece tek uzantı için de aranabilirmiş. aynen şöyle:
İngilizce arayıp da bulamamak bi de almanca arayıp da tam hedefe gitmek
Kod: Tümünü seç
procedure GetAllFilesEM(Path, ExtMask: String; List: TStrings;
SubFolder: Boolean);
var
Attrib, k: Integer;
Search: TSearchRec;
begin
Attrib := faArchive + faReadOnly + faHidden;
if Path[Length(Path)] <> '\' then Path := Path + '\';
with TStringList.Create do
try
CommaText := ExtMask;
for k := 0 to Count - 1 do
if FindFirst(Path + '*.' + Strings[k], Attrib, Search) = 0 then
repeat
List.Add(AnsiUpperCase(Path + Search.Name));
until FindNext(Search) <> 0;
FindClose(Search);
finally Free end;
if SubFolder then
begin
if FindFirst(Path + '*.*', faDirectory, Search) = 0 then
begin
repeat
if ((Search.Attr and faDirectory) = faDirectory) and
(Search.Name[1] <> '.') then
GetAllFilesEM(Path + Search.Name, ExtMask, List, SubFolder);
until FindNext(Search) <> 0;
FindClose(Search);
end;
end;
end; {Popov}
Kod: Tümünü seç
procedure TForm1.Button1Click(Sender: TObject);
begin
GetAllFilesEM('c:\programme', 'bmp, gif, jpg, ico', ListBox1.Items, True);
end;
Kod: Tümünü seç
procedure TForm1.Button1Click(Sender: TObject);
begin
GetAllFilesEM('c:\programme', 'exe', ListBox1.Items, True);
end;