Поиск-извлечение блока данных из бинарного файла

[Alter]

Имеется некий бинарный файл, в нём нужно найти начало и конец блока для копирования, как нашли скопировать от начала маркера и до окончания второго маркера:

const
   // маркеры , для определения области нужных данных(Значения массивов для примера! Могут быть любые)
  BeginByt :array[0..4] of Byte = ($5B, $4A, $d3, $d7, $47);
  EndByt :array[0..1] of Byte = ($Af, $Af);

Поиск в бинарном файле(работает криво ):

procedure ExtractInDumpFile(DumpFile, OutDir: string);
var
  Fs :TFileStream;
  TmpFileName :string;
  BufBeg :array[0..4] of Byte;
  BufEnd :array[0..1] of Byte;
  ExBegin :Boolean; // найденно начало блока
  ExEnd :Boolean; // найден конец блока
  A,B :Int64; // позиция начала и конца блока
begin
 if (FileExists(DumpFile) = False)or
    (DirectoryExists(OutDir) = False) then Exit;
 Fs := TFileStream.Create(DumpFile, fmOpenRead);
  try
 A := 0;
 B := 0; 
 ExBegin := False;
 ExEnd := False;
 Fs.Position := 0;
 while Fs.Position < Fs.Size - Length(BufBeg) - Length(BufEnd) - 1 do
 begin
    // начало блока не найдено
   if ExBegin = False then
   begin
    Fs.ReadBuffer(BufBeg, SizeOf(BufBeg));
     // если нашли начало блока
    if CompareMem(@BufBeg, @BeginByt, SizeOf(BufBeg)) then
    begin
      //нашли начало блока
     ExBegin := True;
      // запомним позицию начала блока
     A := Fs.Position;
    end;  
   end;
    // нашли начало блока, ищем конец
   If ExBegin then
   begin
      // поиск конца блока
     if ExEnd = False then
     begin
      Fs.ReadBuffer(BufEnd, SizeOf(BufEnd));
       // если нашли конец блока
      If CompareMem(@BufEnd, @EndByt, SizeOf(BufEnd)) then
      begin
        // запомнить конец блока
       B := Fs.Position + Length(BufEnd);
        // сохраним в файл найденное
       CopyFsToFile(Fs, A, B, IncludeTrailingBackslash(OutDir) + 'Out_Data.bin');
        // позицию в файле, в конец блока
       Fs.Position := B;
        // сброс маркеров, продолжить поиск в оставшейся части файла
       ExBegin := False;
       ExEnd := False; 
      end;   
     end;
   end;
 end;
  finally
 Fs.Free;
  end;
end;

Копирование части данных из файлового потока, в файл:

procedure CopyFsToFile(InFs: TFileStream; a, b: Int64;
  SavFile: string);
var
  Buf :array of Byte; // буфер для данных
  Len :Int64; // длина копируемого блока
  SavFs :TFileStream;
begin 
 if InFs = nil then Exit;
 Len := b - a; // размер копируемых данных
  SetLength(Buf, Len);
  ZeroMemory(@Buf, SizeOf(Buf))
 SavFs := TFileStream.Create(SavFile, fmCreate);
  try
 InFs.Position := a; // начальная позиция, для копирования
 InFs.ReadBuffer(Buf, Len); // в буфер
 SavFs.WriteBuffer(Buf, Len); // из буфера
  finally
 SetLength(Buf, 0);
 SavFs.Free;
  end;
end;

Что исправить, или кто что может предложить получше для поиска-извлечения.

[mutabor]

А что, не работает? Или медленно? Как понять "криво"?

Копировать между потоками просто - Stream.CopyFrom.
Поиск в принципе тоже ничего сложного, разве что со скоростью бывает не очень, я игрался с размером буфера для чтения кусков файла, желательно побольше его делать, я считывал по 512 или 2048 байт, если малый буфер то будет медленно очень за счет потерь времени на чтение с диска очередной партии данных. Если файл малый - то его можно сразу весь в память, в TMemoryStream, но тогда есть задержка на загрузку его, и если к примеру то что надо найдется в самом начале, то с чтением с диска было бы быстрее. Под каждый конкретный случай нужно подстраивать.

Я бы эту процедуру так написал (позиция в потоке InFs выставляется в нужное место перед вызовом процедуры)

procedure CopyFsToFile(InFs: TFileStream; Size: int64;
  SavFile: string);
var
  SavFs :TFileStream;
begin 
 if InFs = nil then Exit;
 SavFs := TFileStream.Create(SavFile, fmCreate);
  try
 SavFs.CopyFrom(InFs, Size);
  finally
 SavFs.Free;
  end;
end;

Кстати, проверка на nil эффективна, только если ты будешь присваивать nil объектам после освобождения. Если же просто вызвать Free, то объект все равно будет содержать старый уже недействительный адрес. Нужно или явно присваивать после этого ему nil, или вызывать FreeAndNil вместо Free.

[Alter]

Размер файла: от 40 до 200Мб

Сделал таким образом, работает как надо, но относительно медленно:

procedure TMemWrk.ExtractKeyInDumpFile(DumpFile, OutDir: string);
var
  Fs :TFileStream;
  TmpFileName :string;
  BufBeg :array[0..High(BeginByt)] of Byte;
  BufEnd :array[0..Low(EndByt)] of Byte;
  Buf :Byte; // буфер для 1-го символа
  ExBegin :Boolean; // найденно начало блока
  ExEnd :Boolean; // найден конец блока
  A,B :Int64; // позиция начала, конца блока
  EndCont :Byte;
  StPos :Int64;
begin // выделить блоки из файла дампа
 if (FileExists(DumpFile) = False)or
    (DirectoryExists(OutDir) = False) then Exit;
 Fs := TFileStream.Create(DumpFile, fmOpenRead);
  try
 A := 0;
 B := 0;
 EndCont := 0;
 ExBegin := False;
 ExEnd := False;
   StPos := 0;
 Fs.Position := 0;
 while Fs.Position < Fs.Size - Length(BufBeg) - Length(BufEnd) - 1 do
 begin
    // начало блока не найдено
   if ExBegin = False then
   begin
     StPos := Fs.Position;
    Fs.ReadBuffer(BufBeg, SizeOf(BufBeg));
     Fs.Position := StPos + 1;
     // если нашли начало блока
    if CompareMem(@BufBeg, @BeginByt, SizeOf(BufBeg)) then
    begin
      //нашли начало блока
     A := Fs.Position - 1;
     ExBegin := True;
    end;
   end;
    // нашли начало блока, ищем конец
   If ExBegin then
   begin
      // поиск конца блока
     Fs.ReadBuffer(Buf, SizeOf(Buf));
    if Buf = EndByt[0] then 
     begin
       Fs.Read(Buf, SizeOf(Buf));
      if Buf = EndByt[1] then 
       Inc(EndCont);
     end;  
       // проверка маркера
      if EndCont > 1 then
      begin
        // запомнить конец блока
       B := Fs.Position;
        // сохраним в файл
       Fs.Position := A;
       CopyFsToFile(Fs, B - A, IncludeTrailingBackslash(OutDir) + 'Out_Data.bin');
        // сброс маркеров
       ExBegin := False;
       ExEnd := False;
       EndCont := 0;
        Break;
      end;
   end;
 end;
  finally
 FreeAndNil(Fs);
  end;
end;

[mutabor]

Засекай время выполнения с помощью GetTickCount и оптимизируй поиск. Смотри внимательно в теле циклов, чтобы не было лишних проверок, лишних операций с памятью, размер блока считываемого в буфер попробуй увеличить, или уменьшить. В идеале поиск должен приближаться к простому последовательному считыванию данных с диска по скорости.

[Alter]

Сделал ещё одну, почти идентичную, функцию, где гружу в TMemoryStream. Ищет достаточно быстро, пара секунд.
Если например для поиска позиций маркеров в файле, использовать код отсюда http://www.programmersforum.ru/showp...19&postcount=5

function BMFind(szSubStr, buf: PChar; iBufSize: integer): integer;

возвращает позицию или что-то другое?

[mutabor]

Сделал ещё одну, почти идентичную, функцию, где гружу в TMemoryStream. Ищет достаточно быстро, пара секунд.

Значит торомоза были из-за частых чтений с диска. Делай лучше на TFileStream просто увеличь буфер, т.е. считывай в память большими кусками. TMemoryStream на больших файлах будет неэффективен (если искомая строка в начале, тогда время на загрузку в память уйдет в пустую), а если файл будет очень большой то он память переполнит.
Если правильно настроить, то можно добиться при потоковом считывании практически такого же времени как и с предварительной загрузкой в память.

The BMFind function used above is a Boyer-Moore search as shown below. This is the fastest string search known.

function BMFind(szSubStr, buf: PChar; iBufSize: integer): integer;
{ Returns -1 if substring not found,
or zero-based index into buffer if substring found }

Возвращает или -1 если не найдена строка, или же индекс в буфере, если найдена.

В том коде используется буфер в 8 кб

BUFSIZE = 8192;

Почему именно 8 кб (это 16 секторов), я не знаю, сам задавался вопросом как оптимальнее читать файлы с диска, мне говорили что-то про страницы памяти, что винда так память распределяет, а вообще сектор на диске равен 512 байт. Может еще от размера кластера зависит.

[Alter]

Модифицирован под 8 Кб буфер, вроде быстро:

const 
  BUFSIZE = 8192;
   // маркеры , для определения области нужных данных(Значения массивов[могут быть любой длины] для примера! Могут быть любые)
  BeginByt :array[0..4] of Byte = ($5B, $4A, $d3, $d7, $47);
  EndByt :array[0..1] of Byte = ($Af, $Af);

Поиск метки в буфере(-1 = Нет; в ином случае его позиция в файле):

function GetPosMark(var Strm: TFileStream; InpBuf, Marker: array of Byte;
  bfSize: Integer): Int64;
var
  BufRd :array of Byte; // чтение блока на сравнение, если нашли 1-ый символ
  I,II, J :Integer;
  DifPos :Int64; // узнать хватит ли позиций буфера, для сравнения
  Tst :Integer;
begin // поиск позиции метки
 Result := -1;
   Try
  II := High(InpBuf);
 for I:=Low(InpBuf) to II do
 begin
    // ищем первый символ маркера
  If InpBuf[I] = Marker[Low(Marker)] then
  begin
   DifPos := bfSize - I;
    // позиций буфера хватает
   If DifPos >= Length(Marker) then
   begin
    SetLength(BufRd, Length(Marker));
    // копир. из буфера файла для сравнения
    for J:=Low(Marker) to High(Marker) do
     BufRd[J] := InpBuf[I + J];
    // тест
     Tst := 0;
    for J:=Low(Marker) to High(Marker) do
     if BufRd[J] = Marker[J] then
      Inc(Tst);
    If Tst = Length(Marker) then
    begin
     Result := Strm.Position - DifPos;
      ///
     Strm.Position := (Strm.Position - DifPos) + Length(Marker);
     SetLength(BufRd, 0);
     Break;
    end;
   end
    else
   If DifPos < Length(Marker) then // позиций в буфере не достаточно
   begin
    // откат назад к позиции символа 1-го символа маркера
    Strm.Position := Strm.Position - DifPos;
    Result := -1;

     Break;
   end;
  end;
 end;
   finally
 SetLength(BufRd, 0);
   End;
end;

Поиск блока:

function FastExtractInDumpFile(DumpFile,
  OutDir: string): string;
var
  Fs :TFileStream;
  A,B :Int64;
  ExBegin :Boolean; // найденно начало блока
  ExEnd :Boolean; // найден конец блока
  EndCont :Byte; // сколько раз встречался конец маркера
  Buffer :array [0..BUFSIZE-1] of Byte;
  Poz :Int64; // значение функции проверки буфера
  SavFilePath :string;
begin
 if (FileExists(DumpFile) = False)or
    (DirectoryExists(OutDir) = False) then Exit;
 Fs := TFileStream.Create(DumpFile, fmOpenRead);
  try
 A := 0;
 B := 0;
 EndCont := 0;
 ExBegin := False;
 ExEnd := False;
 Fs.Position := 0;
 Fs.Position := 0;
 Poz := -1;
 while Fs.Position < Fs.Size - BufSize - 1 do
 begin
    // начало блока не найдено
   if ExBegin = False then
   begin
    Fs.ReadBuffer(Buffer, SizeOf(Buffer));
     // поиск позиции
    Poz := GetPosMark(Fs, Buffer, BeginByt, BUFSIZE);
     // нашли начало блока
    if Poz > -1 then
    begin
     A := Poz;
     ExBegin := True;
    end;
   end;
    // нашли начало блока, ищем конец
   If ExBegin then
   begin
    Fs.ReadBuffer(Buffer, SizeOf(Buffer));   
     // поиск конца блока
    Poz := GetPosMark(Fs, Buffer, EndByt, BUFSIZE);
    if Poz > -1 then
     Inc(EndCont);
       // проверка маркера
    if EndCont > 1 then
    begin
        // запомнить конец блока
       B := Poz + Length(EndByt);
       Fs.Position := A;
       SavFilePath := IncludeTrailingBackslash(OutDir) + GetNewKeyName;
       CopyFsToFile(Fs, B - A, SavFilePath);
        // сброс маркеров
       ExBegin := False;
       ExEnd := False;
       EndCont := 0;
        Result := SavFilePath; 
        Break; 
    end;
   end;
 end;
  finally
 FreeAndNil(Fs);
  end;
end;