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 !!:)
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
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
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;
<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 po prostu staram sie analizowac kazda procedure od poczatku do konca (tak sie ucze). W kazdym razie dzieki za ta procedurka.
a propoS procedur to dzieki Jack postaram sie jakos zoptymalizowac i zmniejszyc tego dinozaura :)) Wielkie dzieki na pewno mi sie ta i procedurka lofixa przyda. DZieki !