unit uHexSearch;
interface
uses
SysUtils, Classes;
type
THexSearchFoundEvent =
procedure(Sender : TObject;
Position : Integer;
var Cancel : Boolean)
of object;
THexSearchSkipTable =
Array[0..255]
of Byte;
PHexByteArray = ^THexByteArray;
THexByteArray =
Array of Byte;
THexSearch =
class(TComponent)
private
FBytes : THexByteArray;
FCanCancel : Boolean;
FSkipTable : THexSearchSkipTable;
FStream : TStream;
FOnFound : THexSearchFoundEvent;
procedure InitSkipTable(
var SkipTable : THexSearchSkipTable;
const aBytes : THexByteArray);
procedure Search(aStream : TStream;
SkipTable : THexSearchSkipTable;
const aBytes : THexByteArray);
function GetArrayOfByte(Source :
Array of Byte;
Index, Count : Integer) : THexByteArray;
function EqualBytes(Source, Dest :
Array of Byte) : Boolean;
protected
procedure DoFound(Position : Integer;
var Cancel : Boolean);
virtual;
public
procedure Execute;
property Cancel : Boolean
read FCanCancel
write FCanCancel;
property Stream : TStream
read FStream
write FStream;
property SearchBytes : THexByteArray
read FBytes
write FBytes;
published
property OnFound : THexSearchFoundEvent
read FOnFound
write FOnFound;
end;
implementation
const
iBufferSize = 4096;
procedure THexSearch.DoFound(Position : Integer;
var Cancel : Boolean);
begin
If Assigned(FOnFound)
then FOnFound(Self,Position, Cancel);
end;
procedure THexSearch.Execute;
begin
InitSkipTable(FSkipTable, FBytes);
Search(FStream, FSkipTable, FBytes);
end;
procedure THexSearch.InitSkipTable(
var SkipTable : THexSearchSkipTable;
const aBytes : THexByteArray);
var
I : Integer;
L : Integer;
begin
L := Length(aBytes);
FillChar(SkipTable,SizeOf(THexSearchSkipTable), L);
for I := 0
to L
do
SkipTable[aBytes[I]]:= L - I;
end;
procedure THexSearch.Search(aStream : TStream;
SkipTable : THexSearchSkipTable;
const aBytes : THexByteArray);
var
ReadLen : Integer;
TextLen : Integer;
SourcePos : Integer;
SubStrPos : Integer;
aBuffer :
Array[1..iBufferSize]
of Byte;
ReadBufferCount : Integer;
A : Integer;
begin
FCanCancel := false;
ReadBufferCount := 0;
TextLen := Length(aBytes);
ReadLen := 0;
aStream.Seek(0, soFromBeginning);
While aStream.Position<aStream.Size
do
begin
A := 0;
SourcePos := TextLen;
ReadLen := aStream.
Read(aBuffer, SizeOf(aBuffer));
Repeat
SubStrPos := TextLen;
Repeat
If aBuffer[SourcePos]= aBytes[SubStrPos]
then
begin
Dec(SourcePos);
Dec(SubStrPos);
end
else
begin
If SkipTable[aBytes[SubStrPos]]>SkipTable[aBuffer[SourcePos]]
then
SourcePos := SourcePos + TextLen
else
SourcePos := SourcePos +SkipTable[aBuffer[SourcePos]];
If SourcePos>ReadLen
then
begin
SourcePos := ReadLen;
Inc(A);
end;
SubStrPos := TextLen;
end;
Until (SubStrPos=0)
or (SourcePos>ReadLen)
or (A=2);
If SubStrPos = 0
then // Text gefunden
begin
DoFound(ReadBufferCount*SizeOf(aBuffer)+SourcePos-ReadBufferCount*TextLen, FCanCancel);
SourcePos := SourcePos + 2 * TextLen;
end;
If FCanCancel
then Exit;
Until (SourcePos>ReadLen)
or (A=2);
// Block ist abgearbeitet
Inc(ReadBufferCount);
If (EqualBytes(GetArrayOfByte(aBuffer, ReadLen-TextLen+1, TextLen), aBytes))
and
(Stream.Position < Stream.Size)
then
aStream.Seek(-(TextLen),soFromCurrent);
end;
end;
function THexSearch.GetArrayOfByte(Source :
Array of Byte;
Index, Count : Integer) : THexByteArray;
var
I : Integer;
begin
SetLength(Result, Count);
for I := 0
to Count
do
Result[I] := Source[
Index + I];
end;
function THexSearch.EqualBytes(Source, Dest :
Array of Byte) : Boolean;
var
SA, DA :
String;
I : Integer;
begin
SA := '
';
DA := '
';
for I := 0
to Length(Source)
do SA := SA + IntToHex(Source[I], 2);
for I := 0
to Length(Dest)
do DA := DA + IntToHex(Dest[I], 2);
Result := CompareText(SA, DA) = 0;
end;
end.