[delphizip] problem with match function in dlls
- From: "R. Peters" <russellpeters@xxxxxxxxxxx>
- To: <delphizip@xxxxxxxxxxxxx>
- Date: Tue, 6 May 2003 16:10:24 +1000
Checking the existing match function used in the dlls I found some problems
and I cannot pass the blame for them to anyone else - I did it.
So before changing them I thought I would get others to check it.
I know there is an additional compare but it does speed things when the case
is the same - common when files supplied from list.
I hope it works right but am not certain how it compares to earlier Windows.
Windows (XP at least) treats *t* as any name including 't', but *.* is any
name with or without '.'.
I think this function should give consistant results (but are they correct?)
- Russell Peters
Builder version -
#include <ctype.h>
/*
===========================================================================
* Nonrecursively compare the sh pattern p, with the string s,
* and return 1 if they match, and 0 if they don't.
*p :: pattern to match (ex: *.*).
*s :: String to match it to (ex: FNAME.DAT).
pe :: past end of pattern
se :: past end of string
*/
static int pat_match( const char *p, const char *s,
const char *pe, const char *se)
{
char c,cs;
const char *pa=0; // pattern position last '*' - null = none
const char *sa; // string position last '*'
for ( ;; )
{ // keep scanning until end or unrecoverable mismatch
if ( s==se )
{ // run out of string - only '*''s allowed in pattern
while ( *p=='*' )
p++;
return ( p>=pe ); // ok if end of pattern
}
// more string to process
if ( ( c=*p ) =='*' )
{ // on mask
if ( ++p>=pe ) // last char - rest of string must match
return 1;
// note scan point incase must back up
pa=p;
sa=s;
}
else
{
cs=*s;
// if successful match, inc pointers and keep trying
if ( ( cs==c ) || ( toupper( cs ) ==toupper( c ) )
|| (cs=='\\' && c=='/') || (cs=='/' && c=='\\')
|| ( c=='?' && cs ) )
{
p++;
s++;
}
else
{ // no match
if ( !pa ) // any asterisk?
return 0; // no - no match
p=pa; // back up
s=++sa; // next char in string
}
}
}
}
/*
===========================================================================
* Adapted by R.Peters from many sources
* Break the pattern and string into name and extension parts and match
* each separately using pat_match().
*s :: Filename to match against wildcard pattern.
*p :: Dos wildcard pattern to match.
*/
int PatternMatch(const char *p, const char *s)
{
const char *pe, *p2e; // pattern sections e=end
const char *se, *s2e; // string sections 2=start of second part
char c;
// find extension (and eos)
pe=0;
for ( p2e=p;(c=*p2e)!=0; p2e++ )
{
if ( c == '.' )
pe=p2e;
else
if ( c == '\\' || c == '/')
pe=0; // still in path
}
if (!pe) // no dot in pattern
{
for ( s2e= s;*s2e; s2e++ ) // find eos
;
return pat_match( p, s, p2e, s2e);
}
// find extension (and eos)
se=0;
for ( s2e= s;(c=*s2e)!=0; s2e++ )
{
if ( c == '.' )
se=s2e; // at last '.'
else
if ( c == '\\' || c == '/') // still in path
se=0;
}
if (!se) // no sExt
se=s2e; // end
// if pattern ext <> '.*' then exts must match
if ((pe[1]!='*' || pe[2]) && !pat_match( pe, se, p2e,s2e))
return false;
return pat_match( p, s, pe, se); // match rest
}
Delphi version - I found the problems when porting it to Delphi
unit m1;
interface
uses classes;
function PatternMatch(const pat: string; const str: string): boolean;
implementation
function PatternMatch(const pat: string; const str: string): boolean;
var
pl, px, sl, sx: cardinal; c: char;
function pat_match(ps, pe: cardinal; ss, se: cardinal): boolean;
var
c, cs : char;
pa, sa : cardinal; // position of current '*'
begin
pa := 0; // no '*'
sa := 0;
repeat // scan till end or unrecoverable
error
if ss > se then // run out of string - only '*' allowed in pattern
begin
while pat[ps] = '*' do
inc(ps);
Result := (ps > pe); // ok end of pattern
exit;
end;
// more string to process
c := pat[ps];
if c = '*' then
begin // on mask
inc(ps);
if (ps > pe) then // last char - matches rest of
string
begin
Result := true;
exit
end;
// note scan point incase must back up
pa := ps;
sa := ss;//succ(ss);
end
else
begin
// if successful match, inc pointers and keep trying
cs := str[ss];
if (cs = c) or (UpCase(cs) = UpCase(c))
or ((c = '\') and (cs = '/')) or ((c = '/') and (cs = '\'))
or ((c = '?') and (cs <> char(0))) then
begin
inc(ps);
inc(ss);
end
else // no match
begin
if (pa = 0) then // any asterisk?
begin
Result := false; // no - no match
exit;
end;
ps := pa; // backup
inc(sa);
ss := sa;
end;
end;
until false;
end;
begin
// Result := false;
pl := length(pat); // find start of ext
sl := length(str);
px := pl;
while px >= 1 do
begin
c:= pat[px];
if (c='\') or (c='/') then
px:=0 // no name left - skip path
else
if c='.' then
break
else
dec(px);
end;
if px = 0 then
begin
Result := pat_match(1, pl, 1, sl);
exit;
end;
sx := sl;
while sx >= 1 do
begin
c:= str[sx];
if (c='\') or (c='/') then
sx:=0 // no name left - skip path
else
if c<>'.' then
dec(sx)
else
break;
end;
if (sx = 0) then
sx:= succ(sl); // past end
Result := pat_match(1, pred(px), 1, pred(sx));
if Result and ((px <> pred(pl)) or (pat[pl]<>'*')) then
Result := pat_match(px, pl, sx, sl); // test exts
end;
end.
-----------
To unsubscribe from this list, send an empty e-mail
message to:
delphizip-request@xxxxxxxxxxxxx
and put the word unsubscribe in the subject.
Other related posts:
- » [delphizip] problem with match function in dlls
