comparewild.pas

   1 {$MODE DELPHI}
   2 unit comparewild;
   3 {Copyright (C) 2007 Thomas Kelsey; 2010 MegaBrutal
   4
   5 This program is free software; you can redistribute it and/or
   6 modify it under the terms of the GNU General Public License
   7 as published by the Free Software Foundation; either version 2
   8 of the License, or (at your option) any later version.
   9
  10 This program is distributed in the hope that it will be useful,
  11 but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13 GNU General Public License for more details.
  14
  15 You should have received a copy of the GNU General Public License
  16 along with this program; if not, write to the Free Software
  17 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.}
  18
  19 {
  20    COMMENTS FOR MY MODIFICATION TO THE ORIGINAL CODE:
  21    This unit is originally written by Thomas Kelsey to match wildcards
  22    for filenames in Borland Delphi. I've adapted it to match internet
  23    hostnames and IPs instead, and I've added the $MODE DELPHI directive
  24    to make the unit usable in Free Pascal.
  25    Basically, the only difference between matching filenames and
  26    hostnames is that '*' should match '.' as well, while in the case of
  27    filenames, it shouldn't.
  28    (MegaBrutal, 2010)
  29 }
  30
  31 // KNOWN BUGS: accepts wildcards in target string
  32 interface
  33
  34 function WildComp(const mask: String; const target: String): Boolean;
  35
  36 {function Test: Boolean;}
  37
  38 implementation
  39
  40 function WildComp(const mask: String; const target: String): Boolean;
  41
  42     // '*' matches greedy & ungreedy
  43     // simple recursive descent parser - not fast but easy to understand
  44     function WComp(const maskI: Integer; const targetI: Integer): Boolean;
  45     begin
  46
  47         if maskI > Length(mask) then begin
  48             Result := targetI = Length(target) + 1;
  49             Exit;
  50         end;
  51         if targetI > Length(target) then begin
  52             // unread chars in filter or would have read '#0'
  53             Result := False;
  54             Exit;
  55         end;
  56
  57         case mask[maskI] of
  58             '*':
  59                 // CHANGED BY MegaBrutal
  60                 // If I compare hostnames, '*' should match '.' as well.
  61                 Result := WComp(succ(maskI), Succ(targetI)) or WComp(maskI, Succ(targetI));
  62
  63             '?':
  64                 // ? doesnt match '.'
  65                 if target[targetI] <> '.' then
  66                     Result := WComp(succ(maskI), Succ(targetI))
  67                 else
  68                     Result := False;
  69
  70             else     // includes '.' which only matches itself
  71                 if mask[maskI] = target[targetI] then
  72                     Result := WComp(succ(maskI), Succ(targetI))
  73                 else
  74                     Result := False;
  75         end;// case
  76
  77     end;
  78
  79 begin
  80     WildComp := WComp(1, 1);
  81 end;
  82
  83
  84 { This test function should always return true, I modified it to test
  85   if the function fulfills my needs.
  86   I commented it out, because I don't really need it in my project,
  87   but I left it here for others to inspect. (MegaBrutal) }
  88
  89 {
  90 function Test: Boolean;
  91 begin
  92 Result := WildComp('a*.bmp', 'auto.bmp');
  93     Result := Result and (not WildComp('a*x.bmp', 'auto.bmp'));
  94     Result := Result and WildComp('a*o.bmp', 'auto.bmp');
  95     Result := Result and (not WildComp('a*tu.bmp', 'auto.bmp'));
  96     Result := Result and WildComp('a*o.b*p', 'auto.bmp') and (WildComp('a*to.*', 'auto.bmp'));
  97     Result := Result and WildComp('a**o.b*p', 'auto.bmp');
  98     Result := Result and (WildComp('*ut*.**', 'auto.bmp'));
  99     Result := Result and (WildComp('*ut*.*.*', 'auto.bmp.splack'));
 100     Result := Result and WildComp('**.**', 'auto.bmp') and (WildComp('*ut*', 'auto.bmp'));
 101     // '*' = at least 1 char
 102     Result := Result and not WildComp('**', 'a');
 103     // shows '.' -> '*'
 104     Result := Result and (WildComp('*ut*.*', 'auto.bmp.foo'));
 105     // shows un-greedy match
 106     Result := Result and (WildComp('*ut', 'autout'));
 107
 108     Result := Result and (not WildComp('auto?', 'auto'));
 109     Result := Result and not WildComp('?uto', 'uto');
 110     Result := Result and WildComp('aut?', 'auto');
 111     Result := Result and WildComp('???', 'uto');
 112     Result := Result and not WildComp('????', 'uto');
 113     Result := Result and not WildComp('??', 'uto');
 114
 115     // ADDED BY MegaBrutal
 116     // We should still match '.' for '*':
 117     Result := Result and WildComp('*.t-online.hu', 'dslwhatever.pool.t-online.hu');
 118     Result := Result and WildComp('192.168.*', '192.168.1.25');
 119     // But we shouldn't match '.' for '?':
 120     Result := Result and (not WildComp('whatever?net', 'whatever.net'));
 121
 122 end;
 123 }
 124
 125
 126 end.