1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:

function Find(szSubStr: PChar; buf: PByteArray; iBufSize: integer;
  iOffset: integer = 0): integer;
{ Returns -1 if substring not found,
  or zero-based index into buffer if substring found }
var
  iSubStrLen: integer;
  skip: array [byte] of integer;
  found: boolean;
  iMaxSubStrIdx: integer;
  iSubStrIdx: integer;
  iBufIdx: integer;
  iScanSubStr: integer;
  mismatch: boolean;
  iBufScanStart: integer;
  ch: byte;
begin
  { Initialisations }
  found := False;
  result := -1;

  { Check if trivial scan for empty string }
  iSubStrLen := StrLen(szSubStr);
  if iSubStrLen = 0 then
  begin
    result := 0;
    Exit
  end;
  iMaxSubStrIdx := iSubStrLen - 1;

  { Initialise the skip table }
  for ch := Low(skip) to High(skip) do
    skip[ch] := iSubStrLen;
  for iSubStrIdx := 0 to (iSubStrLen - 1) do
    skip[ord(szSubStr[iSubStrIdx])] := Max(iMaxSubStrIdx - iSubStrIdx, 1);

  { Scan the buffer, starting comparisons at the end of the substring }
  iBufScanStart := iOffset + iMaxSubStrIdx;
  while (not found) and (iBufScanStart < iBufSize) do
  begin
    iBufIdx := iBufScanStart;
    iScanSubStr := iMaxSubStrIdx;
    repeat
      mismatch := (ord(szSubStr[iScanSubStr]) <> buf[iBufIdx]);
      if not mismatch then
        if iScanSubStr > 0 then
        begin // more characters to scan
          Dec(iBufIdx);
          Dec(iScanSubStr)
        end
        else
          found := True;
    until mismatch or found;
    if found then
      result := iBufIdx
    else
      iBufScanStart := iBufScanStart + skip[buf[iBufScanStart]];
  end;
end;

function findInBuffer(buffer: PByteArray; bufSize: integer): TIntList;
var
  tmpRes: integer;
  memBuf: TMemoryStream;
  szFind: array [0 .. 255] of char;
begin

  result := TIntList.Create;
  memBuf := TMemoryStream.Create();
  try
    memBuf.Write(buffer^, bufSize);
    tmpRes := 0;
    while (tmpRes <> -1) and (tmpRes <= bufSize) do
    begin
      strPCopy(szFind, $78 + $9C);
      tmpRes := Find(szFind, buffer, bufSize, tmpRes);
      if (tmpRes <> -1) then
      begin
        // Add found offset to the list
        result.Add(tmpRes);
        // Next searchable offset is 15 bytes after the one found
        inc(tmpRes, 15);
      end;
    end;
  finally
    FreeAndNil(memBuf);
  end;
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:

procedure FindByteSequenceInFile(FileName: string; Sequence: array of byte; var List: TStringList);
var
  Buffer: array of byte;
  Fs: TFileStream;
  l, n, sl: Integer;
  ScanStopped: boolean;

begin
  // there is no optimization for a certain Sequence length
  // which means the length can be between 1 and Fs.Size
  List.Clear;
  sl := Length(Sequence);
  if sl = 0 then
    Exit;

  Fs := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  try
    // Size of the file should not more than two GB be (otherwise get we an integer overflow)
    SetLength(Buffer, Fs.Size);
    Fs.Read(Buffer[0], Fs.Size);
    for l := 0 to Fs.Size-1 do
    begin
      if Buffer[l] = Sequence[0] then
      begin
        if sl = 1 then
          List.Add(IntToStr(l))
        else
        begin
          n := 1;
          ScanStopped := false;
          while n < sl do
          begin
            if Buffer[l+n] <> Sequence[n] then
            begin
              ScanStopped := true;
              Break;
            end;
            Inc(n);
          end;
          if not ScanStopped then
            List.Add(IntToStr(l));
        end;
      end;
    end;
  finally
    Finalize(buffer);
    Fs.Free;
  end;
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:

var
  Test: array [0 .. 1] of byte = (
    $78,
    $9C
  );
  pos: TStringList;

begin
  FindByteSequenceInFile(ParamStr(1), Test, pos);
  pos.SaveToFile('log.txt');
end.                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:

procedure Test;
var
  sl: TStringList;

begin
  sl := TStringList.Create;
  try
    FindByteSequenceInFile(ParamStr(1), [13,10], sl);
    //ListBox.Items.AddStrings(sl);
    sl.SaveToFile('log.txt');
  finally
    sl.Free;
  end;
end;