[Delphi] Замена текста в бинарном файле, как?

Discussion in 'С/С++, C#, Rust, Swift, Go, Java, Perl, Ruby' started by Москва, 22 Jul 2015.

  1. Москва

    Москва New Member

    Joined:
    19 Oct 2010
    Messages:
    63
    Likes Received:
    3
    Reputations:
    0
    Если открыть файл через WinHex то видно текстовую строку, вот ее надо заменить на другую такой же длины. Нужно именно найти и заменить, а не по заранее заданным байтам патчить, т.к. файлы разные и соответственно адреса тоже.

    Приведу пример, к примеру мне надо заменить слово cannot на другое, оно в файле одно и не повторяется, а так же файлы могут быть разными и соответственно адреса к этому слову разные:
    [​IMG]
     
    #1 Москва, 22 Jul 2015
    Last edited: 22 Jul 2015
  2. #colorblind

    #colorblind Moderator

    Joined:
    31 Jan 2014
    Messages:
    634
    Likes Received:
    246
    Reputations:
    42
    #2 #colorblind, 22 Jul 2015
    Москва likes this.
  3. Москва

    Москва New Member

    Joined:
    19 Oct 2010
    Messages:
    63
    Likes Received:
    3
    Reputations:
    0
    #3 Москва, 22 Jul 2015
  4. #colorblind

    #colorblind Moderator

    Joined:
    31 Jan 2014
    Messages:
    634
    Likes Received:
    246
    Reputations:
    42
    Да, для такого большого файла алго хреновый, там идет побайтовое сравнение, а 70 000 000 итераций - это не круто)
    Хотя цикл не большой, в теории должно работать. Возможно у тебя намертво подвисает основной поток, в котором идет отрисовка формы. Щас ради интереса гляну, как у меня будет работать с большим файлом
     
    #4 #colorblind, 22 Jul 2015
    Москва likes this.
  5. #colorblind

    #colorblind Moderator

    Joined:
    31 Jan 2014
    Messages:
    634
    Likes Received:
    246
    Reputations:
    42
    Затестил, скорость конечно каловая. Создал файл 70 000 000 байт, в конце файла написал строку и через этот модуль запустил замену. Результаты удручают.
    PHP:
    Intel CoreQuad Q8300 2.50Ghz
    Execution time    : 271,911291515031 sec
    Зато нашел такую вот реализацию шикарного алгоритма Бойера-Мура:
    PHP:
    unit BMSearch;

    interface

    type
    {$ifdef WINDOWS}

    size_t = Word;
    {    $else}

    size_t = LongInt;
    {    $endif}

    type

    TTranslationTable     = array[char] of char; { таблица перевода }


    TSearchBM = class(TObject)
    private
    FTranslate : TTranslationTable; { таблица перевода }
    FJumpTable : array[char] of Byte; { таблица переходов }
    FShift_1 : integer;
    FPattern : pchar;
    FPatternLen : size_t;


    public
    procedure Prepare( Pattern: pchar; PatternLen: size_t; IgnoreCase: Boolean );
    procedure PrepareStr( const Pattern: string; IgnoreCase: Boolean );


    function     Search( Text: pchar; TextLen: size_t ): pchar;
    function     Pos( const S: string ): integer;
    end;


    implementation

    uses SysUtils    ;

    {    Игнорируем регистр таблицы перевода}
    procedure CreateTranslationTable( var T: TTranslationTable; IgnoreCase: Boolean );
    var
    c: char;
    begin
    for c := #0 to #255 do
    T[c] := c;

    if     not IgnoreCase then
    exit;

    for     c := 'a' to 'z' do
    T[c] := UpCase(c);

    {     Связываем все нижние символы с их эквивалентом верхнего регистра }
    T['Б'] := 'A';
    T['А'] := 'A';
    T['Д'] := 'A';
    T['В'] := 'A';


    T['б'] := 'A';
    T['а'] := 'A';
    T['д'] := 'A';
    T['в'] := 'A';


    T['Й'] := 'E';
    T['И'] := 'E';
    T['Л'] := 'E';
    T['К'] := 'E';


    T['й'] := 'E';
    T['и'] := 'E';
    T['л'] := 'E';
    T['к'] := 'E';


    T['Н'] := 'I';
    T['М'] := 'I';
    T['П'] := 'I';
    T['О'] := 'I';


    T['н'] := 'I';
    T['м'] := 'I';
    T['п'] := 'I';
    T['о'] := 'I';


    T['У'] := 'O';
    T['Т'] := 'O';
    T['Ц'] := 'O';
    T['Ф'] := 'O';


    T['у'] := 'O';
    T['т'] := 'O';
    T['ц'] := 'O';
    T['ф'] := 'O';


    T['Ъ'] := 'U';
    T['Щ'] := 'U';
    T['Ь'] := 'U';
    T['Ы'] := 'U';


    T['ъ'] := 'U';
    T['щ'] := 'U';
    T['ь'] := 'U';
    T['ы'] := 'U';


    T['с'] := 'С';
    end;

    {    Подготовка таблицы переходов}
    procedure TSearchBM.Prepare( Pattern: pchar; PatternLen: size_t;

    IgnoreCase: Boolean );
    var

    i: integer;
    c, lastc: char;
    begin

    FPattern     := Pattern;
    FPatternLen := PatternLen;


    if     FPatternLen < 1 then
    FPatternLen     := strlen(FPattern);


    {    Данный алгоритм базируется на наборе из 256 символов}
    if     FPatternLen > 256 then
    exit;

    {    1. Подготовка таблицы перевода}
    CreateTranslationTable( FTranslate, IgnoreCase);

    {    2. Подготовка таблицы переходов}
    for     c := #0 to #255 do
    FJumpTable[c] := FPatternLen;

    for     i := FPatternLen - 1 downto 0 do begin
    c     := FTranslate[FPattern[i]];
    if     FJumpTable[c] >= FPatternLen - 1 then
    FJumpTable    [c] := FPatternLen - 1 - i;
    end;

    FShift_1 := FPatternLen - 1;
    lastc := FTranslate[Pattern[FPatternLen - 1]];

    for     i := FPatternLen - 2 downto 0 do
    if     FTranslate[FPattern[i]] = lastc then begin
    FShift_1     := FPatternLen - 1 - i;
    break;
    end;

    if     FShift_1 = 0 then
    FShift_1     := 1;
    end;

    procedure TSearchBM.PrepareStr( const Pattern: string; IgnoreCase: Boolean );
    var
    str: pchar;
    begin
    if Pattern <> '' then begin
    {$ifdef Windows}

    str := @Pattern[1];
    {    $else}

    str := pchar(Pattern);
    {    $endif}

    Prepare( str, Length(Pattern), IgnoreCase);
    end;
    end;

    {    Поиск последнего символа & просмотр справа налево}
    function     TSearchBM.Search( Text: pchar; TextLen: size_t ): pchar;
    var
    shift, m1, j: integer;
    jumps: size_t;
    begin
    result     := nil;
    if     FPatternLen > 256 then
    exit;

    if     TextLen < 1 then
    TextLen     := strlen(Text);

    m1 := FPatternLen - 1;
    shift := 0;
    jumps := 0;

    {    Поиск последнего символа}

    while     jumps <= TextLen do begin
    Inc    ( Text, shift);
    shift := FJumpTable[FTranslate[Text^]];
    while     shift <> 0 do begin
    Inc    ( jumps, shift);
    if     jumps > TextLen then
    exit;

    Inc( Text, shift);
    shift := FJumpTable[FTranslate[Text^]];
    end;

    {    Сравниваем справа налево FPatternLen - 1 символов}
    if     jumps >= m1 then begin
    j     := 0;
    while     FTranslate[FPattern[m1 - j]] = FTranslate[(Text - j)^] do begin
    Inc    (j);
    if     j = FPatternLen then begin
    result     := Text - m1;
    exit;
    end;
    end;
    end;

    shift := FShift_1;
    Inc( jumps, shift);
    end;
    end;

    function     TSearchBM.Pos( const S: string ): integer;
    var
    str, p: pchar;
    begin
    result     := 0;
    if     S <> '' then begin
    {$ifdef Windows}

    str := @S[1];
    {    $else}

    str := pchar(S);
    {    $endif}

    p := Search( str, Length(S));
    if     p <> nil then
    result     := 1 + p - str;
    end;
    end;

    end.
     
    #5 #colorblind, 22 Jul 2015
    Москва likes this.
  6. Москва

    Москва New Member

    Joined:
    19 Oct 2010
    Messages:
    63
    Likes Received:
    3
    Reputations:
    0
    Вникнуть не могу как это применить)
     
    #6 Москва, 22 Jul 2015
  7. #colorblind

    #colorblind Moderator

    Joined:
    31 Jan 2014
    Messages:
    634
    Likes Received:
    246
    Reputations:
    42
    PHP:
    var
    mysearch:TSearchBM;
    begin
    mysearch    := TSearchBM.Create;
      try
          mysearch.PrepareStr('test', false);
          Writeln(mysearch.Pos('ttttesttttt'));
      finally
          SearchBM.Free;
          end;
    end;
    А вот под поиск в файле придется допиливать...
     
    #7 #colorblind, 22 Jul 2015
    Москва likes this.
  8. alexey-m

    alexey-m Elder - Старейшина

    Joined:
    15 Jul 2009
    Messages:
    518
    Likes Received:
    100
    Reputations:
    37
    замапь файл и пробегись по сигнатуре, например, должно отработать быстро на ~100М, а потом по найденному указателю сразу можно и записать нужные данные, код примерно такой:
    Code:
    function MemoryOffset(Memory: Pointer; Offset: Integer): Pointer;
asm
  add  eax,edx
end;

procedure writeFile(const szFile: PAnsiChar);
var
   hFile, hFileMap: THandle;
   pMem: Pointer;
   FileSize, x: DWORD;
const
   pwd: PWideChar = 'StoredPassword';
   sign: Integer = $00740053;
begin

   hFile:= CreateFileA(szFile,
             GENERIC_WRITE or GENERIC_READ,
             FILE_SHARE_READ or FILE_SHARE_WRITE,
             nil,
             OPEN_EXISTING,
             FILE_ATTRIBUTE_NORMAL,
             0);
            
   if (hFile <> INVALID_HANDLE_VALUE) then try
  
     FileSize:= GetFileSize(hFile, nil);
     hFileMap:= CreateFileMappingA(hFile, nil, PAGE_READWRITE, 0, FileSize, nil);
    
     if (hFileMap <> INVALID_HANDLE_VALUE) then try
      
       pMem:= MapViewOfFile(hFileMap, FILE_MAP_ALL_ACCESS, 0, 0, FileSize);
      
       if (pMem <> nil) then try
      
         for x:= 0 to FileSize - 4 do begin
        
           if DWORD(MemoryOffset(pMem, x)^) <> sign then Continue else
          
             if CmpStrW(pwd, MemoryOffset(pMem, x)) then begin
            
               // нашли нужную строку и сделали, что нам нужно
               ............
               Move(MemoryOffset(pMem, x)^, yourString[1], Length(yourString));
               ............
               Break;
             end;
         end;
       finally
         UnmapViewOfFile(pMem);
       end;
     finally
       CloseHandle(hFileMap);
     end;
   finally
     CloseHandle(hFile);
   end;
end;
     
    #8 alexey-m, 22 Jul 2015
    Москва likes this.
  9. #colorblind

    #colorblind Moderator

    Joined:
    31 Jan 2014
    Messages:
    634
    Likes Received:
    246
    Reputations:
    42
    Тоже запилил через мапинг, только без испольования CpwStrW, Move и прочего(имхо влияет на производительность). Результат порадовал.
    PHP:
    Position: 69999988
    Execution time    : 0,259840626516782 sec
    Всего 0,25 сек, при условии что искомый паттерн нашелся практически в самом конце файла

    Вот непосредственно поиск:
    PHP:
      For I := 1 To hFileSize Do
          Begin
          if result<>0
      then     break;

      If     lpBaseAddress[I] = search[1]
          Then begin
          for j:=1 to length(search)-1 do
      if     lpBaseAddress[I+J] = search[j+1]
          then begin
          if j+1=length(search)
          then begin
      result    :=i;
      break;
          end;
          end
          else break;
          end;

          End;
     
    #9 #colorblind, 22 Jul 2015
  10. alexey-m

    alexey-m Elder - Старейшина

    Joined:
    15 Jul 2009
    Messages:
    518
    Likes Received:
    100
    Reputations:
    37
    я бы такой код, скорее всего, использовать не стал, в силу того, что если, например, искомая строка common, а в файле будет частая последовательность символов с, со и т.д. будут выполняться дополнительные итерации и сравнения из второго цикла, имхо быстрее свериться с бОльшей сигнатурой, чем байт, у меня, к примеру, это двойное слово 0x00740053, что соответствует первым двум символам (в юникод) искомой строки StoredPassword, но это все имхо, тесты скорости не замерял) XD
     
    #10 alexey-m, 22 Jul 2015
    #colorblind likes this.
(You must log in or sign up to post here.)
Language
English (US)
    ANTICHAT ™ © 2001-2027 Antichat Kft.