向各位算法高手求个算法，海量关键词过滤

unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, superobject;type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Memo2: TMemo;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Edit1: TEdit;
    Memo3: TMemo;
    Memo4: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
    StrJson: ISuperObject;
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}procedure TForm1.Button1Click(Sender: TObject);
var
  sl: TStringList;
begin
  sl := TStringList.Create;
  sl.Text := Memo1.Text;
  sl.Sort;
  Memo1.Text := sl.Text;
  sl.Free;
end;procedure TForm1.Button2Click(Sender: TObject);
var
  I: Integer;  procedure Insert(s: string);
  var
    sl: Integer;
    slen: Integer;
    sss: string;
    ss: string;
  begin
    slen := Length(s);
    sss := '';
    ss := '';
    for sl := 1 to slen do
    begin
      sss := IntToStr(Ord(s[sl]));
      //sss := s[sl];
      //if (sss=' ') or (sss='.') then sss := IntToStr(Ord(sss));
      if sss<>'' then
        if ss='' then
          ss := sss
        else
          ss := ss + '.' + sss;
        if StrJson.O[ss]=nil then
        begin
          if sl=slen then
            StrJson.O[ss] := SO('{flg:1}')
          else
            StrJson.O[ss] := SO('{flg:0}');
        end;
    end;
  end;begin
  for I := 0 to Memo1.Lines.Count - 1 do
  begin
    Insert(Memo1.Lines[I]);
  end;
  Memo2.Text := StrJson.AsJSon(True, True);
end;procedure TForm1.Button3Click(Sender: TObject);
var
  s: string;
  sss: string;
  ss: string;
  ms: string;
  slen: Integer;
  sI: Integer;
  flg: Integer;
  lst: TStringList;
  n1,n2: Int64;  function GetFlg(const path: string): Integer;
  begin
    Result := -1;
    if StrJson.O[path]<>nil then
      Result := StrJson.O[path].I['flg'];
  end;
begin
  //查找
  s := Memo3.Text;
  slen := Length(s);
  sss := '';
  ss := '';
  ms := '';
  lst := TStringList.Create;
  sI := 1;
  n1 := GetTickCount;
  for sI := 1 to slen do
  begin
    sss := IntToStr(Ord(s[sI]));
    //sss := s[sI];
    //if (sss=' ') or (sss='.') then sss := IntToStr(Ord(sss));
    if ss='' then
    begin
      ss := sss;
      ms := s[sI];
    end
    else begin
      ss := ss + '.' + sss;
      ms := ms + s[sI];
    end;
    flg := GetFlg(ss);
    if flg=-1 then
    begin
      //没有找到,清除ss
      ss := '';
      ms := '';
      Continue;
    end
    else if flg=0 then begin
      //已找到但不是词
      Continue;
    end
    else begin
      //是词
      lst.Add(ms);
      Continue;
    end;
  end;
  n2 := GetTickCount - n1;
  Memo4.Text := lst.Text;
  lst.Free;
  Edit1.Text := IntToStr(n2);
end;procedure TForm1.FormCreate(Sender: TObject);
begin
  StrJson := TSuperObject.Create(stObject);
end;procedure TForm1.FormDestroy(Sender: TObject);
begin
  StrJson := nil;
end;end.
Button1 只是个对关键词排序
Button2 是把词语加载到json,就是hash表Button3 就是遍历Memo3.text中的文本，进行查找请高手指点