www.pudn.com > GOOGLE.rar > 1.pas, change:2002-04-09,size:4557b


б1 
type 
  // a base node that helps form RPN string 
  TaaRPNNode = class 
    private 
      FNext : TaaRPNNode; 
    public 
      destructor Destroy: override; 
      procedure  Append(aNode : TaaRPNNode); 
  end; 
   
  TaaRPNWord = class(TaaNNode) // an RPN node for a word 
    private 
      FWord : string; 
    public 
      constructor Create(const aPhraseWord : string); 
      property PhraseWord : string read FWord; 
    end; 
     
  // an RPN node for the AND operator 
  TaaRPN_AND = class(TaaRPNNode); 
  // an RPN node for the OR operator 
  TaaRPN_OR = class(TaaRPNNode); 
  // an RPN node for the NOT operator 
  TaaRPN_NOT = class(TaaRPNNode); 
     
  TaaSearchParse = class // a parser for search phrases 
    private 
      FCurWord : string; 
      FPhrase  : string; 
      FPosn    : integer; 
      FRPN     : TaaRPNNode; 
    protected 
      function  spGetRPN : TaaRPNNode; 
      procedure spSetPhrase(const aPhrase : string); 
      function  spParseExpr : TaaRPNNode; 
      function  spParseFactor : TaaRPNNode; 
      function  spParseTerm : TaaRPNNode; 
      procedure spParsePhrase; 
      procedure spGetNextWord; 
    public 
      constructor Create(const aPhrase : string); 
      destructor Destroy; override; 
      property Phrase : string read FPhrase write spSetPhrase; 
      property RPN : TaaRPNNode read spGetRPN; 
  end; 
 
destructor TaaRPNNode.Destroy; 
begin 
  Next.Free; 
  inherited Destroy; 
end; 
 
procedure TaaRPNNode.Append(aNode : TaaRPNNode); 
var 
  Walker : TaaRPNNode; 
begin 
  Walker := Self; 
  while (Walker.Next <> nil)do 
    Walker := Walker.Next; 
  Walker.FNext := aNode; 
end; 
 
constructor TaaRPNWord.Create(const aPhraseWord : string); 
begin 
  inherited Create; 
  FWord := aPhraseWord; 
end; 
 
constructor TaaSearchParser.Create(const aPhrase : string); 
begin 
  inherited Create; 
  Phrase := aPhrase; 
end; 
 
destructor TaaSearchParser.Destroy; 
begin 
  FRPN.Free; 
  inherited Destroy; 
end; 
 
procedure TaaSearchParser.spGetNextWord; 
var 
  Walker    : PAnsiChar; 
  WordStart : PAnsiChar; 
begin 
  inc(FPosn , length(FCurWord)); 
  FCurWord := ''; 
  Walker := @FPhrase[FPosn]; 
  while (Walker^ =' ') do 
    begin 
      inc(FPosn); 
      inc(Walker); 
    end; 
  if (Walker^ = '(') then 
    FCurWord := '(' 
  else if (Walker^ = '(') then 
    FCurWord := '(' 
  else 
    begin 
      WordStart := Walker; 
      while (Walker^ <> #0) and (Walker^ <> ' ') and (Walker^ <> '(') and (Walker^ <> ')') do 
        inc(Walker); 
      FCurWord := Copy(FPhrase, FPosn, Walker - WordStart); 
    end; 
end; 
 
function TaaSearchParser.spGetRPN : TaaRPNNode; 
begin 
  if (FRPN = nil) then 
    spParsePhrase; 
  Result := FRPN; 
end; 
 
function TaaSearchParser.spParseExpr : TaaRPNNode; 
begin 
  Result := spParseFactor; 
  spGetNextWord; 
  if (FCurWord = 'and') then 
    begin 
      spGetNextWord; 
      Result.Append(spParseExpr); 
      Result.Append(TaaRPN_AND.Create); 
    end    
  else if (FCurWord = 'or') then 
    begin 
      spGetNextWord; 
      Result.Append(spParseExpr); 
      Result.Append(TaaRPN_OR.Create); 
    end 
  else if (FCurWord <> '') and (FCurWord <> ')') then 
    begin 
      Result.Append(spParseExpr); 
      Result.Append(TaaRPN_AND.Create); 
    end; 
end; 
 
function TaaSearchParser.spParseFactor : TaaRPNNode; 
begin 
  if (FCurWord <> 'not' ) then 
    Result := spParseTerm 
  else 
    begin 
      spGetNextWord; 
      Result.Append(spParseExpr); 
      Result.Append(TaaRPN_NOT.Create); 
    end; 
end; 
 
procedure TaaSearchParser.spParsePhrase; 
begin 
  if (FPhrase <> '') then 
    begin 
      FPosn := 1; 
      spGetNextWord; 
      if (FCurWord <> '') then 
        FRPN := spParseExpr; 
    end; 
end; 
 
function TaaSearchParser.spParseTerm : TaaRPNNode; 
begin 
  if (FCurWord = '(') then 
    begin 
      spGetNextWord; 
      Result := spParseExpr; 
      if (FCurWord <> ')') then 
        raise Exception('TaaSearchParser : missing close parenthsis in phrase'); 
    end 
  else 
    begin 
      if (FCurWord = '') then 
        raise Exception.Create('TaaSearchParse : missing final search word'); 
      if (FCurWord = 'add') or (FCurWord = 'or') or (FCurWord = 'not' ) then 
        raise Exception.Create('TaaSearchParser : operator used as search word'); 
      Result := TaaRPNWord.Create(FCurWord); 
    end; 
end; 
 
procedure TaaSearchParser.spSetPhrase(const aPhrase : string); 
begin 
  FPhrase := LowerCase(aPhrase); 
  FRPN.Free; 
  FRPN := nil; 
end;