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
Delphi Dosya ara ve sil
Forum kuralları
Forum kurallarını okuyup, uyunuz!
Forum kurallarını okuyup, uyunuz!
Re: Delphi Dosya ara ve sil
fileexist ve deletefile
fonksiyonlarını kullanabilirsiniz..
fonksiyonlarını kullanabilirsiniz..
amatör küme programcı
- sabanakman
- Kıdemli Üye
- Mesajlar: 3077
- Kayıt: 17 Nis 2006 08:11
- Konum: Ah bi Antalya olaydı keşke (Ankara)
Re: Delphi Dosya ara ve sil
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.
Şaban Şahin AKMAN
_________________
Derin olan kuyu değil kısa olan iptir. - .
_________________
Derin olan kuyu değil kısa olan iptir. - .