Procházení adresáře – Delphi – Fórum – Programujte.com

Moje funkce

function createTestyDirsList(TestyDir: string):TStringList;
var i: Integer;
  TestyDirs : TStringList; // for folders sreach
  SearchRecord : TSearchRec;
begin
  TestyDirs := TStringList.create();

  if FindFirst(TestyDir,faDirectory,SearchRecord)=0 then
    begin

    while FindNext(SearchRecord) = 0 do
      begin
        if (SearchRecord.Attr = 16 {faDirectory}) and (SearchRecord.Name <> '.') and (SearchRecord.Name<>'..') then
          TestyDirs.Add(SearchRecord.Name);
      end;
    SysUtils.FindClose(SearchRecord);
    end;

  Result := TestyDirs;
end;

Volám ji

TestyDir := "P:\PROGRAMY\programování\PAS\delphi7\Projects\heb\Testy";

TestyDirs := createTestyDirsList(TestyDir);

V tom adresáři mám několik adresářů, ale problém je, že se mi nepřidají do seznamu. To while to completně přeskočí a projde to na SysUtils.FindClose(SearchRecord) ještě než by se cokoliv přidalo.

Minimálně by to chtělo nastavit výchozí složku pro hledání a ve funkci FindFirst je první parametr maska pro názvy souborů které hledáš.

Osobně bych to celé napsal nějak takto:

 

function createTestyDirsList(TestyDir: string): TStringList;
var
  searchResult: TSearchRec;
begin
  Result := nil;
  //nastaveni vychoziho adresare
  SetCurrentDir(TestyDir);

  if findfirst('*', faDirectory, searchResult) = 0 then
  begin

    repeat
      // chci jen slozky
      if (searchResult.attr and faDirectory) = faDirectory then
      begin
        if NOT Assigned(Result) then
        begin
          Result := TStringList.Create;
        end;

        Result.Append(searchResult.Name);
      end;
    until FindNext(searchResult) <> 0;

  end;
  FindClose(searchResult);

end;

1. Takhle ti to asi vrátí jen záznam pro ten jeden adresář. Jestli chceš jeho obsah, tak asi bude potřeba přídat za to ještě masku.

2. Už FindFirstDalší v případě úspěchu naplní ten SearchRecord. Takhle ho přeskakuješ.

3. V Attr asi může být více flagů. Netestoval bych rovnost.

if FindFirst(TestyDir + '\*', faDirectory, SearchRecord) = 0 then
begin
  repeat
    if (SearchRecord.Attr and faDirectory) = faDirectory
      ..
  until FindNext(searchResult) <> 0;
  FindClose(SearchRecord);
end;

Díky moc. Teda ja v původním kódu viděl tu masku, jenže jsem ji odstranil, tak to přestalo fungovat.

#4 oxidián
měl by sis zálohovat zdroje nebo použít nějaký verzovací program.

Tedy nevím jak D2007, ale 2010 si ukládají historii ukládání změn.

čas od času to zálohuju ručně. Obvykle když něco rozjedu. V Delphi mi to jde pomalu tak asi jednou dvakrát za týden.

#6 oxidián
jinak taková drobnost, TString a TStringList z funkce mi nějak zlobili, lepší je konstrukce s  výstupním TStrings nebo TStringList v argumentech.

procedure/funkction xxx (var vystup : TStrings /TStringList ; .....)

proto to ty funkce jako např. ExtractStrings  tak mají, žze je výstupní pole argumentem procedury/funkce