İki dosya boyutu aynı sonuncusunu yoksayma

Delphi'de kod yazma ile ilgili sorularınızı bu foruma yazabilirsiniz.
Cevapla
kazimates
Üye
Mesajlar: 332
Kayıt: 01 Tem 2005 12:40
Konum: Kıbrıs
İletişim:

İki dosya boyutu aynı sonuncusunu yoksayma

Mesaj gönderen kazimates »

Merhaba, aşağıda ki gibi bir klasör yapısı ve içinde jpeg dosyaları var. dosyalar görüleceği üzere ardışık fakat bazende atlamalı olarak devam ediyor. Bu dosya isimlerini ve dosya boyutlarını (file size) klasörden okuyup bir text dosyaya yada arraye atmam gerekiyor. Daha sonra ise sırasıyla birinci sıradakini okuyup ikinci ile karşılaştırmam lazım ve dosya boyutu birinci ile ikinci aynı ise 2nci (yani birinciden sonra geleni) yi arrayden silmem gerekiyor. Sildikten sonra bu sefer 1nci ile 3ncüyü karşılaştırmalı ve 1 ve 3 farklı boyutta ise bu sefer 3ncü dosya arrayde kalırlen (arrayde 1,3, kaldılar 2 bir ile aynı olduğundan kaldırmıştık.) 3ncü dosyanın boyutu ile 4ncü kontrol edilecek ve arrayin sonuna kadar bu devam edecek. En sonunda arrayde dosya isimleri kalacak ve her dosya bir öncekinden farklı dosya boyutunda olacağından ötürü dosyaların farklı olduklarından emin olmuş olacağım. En son bu arrayde ki listeleri de bir text dosyaya yazmam lazım. Bunu nasıl çözebiliriz?

c:\test\00051000.jpg 40KByte
c:\test\00051001.jpg 40KByte
c:\test\00051002.jpg 42KByte
c:\test\00051005.jpg 43KByte
c:\test\00051009.jpg 43KByte
c:\test\00051012.jpg 43KByte
c:\test\00051013.jpg 20KByte
kazimates
Üye
Mesajlar: 332
Kayıt: 01 Tem 2005 12:40
Konum: Kıbrıs
İletişim:

Re: İki dosya boyutu aynı sonuncusunu yoksayma

Mesaj gönderen kazimates »

Aşağıda ki kodla Edit3.text içerisinde klasoryolu c:\test içinde bulunan jpg dosyalar ve dosya boyutları memo3 içerisine gönderilebildi. Şimdi bunları nasıl karşılatıracağıma geldi.

Kod: Tümünü seç

procedure TForm1.Button3Click(Sender: TObject);
var
  searchResult : TSearchRec;
  referansdosyaadi: string;
  referansdosyaboyutu: integer;
  dosyaveboyut: string;
  klasoryolu: string;

begin
  // Try to find regular files matching Unit1.d* in the current dir
  Memo3.Lines.Clear;
  klasoryolu:=Edit3.Text;
  if findfirst(klasoryolu+'\'+'*.jpg', faAnyFile, searchResult) = 0 then
  begin
    repeat
     //  referansdosyaadi:= searchResult.Name;
     //  referansdosyaadi:= IntToStr(searchResult.Size);

     // ShowMessage('File name = '+searchResult.Name);
     // ShowMessage('File size = '+IntToStr(searchResult.Size));
     // dosyaveboyut:=referansdosyaadi+'_'+(IntToStr(referansdosyaboyutu));
      Memo3.Lines.add((searchResult.Name)+';'+IntToStr(searchResult.Size));
    until FindNext(searchResult) <> 0;

    // Must free up resources used by these successful finds
    FindClose(searchResult);
  end;
end;
Kullanıcı avatarı
greenegitim
Üye
Mesajlar: 713
Kayıt: 28 Nis 2011 10:33
Konum: İstanbul

Re: İki dosya boyutu aynı sonuncusunu yoksayma

Mesaj gönderen greenegitim »

tam test edemedim hata olabilir ayrıca fazladan dönüyorda fikir verir umarım
memo1 de ki girdi
c:\test\00051000.jpg 40KByte
c:\test\00051001.jpg 40KByte
c:\test\00051002.jpg 42KByte
c:\test\00051005.jpg 43KByte
c:\test\00051009.jpg 43KByte
c:\test\00051012.jpg 43KByte
c:\test\00051013.jpg 20KByte

Kod: Tümünü seç

uses'a strutilsi ekleyin AnsiReplaceStr için
function LastDelim(const sVal: string; const Delim:Char): string;
var
  i: Integer;
begin
  i := LastDelimiter(Delim, sVal);
  Result := Copy(sVal, i + 1, Length(sVal) - (i));
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  i:integer;
  sayi1:integer;
  sayi2:integer;
begin
  Memo1.Text := AnsiReplaceStr(Memo1.Text,'KByte',''); // KByte sil

  for i:= 0 to Memo1.Lines.Count -1 do
  begin

   if i < Memo1.Lines.Count -1 then
   begin
     sayi1:=strtoint(LastDelim(Memo1.Lines[i],' '));
     sayi2:=strtoint(LastDelim(Memo1.Lines[i+1],' '));
   if sayi1=sayi2 then
     begin
     Memo1.Lines[i+1]:='-'+Memo1.Lines[i+1];
     end
  end;

  end;


  for i:= 0 to Memo1.Lines.Count -1 do
  begin
      if copy(Memo1.Lines[i],1,1)<>'-' then Memo2.Lines.Add(Memo1.Lines[i])
  end;

end;


Mücadele güzelleştirir!
Cevapla