Поиск в файле с использованием MMF

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.