聪明二休-程序结构.txt

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

    end;
  procedure TMemory.setVar(name:string;index:integer;value:string);
    //设置带索引的变量值
    begin
      name:=name+'['+inttostr(index)+']';
      vars.values[name]:=unDelimitChinese(value);  //变量存入前应进行中文去空格处理
    end;

  function TMemory.getVar(name:string):string;
    //获取变量值
    begin
      result:=getVar(name,0);  //索引默认为0
    end;
  function TMemory.getVar(name:string;index:integer):string;
    //获取带索引的变量值
    begin
      name:=name+'['+inttostr(index)+']';
      result:=vars.Values[name];
    end;
  procedure TMemory.setprop(name,value:string);
    begin
      props.values[name]:=value;
    end;
  function TMemory.getProp(name:string):string;
    begin
      result:=props.Values[name];
    end;
  procedure TMemory.ClearVars;
    //清除所有变量
    begin
      vars.Clear;
    end;

  Procedure TMemory.Save;
    //保存所有变量
    var filename:string;
    begin
      filename:=bot_id+'.variables';
      Log.Log('variables','正在保存机器人 '+bot_id+' 的变量');
      try
        Vars.SaveToFile(filename);
      except
        Log.Log('variables','错误：不能保存变量');
      end;
    end;
  Procedure TMemory.Load;
    //加载变量
    var
      filename:string;
    begin
      filename:=bot_id+'.variables';
      if fileexists(filename) then begin  //文件存在则加载
        Log.Log('variables','正在加载机器人 '+bot_id+' 的变量');
        Vars.LoadFromFile(filename);
      end;
    end;

end.

----------------------------------------------------------------------------
unit UTemplateProcessor;
{模板处理}

interface
uses
   LibXMLParser,UPatternMatcher,classes,UElementFactory;
type
  TTemplateProcessor=class
    function Process(Match:Tmatch):string;
  end;

  function ProcessContents(Match:TMatch;Parser:TXMLParser):string;
var
  TemplateProcessor:TTemplateProcessor;
implementation
uses
  UVariables,SysUtils,UUtils;

  function ProcessContents(Match:TMatch;Parser:TXMLParser):string;
    var
      name:string;
    begin
     result:='';
     if parser.CurPartType=ptEmptyTag then exit;
     name:=Parser.CurName;

     while parser.Scan do begin
       if (parser.CurPartType=ptendTag) and (parser.CurName=name) then
         break
       else
       case parser.CurPartType of
         ptContent:result:=result+GetElementContents(parser);
         ptEmptyTag,
         ptStartTag,
         ptEndTag:begin
                    if parser.CurStart[-1] in CWhitespace then result:=result+' ';         
                    result:=result+ElementFactory.get(parser.CurName).Process(Match,Parser);
                  end;
       end
     end;
    end;

function TTEmplateProcessor.Process(match:TMatch):string;
  var
    Parser:TXMLParser;
//Added program begin
    i:integer;
//Added program end
  begin
    result:='';
    if match._template='' then exit;
    Parser:=TXMLParser.Create;
    Parser.LoadFromBuffer(PChar(match._template));
    Parser.StartScan;
     while parser.Scan do begin
       case parser.CurPartType of
        ptContent:result:=result+GetElementContents(parser);
        ptEmptyTag,
        ptStartTag,
        ptEndTag:begin
                   if (parser.CurStart<>Parser.DocBuffer) and (parser.CurStart[-1] in CWhitespace) then result:=result+' ';
                   result:=result+ElementFactory.get(parser.CurName).Process(Match,Parser);
                 end;
      end
    end;
    Parser.Free;
    result:=ConvertWs(result,true);

//中文字符处理完后的去空格处理
    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;
end.

------------------------------------------------------------------------------
unit UElementFactory;
{元素工厂}

interface
uses LibXMLParser,UPatternMatcher,classes;
type
  {abstract base class for all template elements}
  TTemplateElement=class
    constructor Create;
    procedure Register;virtual;abstract;
    function Process(Match:TMatch;Parser:TXMLParser):string;virtual;abstract;
  end;

  {this is a container class that returns an instance of a template processing element}
  TElementFactory=class
    _Elements:TStringList;
    _default:TTemplateElement;
    constructor Create;
    destructor Destroy; override;
    procedure register(name:string;Element:TTemplateElement);

    procedure registerdefault(element:TTemplateElement);
    function get(name:string):TTEmplateElement;
  end;



var
  ElementFactory:TElementFactory;

implementation

  constructor TTemplateElement.Create;
    //元素对象-构造函数
    begin
      inherited create;
      register;
    end;
  constructor TElementFactory.Create;
    //元素工厂-构造函数
    begin
      _Elements:=TStringlist.Create;
      _Elements.Sorted:=True;
    end;
  Destructor TElementFactory.Destroy;
    //元素工厂-析构函数
    var
      i:integer;
      j:integer;
      this:TObject;
    begin
      for i:=0 to _Elements.Count-1 do
        if assigned(_Elements.Objects[i]) then begin {frees the current instance, and removes all references to it}
          This:=_Elements.Objects[i];
          _Elements.Objects[i].Free;
          for j:=i+1 to _Elements.Count-1 do
            if _Elements.Objects[j]=this then _Elements.Objects[j]:=nil;
        end;
      _Elements.Free;
      inherited destroy;
    end;
  Procedure TElementFactory.register(name:string;Element:TTemplateElement);
    //注册一个元素对象
    begin
      _Elements.AddObject(name,Element);
    end;
  Procedure TElementFactory.registerdefault(Element:TTemplateElement);
    //注册一个元素对象，使其成为默认对象
    begin
      _default:=Element;
    end;
  function TElementFactory.get(name:string):TTEmplateElement;
    //输入一个元素名，返回名字代表的元素对象
    var
      i:integer;
    begin
      if _Elements.Find(name,i) then
        result:=_elements.Objects[i] as TTEmplateElement  //返回找到的对象
      else  //找不到该对象，则返回默认对象
        result:=_default;
    end;
begin
  if not assigned(ElementFactory) then ElementFactory:=TElementFactory.Create;
end.

-----------------------------------------------------------------------------
unit UElements;
{所有在模板中支持的元素对象}

interface
implementation
uses
  UElementFActory,UPatternMatcher,UVariables,UAIMLLoader,UTemplateProcessor,
  LibXMLParser,SysUtils,classes,UUtils;

type
  TBotElement=class(TTEmplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;

type
  TxStarElement=class(TTEmplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;
type
  TGetElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;
type
  TSetElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;

type
  TDefaultElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;

type
  TLearnElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;
type
  TSrElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;

type
  TThinkElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;

type
  TSraiElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;

type
  TRandomElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;

type
  TBrElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;

type
  TConditionElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    function blockCondition(variable,value:string;Match:TMatch;Parser:TXMLParser):string;
    function blockSwitch(variable:string;Match:TMatch;Parser:TXMLParser):string;
    //function blockMulti(Match:TMatch;Parser:TXMLParser):string;

    procedure register;override;
  end;
type
  TCaseElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;

type
  TThatElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;

type
  TVersionElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;

type
  TidElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;

type
  TSizeElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;

type
  TDateElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;

type
  TGossipElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;

type
  TInputElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;

type
  TSubstElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;

type
  TJScriptElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;

type
  TSystemElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;

type
  TforgetElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;


  function TSetElement.Process(Match:TMatch;Parser:TXMLParser):string;
    var
      name:string;
    begin
      name:=parser.CurAttr.Value('name');
      result:=ProcessContents(Match,Parser);
      result:=TrimWS(ConvertWs(result,true));
      Memory.setVar(name,result);
    end;
  procedure TSetElement.register;
    begin
      ElementFactory.register('set',self);
    end;

  function TBotElement.Process(Match:TMatch;Parser:TXMLParser):string;
    begin
      result:=Memory.getProp(parser.CurAttr.Value('name'));
    end;
  procedure TBotElement.register;
    begin
      ElementFactory.register('bot',Self);
    end;
  function TGetElement.Process(Match:TMatch;Parser:TXMLParser):string;
    begin
      result:=Memory.getVar(parser.CurAttr.Value('name'));
      if (Parser.CurPartType=ptEmptyTag) or
         (Parser.CurPartType=ptEndTag) then exit;
      if result<>'' then
        repeat until
          (not parser.Scan)or
          ((parser.CurPartType=ptEndTag)and
           (parser.CurName='get'))
      else
        result:=ProcessContents(Match,Parser);
    end;
  procedure TGetElement.register;
    begin
      ElementFactory.register('get',Self);
    end;

  function TxStarElement.Process(Match:TMatch;Parser:TXMLParser):string;
    //统配符(star)元素-处理
    var
      context:integer;
      index:string;
    begin
      if parser.CurPartType<>ptEndTag then begin
        if parser.CurName='star' then context:=0;
        if parser.CurName='thatstar' then context:=1;
        if parser.CurName='topicstar' then context:=2;
        index:=Parser.CurAttr.Value('index');