dizinlerde dosya arama

Delphi'de kod yazma ile ilgili sorularınızı bu foruma yazabilirsiniz.
Cevapla
Kullanıcı avatarı
xcom
Üye
Mesajlar: 83
Kayıt: 05 Ağu 2003 05:56

dizinlerde dosya arama

Mesaj gönderen xcom »

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.
Kullanıcı avatarı
eduran
Üye
Mesajlar: 52
Kayıt: 03 Tem 2003 04:02

dosya arama

Mesaj gönderen eduran »

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');
Kullanıcı avatarı
webaytek
Üye
Mesajlar: 377
Kayıt: 23 Haz 2004 10:58

Mesaj gönderen webaytek »

Makale bölümünde de aynı kod var sanırım... benim sorum şu olacak...

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;
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...)
ikutluay
Üye
Mesajlar: 2341
Kayıt: 03 Tem 2007 10:13

Mesaj gönderen ikutluay »

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.
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
Kullanıcı avatarı
webaytek
Üye
Mesajlar: 377
Kayıt: 23 Haz 2004 10:58

Mesaj gönderen webaytek »

http://www.delphi-library.de/topic_nach ... 8dd6effbf9
İ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}
Bu da kullanılışı

Kod: Tümünü seç

procedure TForm1.Button1Click(Sender: TObject);
begin
  GetAllFilesEM('c:\programme', 'bmp, gif, jpg, ico', ListBox1.Items, True);
end;
istersek sadece tek uzantı için de aranabilirmiş. aynen şöyle:

Kod: Tümünü seç

procedure TForm1.Button1Click(Sender: TObject);
begin
  GetAllFilesEM('c:\programme', 'exe', ListBox1.Items, True);
end;
Cevapla