program MMapFileSearch;

{$APPTYPE CONSOLE}

uses
  Windows, SysUtils, AnsiStrings;

var
  IsDebuggerPresent: function: Boolean;

function MapFileRead(const Filename: String; var hFile, hMap: THandle ): Pointer;
begin
  hFile := FileOpen(Filename, fmOpenRead + fmShareDenyNone);
  Win32Check(hMap <> INVALID_HANDLE_VALUE);

  hMap := CreateFileMapping(hFile, nil, PAGE_READONLY, 0, 0, nil);
  Win32Check(hMap <> 0);

  Result := MapViewOfFile(hMap, FILE_MAP_READ, 0, 0, 0);
  Win32Check(Result <> nil);
end;

procedure UnmapFile( BasePtr: Pointer; hFile, hMap: THandle );
begin
  if BasePtr <> nil then
    UnmapViewOfFile( BasePtr );

  if hMap <> 0 then
    CloseHandle( hMap );

  if hFile <> INVALID_HANDLE_VALUE then
    CloseHandle( hFile );
end;

function StrPos(const Str1, Str2: PAnsiChar; const LenStr1: UInt64): PAnsiChar;
var
  MatchStart, LStr1, LStr2: PAnsiChar;
  l1, l2: UInt64;
begin
  Result := nil;
  if (Str1^ = #0) or (Str2^ = #0) then
    Exit;

  MatchStart := Str1;
  l2 := 0;
  while l2 < LenStr1 do
  begin
    if MatchStart^ = Str2^ then
    begin
      l1 := l2+1;
      LStr1 := MatchStart+1;
      LStr2 := Str2+1;
      while True do
      begin
        if LStr2^ = #0 then
          Exit(MatchStart);
        if (LStr1^ <> LStr2^) or (l1 >= LenStr1) then
          Break;
        Inc(LStr1); Inc(l1);
        Inc(LStr2);
      end;
    end;
    Inc(MatchStart); Inc(l2);
  end;
end;

function FileSize(AFileName: String): Int64;
var
  sr : TSearchRec;
begin
  if FindFirst(AFileName, faAnyFile, sr) = 0 then
     Result := sr.Size
  else
     Result := -1;
  FindClose(sr) ;
end;

var
  pFile, iStr, p2: PAnsiChar;
  hFile, hMap: THandle;
  time, szFile: Cardinal;
begin
  @IsDebuggerPresent := GetProcAddress(GetModuleHandle('kernel32.dll'), 'IsDebuggerPresent');

  Writeln('ParamStr(1): ', ParamStr(1));
  Writeln('ParamStr(2): ', ParamStr(2));

  szFile := FileSize(ParamStr(1));
  Writeln('File size: ', szFile);

  GetMem(p2, Length(ParamStr(2))+1);
  AnsiStrings.StrPCopy(p2, AnsiString(ParamStr(2)));

  time := GetTickCount;
  pFile := MapFileRead(ParamStr(1), hFile, hMap);
  iStr := StrPos(pFile, p2, szFile);
  Writeln('Elapsed time: ',GetTickCount-time);

  if iStr <> nil then
    Writeln('Found: ', iStr-pFile+1)
  else
    Writeln('Not found');

  FreeMem(p2, Length(ParamStr(2))+1);
  UnmapFile(pFile, hFile, hMap);

  if Assigned(IsDebuggerPresent) and IsDebuggerPresent then
  begin
    Writeln('Press enter');
    Readln;
  end;
end.

program MMapFileSearch;

{$APPTYPE CONSOLE}

uses
  Windows, SysUtils, StrUtils, AnsiStrings;

type
  TCUInt64 = packed record
      L, H: Cardinal;
    end;

var
  lenParam2, SizeBlock: Cardinal;
  IsDebuggerPresent: function: Boolean;

procedure OpenFileMapRead(const Filename: String; var hFile, hMap: THandle );
begin
  hFile := FileOpen(Filename, fmOpenRead + fmShareDenyNone);
  Win32Check(hFile <> INVALID_HANDLE_VALUE);

  hMap := CreateFileMapping(hFile, nil, PAGE_READONLY, 0, 0, nil);
  Win32Check(hMap <> 0);
end;

function MapFile(const hMap: THandle; nOffset: UInt64; szBlock: Cardinal ): Pointer;
var
  CUInt64: TCUInt64 absolute nOffset;
begin
  repeat
    Result := MapViewOfFile(hMap, FILE_MAP_READ, CUInt64.H, CUInt64.L, szBlock);

    if Result = nil then
      if szBlock > lenParam2 then
        szBlock := szBlock div 2
      else
        Break;
  until Result <> nil;
  Win32Check(Result <> nil);
end;

procedure UnmapFile( BasePtr: Pointer );
begin
  if BasePtr <> nil then
    UnmapViewOfFile( BasePtr );
end;

procedure CloseFile( const hFile, hMap: THandle );
begin
  if hMap <> 0 then
    CloseHandle( hMap );

  if hFile <> INVALID_HANDLE_VALUE then
    CloseHandle( hFile );
end;

function FileSize(AFileName: String): Int64;
var
  sr : TSearchRec;
begin
  if FindFirst(AFileName, faAnyFile, sr) = 0 then
     Result := sr.Size
  else
     Result := -1;
  FindClose(sr) ;
end;

var
  pFile, iStr, param2: PAnsiChar;
  hFile, hMap: THandle;
  time, szBlock, dwAllocationGranularity : Cardinal;
  szFile, fOffset: Int64;
  l: _SYSTEM_INFO;
begin
  @IsDebuggerPresent := GetProcAddress(GetModuleHandle('kernel32.dll'), 'IsDebuggerPresent');

  Writeln('ParamStr(1): ', ParamStr(1));
  Writeln('ParamStr(2): ', ParamStr(2));

  szFile := FileSize(ParamStr(1));
  Writeln('File size: ', szFile);

  lenParam2 := Length(ParamStr(2));

  // MapViewOfFile может мапить только по смещению, равному (N * _SYSTEM_INFO.dwAllocationGranularity), поэтому запомним эту цифру
  GetSystemInfo(l);
  dwAllocationGranularity := l.dwAllocationGranularity;

  // размер блока поиска
  //SizeBlock := 1024 * 1024 * 1024;
  //SizeBlock := 512 * 1024 * 1024;
  SizeBlock := 256 * 1024 * 1024;

  Assert((SizeBlock > lenParam2) and (SizeBlock < MaxInt));

  GetMem(param2, lenParam2+1);
  AnsiStrings.StrPCopy(param2, AnsiString(ParamStr(2)));

  iStr := nil;
  pFile := nil;
  fOffset := 0;
  szBlock := SizeBlock;

  time := GetTickCount;

  OpenFileMapRead(ParamStr(1), hFile, hMap);

  // мапим файл по блокам размером szBlock и выполняем поиск
  while True do
  begin
    if fOffset+szBlock > szFile then
      szBlock := szFile - fOffset
    else if fOffset > szFile then
      Break;

    pFile := MapFile(hMap, fOffset, szBlock);
    iStr := AnsiStrings.SearchBuf(pFile, szBlock, 0, 0, param2, [soDown, soMatchCase{, soWholeWord}]);
    UnmapFile(pFile);

    if (iStr <> nil) or (fOffset+szBlock = szFile) then
      Break;

    // на случай, если искомое находится на границе между блоками, отступаем назад на длину искомого
    // с учетом гранулярности смещения
    fOffset := dwAllocationGranularity * ((fOffset + szBlock - lenParam2) div dwAllocationGranularity);
  end;

  CloseFile(hFile, hMap);

  Writeln('Elapsed time: ',GetTickCount-time);

  if iStr <> nil then
    Writeln('Found offset: ', fOffset+(iStr-pFile+1), ' (', IntToHex(fOffset+(iStr-pFile+1), 10), ')')
  else
    Writeln('Not found');

  FreeMem(param2, lenParam2+1);

  if Assigned(IsDebuggerPresent) and IsDebuggerPresent then
  begin
    Writeln('Press enter');
    Readln;
  end;
end.

program MMapFileSearch;

{$APPTYPE CONSOLE}

uses
  Windows, SysUtils, StrUtils, AnsiStrings;

type
  ACardinal = array of Cardinal;
  TCUInt64 = packed record
      L, H: Cardinal;
    end;

const
  // размер блока поиска
  //SizeBlock := 1024 * 1024 * 1024;
  //SizeBlock := 512 * 1024 * 1024;
  SizeBlock = 256 * 1024 * 1024;

var
  dwAllocationGranularity: Cardinal;
  IsDebuggerPresent: function: Boolean;

procedure OpenFileMapRead(const Filename: String; var hFile, hMap: THandle );
begin
  hFile := FileOpen(Filename, fmOpenRead + fmShareDenyNone);
  Win32Check(hFile <> INVALID_HANDLE_VALUE);

  hMap := CreateFileMapping(hFile, nil, PAGE_READONLY, 0, 0, nil);
  Win32Check(hMap <> 0);
end;

function MapFile(const hMap: THandle; nOffset: UInt64; szBlock: Cardinal ): Pointer;
var
  CUInt64: TCUInt64 absolute nOffset;
begin
  Result := MapViewOfFile(hMap, FILE_MAP_READ, CUInt64.H, CUInt64.L, szBlock);
  Win32Check(Result <> nil);
end;

procedure UnmapFile( BasePtr: Pointer );
begin
  if BasePtr <> nil then
    UnmapViewOfFile( BasePtr );
end;

procedure CloseFile( const hFile, hMap: THandle );
begin
  if hMap <> 0 then
    CloseHandle( hMap );

  if hFile <> INVALID_HANDLE_VALUE then
    CloseHandle( hFile );
end;

function FileSize(AFileName: String): Int64;
var
  sr : TSearchRec;
begin
  if FindFirst(AFileName, faAnyFile, sr) = 0 then
     Result := sr.Size
  else
     Result := -1;
  FindClose(sr) ;
end;

function StrPNew(const AStr: AnsiString; var ALen: Integer): PAnsiChar;
begin
  ALen := Length(AStr);
  GetMem(Result, ALen+1);
  AnsiStrings.StrPCopy(Result, AStr);
end;

// поиск подстроки по алгоритму Кнута - Морриса - Пратта
function SearchKMP(const s: PAnsiChar; const N: Integer; const p: PAnsiChar; const M: Integer): Integer;
var
  i, j: Integer;
  d: array of Integer;
begin
  SetLength(d, M);

  // Вычисление префикс-функции
  d[0] := 0;
  j := 0;
  for i := 1 to M-1 do
  begin
    while (j > 0) and (p[j] <> p[i]) do
      j := d[j-1];

    if p[j] = p[i] then
      Inc(j);

    d[i] := j;
  end;

    // Поиск
  j := 0;
  for i := 0 to N-1 do
  begin
    while (j > 0) and (p[j] <> s[i]) do
      j := d[j-1];

    if p[j] = s[i] then
      Inc(j);

    if j = M then
    begin
      SetLength(d, 0);
      Exit(i - j + 1);
    end;
  end;

  SetLength(d, 0);
  Exit(-1);
end;

function MMFSearch(const AFileName: String; AFileSize: Int64; const pSearch: PAnsiChar; lenSearch: Cardinal;
  var ATime: Cardinal): Int64;
var
  //iStr,
  pFile: PAnsiChar;
  hFile, hMap: THandle;
  szBlock: Cardinal;
  nPos: Integer;
  fOffset: Int64;
begin
  ATime := GetTickCount;

  nPos := -1;
  fOffset := 0;
  szBlock := SizeBlock;

  OpenFileMapRead(AFileName, hFile, hMap);

  // мапим файл по блокам размером szBlock и выполняем поиск
  while True do
  begin
    if fOffset+szBlock > AFileSize then
      szBlock := AFileSize - fOffset
    else if fOffset > AFileSize then
      Break;

    pFile := MapFile(hMap, fOffset, szBlock);
    //iStr := AnsiStrings.SearchBuf(pFile, szBlock, 0, 0, pSearch, [soDown, soMatchCase{, soWholeWord}]);
    //nPos := iStr-pFile;
    nPos := SearchKMP(pFile, szBlock, pSearch, lenSearch);
    UnmapFile(pFile);

    if (nPos >= 0) or (fOffset+szBlock = AFileSize) then
      Break;

    // на случай, если искомое находится на границе между блоками, отступаем назад на длину искомого
    // с учетом гранулярности смещения
    fOffset := dwAllocationGranularity * ((fOffset + szBlock - lenSearch) div dwAllocationGranularity);
  end;

  CloseFile(hFile, hMap);

  if nPos >= 0 then
    Result := fOffset + nPos
  else
    Result := -1;

  ATime := GetTickCount-ATime;
end;

var
  param2: PAnsiChar;
  AllTime, time, i, nCnt: Cardinal;
  lenSearch, nPos: Integer;
  szFile: Int64;
  l: _SYSTEM_INFO;
begin
  @IsDebuggerPresent := GetProcAddress(GetModuleHandle('kernel32.dll'), 'IsDebuggerPresent');

  Writeln('ParamStr(1): ', ParamStr(1));
  Writeln('ParamStr(2): ', ParamStr(2));

  szFile := FileSize(ParamStr(1));
  Writeln('File size: ', szFile);

  // MapViewOfFile может мапить только по смещению, равному (N * _SYSTEM_INFO.dwAllocationGranularity), поэтому запомним эту цифру
  GetSystemInfo(l);
  dwAllocationGranularity := l.dwAllocationGranularity;

  param2 := StrPNew(AnsiString(ParamStr(2)), lenSearch);

  Assert((SizeBlock > lenSearch) and (SizeBlock < Cardinal(MaxInt)));

  // 3-й параметр - число прогонов поиска, чтобы вычислить среднее
  nCnt := StrToIntDef(ParamStr(3), 1);
  if nCnt > 1 then
  begin
    Writeln(0,'/',nCnt,': время не учитывается');
    MMFSearch(ParamStr(1), szFile, param2, lenSearch, time);
  end;

  nPos := -1;
  AllTime := 0;
  if nCnt > 0 then
  begin
    for i := 1 to nCnt do
    begin
      if nCnt > 1 then
        Write(i,'/',nCnt);

      nPos := MMFSearch(ParamStr(1), szFile, param2, lenSearch, time);

      if nCnt > 1 then
        Writeln(': ', time, ' ms');
      AllTime := AllTime + time;
    end;

    Writeln('Elapsed ', IfThen(nCnt > 1, 'mean '), 'time: ', AllTime div nCnt, ' ms');

    if nPos >= 0 then
      Writeln('Found offset: ', nPos, ' (', IntToHex(nPos, 10), ')')
    else
      Writeln('Not found');
  end;

  FreeMem(param2, lenSearch+1);

  if Assigned(IsDebuggerPresent) and IsDebuggerPresent then
  begin
    Writeln('Press enter');
    Readln;
  end;
end.

>MMapFileSearch_SearchKMP.exe "File750MB.dat" "search" 10
ParamStr(1): File750MB.dat
ParamStr(2): search
File size: 785068650
0/10: время не учитывается
1/10: 7098 ms
2/10: 6739 ms
3/10: 7161 ms
4/10: 6677 ms
5/10: 6989 ms
6/10: 6692 ms
7/10: 6817 ms
8/10: 6771 ms
9/10: 6957 ms
10/10: 6911 ms
Elapsed mean time: 6881 ms
Found offset: 773626828 (002E1C9BCC)

>MMapFileSearch_SearchBuf.exe "File750MB.dat" "search" 10
ParamStr(1): File750MB.dat
ParamStr(2): search
File size: 785068650
0/10: время не учитывается
1/10: 7862 ms
2/10: 7676 ms
3/10: 7987 ms
4/10: 7675 ms
5/10: 7660 ms
6/10: 7956 ms
7/10: 7706 ms
8/10: 8065 ms
9/10: 7707 ms
10/10: 7816 ms
Elapsed mean time: 7811 ms
Found offset: 773626828 (002E1C9BCC)