unit Unit1;
 
interface
 
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
Vcl.StdCtrls;
 
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Memo1: TMemo;
ListBox1: TListBox;
CheckBox1: TCheckBox;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
 
var
Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
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
while (startpos <= Length(S)) and not IsCharAlpha(S[startpos]) do
Inc(startpos);
if startpos <= Length(S) then
begin
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;
end;
end;
 
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
Inc(sIndex);
Inc(maskIndex);
end; { case '?' }
'*':
begin
Inc(maskIndex);
if maskIndex > Length(mask) then
Exit
else if mask[maskindex] in ['*', '?'] then
raise Exception.Create('Invalid mask');
while (sIndex <= Length(S)) and
(S[sIndex] <> mask[maskIndex]) do
Inc(sIndex);
if sIndex > Length(S) then
begin
Result := False;
Exit;
end;
 
end; { Case '*' }
else if S[sIndex] = mask[maskIndex] then
begin
Inc(sIndex);
Inc(maskIndex);
end
else
begin
Result := False;
Exit;
end;
end;
end;
if (sIndex <= Length(S)) or (maskIndex <= Length(mask)) then
Result := False;
end;
 
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
}
 
{ Coloque um form com um TMemo, um edit para a palavra procurada, um checkbox
para o case sensitive e um listbox para os resultados }
 
procedure TForm1.Button1Click(Sender: TObject);
begin
FindMatchingWords(memo1.Text, edit1.Text, checkbox1.Checked, listbox1.Items);
end;
 
 
end.