聪明二休-程序结构.txt

用AIML语言开发的一款中文自动聊天软件

          m.add(_context,wc); {add the matched wildcard to the match using the current context}
          exit;
        end;
      end;

      {try to match the exact word}
      n:=get(newcontext,input[depth]);
      if n<>nil then begin
        if depth<input.Count-1 then {check if we aren't at the last word in the input}
          result:=n.Match(input,depth+1,m)
        else if n._template<>'' then
          result:=n;
        if result<> nil then exit;
      end;

      wcl:=0;
      n:=get(newcontext,'*');
      {try to match the * wildcard}
      if n<>nil then begin
        repeat
          if (depth+wcl<input.Count-1) then
            result:=n.Match(input,depth+wcl+1,m)
          else if n._template<>'' then
            result:=n;
          inc(wcl);
        until (result<> nil) or (depth+wcl>=input.Count);
        if result<>nil then begin
          if m=nil then m.create;
          for i:=depth to depth+wcl-1 do
            wc:=wc+input[i]+' ';
          m.add(_context,wc);
          exit;
        end;
      end;


    end;
  procedure TPatternnode.delete(context:integer;I:integer);
    begin
      if i<=_count[context] then begin
        TPatternNode(_childs[context].Objects[i]).clear;
        _childs[context].Delete(i);
        dec(_count[context]);
      end;
    end;
  Procedure TPatternnode.clear;
    var i:integer;
    begin
      for i:=0 to CNumContext-1 do
        while _count[i] >0 do delete(i,0);
    end;
  constructor TPatternMatcher.Create;
    begin
      _root:=TPatternNode.Create('',nil);
      _tokenizer:=TStringTokenizer.create(' ');

      _locked:=false;
    end;
  destructor TPatternMatcher.destroy;
    var
      N:TPatternNode;
    begin
      _tokenizer.free;
      N:=_root;
      n.clear;
      n.destroy;
      inherited destroy;
    end;
  procedure TPatternMatcher.Add(path:string;t:string);
    var
      i:integer;
      n:Tpatternnode;
      c:integer;
      ci:integer;
    begin
      while _locked do ;
      _locked:=true;
      Path:=Trim(path);
      n:=_root;
      _Tokenizer.tokenize(path);
      c:=0; {context=<input>}
      for i:=0 to _Tokenizer._count-1 do begin
        for ci:=0 to CNumContext-1 do
          if AnsiSameText(_Tokenizer._tokens[i],CContext[ci]) then
            c:=ci;

        n:=n.add(_Tokenizer._tokens[i],c);
      end;
      if n._template='' then begin
        n._template:=t;
        n._path:=path;
        inc(_count);
      end;
      _locked:=false;
    end;
  function TPatternMatcher.Match:TMatch;
    var
      input,that,topic:string;
      i:integer;
    begin
      result:=nil;
      if not assigned(_SentenceTokenizer) then
        _SentenceTokenizer:=TStringTokenizer.Create(UUtils.SentenceSplitterChars);

      input:=Memory.getVAr('input');
      input:=Preprocessor.process(' '+input+' ');
      input:=Trim(input);

      _SentenceTokenizer.Tokenize(input);
      For i:=0 to _sentenceTokenizer._count-1 do begin
        that:=Memory.getVar('that');
        if that='' then that:='*';
        topic:=Memory.getVar('topic');
        if topic='' then topic:='*';
        input:=trim(_sentenceTokenizer._Tokens[i]);
        if (input<>' ') and (input<>'') then begin
          if result<>nil then begin
            result.free;
          end;
          result:=Match(input,that,topic);

        end;
      end;
    end;
  function TPatternMatcher.Match(path:string):TMatch;
    var
      n:Tpatternnode;
    begin
      while _locked do ;
      _locked:=true;
      Matchfault:=0;
      Path:=Trim(path);
      n:=_root;
      _Tokenizer.tokenize(path);
      result:=TMatch.create;
      n:=n.match(_tokenizer._tokens,0,result);
      _locked:=false;
      if n<> nil then begin
        result._template:=n._template;
        result._path:=n._path;
      end;
      _matchfault:=matchfault;
      //Memory.Match:=Result;
      //result:=n._template;
      //result:=result + '//'+ inttostr(matchfault);
    end;
  function TPatternMatcher.Match(input,that,topic:string):TMatch;
    begin
      result:=Match(input+' <that> '+that+' <topic> '+topic);
    end;
  function TPatternMatcher.MatchInput(input:string):TMatch;
    var
      that,topic:string;
    begin
      that:=Memory.getVar('that');
      if that='' then that:='*';
      topic:=Memory.getVar('topic');
      if topic='' then topic:='*';
      result:=Match(input,that,topic);
    end;
begin
nodecount:=0;
end.

----------------------------------------------------------------------------------
unit UAIMLLoader;

interface
uses UPatternMatcher,LibXmlParser;
type

  TAIMLLoader=class
    _pattern,
    _that,
    _topic:string;

    _template:string;
    parser:TXmlParser;
    procedure load(filename:string);
    procedure TopicStart;
    procedure TopicEnd;
    procedure That;
    procedure CategoryStart;
    Procedure CategoryEnd;

    function PatternElement:boolean;
    function ThatElement:boolean;
    function TemplateElement:boolean;
    function PatternBotElement:boolean;
    function CategoryElement:boolean;
    function AIMLElement:boolean;
  end;
var
  AIMLLoader:TAIMLLoader;

implementation
  uses SysUtils,UVariables,ULogging;


  const max_content_size=20480;
  Procedure TAIMLLoader.TopicStart;
    begin
      _topic:=parser.CurAttr.Value('name');
    end;
  Procedure TAIMLLoader.TopicEnd;
    begin
      _topic:='*';
    end;
  Procedure TAIMLLoader.That;
    begin
      _That:=parser.CurContent;
    end;
  Procedure TAImlLoader.CategoryStart;
    begin
      _pattern:='';
      _that:='';
      _template:='';
    end;
  Procedure TAImlLoader.CategoryEnd;
    begin
      if _pattern='' then _pattern:='*';
      if _that='' then _that:='*';
      PatternMatcher.add(_pattern+' <that> '+_that+' <topic> '+_topic,_template);

    end;
  function TAIMLLoader.PatternBotElement:boolean;
    var
      prop:string;
    begin
      prop:=Memory.getProp(parser.CurAttr.Value('name'));
      if prop='' then
        result:=false
      else begin
        _Pattern:=_pattern+' '+Prop;
        result:=true;
      end;
    end;
  function TAIMLLoader.PatternElement:boolean;
    begin
      _pattern:='';
      result:=true;
      while (result)and(Parser.Scan) do begin
        case Parser.CurPartType of
          ptContent:_pattern:=_pattern+' '+Parser.CurContent;
          ptEmptyTag: if (Parser.CurName='bot') then
                        result:=PAtternBotElement
                      else
                        result:=false;
          ptEndTag: if (Parser.CurName='pattern') then break
                    else result:=false;
          ptComment:;
        else
          result:=false;
        end;
      end;
    end;
  function TAIMLLoader.ThatElement:boolean;
    begin
      _that:='';
      result:=true;
      while (result)and(Parser.Scan)  do begin
        case Parser.CurPartType of
          ptContent:_that:=_that+' '+Parser.CurContent;
          ptEndTag: if (Parser.CurName='that') then break
                    else result:=false;
          ptComment:;
        else
          result:=false;
        end;
      end;
      if _that='' then _that:='*';
    end;
  function TAIMLLoader.TemplateElement:boolean;
    var
      start:Pchar;
      done:boolean;
    begin
      _template:='';
      start:=Parser.CurFinal+1;
      done:=false;
      while (not done) and (parser.scan) do
        done:=(Parser.CurPartType=ptEndTag) and (Parser.CurName='template');
      if done then begin
        SetLength(_template,Parser.CurStart-start);
        _template:=StrLCopy(PCHar(_template),start,Parser.CurStart-start);
        result:=true;
      end else
        result:=false;
    end;
  function TAIMLLoader.CategoryElement:boolean;

    begin
      result:=true;
      _that:='*';
      while (result)and(parser.Scan) do
        case parser.CurPartType of
          ptStartTag:begin
            if parser.CurName='template' then result:=TemplateElement else
            if parser.CurName='pattern' then result:=PatternElement else
            if parser.CurName='that' then result:=ThatElement;
          end;
          ptEndTag: begin
            if parser.CurName='category' then break;
          end;
        end;
      if result then begin
        if _that='' then _that:='*';
        PatternMatcher.add(_pattern+' <that> '+_that+' <topic> '+_topic,_template);
      end else
        while not ((Parser.CurPartType=ptEndTag) and (Parser.CurName='category')) do
          parser.Scan;
      if (PatternMatcher._count mod 5000)=0 then log.Log('aimlloader',Inttostr(PatternMatcher._count)+' 个类别...');
    end;
  function TAIMLLoader.AIMLElement:boolean;
    begin
      _topic:='*';
      result:=true;
      while (result)and(parser.Scan) do
        case parser.CurPartType of
          ptStartTag:begin
            if parser.CurName='category' then CategoryElement else
            if parser.CurName='topic' then Topicstart;
          end;
          ptEndTag: begin
            if parser.CurName='topic' then TopicEnd else
            if parser.CurName='aiml' then break;
          end;
        end;
    end;
  procedure TAIMLLoader.load(filename:string);
    var
      search:TSearchRec;
      dir:string;
      name:string;
      i:integer;
    begin
      parser:=TXmlParser.Create;
      parser.Normalize:=true;
      for i:=1 to length(filename) do
        if filename[i]='/' then filename[i]:='\';
      dir:=ExtractFilePath(filename);

      if findfirst(filename,0,search) =0 then
        repeat
          name:=dir+Search.Name;
          if not FileExists(name) then begin
            log.log('aimlloader','警告： '+Name+' 不存在。');
            continue;
          end;
          log.log('aimlloader','正在加载 '+Name);
          parser.LoadFromFile(Name);
          parser.startscan;
          while parser.Scan do
            case parser.CurPartType of
              ptStartTag:if parser.CurName='aiml' then AIMLElement;
            end;
          parser.clear;
        until FindNext(search)<>0;
      FindClose(search);
      parser.free;
      Log.log('aimlloader','完成，共加载 '+InttoStr(PatternMatcher._count)+' 个种类。');
    end;
end.

-----------------------------------------------------------------------------------
unit UVariables;
{变量处理}

interface
uses classes,UPatternMatcher;
type
  TMemory=class
    vars:TStringList;
    props:TStringList;
    bot_ID:string;   
    //Match:TMatch;
    constructor create;
    destructor Destroy; override;
    procedure setVar(name,value:string); overload; virtual;
    procedure setVar(name:string;index:integer;value:string); overload; virtual;
    function getVar(name:string):string; overload; virtual;
    function getVar(name:string;index:integer):string; overload; virtual;
    procedure ClearVars;


    function getProp(name:string):string;
    procedure setProp(name,value:string);

    Procedure Save;
    Procedure Load;

    function unDelimitChinese(s:string):string;
  end;
var Memory:Tmemory;
implementation
uses sysutils,ULogging;
  constructor TMemory.Create;
    begin
      inherited Create;
      vars:=TStringList.Create;
      vars.Duplicates:=dupError;
      vars.Sorted:=False;
      Props:=TStringList.Create;
      Props.Duplicates:=dupError;
      Props.Sorted:=False;
    end;
  destructor TMemory.Destroy;
    begin
      Save;
      vars.Free;
      inherited Destroy;
    end;

  function TMemory.unDelimitChinese(s:string):string;
    //中文字符处理完后的去空格处理
    var
      i:longint;
    begin
      result:=s;
      i:=1;
      while i<length(result)-1 do
        begin
          if ord(result[i]) in [$81..$FF] then //GB 码
            if result[i+2]=' ' then
              begin
                delete(result,i+2,1);
                dec(i);
              end
            else
              inc(i);
          inc(i);
        end;
      result:=Trim(result);
    end;

  procedure TMemory.setVar(name,value:string);
    //设置变量值
    begin
      setVar(name,0,value);