unit uHexSearch;
interface
uses
SysUtils, Classes;
type
THexSearchFoundEvent =
procedure(Sender : TObject;
Position : Integer;
var Cancel : Boolean)
of object;
THexSearchProgressEvent =
procedure(Sender : TObject;
Position : WORD;
Max : Int64)
of Object;
THexByteArray =
Array of Byte;
TFiFoByteBuffer =
class(TObject)
private
FBuffer : THexByteArray;
FCount : Int64;
function GetHasData : Boolean;
function GetByteStr :
String;
public
constructor Create(aSize : Integer);
procedure Add(Value : Byte);
property HasData : Boolean
read GetHasData;
property ByteStr :
String read GetByteStr;
end;
THexSearch =
class(TComponent)
private
FBytes :
String;
FBuffer : TFiFoByteBuffer;
FCanCancel : Boolean;
FStream : TStream;
FSearchTime : TDateTime;
FOnFound : THexSearchFoundEvent;
FOnProgress : THexSearchProgressEvent;
procedure Search(aStream : TStream;
const aBytes :
String);
function EqualBytes(aSource, aSearchStr :
String) : Boolean;
protected
procedure DoFound(Position : Integer;
var Cancel : Boolean);
virtual;
procedure DoProgress(Position : WORD; Max : Int64);
virtual;
public
procedure Execute;
property Cancel : Boolean
read FCanCancel
write FCanCancel;
property Stream : TStream
read FStream
write FStream;
property SearchBytes :
string read FBytes
write FBytes;
property SearchTime : TDateTime
read FSearchTime;
published
property OnFound : THexSearchFoundEvent
read FOnFound
write FOnFound;
property OnProgress : THexSearchProgressEvent
read FOnProgress
write FOnProgress;
end;
implementation
constructor TFiFoByteBuffer.Create(aSize : Integer);
begin
SetLength(FBuffer, aSize);
FCount := 0;
end;
procedure TFiFoByteBuffer.Add(Value : Byte);
var
I : WORD;
begin
for I := Low(FBuffer)
to High(FBuffer) -1
do
FBuffer[I] := FBuffer[I+1];
FBuffer[High(FBuffer)] := Value;
Inc(FCount);
end;
function TFiFoByteBuffer.GetHasData : Boolean;
begin
Result := FCount >= Length(FBuffer);
end;
function TFiFoByteBuffer.GetByteStr :
String;
var
I : Integer;
begin
Result := '
';
for I := 0
to Length(FBuffer)-1
do Result := Result + IntToHex(FBuffer[I], 2);
end;
procedure THexSearch.DoFound(Position : Integer;
var Cancel : Boolean);
begin
If Assigned(FOnFound)
then FOnFound(Self,Position, Cancel);
end;
procedure THexSearch.DoProgress(Position : WORD; Max : Int64);
begin
If Assigned(FOnProgress)
then FOnProgress(Self,Position, Max);
end;
procedure THexSearch.Execute;
begin
FSearchTime := Now;
Search(FStream, FBytes);
FSearchTime := Now - FSearchTime;
end;
procedure THexSearch.Search(aStream : TStream;
const aBytes :
String);
var
Buffer : Byte;
FileSize : Int64;
begin
FCanCancel := false;
FileSize := aStream.Size;
FBuffer := TFiFoByteBuffer.Create(Length(aBytes)
div 2);
try
aStream.Seek(0, soFromBeginning);
While (aStream.Position < aStream.Size)
do
begin
aStream.
Read(Buffer, SizeOf(Buffer));
FBuffer.Add(Buffer);
DoProgress(aStream.Position, FileSize);
if FBuffer.HasData
then
if EqualBytes(FBuffer.ByteStr, aBytes)
then
DoFound(aStream.Position, FCanCancel);
if FCanCancel
then Break;
end;
finally
FBuffer.Free;
end;
end;
function THexSearch.EqualBytes(aSource, aSearchStr :
String) : Boolean;
begin
Result := CompareText(aSource, aSearchStr) = 0;
end;
end.