Delphi Dosya ara ve sil

Delphi'de kod yazma ile ilgili sorularınızı bu foruma yazabilirsiniz.
Cevapla
cdmesut
Üye
Mesajlar: 29
Kayıt: 16 Mar 2008 02:40

Delphi Dosya ara ve sil

Mesaj gönderen cdmesut » 04 Tem 2010 09:19

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

Kullanıcı avatarı
barutali
Üye
Mesajlar: 299
Kayıt: 02 Tem 2007 01:30

Re: Delphi Dosya ara ve sil

Mesaj gönderen barutali » 04 Tem 2010 11:26

fileexist ve deletefile
fonksiyonlarını kullanabilirsiniz..
amatör küme programcı :D

Kullanıcı avatarı
sabanakman
Kıdemli Üye
Mesajlar: 2991
Kayıt: 17 Nis 2006 07:11
Konum: Ah bi Antalya olaydı keşke (Ankara)

Re: Delphi Dosya ara ve sil

Mesaj gönderen sabanakman » 04 Tem 2010 03:44

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. - .

Cevapla