我帮LiChaoHui贴出来吧,相信他不会介意
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
Edit1: TEdit;
Memo2: TMemo;
Label1: TLabel;
Label2: TLabel;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
function LcScan(Text: String
Keyw: String;
var iStart: Integer): Integer;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TForm1 }
function TForm1.LcScan(Text, Keyw: String
var iStart: Integer): Integer;
var
iState: Integer;
LastState: Integer;
i, m, len, ml: Integer;
NextCh, LastCh: Char;
begin
len := Length(Text);
ml := Length(Keyw);
if (len = 0) or (ml = 0) then
begin
Result := 0;
Exit;
end;
iState := 0;
LastState := 0;
m := 1;
NextCh := Keyw[m];
LastCh := #0;
i := iStart;
while i <= len do
begin
case iState of
0: //表示当然位置在标记之外
begin
case Text of
' ',#13,#10: iState := 4;
'<': iState := 2;
end;
end;
1:
begin
case Text of
' ': iState := 2;
#13: iState := 2;
#10:
begin
if (i > 1) and (Text[i-1] = #13) then
iState := 2
else
iState := 2;
end;
'"': iState := 3;
'>': iState := 4;
end;
end;
2:
begin
case Text of
' ',#13,#10: ;
'"': iState := 3;
'>': iState := 4;
else
iState := 1;
end;
end;
3:
begin
case Text of
'"': iState := 1;
'>': iState := 4;
end;
end;
4:
begin
case Text of
' ',#13,#10: ;
else
iState := 0;
end;
end;
end;
if iState = 2 then
begin
if (NextCh = '=') or (LastCh = '=') or (NextCh = '>') then
begin
if m = 1 then iStart := i + 1;
end
else
if LastState <> 2 then
begin
if Text = Keyw[m] then
begin
m := m + 1;
if m > ml then
begin
//完成匹配
Break;
end
else
begin
LastCh := NextCh;
NextCh := Keyw[m];
end;
end
else
begin
if m > 1 then
begin
i := iStart
//进行回退
m := 1;
end;
iStart := i + 1;
end;
end;
end
else
begin
if Text = Keyw[m] then
begin
m := m + 1;
if m > ml then
begin
Break;
end
else
begin
LastCh := NextCh;
NextCh := Keyw[m];
end;
end
else
if (iState = 4)then
begin
if m = 1 then iStart := i + 1;
end
else
begin
if m > 1 then
begin
i := iStart
//进行回退
m := 1;
end;
iStart := i + 1;
end;
end;
LastState := iState;
i := i + 1;
end;
if i > len then
begin
iStart := len + 1;
Result := 0;
end
else
Result := i - iStart + 1;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
im: Integer;
len: Integer;
s1: String;
s2: String;
begin
im := 1;
//s1 := 'ad<fa fa = "fd me" df >1234 fasdf fdas';
//s1 := '<font face="Arial" ><small>'#13#10'2001 . 4 . 1 </small></font>';
//s1 := '<font face="Arial" ><small> ' + #13#10 +
// '2001 .4. 1</small></font>';
//s2 := 'd<fa fa="fd me" df >1234';
//s2 := '<font face="Arial"><small>2001.4.1</small></font>';
s1 := Memo2.Lines.Text;
s2 := StringReplace(Edit1.Text, '^p', #13#10, [rfReplaceAll]);
len := LcScan(s1, s2, im);
//ShowMessage(Copy(s1, im, len));
Memo1.Lines.Clear;
Memo1.Lines.Add('Search Text:');
Memo1.Lines.Add(s1);
Memo1.Lines.Add('');
Memo1.Lines.Add('KeyWord:');
Memo1.Lines.Add(s2);
Memo1.Lines.Add('');
Memo1.Lines.Add('Search Result:');
Memo1.Lines.Add('StartPos: ' + IntToStr(im));
Memo1.Lines.Add('MatchLen: ' + IntToStr(len));
Memo1.Lines.Add('FoundTxt: ' + Copy(s1, im, len))
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Memo2.Clear;
Memo1.Clear;
Edit1.Clear;
end;
end.