exe地址:http://loqi.myetang.com/findtext.exe
代码如下:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
Edit1: TEdit;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
function FindInText(const SubStr, FindStr: string;
const IgnoreCase: Boolean = True;
const IgnoreCRLFSPACE: Boolean = False): Integer;
public
{ Public declarations }
end;
const
IgnoreChar = [#9, #10, #13, #32];
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
begin
i := FindInText(Edit1.Text,
Memo1.Lines.Text,
CheckBox1.Checked,
CheckBox2.Checked);
ShowMessage(IntToStr(i) + #13#10 + Copy(Memo1.Lines.Text, i, MaxInt));
end;
function CheckLeadChar(var P: PChar
const Add: Boolean): Boolean;
var
ByteType: TMbcsByteType;
begin
ByteType := StrByteType(P, 0);
Result := ByteType = mbLeadByte;
if Result and Add then
begin
Inc(P);
end;
end;
function IsSingle(const P: PChar): Boolean;
var
ByteType: TMbcsByteType;
begin
ByteType := StrByteType(P, 0);
Result := ByteType = mbSingleByte;
end;
function MyPos(const SubStr, s: string
StartPos: Cardinal = 0;
IgnoreCase: Boolean = False): Integer;
begin
if StartPos = 0 then
begin
if IgnoreCase then
Result := Pos(AnsiUpperCase(SubStr), AnsiUpperCase(s))
else
Result := Pos(SubStr, s)
end
else
begin
if IgnoreCase then
Result := Pos(
AnsiUpperCase(SubStr), AnsiUpperCase(Copy(s, StartPos, MaxInt)))
else
Result := Pos(SubStr, Copy(s, StartPos, MaxInt));
if Result > 0 then Result := (Result + Integer(StartPos)) - 1;
end;
end;
function GetFirstStr(const Str: string): string;
var
P: PChar;
i: Integer;
begin
Result := '';
P := PChar(Str);
i := Integer(P);
if P <> nil then
while P^ <> #0 do
begin
if not (P^ in IgnoreChar {[#32, #13, #10, #9]}) {SPACE,CR,LF,TAB} then
begin
CheckLeadChar(P, True);
Result := Copy(Str, 1, Integer(P) - i + 1);
Break;
end;
Inc(P);
end;
end;
function TForm1.FindInText(const SubStr, FindStr: string;
const IgnoreCase: Boolean;
const IgnoreCRLFSPACE: Boolean): Integer;
function IsSameText(SubStr, FindStr: string;
const StartPos: Integer;
const IgnoreCase: Boolean): Boolean;
var
P: PChar;
PFS: PChar;
//FS:string;
begin
Result := False;
if IgnoreCase then
begin
SubStr := AnsiUpperCase(SubStr);
FindStr := AnsiUpperCase(FindStr);
end;
P := PChar(SubStr);
if P <> nil then //其实不用判断了
begin
//FS := Copy(FindStr, StartPos, MaxInt);
if StartPos > Length(FindStr) then Exit
//越界
PFS := PChar(FindStr);
Inc(PFS, StartPos - 1);
while P^ <> #0 do
begin
if PFS^ <> #0 then
begin
if IsSingle(P) then
begin
if P^ <> PFS^ then
begin
repeat
if PFS^ in IgnoreChar {[#32, #13, #10, #9]} then
begin
Inc(PFS);
end
else
Exit;
if PFS^ = #0 then Exit;
until PFS^ = P^;
end;
Inc(P);
Inc(PFS);
end
else
begin
Assert(CheckLeadChar(P, False));
if (P^ <> PFS^) or ((P + 1)^ <> (PFS + 1)^) then
begin
repeat
if IsSingle(PFS) and (PFS^ in IgnoreChar) then
begin
Inc(PFS);
end
else
Exit;
if PFS^ = #0 then Exit;
until (PFS^ = P^) and ((P + 1)^ = (PFS + 1)^);
end;
Inc(P, 2);
Inc(PFS, 2);
end;
end
else
Exit;
end;
Result := True;
end;
end;
var
iPos: Integer;
FirstStr: string;
begin
Result := 0;
iPos := 0;
if (SubStr = '') or (FindStr = '') then Exit;
if not IgnoreCRLFSPACE then
begin
Result := MyPos(SubStr, FindStr, iPos, IgnoreCase);
Exit;
end
else
begin
FirstStr := GetFirstStr(SubStr);
repeat
iPos := MyPos(FirstStr, FindStr, iPos, IgnoreCase);
if iPos <> 0 then
begin
if IsSameText(SubStr, FindStr, iPos, IgnoreCase) then
begin
Result := iPos;
Exit;
end
else
Inc(iPos, Length(FirstStr));
end;
until iPos = 0;
Result := 0;
end;
end;
end.