谁做过搜索引擎，请教

Question

在HTML中用替换
如把"关键字"替换为"<font color=CC0033>关键字</font>"

Answer 1

SearchStr='关键字';
NewStr='<font color=CC0033>关键字</font>';
Repeat
  Place := pos(SearchStr,MyString);
  if place > 0 then begin
    Delete(MyString, Place, Length(SearchStr));
    Insert(NewStr,MyString, Place);
  end;
until place = 0;

Answer 2

恕我用小儿科这个词形容
我如果查找“font”，会怎么样？
我如果查找“fon”会怎么样
哈，全世界会的不多

Answer 3

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;

Answer 4

fuction IsDelimiter(aCh : Char; const aDelims : string) : boolean;
var
  i : integer;
begin
  Result := true;
  if (aCh > ' ') then 
    begin
      for i := 1 to length(aDelims) do
        if (aDellims[i] = aCh then Exit;
      Result := false;
    end;
end;procedure AAParseWords(aText : TStream; const aDelims : string; aAction : TaaWordParseAction);
const
  BufSize = 16 * 1024;
var
  State   : (ScanWord , ScanOther);
  Buffer  : PChar;
  BufPos  : PChar;
  BufLeft : integer;
  Ch      : char;
  StopNow : boolean;
  CharQ   : TaaCharQueue;
begin
  //perpare for the memory allocations
  Buffer := nil;
  CharQ := nil;
  try
    //create a character queue with which to bulid words
    CharQ := TaaCharQueue.Create;
    //allocate a buffer to hold data from the stream
    GetMem(Buffer , BufferSize);
    //force the stream to be read first time through
    BufLeft := 1;
    BufPos := Buffer;
    //we'll start in the scanning delimiter state
    State := ScanOther;
    StopNow := false;
    //continue until there is no more data in the stream
    while (not StopNow) and (BufLeft <> 0) do
      begin
        //advance the buffer variables (reading more data if needed)
        dec(BufLeft);
        if (BufLeft <> 0) then
          inc(BufPos)
        else
          begin
            BufLeft := aText.Read(Buffer^ , BufSize);
            BufPos := Buffer;
          end;
        //get the next character
        Ch := BufPos^;
        //process the character according to the state
        case State of
          ScanWord :
            begin
              if IsDelimiter(Ch , aDelims) then 
                begin
                  aAction(CharQ.AsString , StopNow);
                  State := ScanOther;
                end
              else
                CharQ.Append(Ch);
            end;
          ScanOther :
            begin
              if not IsDelimiter(Ch , aDelims) then
                begin
                  CharQ.Clear;
                  CharQ.Append(Ch);
                  State := ScanWord;
                end;
            end;
        end;
      end;
  finally
    if (Buffer <> nil) then
      FreeMem(Buffer);
    CharQ.Free;
  end;
end;

Answer 5

type
  TRLEData = packed record
    rdLen : byte;
    rdVal : byte;
  end;
  TRLEPacker = class
    private
      FRLEData : array[0..7] of TRLEData;
      FRLEInx  : integer;
      FBuffer  : PByteArray;
      FBufInx  : integer;
    protected
      procedure rpWriteEncoding(aCount : integer);
    public
      constructoe Create(aBufSize : integer);
      destructor  Destroy : override;
      procedure   Add(aLen : byte; aValue : byte);
      procedure   MarkComplete;
      procedure   CopyBuffer(var aDest);
      property    BufferLen : integer read FBufInx;
    end;constructor TRLEPacker.Create(aBufSize : integer);
begin
  inherited Create;
  GetMem(FBuffer , aBufSize);
end;destructor TRLEPacker.Destroy;
begin
  if (FBuffer <> nil) then
    FreeMem(FBuffer);
  inherited Destroy;
end;procedure TRLEPacker.CopyBuffer(var aDest);
begin
  Move(FBuffer^ , aDest, FBufInx);
end;procedure TRLEPacker.Add(aLen : byte; aAalue : byte);
begin
  FRLEDara[FRLEInx].rdLen := aLen;
  FRLEData[FRLEInx].rdVal := aValue;
  inc(FRLEInx);
    if (FRLEInx = 8 ) then
      rpWriteEncoding(8);
end;procedure TRLEPacker.MarkComplete;
begin
  {add the sentinel to indicate end-off-compressed-data(a code for a length of zerodoes this)}
  Add(0,0);
  {write out any final encoding}
  if (FRLEInx <> 0) then
    rpWriteEncoding(FRLEInx);
end;procedure TRLEPacker.rpWriteEncoding(aCount : integer);
var
  i : integer;
  ControlByte : byte;
begin
  {initialize the control byte}
  ControlByte := 0;
  {for all the encodings, set the relevant bit of the control byte if a run, leave it clear otherwise (note: the end-of-data sentinel has a length of zero and this code treats it as an actual length)}
  for i := 0 to pred(aCount) do 
    begin
      ControlByte := ControlByte shl 1;
      if (FRLEData[i].rdLen <> 1) then inc(ControlByte);
    end;
  {if the number of encoding is less than 8, set the rest of the bits as clear}
  if (aCount <> 8) then
    for i := aCount to 7 do
      ControlByte := ControlByte shl 1;
  {write out the control byte}
  FBuffer^[FBufInx] := ControlByte;
  inc(FBufInx);
  {write out the encodings, either as run length followed by the byte or as the byte itself if the runlength were 1}
  for i := 0 to pred(aCount) do 
    begin
      case FRLEData[i].rdLen of
        0 : begin
              FBuffer^[FBufInx] := 0;
              inc(FBufInx);
            end;
        1 : begin
              FBuffer^[FBufInx[ := FRLEData[i].rdVal;
              inc(FBufInx);
            end;
        else  {any other value :2..255}
            FBuffer^[FBufInx] := FRLEData[i].rdLen;
            inc(FBufInx);
            FBuffer^[FBufInx] := FRLEData[i].rdVal;
            inc(FBufInx);
      end;
    end;
  FRLEInx := 0;
end;procedure TaaBitSet.bsPack;
var
  i      : integer;
  B      : byte;
  PrevB  : byte;
  RunLEn : byte;
  PAcker : TRLEPacker;
begin
  {allocate a packer object with a buffer big enough for the worst case, in which all runs are of length one—that is, packing will grow the data by 1 byte for each 8 unapcked bytes, plus one byte over for the sentinel}
  Packer := TRLEPacker.Create(FBitArraySize + ((FBitArraysize + 8) div 8));
  try
    {set it up so previous byte is the first byte and current run length is zero: s loop code easier}
    PrevB := FBitArray^[0];
    RunLen := 0;
    {process the rest of the bytes}
    for i := 0 to pred(FBitArraySize) do
      begin
        {get the next byte}
        B := FBitArray^[i];
        {if it is different from the previous byte, close off the previous run and start a new one}
        if (B <> PrevB) then 
          begin
            Packer.Add(RunLen , PrevB);
            PrevB := B;
            RunLen := 1;
          end
        {otherwise, continue this run}
        else
          begin
            {if we've already reached 255 bytes in this run before adding this byte, close it off and start a new one}
            if (RunLen = 255) then
              begin
                Packer.Add(RunLen , PrevB);
                RunLen := 0;
              end;
            inc(RunLen);
          end;
      end;
    {close off the final run}
    Packer.Add(RunLen , PrevB);
    { the packer object as being complete (this adds the sentinel and calculates the compressed buffer size}
    Packer.MarkComplete;
    {reallocate our buffer and copy over the compressed data}
    FBitArraySize := PAcker.BufferLen;
    ReallocMem(FBitArray , FBitArraySize);
    Packer.CopyBuffer(FBitArray^);
    FPacked := ture;
  finally
    Packer.Free;
  end;
end;procedure TaaBitSet.bsUnpack;
var
  i      : integer;
  Buf    : PButeArray;
  RunLen : integer;
  InInx  : integer;
  OutInx : integer;
  Done   : boolean;
  Value  : byte;
  Mask   : byte;
  ControlByte : byte;
begin
  {allocate output buffer large enough to hold all the bits}
  GetMem(Buf , (FBitCount + 7) div 8);
  try
    {initialize for the loop}
    Done := false;
    InInx := 0;
    OutInx := 0;
    {continue unpacking until the end of compressed data is found}
    repeat
      {set the mask for the control byte}
      Mask := $80;
      {read the control byte}
      ControlByte := FBitArray^[InInx];
      inc(InInx);
      {repeat until all the bits in the control byte have been used}
      while (Mask <> 0) do
        begin
          {if the control bit says that the next byte is literal, copy it over to the output buffer}
          if ((ControlByte and Mask) = 0) then
            begin
              Buf^[OutInx] := FBitArray^[InInx];
              inc(OutInx);
              inc(InInx);
            end
          {otherwise it's an FLE instruction; get the run length and the value to copy and duplivate it {note: a runlength of zero indicates the end of the compressed data)}
          else
            begin
              RunLen := FBitArray^[InInx];
              inc(InInx);
              if (RunLen = 0) then 
                begin
                  Done := true;
                  Break;
                end
              else
                begin
                  Value := FBitArray^[InInx];
                  inc(InInx);
                  for i := 1 to RunLen do
                    begin
                      Buf^[OutInx] := Value;
                      inc(OutInx);
                    end;
                end;
            end;
          {set mask to get the next bit} 
          Mask L= Mask shr 1;
        end;
      until Done;
      {throw away the old packed buffer, and set it (and other fields) for the new unpacked one}
      FreeMem(FBitArray);
      FBitArray := Buf;
      FBitArraySize := (FBitCount + 7) div 8;
      FPacked := false;
    except
      FreeMem(Buf);
      raise;
    end;
end;

Answer 6

简直是一个弱智的问题，本来不想说的，我如果查找“font”，会怎么样？
我如果查找“fon”会怎么样
哈，全世界会的不多看到你这话实在气愤不过。好象你才在研究世界顶级的问题。查font又怎么样？查"<font>"处理起来都非常简单。

Answer 7

type
  TaaWordIndex = class
    private
      FTable : TaaHashTableLinear;
      FSaveStream : TStream;
    protected
      procedure wiSaveAction(const S : string; aObject : pointer; var sStopNow : boolean);
    public
      constructor Create(aWordCount : integer);
      destructor  Destroy : override;
      procedure   Add(const aWord : string; aBitSet : TaaBitSet);
      function    Find(const aWord : string) : TaaBitSet;
      procedure   LoadFromStream(aStream : TStream);
      procedure   LoadFromFile(const aFileName : string);
      procedure   StoreToStream(aStream : TStream);
      procedure   StoreToFile(const aFileName : string);
end;procedure DestroyTableEntry(const S : string; aObject : pointer);
begin
  TaaBitSet(aObject).Free;
end;constructor TaaWordIndex.Create(aWordCount : integer);
begin
  inherited Create;
  FTable := TaaHashTableLinear.Create(aWordCount , AAELFHash);
  FTable.OnDeleteString := DestroyTableEntry;
end;destructor TaaWordIndex.Destroy;
begin
  FTable.Free;
  inherited Destroy;
end;procedure TaaWordIndex.Add(const aWord : string; aBitSet : TaaBitSet);
begin
  FTable.Insert(aWord , aBitSet);
end;function TaaWordIndex.Find( const aWord : string) : TaaBitSet;
var
  Obj : pointer;
begin
  if not FTable.Find(aWord , Obj) then
    Result := nil
  else
    Result := TaaBitSet(Obj);
end;procedure TaaWordIndex.LoadFromStream(aStream : TStream);
var
  i         : integer;
  WordCount : integer;
  Len       : integer;
  S         : string;
  BitSet    : TaaBitSet;
begin
  aStream.ReadBuffer()WordCount , sizeof(WordCount));
  S := '';
  BitSet := nil;
  try
    for i:= 1 to WordCount do
      begin
        aStream.ReadBuffer(Len , sizeof(Len));
        SetLength(S , Len);
        aStream.ReadBuffer(S[1] , Len);
        BitSet := TaaBitSet.Create(1);
        BitSet.LoadFromStream(aStream);
        Add(S , BitSet);
        S := '';
        BitSet := nil;
      end;
    except
      s := '';
      BitSet.Free;
      raise;
    end;
end;procedure TaaWordIndexStoreToStream(aStream : TStream);
var
  WordCount : integer;
begin
  WordCount := FTable.Count;
  aStream.WriteBuffer(WordCount , sizeof(WordCount));
  FSaveStream := aStream;
  FTable.Iterate(wiSaveAction);
  FSaveStream := nil;
end;procedure TaaWordIndex.wiSaveAction(const S :string; aObject : pointer var aStopNow : boolean);
var
  Len : integer;
begin
  Len := length(S);
  FSaveStream.WriteBuffer(Len , sizeof(Len));
  FSaveStream.WriteBuffer(S[1] , Len);
  TaaBitSet(aObject).StoreToStream(FSaveStream);
end;
procedure TFrmSearch.btnSearchClick(Sender : Tobject);
var
  SerachPhrase : TaaSearchParser;
  RPNWalker    : TaaRPNNode;
  Stack        : TBitSetStack;
  BS1          : TaaBitSet;
  BS2          : TaaBitSet;
  i            : integer;
begin
  {prepare for the evaluation}
  lbxResults.Items.Clear;
  SearchPhrase := nil;
  Stack := nil;
  BS1 := nil;
  try
    {parse the search phrase}
    SearchPhrase := TaaSearchPhrase.Create(edtSearchPhrase.Text);
    RPNWalker := SearchPhrase.RPN;
    {create the stack for evaluating the RPN expression}
    Stack := TBitSetStack.Create;
    while (RPNWalker <> nil) do
      begin
        if RPNWalker is TaaRPNWord then 
          begin
            BS1 := TaaBitSet.Create(DocList.Count);
            BS2 := WordIndex.Find(TaaRPNWord(RPNWalker).PhraseWord);
            if (BS2 <> nil) then
              BS1.Assign(BS2);
            Stack.Push(BS1);
          end
        else if RPNWalker is TaaRPN_AND then
          begin
            BS1 := Stack.Pop;
            BS2 := Stack.Pop;
            BS1.AndBitSet(BS2);
            Stack.Push(BS1);
            BS2.Free;
          end
        else if RPNWalker is TaaRPN_OR then
          begin
            BS1 := Stack.Pop;
            BS2 := Stack.Pop;
            BS1.OrBitSet(BS@);
            StackPush(BS1);
            BS2.Free;
          end
        else {RPNWalker is TaaRPN_NOT}
          begin
            BS1 := Stack.Pop;
            BS1.NOTBitSet;
            Stack.Push(BS1);
          end;
        BS1 := nil;
        RPNWalker := RPNWalker.Next;
      end;
    {display the results}      
    BS1 := Stack.Pop;
    for i :=0 to pred(DocList.Count) do
      begin
        if BS1[i] then
          lbxResult.Items.Add(DocList[i]);
      end;
  finally
    BS1.Free;
    Stack.Free;
    SearchPhrase.Free;
  end;
end;
搜索引擎的核心代码,慢慢研究吧

Answer 8

jxzqsun(少年时代) :你是不是觉得只要用字符串替换就行啦？
比如，把XXX替换为<font color=red>xxx</font>？哈，如果是这样的话，新浪搜狐这样的网站何必花钱租人家的搜索引擎。
小伙子，你肯定没搞过搜索引擎。
这需要对HTML进行分析，同时，要能对世界各国语言的词法进行分析。我查遍互联网，都没有公开的代码。
如果你很简单地解决了这个问题，可喜可贺。

Answer 9

我觉得所谓的搜索引擎是不是就是,首先去搜索并获得内容,然后在别人查询时检索以前搜索的内容.并返回连接和内容提要?
如果是的话,在搜索的时候已经将html格式解释掉了。因此就算查询font也不应该能够查到html标志里面去。而且我觉得如果只是简单的查询比较不应该还要词法文法分析这么复杂吧！是不是说得有点悬了？

Answer 10

firewings() :
google的网页快照是显示HTML代码的，所以，需要对HTML代码进行分析
另外，搜索引擎是精确匹配的。比如，搜索“be”，那么，“before”就不应该标出。

Answer 11

精确匹配的实现不是一两句能说清楚的!涉及到语句成分的分析!中文尤其复杂!其在全文翻译软件,语音识别软件中都有应用!这类技术带有很高的商业价值,没人会把核心算法告诉你!如果只是单纯区别"be"和"before"就没那么复杂,英语中每两个单词间不是有空格吗?

Answer 12

英文中的全文检索我觉得就是使用空格和标点符号分割检索。至于google我看好像只不过是检索时略过动词，而象sohu根本就不应该略过，因为在汉语中不可能判断出动词到底是不是作为名次出现的！所以就算有一些语法分析也不应该很复杂！另外显示html代码并不表示是基于html代码的搜索！

Answer 13

ehom(？！) :
是的，英语很容易分词，但中文等亚洲语言怎么办？我不敢做这个事情，怕力不从心。firewings() ：
我做了一个简单的HTML语法分析器，但不完善。