Znalezione w czeluściach mojego archaicznego CodeBank :)
(*
> Mam takie 4 pliki:
> 1. c:\temp\test1.tx
> 2. c:\temp\test2.txt
> 3. c:\temp\test3.txtA
> 4. c:\temp\test3.txtB
> FindFirst('c:\temp\*.txt', ...
> zwróci #2, #3 i #4 !!!
Błąd Windows, czy też działanie niezgodne z oczekiwanym
Można filtrować samemu używając funkcji którą kiedyś na tej grupie podał
Wojciech Spook Sura:
*)
function StringMatchesMask(S, mask: string; CaseSensitive:
Boolean = false): Boolean;
function InternalStringMatchesMask(PS, PMask : PChar) : boolean;
begin
while PMask^<>#0 do
begin
// Trzy możliwości:
case PMask^ of
'?' : begin
// Znak zapytania zastępuje dokładnie jeden znak.
if PS^=#0 then
begin
// Osiągnięto koniec ciągu znaków - brakuje znaku
// pasującego do znaku zapytania - czyli ciąg
// nie pasuje do maski
result:=false;
exit
end;
inc(PMask);
inc(PS);
end;
'*' : begin
// Przy gwiazdce - zastępującej dowolną serię zera lub więcej
// znaków - sprawa komplikuje się: nie możemy użyć strategii
// zachłannej, bo funkcja powie, że 'adas' nie pasuje do '*as'.
// Dlatego dla każdego potencjalnego trafienia trzeba będzie
// sprawdzić, czy reszta ciągu i maski do siebie pasują.
// Najpierw sprawdzamy prosty warunek:
inc(PMask);
if PMask^=#0 then
begin
// Gwiazdka na końcu wyrażenia - akceptujemy wszystko,jak
// leci.
result:=true;
exit
end;
// Teraz PMask znajduje się na pierwszym znaku za gwiazdką.
while (PS^<>#0) do
begin
// Teraz mamy dwie możliwości.
// 1. PMask nie jest wildcardem i nie pasuje do ciągu
// na tej pozycji. W tej sytuacji inkrementujemy ciąg.
// Potocznie: "gwiazdka zjada ten znak".
if not(PMask^ in ['?','*']) and (PMask^<>PS^) then
begin
inc(PS);
if PS^=#0 then
begin
// Osiągnęliśmy koniec ciągu znaków, ale nie
// udało się znaleźć pasującego znaku, czyli
// ciąg nie pasuje do wzorca.
result:=false;
exit
end;
end else
// 2. PMask pasuje do ciągu na tej pozycji lub
// jest wildcardem. Wtedy jeśli rekurencyjne wywołanie
// zwróci true - kończymy działanie z rezultatem true.
// W przeciwnym wypadku inkrementujemy ciąg.
begin
if InternalStringMatchesMask(PS, PMask) then
begin
result:=true;
exit
end else
begin
inc(PS);
if PS^=#0 then
begin
// Analogicznie, jak powyżej
result:=false;
exit
end;
end;
end;
end;
// Jeżeli do tego miejsca nie udało się znaleźć pasującej
// części wzorca, oznacza to, że ciąg nie pasuje do wzorca.
result:=false;
exit
end;
else begin
// Na koniec najprostsze: badany znak maski nie jest
// wildcardem. Jeśli pasuje do ciągu, to inkrementujemy oba
if PMask^=PS^ then
begin
inc(PMask);
inc(PS);
end else
// Jeśli nie, oznacza to, że ciąg nie pasuje do maski.
begin
result:=false;
exit
end;
end;
end;
end;
// Maska skończyła się. Jeśli ciąg znaków również - oznacza to, że pasuje
// do niej.
if PS^=#0 then
result:=true else
result:=false;
end;
begin
if CaseSensitive then
result:=InternalStringMatchesMask(PChar(s), PChar(mask)) else
result:=InternalStringMatchesMask(PChar(UpperCase(s)),
PChar(UpperCase(mask)));
end;
Jednak najlepsze rozwiązanie to RegExp:
uses PerlRegExp;
var
RegExp: TPerlRegEx;
begin
RegExp := TPerlRegEx.Create;
RegExp.Options := [preCaseLess];
RegExp.RegEx := '.+\.jpg$';
if FindFirst('*', faAnyFile, SearchResult) = 0 then
begin
repeat
RegExp.Subject := SearchResult.Name;
if RegExp.Match then Memo.Lines.Add(RegExp.MatchedText);
until FindNext(SearchResult) <> 0;
FindClose(searchResult);
end;
{Zwolnienie zmiennej}
RegExp.Free;
end;