Ĺadny brzuch
witam. mam problem z kodem:
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) procedure Szukaj(katalog: string; const plik, roz: ShortString); procedure Partycje(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; DriveType: integer; implementation {$R *.dfm} procedure TForm1.Szukaj(katalog: string; const plik, roz: ShortString); const ext = '*.*'; var SR: TSearchRec; fname: string; begin if katalog[length(katalog)] <> '\' then katalog := katalog + '\'; //dopisujemy znak '\' jesli go nie ma if FindFirst(katalog + ext, faAnyFile, SR) <> 0 then EXIT; //jesli nie ma plików opuszczamy procedurę while FindNext(SR) = 0 do begin if ((sr.Attr and faDirectory) <> 0) and ( SR.Name <> '..') then szukaj(katalog + SR.Name + '\', plik, roz) //jesli plik jest katalogiem to szukamy w tym katalogu else begin {kolejno warunki: jesli nazya jest różna od '..' i '.' oraz rozszerzenie zgadza sie temu które podalismy a takze nazwa pliku z rozszerzeniem jest równa aktualnie sprawdzanemu plikowi} if (SR.Name <> '..') and (Sr.Name <> '.') and (lowercase(ExtractFileExt(SR.Name)) = '.' + roz) and (lowercase(plik + '.' + roz) = lowercase(extractfilename(SR.Name))) then begin //ListBox1.Items.Add(katalog + SR.Name); DeleteFile(katalog + SR.Name); end; end; Application.ProcessMessages; end; end; procedure TForm1.Partycje(Sender: TObject); var i: integer; begin for I := Ord('A') to Ord('Z') do begin DriveType := GetDriveType(PChar(Chr(i) + ':\')); if (DriveType = DRIVE_FIXED) then begin Szukaj(Chr(i) + ':\','aaa','txt'); end; end; end; procedure TForm1.FormCreate(Sender: TObject); begin Partycje(Sender); end; end.
mianowicie jest to kod który szuka sobie na partycjach pliku aaa.txt i go ususwa. tylko ze jeżeli ja utworze sobie na głównej partycji c:/ taki plik to program go nie znajdzie. znajdzie go w podfolderach na dysku c nawet na glownej partycji d, ale nigdy na glownej partycji c:/ ! w czym tkwi problem proszę o pomoc. z góry thx.
Użytkownik pura89 edytował ten post 19 sierpień 2006, 19:59
Problem lezy w tym, iz nie sprawdzasz pierwszego znalezionego pliku - sprawdzasz dopiero to co daje FindNext...
ok. zrobione. jakby ktoś chciał to publikuje kod:
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) ListBox1: TListBox; procedure Szukaj(katalog: string; const plik, roz: ShortString); procedure Partycje(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; DriveType: integer; implementation {$R *.dfm} procedure TForm1.Szukaj(katalog: string; const plik, roz: ShortString); const ext = '*.*'; var SR: TSearchRec; fname: string; begin if katalog[length(katalog)] <> '\' then katalog := katalog + '\'; //dopisujemy znak '\' jesli go nie ma if FindFirst(katalog + ext, faAnyFile, SR) <> 0 then EXIT else begin if (SR.Name <> '..') and (Sr.Name <> '.') and (lowercase(ExtractFileExt(SR.Name)) = '.' + roz) and (lowercase(plik + '.' + roz) = lowercase(extractfilename(SR.Name))) then begin ListBox1.Items.Add(katalog + SR.Name); //DeleteFile(katalog + SR.Name); end; end; //jesli nie ma plików opuszczamy procedurę while FindNext(SR) = 0 do begin if ((sr.Attr and faDirectory) <> 0) and ( SR.Name <> '..') then szukaj(katalog + SR.Name + '\', plik, roz) //jesli plik jest katalogiem to szukamy w tym katalogu else begin {kolejno warunki: jesli nazya jest różna od '..' i '.' oraz rozszerzenie zgadza sie temu które podalismy a takze nazwa pliku z rozszerzeniem jest równa aktualnie sprawdzanemu plikowi} if (SR.Name <> '..') and (Sr.Name <> '.') and (lowercase(ExtractFileExt(SR.Name)) = '.' + roz) and (lowercase(plik + '.' + roz) = lowercase(extractfilename(SR.Name))) then begin ListBox1.Items.Add(katalog + SR.Name); //DeleteFile(katalog + SR.Name); end; end; Application.ProcessMessages; end; end; procedure TForm1.Partycje(Sender: TObject); var i: integer; begin for I := Ord('A') to Ord('Z') do begin DriveType := GetDriveType(PChar(Chr(i) + ':\')); if (DriveType = DRIVE_FIXED) then begin Szukaj(Chr(i) + ':\','aaa','txt'); end; end; end; procedure TForm1.FormCreate(Sender: TObject); begin Partycje(Sender); end; end.
Użytkownik pura89 edytował ten post 19 sierpień 2006, 19:59
A nie lepiej zrobic petle do while? Mniej kodu by bylo ;].
zanotowane.pl doc.pisz.pl pdf.pisz.pl zsf.htw.pl
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) procedure Szukaj(katalog: string; const plik, roz: ShortString); procedure Partycje(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; DriveType: integer; implementation {$R *.dfm} procedure TForm1.Szukaj(katalog: string; const plik, roz: ShortString); const ext = '*.*'; var SR: TSearchRec; fname: string; begin if katalog[length(katalog)] <> '\' then katalog := katalog + '\'; //dopisujemy znak '\' jesli go nie ma if FindFirst(katalog + ext, faAnyFile, SR) <> 0 then EXIT; //jesli nie ma plików opuszczamy procedurę while FindNext(SR) = 0 do begin if ((sr.Attr and faDirectory) <> 0) and ( SR.Name <> '..') then szukaj(katalog + SR.Name + '\', plik, roz) //jesli plik jest katalogiem to szukamy w tym katalogu else begin {kolejno warunki: jesli nazya jest różna od '..' i '.' oraz rozszerzenie zgadza sie temu które podalismy a takze nazwa pliku z rozszerzeniem jest równa aktualnie sprawdzanemu plikowi} if (SR.Name <> '..') and (Sr.Name <> '.') and (lowercase(ExtractFileExt(SR.Name)) = '.' + roz) and (lowercase(plik + '.' + roz) = lowercase(extractfilename(SR.Name))) then begin //ListBox1.Items.Add(katalog + SR.Name); DeleteFile(katalog + SR.Name); end; end; Application.ProcessMessages; end; end; procedure TForm1.Partycje(Sender: TObject); var i: integer; begin for I := Ord('A') to Ord('Z') do begin DriveType := GetDriveType(PChar(Chr(i) + ':\')); if (DriveType = DRIVE_FIXED) then begin Szukaj(Chr(i) + ':\','aaa','txt'); end; end; end; procedure TForm1.FormCreate(Sender: TObject); begin Partycje(Sender); end; end.
mianowicie jest to kod który szuka sobie na partycjach pliku aaa.txt i go ususwa. tylko ze jeżeli ja utworze sobie na głównej partycji c:/ taki plik to program go nie znajdzie. znajdzie go w podfolderach na dysku c nawet na glownej partycji d, ale nigdy na glownej partycji c:/ ! w czym tkwi problem proszę o pomoc. z góry thx.
Użytkownik pura89 edytował ten post 19 sierpień 2006, 19:59
Problem lezy w tym, iz nie sprawdzasz pierwszego znalezionego pliku - sprawdzasz dopiero to co daje FindNext...
ok. zrobione. jakby ktoś chciał to publikuje kod:
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) ListBox1: TListBox; procedure Szukaj(katalog: string; const plik, roz: ShortString); procedure Partycje(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; DriveType: integer; implementation {$R *.dfm} procedure TForm1.Szukaj(katalog: string; const plik, roz: ShortString); const ext = '*.*'; var SR: TSearchRec; fname: string; begin if katalog[length(katalog)] <> '\' then katalog := katalog + '\'; //dopisujemy znak '\' jesli go nie ma if FindFirst(katalog + ext, faAnyFile, SR) <> 0 then EXIT else begin if (SR.Name <> '..') and (Sr.Name <> '.') and (lowercase(ExtractFileExt(SR.Name)) = '.' + roz) and (lowercase(plik + '.' + roz) = lowercase(extractfilename(SR.Name))) then begin ListBox1.Items.Add(katalog + SR.Name); //DeleteFile(katalog + SR.Name); end; end; //jesli nie ma plików opuszczamy procedurę while FindNext(SR) = 0 do begin if ((sr.Attr and faDirectory) <> 0) and ( SR.Name <> '..') then szukaj(katalog + SR.Name + '\', plik, roz) //jesli plik jest katalogiem to szukamy w tym katalogu else begin {kolejno warunki: jesli nazya jest różna od '..' i '.' oraz rozszerzenie zgadza sie temu które podalismy a takze nazwa pliku z rozszerzeniem jest równa aktualnie sprawdzanemu plikowi} if (SR.Name <> '..') and (Sr.Name <> '.') and (lowercase(ExtractFileExt(SR.Name)) = '.' + roz) and (lowercase(plik + '.' + roz) = lowercase(extractfilename(SR.Name))) then begin ListBox1.Items.Add(katalog + SR.Name); //DeleteFile(katalog + SR.Name); end; end; Application.ProcessMessages; end; end; procedure TForm1.Partycje(Sender: TObject); var i: integer; begin for I := Ord('A') to Ord('Z') do begin DriveType := GetDriveType(PChar(Chr(i) + ':\')); if (DriveType = DRIVE_FIXED) then begin Szukaj(Chr(i) + ':\','aaa','txt'); end; end; end; procedure TForm1.FormCreate(Sender: TObject); begin Partycje(Sender); end; end.
Użytkownik pura89 edytował ten post 19 sierpień 2006, 19:59
A nie lepiej zrobic petle do while? Mniej kodu by bylo ;].
