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

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

  1. Москва

    Москва New Member

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

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

    #colorblind Elder - Старейшина

    Joined:
    31 Jan 2014
    Messages:
    598
    Likes Received:
    220
    Reputations:
    36
  3. Москва

    Москва New Member

    Joined:
    19 Oct 2010
    Messages:
    67
    Likes Received:
    3
    Reputations:
    0
  4. #colorblind

    #colorblind Elder - Старейшина

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

    #colorblind Elder - Старейшина

    Joined:
    31 Jan 2014
    Messages:
    598
    Likes Received:
    220
    Reputations:
    36
    Затестил, скорость конечно каловая. Создал файл 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[charof char; { таблица перевода }


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


    public
    procedure PreparePatternpcharPatternLensize_tIgnoreCaseBoolean );
    procedure PrepareStr( const PatternstringIgnoreCaseBoolean );


    function 
    SearchTextpcharTextLensize_t ): pchar;
    function 
    Pos( const Sstring ): integer;
    end;


    implementation

    uses SysUtils
    ;

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

    if 
    not IgnoreCase then
    exit;

    for 
    := '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.PreparePatternpcharPatternLensize_t;

    IgnoreCaseBoolean );
    var

    iinteger;
    clastcchar;
    begin

    FPattern 
    := Pattern;
    FPatternLen := PatternLen;


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


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

    {
    1. Подготовка таблицы перевода}
    CreateTranslationTableFTranslateIgnoreCase);

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

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

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

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

    if 
    FShift_1 0 then
    FShift_1 
    := 1;
    end;

    procedure TSearchBM.PrepareStr( const PatternstringIgnoreCaseBoolean );
    var
    strpchar;
    begin
    if Pattern <> '' then begin
    {$ifdef Windows}

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

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

    PreparestrLength(Pattern), IgnoreCase);
    end;
    end;

    {
    Поиск последнего символа просмотр справа налево}
    function 
    TSearchBM.SearchTextpcharTextLensize_t ): pchar;
    var
    shiftm1jinteger;
    jumpssize_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
    Textshift);
    shift := FJumpTable[FTranslate[Text^]];
    while 
    shift <> do begin
    Inc
    jumpsshift);
    if 
    jumps TextLen then
    exit;

    IncTextshift);
    shift := FJumpTable[FTranslate[Text^]];
    end;

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

    shift := FShift_1;
    Incjumpsshift);
    end;
    end;

    function 
    TSearchBM.Pos( const Sstring ): integer;
    var
    strppchar;
    begin
    result 
    := 0;
    if 
    <> '' then begin
    {$ifdef Windows}

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

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

    := SearchstrLength(S));
    if 
    <> nil then
    result 
    := str;
    end;
    end;

    end.
     
    Москва likes this.
  6. Москва

    Москва New Member

    Joined:
    19 Oct 2010
    Messages:
    67
    Likes Received:
    3
    Reputations:
    0
    Вникнуть не могу как это применить)
     
  7. #colorblind

    #colorblind Elder - Старейшина

    Joined:
    31 Jan 2014
    Messages:
    598
    Likes Received:
    220
    Reputations:
    36
    PHP:
    var
    mysearch:TSearchBM;
    begin
    mysearch
    := TSearchBM.Create;
      try
      
    mysearch.PrepareStr('test'false);
      
    Writeln(mysearch.Pos('ttttesttttt'));
      finally
      
    SearchBM.Free;
      
    end;
    end;
    А вот под поиск в файле придется допиливать...
     
    Москва 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;
    
     
    Москва likes this.
  9. #colorblind

    #colorblind Elder - Старейшина

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

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

      If 
    lpBaseAddress[I] = search[1]
      
    Then begin
      
    for j:=1 to length(search)-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;
     
  10. alexey-m

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

    Joined:
    15 Jul 2009
    Messages:
    518
    Likes Received:
    100
    Reputations:
    37
    я бы такой код, скорее всего, использовать не стал, в силу того, что если, например, искомая строка common, а в файле будет частая последовательность символов с, со и т.д. будут выполняться дополнительные итерации и сравнения из второго цикла, имхо быстрее свериться с бОльшей сигнатурой, чем байт, у меня, к примеру, это двойное слово 0x00740053, что соответствует первым двум символам (в юникод) искомой строки StoredPassword, но это все имхо, тесты скорости не замерял) XD
     
    #colorblind likes this.
Loading...