Wyszukiwanie pliku

Odpowiedz Nowy wątek
2003-07-30 00:46
0

Witam !
Szukalem (pewno niezbyt dokladnie) ale nie znalezlem.
Chodzi mi jakas procedurke ktora wyszukuje dany plik o danym rozszerzeniu na dysku. Zdala by sie tak lub takie (moga byc dwie) ktora dziala pod win98 i winxp. ( w obydwu systemach jest co najmniej 2 uzytkownikow). Pomozcie mi trosze !!:)

Pozostało 580 znaków

2003-07-30 00:55
0

Procedura:

procedure TMainFrm.FileSearch(const PathName, FileName : string; const InDir : boolean);
var Rec : TSearchRec; 
 Path, CurFile, AllFiles : string; 
 i: integer; 
begin
Path := IncludeTrailingBackslash(PathName);
AllFiles:=FileName;
while AllFiles<>'' do begin
i:=pos(';', AllFiles); 
if i=0 then begin 
  CurFile:=Trim(AllFiles); 
  AllFiles:=''; 
end else begin 
  CurFile:=Trim(Copy(AllFiles, 1, i-1)); 
  Delete(AllFiles, 1, i); 
end; 
if FindFirst(Path + CurFile, faAnyFile - faDirectory, Rec) = 0 then 
try 
  repeat 
   ListBox1.Items.Add(Path + Rec.name); 
  until FindNext(Rec) <> 0; 
finally 
  FindClose(Rec); 
end; 
end; 

if not InDir then Exit; 

if FindFirst(Path + '*.*', faDirectory, Rec) = 0 then 
try 
repeat 
if { (Rec.Attr and faDirectory) and } (Rec.name <> '.') and (Rec.name <> '..') then 
  FileSearch(Path + Rec.name, FileName, True); 
until FindNext(Rec) <> 0; 
finally 
FindClose(Rec); 
end; 
end; 

Uzycie:

procedure TMainFrm.SzukajClick(Sender: TObject);
begin
ListBox1.Clear;
FileSearch(Edit1.Text,Edit2.Text, CheckBox1.State in [cbChecked]);
end;

Edit1 - ścieżka do katalogu
Edit2 - Maska rozszerzenia


Pozdrawiam. Karol

Pozostało 580 znaków

2003-07-30 01:13
0

Dzieki stary !!!!
Poprawilbym tylko jedno:
Zamiast : Path := IncludeTrailingBackslash(PathName);
dal bym: Path := IncludeTrailingPathDelimiter(PathName);
ale i tak dziala.

Chcialbym jeszcze wiedziec jak znalez plik nie znajac jego polozenie (nie wiem w jakim moze byc katalogu). Gdy wpisz np. C:\ i nazwa pliku tomek.txt to nic nie znajduje (chociaz plik znajduje sie w C:\test)

//Skoro jestes taki spostrzegawczy i wymagajacy STARY to radzilbym samemu szukac rozwiazan..moj przyklad to kod wyciety na zywca z helpa w Delphi - lofix

Pozostało 580 znaków

2003-07-30 01:33
0

Poniżej masz procedurę wyszukującą pliki w określonym katalogu i podkatalogach (bez rekurencji).
Nie jest ona ani zbyt elegancka, ani też zoptymalizowana, ale pisałem to ładnych parę lat temu.

FileMask - (in) maska wyszukiwania, bez katalogu, np: *.exe;
StartDir - (in) katalog, od którego ma się rozpocząć wyszukiwanie, np.: C:\WINNT;
FileList - (in, out) StringList, który zostanie wypełniony nazwami plików;
SubdirsCount - (in, optional) określa, do którego katalogu w strukturze katalogów ma się odbywać wyszukiwanie.

uses
  Windows, SysUtils, Classes,......;
.....
.....
procedure FillFileList(FileMask, StartDir: string; FileList: TStringList; SubdirsCount: byte = 20);
var
  Tmp, Tmp2: TStringList;
  DirList: TStringList;
  Last: TStringList;
  i, x, k: integer;

  function IsDirectory(SearchRec: TSearchRec): boolean;
  begin
    Result := false;
    if ((SearchRec.Attr and faDirectory) > 0) and (SearchRec.Name <> '.')
      and (SearchRec.Name <> '..') then
      Result := true;
  end;

  procedure FindDirs(StartDir: string; List: TStringList);
  var
    sr: TSearchRec;
  begin
    Tmp.Clear;
    if FindFirst(StartDir, faAnyFile, sr) = 0 then
    begin
      if IsDirectory(sr) then
      begin
        List.Add(copy(StartDir, 1, length(StartDir) - 2) + '' + sr.Name);
      end;
      while FindNext(sr) = 0 do
      begin
        if IsDirectory(sr) then
        begin
          List.Add(copy(StartDir, 1, length(StartDir) - 2) + '' + sr.Name);
        end;
      end;
      FindClose(sr);
    end;
  end;

  procedure FindFile(FileMask, StartDir: string; List: TStringList);
  var
    sr: TSearchRec;
  begin
    if FindFirst(StartDir + '' + FileMask, faAnyFile, sr) = 0 then
    begin
      if (sr.Name <> '.') and (sr.Name <> '..') and (sr.Attr and faDirectory = 0) then
        List.Add(StartDir + '' + sr.Name);
      while FindNext(sr) = 0 do
      begin
        if (sr.Name <> '.') and (sr.Name <> '..') and (sr.Attr and faDirectory = 0) then
          List.Add(StartDir + '' + sr.Name);
      end;
      FindClose(sr);
    end;
  end;

  //--------------------S T A R T--------------------------------
begin
  Tmp := TStringList.Create;
  Tmp2 := TStringList.Create;
  Last := TStringList.Create;
  DirList := TStringList.Create;
  try
    try
      if StartDir[length(StartDir)] = '' then
        StartDir := copy(StartDir, 1, length(StartDir) - 1);
      DirList.Add(StartDir);

      if SubdirsCount > 0 then
      begin
        StartDir := StartDir + '\*';
        FindDirs(StartDir, Tmp);
      end;

      for k := 0 to Tmp.Count - 1 do
      begin
        DirList.Add(Tmp.Strings[k]);
        Last.Add(Tmp.Strings[k]);
      end;

      for i := 1 to SubdirsCount - 1 do
      begin
        for x := 0 to Last.Count - 1 do
        begin
          StartDir := Last.Strings[x] + '\*';
          FindDirs(StartDir, Tmp);
          for k := 0 to Tmp.Count - 1 do
          begin
            DirList.Add(Tmp.Strings[k]);
            Tmp2.Add(Tmp.Strings[k]);
          end;
        end; //for x
        Last.Clear;
        for k := 0 to Tmp2.Count - 1 do
          Last.Add(Tmp2.Strings[k]);
        Tmp2.Clear;
      end;

    finally
      DirList.Sort;
      Tmp.Free;
      Tmp2.Free;
      Last.Free;
    end;

    Tmp := TStringList.Create;
    try
      for i := 0 to DirList.Count - 1 do
      begin
        Tmp.Clear;
        FindFile(FileMask, DirList.Strings[i], Tmp);
        for k := 0 to Tmp.Count - 1 do
          FileList.Add(Tmp.Strings[k]);
      end;
    finally
      Tmp.Free;
    end;

  finally DirList.Free;
  end;
end;

Pozostało 580 znaków

2003-07-30 01:53
0

<font color="red"><font color="black">//Skoro jestes taki spostrzegawczy i wymagajacy STARY to radzilbym samemu szukac rozwiazan..moj przyklad to kod wyciety na zywca z helpa w Delphi - lofix</span></span>

Spokojnie lofix nie denerwuj sie. Ja spostrzegwaczy ? hehe poprostu staram sie analizowac kazda procedure od poczatku do konca (tak sie ucze). W kazdym razie dzieki za ta procedurka.

A propo procedur to dzieki Jack postaram sie jakos zoptymalizowac i zmniejszyc tego dinozaura :)) Wielkie dzieki na pewno mi sie ta i procedurka lofixa przyda. DZieki !

Pozostało 580 znaków

Odpowiedz
Liczba odpowiedzi na stronę

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