23-02-2009, 05:10 PM
u_BtrWld هي وحدة تستعمل للبحث عن اي String في اي Stream بإستعمال ال WildCards : * , ? , و ~ .
لقد قمت بإستعمال دالة ال B-M .
و مرحبا باي اقتراح او ملاحظة .
سوف استعملها في محرك التفحص للبتار .
لقد قمت بإستعمال دالة ال B-M .
و مرحبا باي اقتراح او ملاحظة .
سوف استعملها في محرك التفحص للبتار .
PHP كود :
unit u_BtrWld;
interface
{**
Unit WildCard Scanner
I added the B-M search Function
But modified to support the WildCard Scan ( Search ) Support
CopyRight : Mohfa ( B.Mohammed ).
B-M : is Copyrighted by Boyer-Moore
First Public Release : 2009
**}
uses Classes, Windows, SysUtils;
{** Let's first initiat Global Hex Table ** }
const
HexTable : array [0..255] of String[2] = (
'00','01','02','03','04','05','06','07','08','09','0A','0B','0C','0D','0E','0F'
,'10','11','12','13','14','15','16','17','18','19','1A','1B','1C','1D','1E','1F'
,'20','21','22','23','24','25','26','27','28','29','2A','2B','2C','2D','2E','2F'
,'30','31','32','33','34','35','36','37','38','39','3A','3B','3C','3D','3E','3F'
,'40','41','42','43','44','45','46','47','48','49','4A','4B','4C','4D','4E','4F'
,'50','51','52','53','54','55','56','57','58','59','5A','5B','5C','5D','5E','5F'
,'60','61','62','63','64','65','66','67','68','69','6A','6B','6C','6D','6E','6F'
,'70','71','72','73','74','75','76','77','78','79','7A','7B','7C','7D','7E','7F'
,'80','81','82','83','84','85','86','87','88','89','8A','8B','8C','8D','8E','8F'
,'90','91','92','93','94','95','96','97','98','99','9A','9B','9C','9D','9E','9F'
,'A0','A1','A2','A3','A4','A5','A6','A7','A8','A9','AA','AB','AC','AD','AE','AF'
,'B0','B1','B2','B3','B4','B5','B6','B7','B8','B9','BA','BB','BC','BD','BE','BF'
,'C0','C1','C2','C3','C4','C5','C6','C7','C8','C9','CA','CB','CC','CD','CE','CF'
,'D0','D1','D2','D3','D4','D5','D6','D7','D8','D9','DA','DB','DC','DD','DE','DF'
,'E0','E1','E2','E3','E4','E5','E6','E7','E8','E9','EA','EB','EC','ED','EE','EF'
,'F0','F1','F2','F3','F4','F5','F6','F7','F8','F9','FA','FB','FC','FD','FE','FF');
type
TDoubleParam = Record
pName : String;
pParam : String;
end;
{** Boyer-Moor ( B-M ) Table Using and Intialisation **}
type
TBMTable = array [0..255] of Integer;
// Convert Target File or Stream into a Buffer for Speed searching and Scanning
function ConvertFileToBuffer(FileName: String) : String;
// B-M Search Function
function BMSearch( StartPos : Integer; const S, P : String) : Integer;
function FormatParamEx(KeyLine: String; Divider: Char): TDoubleParam;
function ReplaseString(InStr,FindStr,ReplaseStr: String) : string;
function ReplaseAllString(Line, Prefix, Return: String) : String;
// _Wild search function ( uses the above converted buffer for speed
// and uses the WildCard * , ? and an other specific Char ( {} ) .
function _WildSearch(const Buffer: String; Hex: String) : boolean;
implementation
(* -------------------------------------------------------------------------- *)
function ConvertFileToBuffer(FileName: String) : String;
var
FS: TMemoryStream;
BF: array of byte;
i : integer;
begin
Result := '';
FS := TMemoryStream.Create;
FS.LoadFromFile(FileName);
SetLength(BF,FS.SIZE);
FS.Read(BF[0],FS.Size);
for i := 0 to FS.Size-1 do
Result := Result + HexTable[BF[i]];
FS.Free;
Finalize(BF);
end;
(* -------------------------------------------------------------------------- *)
function FormatParamEx(KeyLine: String; Divider: Char): TDoubleParam;
var
tmp,tmp2 : String;
i : integer;
begin
tmp := '';
tmp2 := '';
for i := 1 to Length(KeyLine) do
if KeyLine[i] <> Divider then
tmp := tmp + KeyLine[i] else
Break;
for i := i+1 to Length(KeyLine) do
tmp2 := tmp2 + KeyLine[i];
Result.pName := tmp;
Result.pParam:= tmp2;
end;
(* -------------------------------------------------------------------------- *)
function ReplaseString(InStr,FindStr,ReplaseStr: String) : string;
var
id : integer;
str : string;
begin
Result := InStr;
id := pos(LowerCase(FindStr), LowerCase(InStr));
str := InStr;
Delete(str,id,length(FindStr));
Insert(ReplaseStr,str,id);
Result := str;
end;
(* -------------------------------------------------------------------------- *)
function ReplaseAllString(Line, Prefix, Return: String) : String;
var
tmp : string;
begin
tmp := Line;
while pos(Prefix,tmp) > 0 do
tmp := ReplaseString(tmp,prefix,return);
Result := tmp;
end;
(* -------------------------------------------------------------------------- *)
function BMSearch( StartPos : Integer; const S, P : String) : Integer;
var
BMT : TBMTable;
Pos, lp, i : Integer;
begin
for i := 0 to 255 do BMT[i] := Length(P);
for i := Length(P) downto 1 do
if BMT[Byte(P[i])] = Length(P) then
BMT[Byte(P[i])] := Length(P) - i;
lp := Length(P);
Pos := StartPos + lp -1;
while Pos < Length(S)+1 do
if P[lp] <> S[Pos] then Pos := Pos + BMT[byte(S[Pos])]
else
for i := lp - 1 downto 1 do
if (P[i] <> S[Pos - lp + i]) and (P[i] <> '?') then
begin
Inc(Pos);
Break;
end else
if i = 1 then begin
Result := Pos + 1;
Exit;
end;
Result := -1;
end;
(* -------------------------------------------------------------------------- *)
function SearchAtPos(const Buffer: String; Hex: String; Pos: integer) : boolean;
var
i: integer;
begin
Result := False;
for i := 1 to Length(Hex) do
if (Buffer[Pos+i] <> Hex[i]) and (Hex[i] <> '?') then Exit;
Result := True;
end;
(* -------------------------------------------------------------------------- *)
function LineHexSearch(const Buffer: String; Hex: String; FromPos, ToPos: integer) : integer;
var
i : integer;
begin
Result := -1;
if (FromPos > Length(Buffer)) then Exit;
for i := 0 to (ToPos-FromPos) do
if SearchAtPos(Buffer,Hex,FromPos+i) then begin
Result := (FromPos+i)+(length(Hex) );
Exit;
end;
end;
(* -------------------------------------------------------------------------- *)
function _AdvHexSys(const Buffer: String; const List: TStrings; Step: integer; var LPos: integer) : boolean;
var
i : integer;
SPos: integer;
begin
Result := false;
if Step >= List.Count-1 then begin
Exit;
end;
for i := Step to (List.Count div 2)-1 do begin
if List[i*2] = '*' then begin
while (LPos <> -1) do begin
LPos := BMSearch(LPos,Buffer,List[(i*2)+1]);
SPos := Lpos;
if _AdvHexSys(Buffer,List,i+1,SPos) then begin
Result := true;
Exit;
end;
end;
if (LPos < 0) or (LPos >= Length(Buffer)) then begin
Exit;
end;
end else
// and other specific Char ( ~ ) used for scannning in WildCard
if List[i*2][1] = '~' then begin
LPos := LineHexSearch(Buffer, List[(i*2)+1],LPos,LPos+StrToInt(ReplaseString(List[i*2],'~',''))*2);
if (LPos < 0) or (LPos > Length(Buffer)) then begin
Exit;
end;
end else
if SearchAtPos(Buffer, List[(i*2)+1], StrToInt(List[i*2]) * 2) then begin
LPos := StrToInt(List[i*2][1])+Length(List[(i*2)+1]) div 2;
end else begin
Exit;
end;
end;
Result := true;
end;
(* -------------------------------------------------------------------------- *)
function _WildSearch(const Buffer: String; Hex: String) : boolean;
var
List : TStringList;
i : integer;
Error : boolean;
LPos : integer;
tmp : string;
begin
Result := False;
List := TStringList.Create;
tmp := Hex;
Delete(tmp,1,1);
List.Text := UpperCase(tmp);
List.Text := ReplaseAllString(List.Text,'{',#13#10);
List.Text := ReplaseAllString(List.Text,'}',#13#10);
LPos := 0;
Result := _AdvHexSys(Buffer,List,0,LPos);
List.Free;
end;
(* -------------------------------------------------------------------------- *)
end.