Delphi Dosya ara ve sil

[cdmesut]

merhaba arkdaşlar..
ben delphide kendi belirttiğim bir klasörde ve bunun alt klasörleri de dahil.
bir dosya adını aratıp bulup silmek istiyorum.
delphide bu mümkün mü..

şimdiden teşekkür ederim

[barutali]

fileexist ve deletefile
fonksiyonlarını kullanabilirsiniz..

[sabanakman]

Yıllar önce yazdığım, verilen kriterlere göre dosya arama bileşeni. Tara metodundaki kodları incelemek fikir verebilir veya olduğu gibi kullanabilirsiniz.http://www.delphiturk.com/Replys.aspx?P ... orumId=100

Kod: Tümünü seç

type
  TBulmaOlayi=procedure (const Nesne:TObject;const Ad:String) of object;
  TOlay=procedure (const Nesne:TObject) of object;//TNotifyEvent;

  TDosyaTara=class(TObject)
  protected
    FAbort:Boolean;
    FDosyaSayisi,FDizinSayisi:Integer;
    FBaslangicDizini:String;
    FFiltreler:TStringList;
    FOnDosyaBuldu,FOnDizinBuldu:TBulmaOlayi;
    FOnTaramadanOnce,FOnTaramadanSonra:TOlay;
  private
    function OKU_Sarti: String;
    function OKU_Sart(Index: Integer): String;
    function OKU_SartSayisi:Integer;
    procedure YAZ_Sart(Index: Integer; Deger: String);
    procedure YAZ_BaslangicDizini(const Deger:String);
    procedure SartiDuzelt(var S:String);
    procedure Sifirla;
    procedure KlasorTara(const Dizin:String);
    procedure DosyaTara(const Dizin,_Sart:String);
  public
    constructor Create(const _Sart:String='');
    destructor Destroy;override;
    procedure SartVer(Deger: String);
    procedure SartKontrol;
    procedure Tara;
    procedure Bitir;
    property Sartlar[Index: Integer]: String read OKU_Sart write YAZ_Sart;
  published
    property Sart:String read OKU_Sarti write SartVer;
    property BaslangicDizini:String read FBaslangicDizini write YAZ_BaslangicDizini;
    property DosyaSayisi:Integer read FDosyaSayisi;
    property DizinSayisi:Integer read FDizinSayisi;
    property SartSayisi:Integer read OKU_SartSayisi;
    property TaramayiBitir:Boolean read FAbort write FAbort;
    property OnTaramadanOnce:TOlay read FOnTaramadanOnce write FOnTaramadanOnce;
    property OnDizinBuldu:TBulmaOlayi read FOnDizinBuldu write FOnDizinBuldu;
    property OnDosyaBuldu:TBulmaOlayi read FOnDosyaBuldu write FOnDosyaBuldu;
    property OnTaramadanSonra:TOlay read FOnTaramadanSonra write FOnTaramadanSonra;
  end;

{ TDosyaTara }

constructor TDosyaTara.Create(const _Sart: String='');
begin
  inherited Create; FFiltreler:=TStringList.Create;
  FBaslangicDizini:='C:\';
  SartVer(_Sart);
  Sifirla;
end;

destructor TDosyaTara.Destroy;
begin
  FFiltreler.Destroy;
  inherited Destroy;
end;

function TDosyaTara.OKU_Sarti: String;
var i:Integer;
begin
  Result:='';
  for i:=0 to FFiltreler.Count-1 do Result:=Result+';'+FFiltreler[i];
  if Result='' then Result:='*.*'
  else Delete(Result,1,1);
end;

procedure TDosyaTara.YAZ_Sart(Index: Integer; Deger: String);
var i:Integer; Sarti:String;
begin
  SartiDuzelt(Deger);
  if Index<1 then Index:=0
  else if Index>FFiltreler.Count then raise
   Exception.Create(Format('%d. şart zaten olmadığı için değişiklik yapılamıyor.',[Index]))
  else Dec(Index);
  FFiltreler.Delete(Index);
  repeat
    i:=Pos(';',Deger);
    if i<=0 then Break;
    Sarti:=Trim(Copy(Deger,1,i-1));
    if Sarti='' then FFiltreler.Delete(Index)
    else begin FFiltreler.Insert(Index,Sarti); inc(Index);end;
    Delete(Deger,1,i);
  until False;
  if Deger<>'' then FFiltreler.Insert(Index,Deger);
end;

function TDosyaTara.OKU_Sart(Index: Integer): String;
begin
  if Index=0 then Result:=OKU_Sarti
  else begin
    dec(Index);
    if (Index<0) or (Index>=FFiltreler.Count) then Result:=''
    else Result:=FFiltreler[Index];
  end;
end;

function TDosyaTara.OKU_SartSayisi:Integer;
begin
  Result:=FFiltreler.Count;
end;

procedure TDosyaTara.YAZ_BaslangicDizini(const Deger:String);
begin
  if not DirectoryExists(Deger) then
   raise Exception.Create(Format('"%s" klasörü bulunamadı...',[Deger]))
  else begin
    FBaslangicDizini:=Deger;
    if(Deger<>'')and(Deger[Length(Deger)]<>'\')then FBaslangicDizini:=Deger+'\';
  end;
end;

procedure TDosyaTara.SartiDuzelt(var S:String);
const n=1;
  BulupSiliver:array[1..n] of String=(';;');
  BulupSilivern:array[1..n] of Byte =(   1);
var i,idx:Integer;
begin
  S:=Trim(S);
  for idx:=1 to n do repeat
    i:=Pos(BulupSiliver[idx],S);
    if i<=0 then Break;
    Delete(S,i,BulupSilivern[idx]);
  until False;
end;

procedure TDosyaTara.Sifirla;
begin
  FDosyaSayisi:=0;
  FDizinSayisi:=0;
  FAbort:=False;
end;

procedure TDosyaTara.SartKontrol;
var i,j,n:Integer;
begin
  if FFiltreler.Count>1 then begin
    i:=0;
    repeat
      if i>=FFiltreler.Count then Break;
      if (FFiltreler[i]='*.*') then begin SartVer('*.*');Exit;end
      else if (FFiltreler[i]='') then FFiltreler.Delete(i)
      else Inc(i);
    until False;
    n:=FFiltreler.Count-1;
    for i:=0 to n-1 do for j:=i+1 to n do begin
      if AnsiUpperCase(FFiltreler[i])=AnsiUpperCase(FFiltreler[j]) then
        FFiltreler[j]:='';
    end;
    i:=0;repeat
      if i>=FFiltreler.Count then Break;
      if FFiltreler[i]='' then FFiltreler.Delete(i)
      else inc(i);
    until False;
  end;
end;

procedure TDosyaTara.KlasorTara(const Dizin:String);
var i:Integer;  Dizinler:TSearchRec;
begin
//  if not DirectoryExists(KokDizin) then Exit;
  if Assigned(FOnDizinBuldu) then FOnDizinBuldu(Self,Dizin);Inc(FDizinSayisi);
  if FAbort then Exit;
  for i:=0 to FFiltreler.Count-1 do DosyaTara(Dizin,FFiltreler[i]);
  i:=FindFirst(Dizin+'*.',faDirectory,Dizinler);
  while i=0 do begin
    if FAbort then Exit;
    if (Dizinler.Name<>'.') and (Dizinler.Name<>'..') then
     KlasorTara(Dizin+Dizinler.Name+'\');
    i:=FindNext(Dizinler);
  end;
  FindClose(Dizinler);
end;

procedure TDosyaTara.DosyaTara(const Dizin,_Sart:String);
var i:Integer;  Dosyalar:TSearchRec; DosyaAdi:String;
begin
//  if not DirectoryExists(KokDizin) then Exit;
  if FAbort then Exit;
  i:=FindFirst(Dizin+_Sart,faAnyFile,Dosyalar);
  while i=0 do begin
    DosyaAdi:=Dizin+Dosyalar.Name;
    if FileExists(DosyaAdi) then begin
      if Assigned(FOnDosyaBuldu) then FOnDosyaBuldu(Self,DosyaAdi);
      inc(FDosyaSayisi);
      if FAbort then Exit;
    end;
    i:=FindNext(Dosyalar);
  end;
  FindClose(Dosyalar);
end;

procedure TDosyaTara.SartVer(Deger: String);
var i:Integer; Sarti:String;
begin
  SartiDuzelt(Deger);
  if Trim(Deger)='' then Deger:='*.*';
  FFiltreler.Clear;
  repeat
    i:=Pos(';',Deger);
    if i<=0 then Break;
    Sarti:=Trim(Copy(Deger,1,i-1));
    if Sarti<>'' then FFiltreler.Add(Sarti);
    Delete(Deger,1,i);
  until False;
  if Deger<>'' then FFiltreler.Add(Deger);
  SartKontrol;
end;

procedure TDosyaTara.Tara;
begin
  if Assigned(FOnTaramadanOnce) then FOnTaramadanOnce(Self);
  Sifirla; SartKontrol;
  KlasorTara(FBaslangicDizini);
  if Assigned(FOnTaramadanSonra) then FOnTaramadanSonra(Self);
end;

procedure TDosyaTara.Bitir;
begin
  FAbort:=True;
end;
////////////////////////////////////////////////////////////////////////////////
{Kullanımına örnek:}
var DT:TDosyaTara;

procedure TForm1.Basla(const Nesne: TObject);
begin
//  ShowMessage('Başlıyorum...');
  Animate1.Show;
  Animate1.CommonAVI:=aviFindFile;
  Animate1.Active:=True;
  ListBox1.Clear;
end;

procedure TForm1.DizinBuldu(const Nesne:TObject;const Ad:String);
begin
  Label1.Caption:=Ad;
  //Label1.Update; (*<-Application.ProcessMessages kullanılmadığında faydalı bir kod...*)
end;

procedure TForm1.DosyaSil(const Nesne:TObject;const Ad:String);
var EskiDeger,YeniDeger,HataKodu:Integer;
begin
  Application.ProcessMessages;
  EskiDeger:=FileGetAttr(FileName);
  YeniDeger:=EskiDeger and not faReadOnly{and not faHidden and not faSysFile and faArchive};
  if EskiDeger<>YeniDeger then HataKodu:=FileSetAttr(Ad,YeniDeger)
  else HataKodu:=0;//Dosyanın Read-Only özeliiği varsa kaldırılıyor..
  if HataKodu=0 then begin//dosyanın Read-Only özelliği yok
    if DeleteFile(Ad) then //Sildi
    else;//Silemedi
  end else;//Read-Only özelliği kaldırılamadığı için silemez
  //TDosyaTara(Nesne).Bitir işlemi orada bitirir...
end;

procedure TForm1.DosyaListele(const Nesne:TObject;const Ad:String);
begin
  ListBox1.Items.Add(Ad);
end;

procedure TForm1.Bitir(const Nesne: TObject);
begin
  Animate1.Active:=False;
  ShowMessage('Tarama işlemi bitti...');
  Animate1.Hide;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  DT:=TDosyaTara.Create('*.exe');//istenirse buraya şart verilmeyebilir..
  DT.BaslangicDizini:='C:\';//<- Kök dizin
  DT.OnTaramadanOnce:=Basla;//<-Tarama başlamadan önce yapılcaklar Basla procedure içinde tanımlı
  DT.OnDizinBuldu:=DizinBuldu;//<-Bulunan her kalsör için çalışacak kodlar DizinBulundu içinde tanımlı
  DT.OnDosyaBuldu:=DosyaSil;//<-Bulunan her dosya için çalışacak kodlar DosyaSil içinde tanımlı
  DT.OnTaramadanSonra:=Bitir;//<-Tarama bitince yapılcaklar Bitir procedure içinde tanımlı
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  DT.Sart:='*.dfm;*.pas;*.exe;*.dcu;st*.db*';//5 farklı filtreleme aynı anda olur (önce var olan şart silinir)...
  DT.Sartlar[4]:='';//4. filtre olan *.dcu seçimi silinir, geriye 4 filtre (*.dfm;*.pas;*.exe;st*.db*) kalır
  DT.Sartlar[2]:='*.mdb;*.res;*.pas';//*.pas seçimi silinir onun yerine 3lü filtre yerleşir sonuç '*.dfm;*.mdb;*.res;*.pas*.exe;*.dcu;st*.db*'; olur.
  //Son şarta göre 7 farklı filtre gelmiş olur, bunlara teker teker
  //DT.Sartlar[1],DT.Sartlar[2],..,DT.Sartlar[7] şeklinde erişilebilir..
  //////////////////////////////
  //////////////////////////////
  DT.Sart:='*.net;*.lck';//<- Bu dosyaları silen bir örnek yapalım...
  //FormCreate olayında "DT.OnDosyaBuldu:=DosyaSil;" kodu ile silme işlemini yapan olay atamasını yapmıştık zaten...
  //"DT.OnDosyaBuldu:=DosyaListele;" yazılırsa, bu sefer bulunan dosyalar listelenecektir.
  DT.Tara;//<-- Tarama işlemi burada olur..
  ShowMessage(Format('%d Klasör ve %d dosya tarandı.',
   [DT.DizinSayisi,DT.DosyaSayisi]));
  if DT.TaramayiBitir then ShowMessage('İşlem kullanıcı tarafından kesildi.')
  else ShowMessage('İşlem tamamlandı.');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  DT.Bitir; {yada DT.TaramayiBitir:=True; ikiside aynı işlemi yapar...
  İşlemin yarıda kalıp kalmadığı TaramayiBitir değişkeninden öğrenilir...
  Kullanıcı tanımladığı "OnDizinBuldu ve/veya OnDosyaBuldu" olaylarında
  "Application.ProcessMessages;" kodunu kullanırsa bu şekilde bir buton işlemi
  kesebilir.}
end;

end.