procedure SplitTextIntoWords(
const S:
string; words: TstringList);
var
startpos, endpos: Integer;
begin
Assert(Assigned(words));
words.Clear;
startpos := 1;
while startpos <= Length(S)
do
begin
// skip non-letters
while (startpos <= Length(S))
and not IsCharAlpha(S[startpos])
do
Inc(startpos);
if startpos <= Length(S)
then
begin
// find next non-letter
endpos := startpos + 1;
while (endpos <= Length(S))
and IsCharAlpha(S[endpos])
do
Inc(endpos);
words.Add(Copy(S, startpos, endpos - startpos));
startpos := endpos + 1;
end;
{ If }
end;
{ While }
end;
{ SplitTextIntoWords }
function StringMatchesMask(S, mask:
string;
case_sensitive: Boolean): Boolean;
var
sIndex, maskIndex: Integer;
begin
if not case_sensitive
then
begin
S := AnsiUpperCase(S);
mask := AnsiUpperCase(mask);
end;
{ If }
Result := True;
// blatant optimism
sIndex := 1;
maskIndex := 1;
while (sIndex <= Length(S))
and (maskIndex <= Length(mask))
do
begin
case mask[maskIndex]
of
'
?':
begin
// matches any character
Inc(sIndex);
Inc(maskIndex);
end;
{ case '?' }
'
*':
begin
// matches 0 or more characters, so need to check for
// next character in mask
Inc(maskIndex);
if maskIndex > Length(mask)
then
// * at end matches rest of string
Exit
else if mask[maskindex]
in ['
*', '
?']
then
raise Exception.Create('
Invalid mask');
// look for mask character in S
while (sIndex <= Length(S))
and
(S[sIndex] <> mask[maskIndex])
do
Inc(sIndex);
if sIndex > Length(S)
then
begin
// character not found, no match
Result := False;
Exit;
end;
{ If }
end;
{ Case '*' }
else if S[sIndex] = mask[maskIndex]
then
begin
Inc(sIndex);
Inc(maskIndex);
end { If }
else
begin
// no match
Result := False;
Exit;
end;
end;
{ Case }
end;
{ While }
// if we have reached the end of both S and mask we have a complete
// match, otherwise we only have a partial match
if (sIndex <= Length(S))
or (maskIndex <= Length(mask))
then
Result := False;
end;
{ stringMatchesMask }
procedure FindMatchingWords(
const S, mask:
string;
case_sensitive: Boolean; matches: Tstrings);
var
words: TstringList;
i: Integer;
begin
Assert(Assigned(matches));
words := TstringList.Create;
try
SplitTextIntoWords(S, words);
matches.Clear;
for i := 0
to words.Count - 1
do
begin
if stringMatchesMask(words[i], mask, case_sensitive)
then
matches.Add(words[i]);
end;
{ For }
finally
words.Free;
end;
end;
{
The Form has one TMemo for the text to check, one TEdit for the mask,
one TCheckbox (check = case sensitive), one TListbox for the results,
one Tbutton
}
procedure TForm1.Button1Click(Sender: TObject);
begin
FindMatchingWords(memo1.Text, edit1.Text, checkbox1.Checked, listbox1.Items);
end;