problem z rekurencją

0

Chciałem właśnie użyć gotowca z algorytmów, który tworzy spis katalogów w wybranym katalogu.. i cosik nie chce działać.. :-/

Procedura szukająca katalogi:

procedure TForm1.SearchDir(StartPath: String);
var
SR: TSearchRec; 
Found : Integer; 

function IsDir(Value : String) : String; 
begin
if Value[Length(Value)] <> '\\' then
Result := Value + '\\' else Result := Value;
end; 

begin 
Found := FindFirst(IsDir(StartPath) + '*.*', faDirectory, SR);
while Found = 0 do 
begin 
Application.ProcessMessages; 
if ((SR.Attr and faDirectory) = faDirectory) and 
((SR.Name <> '.') and (SR.Name <> '..')) then
begin

Writeln(t,IsDir(StartPath) + SR.Name);

SearchDir(IsDir(StartPath) + SR.Name); 
end; 
Found := FindNext(SR); 
end; 
FindClose(SR); 
end; 

Przykładowe wywołanie:

procedure TForm1.Button1Click(Sender: TObject);
begin
  AssignFile(t, 'c:/spis.txt');
  rewrite(t);
  SearchDir('D:\Others\MP3');
  closefile(t);
end;

Plik spis.txt oczywiście się tworzy, ale jest niestety pusty... - nie wiem co jest źle ...

0

Na pierwszy rzut oka, to ten fragment jest zły :

if Value[Length(Value)] <> '\\' then
Result := Value + '\\' else Result := Value;

Jeśli Value jets stringiem, czyli tablicą charów, to nie możesz go prównywać z innym (trójznakowym) stringiem...

Powinno być tak :

if Value[Length(Value)] <> '' then
Result := Value + '' else Result := Value;

// to chyba każdy widzi od razu? w bazie danych jest (był?) błąd, który powoduje cytowanie () niektórych znaków, dlatego tak to wygląda - ŁF

0

Niestety dalej nie działa :-(

0

Cześć! Zamisat w FindFirst napisać faDirectory napisz faAnyFile.
// otóż pozwolę sobie nie zgodzić się z Tobą - tak naprawdę to funkcja FindFirst olewa drugi parametr i wyszukuje co popadnie i jak popadnie - ŁF
Dam Ci przykładowe wyciąganie katalogów (do TStringList):

procedure SearchAll(Dir: String; S: TStrings);
  function IsDir(D: String): String;
  begin
  if not(D[Length(D)] = '') then
    D := D + '';
  Result := D;

  end;
var
  SR: TSearchRec;
  LP: Integer;
begin
S.BeginUpdate;
LP := FindFirst(IsDir(Dir) + '*.*', faAnyFile, SR);
while (LP = 0) do
begin
  if (SR.Name <> '..') and (SR.Name <> '.') then
  if (SR.Attr and faDirectory) = faDirectory then
  begin
    S.Add(IsDir(Dir) + SR.Name);
    SearchAll(IsDir(Dir) + SR.Name, S);
  end;
  LP := FindNext(SR);
end;
FindClose(SR);
S.EndUpdate;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
SearchAll(Edit1.Text, Memo1.Lines);
end;

Mam nadzieję, że nie będziesz miał problemów z przeróbką... :P

0

No to patrz na to:

var
  t : textfile;

procedure SearchDir(StartPath: string);
var
SR: TSearchRec;
Found : Integer;

function IsDir(Value : string) : string;
begin
if Value[Length(Value)] <> '' then
Result := Value + '' else Result := Value;
end;

begin
Found := FindFirst(IsDir(StartPath) + '*.*', faDirectory, SR);
while Found = 0 do
begin
  Application.ProcessMessages;
  if ((SR.Attr and faDirectory) = faDirectory) and
  ((SR.name <> '.') and (SR.name <> '..')) then
  begin
    Writeln(t,IsDir(StartPath) + SR.name);
    SearchDir(IsDir(StartPath) + SR.name);
  end else
  if ((SR.Attr and faDirectory) = 0) then
     Writeln(t,IsDir(StartPath) + SR.name);

  Found := FindNext(SR);
end;
FindClose(SR);
end;
0

może mój art sie na coś przyda, choć Lukasz już rozwiązał chyba problem1
http://4programmers.net/view.html?id=368

//Coś chyba powaliłeś z tym linkiem, wysyła w kosmos - ŁF

1 użytkowników online, w tym zalogowanych: 0, gości: 1