聪明二休-程序结构.txt

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

        if index='' then index:='1';  //默认为第一个
        result:=Match.get(context,strtoint(index)); //获得匹配的 star 值
        result:=TrimWS(result);
      end else
        result:='';
    end;
  procedure TxStarElement.register;
    //统配符(star)元素-注册
    begin
      ElementFactory.register('star',self);
      ElementFactory.register('thatstar',self);
      ElementFactory.register('topicstar',self);
    end;

  function TDefaultElement.Process(Match:TMatch;Parser:TXMLParser):string;
    begin
      SetLength(result,Parser.CurFinal-Parser.CurStart+1);
      result:=StrLCopy(PCHar(result),Parser.CurStart,Parser.CurFinal-Parser.CurStart+1);
    end;
  procedure TDefaultElement.register;
    begin
      ElementFactory.registerdefault(Self);
    end;

  function TLearnElement.Process(Match:TMatch;Parser:TXMLParser):string;
    begin
      result:='';
      if parser.CurPartType=ptEmptyTag then exit;
      result:=ProcessContents(Match,Parser);
      if not assigned(AIMLLoader) then AIMLLoader:=TAIMLLoader.Create;
      AIMLLoader.load(result);
    end;
  procedure TLearnElement.register;
    begin
      ElementFactory.register('learn',Self);
    end;

  function TSrElement.Process(Match:TMatch;Parser:TXMLParser):string;
    var
      temp:TMatch;
    begin
      temp:=PatternMatcher.Matchinput(Match.get(0,1));
      result:=TemplateProcessor.Process(temp);
      temp.free;
      if parser.curPartType=ptStartTag then
      while (parser.scan) and (parser.curparttype<>ptEndTag) and (parser.curName<>'sr') do;
    end;
  procedure TSrElement.register;
    begin
      ElementFactory.register('sr',Self);
    end;

  function TThinkElement.Process(Match:TMatch;Parser:TXMLParser):string;
    begin
      ProcessContents(Match,Parser);
      result:='';
    end;
  procedure TThinkElement.register;
    begin
      ElementFactory.register('think',Self);
    end;
  function TSraiElement.Process(Match:TMatch;Parser:TXMLParser):string;
    var
      temp:TMatch;
    begin
      result:=ProcessContents(Match,Parser);
      if result='' then begin
        temp:=PatternMatcher.Matchinput(Match.get(0,1));
        result:=TemplateProcessor.Process(temp);
        temp.free;
      end else begin
        temp:=PatternMatcher.Matchinput(result);
        result:=TemplateProcessor.Process(temp);
        temp.free;
      end;
    end;
  procedure TSraiElement.register;
    begin
      ElementFactory.register('srai',Self);
    end;

  function TRandomElement.Process(Match:TMatch;Parser:TXMLParser):string;
    var
      Options:Tlist;
      //Start:PChar;
      continue:PChar;
      //i:integer;
    begin
      Options:=Tlist.Create;
      result:='';
      While parser.Scan do begin
        case parser.CurPartType of
          ptStartTag:if (parser.CurName='li') then begin
                         Options.Add(Parser.CurFinal);
                         SkipElement(Parser);
                     end;
          ptEndTag:if (parser.CurName='random') then break;
        end;
      end;
      continue:=parser.curfinal;

      Parser.CurFinal:=Options[random(options.count)];
      Parser.CurName:='li';
      result:=ProcessContents(Match,Parser);
      Options.Free;
      parser.CurFinal:=Continue;
    end;
  procedure TRandomElement.register;
    begin
      Randomize;
      ElementFactory.register('random',Self);
    end;

  function TConditionElement.blockCondition(variable,value:string;Match:TMatch;Parser:TXMLParser):string;
    //单条件的条件(condition)元素-处理
    begin
      if AnsiCompareStr(Memory.getVar(variable),value)=0 then begin
        result:=ProcessContents(Match,Parser);
      end else begin
        result:='';
        SkipElement(Parser);
      end;
    end;
  function TConditionElement.blockSwitch(variable:string;Match:TMatch;Parser:TXMLParser):string;
    //多条件的条件(condition)元素-处理
    var
      curval:string;
      curvar:string;
      defaultitem:boolean;
      nvItem:boolean; {<li name="xx" value=""></li>}
      vItem:boolean;  {<li name="xx" value=""></li>}
    begin
      result:='';
      While (Parser.Scan) do begin
        case parser.CurPartType of
          ptStartTag,
          ptEmptyTag:if parser.CurName='li' then begin
                       curval:=Parser.CurAttr.Value('value');
                       curvar:=Parser.CurAttr.Value('name');
                       defaultItem:=(Parser.CurAttr.Count= 0);
                       nvItem:=(Parser.CurAttr.Count= 2)and AnsiSameStr(Memory.getVar(curvar),curval);
                       vItem:=(variable<>'') and AnsiSameStr(Memory.getVar(variable),curval);
                       if (defaultItem or nvItem or vItem)
                       then begin
                         result:=ProcessContents(Match,Parser);
                         SkipElement('condition',parser);
                         break;
                       end else
                         SkipElement(parser);
                     end;
        end;
      end;
    end;
  function TConditionElement.Process(Match:TMatch;Parser:TXMLParser):string;
    //条件(condition)元素-处理
    var
      mainval:string;
      mainvar:string;
    begin
      mainval:=Parser.CurAttr.Value('value');
      mainvar:=Parser.CurAttr.Value('name');
      if (mainvar<>'') and (Parser.CurAttr.Node('value')<>nil) then begin
        result:=blockCondition(mainvar,mainval,Match,Parser);
      end else if (mainval='') then begin
        result:=blockSwitch(mainvar,Match,Parser);
      end;
    end;
  procedure TConditionElement.register;
    //条件(condition)元素-注册
    begin
      ElementFactory.register('condition',Self);
    end;
  function TBrElement.Process(Match:TMatch;Parser:TXMLParser):string;
    begin
      result:=' ';
    end;
  procedure TBrElement.register;
    begin
      ElementFactory.register('br',Self);
    end;

  function TCaseElement.Process(Match:TMatch;Parser:TXMLParser):string;
    //大小写(case)元素-处理
    var
      specificElement:string;
      upstr:string;
      i:integer;
    begin
      result:='';
      specificElement:=Parser.Curname;
      result:=ProcessContents(Match,Parser);
      result:=convertWS(result,true);
      if SpecificElement='uppercase' then
        result:=AnsiUpperCase(result)
      else if SpecificElement='lowercase' then
        result:=AnsiLowerCase(result)
      else if (SpecificElement='formal') and (result<>'')then begin
        upstr:=AnsiUpperCase(result);
        result[1]:=upstr[1];
        for i:=1 to length(result)-1 do
          if result[i]=' ' then
            result[i+1]:=upstr[i+1];
      end else if SpecificElement='sentence' then
        result[1]:=AnsiUpperCase(result)[1];
    end;
  procedure TCaseElement.register;
    //大小写(case)元素-注册
    begin
      ElementFactory.register('uppercase',Self);
      ElementFactory.register('lowercase',Self);
      ElementFactory.register('formal',Self);
      ElementFactory.register('sentence',Self);
    end;

  function TThatElement.Process(Match:TMatch;Parser:TXMLParser):string;
    //上次(that)元素-处理
    var
      thisTag:string;
    begin
      ThisTag:=Parser.CurName;
      if ThisTag='botsaid' then thistag:='that';
      if Parser.CurAttr.Count<>0 then result :=''
      else if ThisTag='that' then
        result:=Memory.getVar('that')
      else if ThisTag='justbeforethat' then
        result:=Memory.getVar('that',1);

      SkipElement(parser);
    end;
  procedure TThatElement.register;
    //上次(that)元素-注册
    begin
      ElementFactory.register('that',Self);
      ElementFactory.register('justbeforethat',Self);
      ElementFactory.register('botsaid',Self);
    end;

  function TVersionElement.Process(Match:TMatch;Parser:TXMLParser):string;
    //版本(version)元素-处理
    begin
      result:='Operator Chat v0.2';
      SkipElement(Parser);
    end;
  procedure TVersionElement.register;
    //版本(version)元素-注册
    begin
      ElementFactory.register('version',Self);
      ElementFactory.register('getversion',Self);
    end;

  function TIdElement.Process(Match:TMatch;Parser:TXMLParser):string;
    begin
      result:='0';
      SkipElement(Parser);
    end;
  procedure TIdElement.register;
    begin
      ElementFactory.register('id',Self);
      ElementFactory.register('get_ip',Self);
    end;

  function TSizeElement.Process(Match:TMatch;Parser:TXMLParser):string;
    begin
      result:=inttostr(PatternMatcher._count);
      SkipElement(Parser);
    end;
  procedure TSizeElement.register;
    begin
      ElementFactory.register('size',Self);
      ElementFactory.register('getsize',Self);
    end;

  function TDateElement.Process(Match:TMatch;Parser:TXMLParser):string;
    //日期(date)元素-处理
    begin
      result:=DatetoStr(now);  //转换日期为字符串
      skipElement(parser);
    end;
  procedure TDateElement.register;
    //日期(date)元素-注册
    begin
      ElementFactory.register('date',Self);
    end;

  function TGossipElement.Process(Match:TMatch;Parser:TXMLParser):string;
    begin
      result:=ProcessContents(Match,Parser);
      WrFile('gossip.log',result);
    end;
  procedure TGossipElement.register;
    begin
      ElementFactory.register('gossip',Self);
    end;

  function TInputElement.Process(Match:TMatch;Parser:TXMLParser):string;
    var
      thisTag:string;
      i:integer;
      si:string;
    begin
      ThisTag:=Parser.CurName;
      SkipElement(Parser);

      if ThisTag='input' then begin
        si:=Parser.CurAttr.Value('index');
        if si<>'' then
          i:=strtoint(si)-1
        else
          i:=0;
        result:=Memory.getVar('input',i)
      end else if ThisTag='justthat' then
        result:=Memory.getVar('input',1)
      else if ThisTag='beforethat' then
        result:=Memory.getVar('input',2);

    end;
  procedure TInputElement.register;
    begin
      ElementFactory.register('input',Self);
      ElementFactory.register('justthat',Self);
      ElementFactory.register('beforethat',Self);
    end;
  function TSubstElement.Process(Match:TMatch;Parser:TXMLParser):string;
    begin
      if parser.CurPartType=ptEmptyTag then
        result:=Match.get(0,1)
      else
        result:='';
    end;
  procedure TSubstElement.register;
    begin
      ElementFactory.register('person',Self);
      ElementFactory.register('person2',Self);
      ElementFactory.register('gender',Self);
    end;
  function TJScriptElement.Process(Match:TMatch;Parser:TXMLParser):string;
    begin
      result:=Parser.CurAttr.Value('alt');
      SkipElement(parser);
    end;
  procedure TJScriptElement.register;
    begin
      ElementFactory.register('javascript',Self);
    end;
  function TSystemElement.Process(Match:TMatch;Parser:TXMLParser):string;
    begin
      result:=Parser.CurAttr.Value('alt');;
      if result<>'' then SkipElement(parser);
    end;
  procedure TSystemElement.register;
    begin
      ElementFactory.register('system',Self);
    end;

  function TForgetElement.Process(Match:TMatch;Parser:TXMLParser):string;
    //忘记(forget)标签-处理
    begin
      result:=ProcessContents(Match,Parser);
      if result='' then
        begin
          SkipElement(parser);
          Memory.ClearVars;
        end
      else
        Memory.setVar(result,' ');
    end;
  procedure TForgetElement.register;
    //忘记(forget)标签-注册
    begin
      ElementFactory.register('forget',Self);
    end;

begin
//创建所有的元素对象
  if not assigned(ElementFactory) then ElementFactory:=TElementFactory.Create;
  TBotElement.Create;
  TDefaultElement.Create;
  TGetElement.Create;
  TxStarElement.Create;
  TLearnElement.Create;
  TSetElement.Create;
  TSrElement.Create;
  TThinkElement.Create;
  TSraiElement.Create;
  TRandomElement.Create;
  TConditionElement.Create;
  TBrElement.Create;
  TCaseElement.Create;
  TThatElement.Create;
  TVersionElement.Create;
  TIdElement.Create;
  TSizeElement.Create;
  TDateElement.Create;
  TGossipElement.Create;
  TInputElement.Create;
  TsubstElement.Create;
  TJscriptElement.Create;
  TsystemElement.Create;

  TForgetElement.Create;

end.

----------------------------------------------------------------------------
unit UChat;
{用户界面}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls, ExtCtrls, UBotloader,UUtils, XPMan;

type
  TChat = class(TForm)
    RichEdit1: TRichEdit;
    Panel1: TPanel;
    Button1: TButton;
    Memo1: TMemo;
    XPManifest1: TXPManifest;
    // the 'main' method, sends user input for matching & processing the result
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure RichEdit1MouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
  private
    _LoaderThread:TBotLoaderThread;
    _SentenceSplitter:TStringTokenizer;
    Procedure Add(s:string);
    { Private declarations }
  public
    Procedure AddUserInput(s:string);
    Procedure AddBotReply(s:string);
    Procedure AddLogMessage(s:string);
    { Public declarations }
  end;

var