Применение функции Хакера замены символов в боевых условиях

[Адская_Капча]

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

Под IDE возвращает правильно: >asd*zxc*qwe*< LenB=24
А в скомпилированном виде возвращает >asd
Причем если раскомментировать внизу функции Repl строку "MsgBox sString", то в Native будет возвращаться верная строка. Чудеса в решете...

В чем тут может быть проблема и как сделать, чтобы верная строка возвращалась?

Код: Выделить всё

Option Explicit

Declare Sub PutMem4 Lib "msvbvm60" (pRet As Any, ByVal lNewVal As Long)

Private m_sMainString As String

Sub Main()
   m_sMainString = "asd" + Chr$(0) + "zxc" + Chr$(0) + "qwe" + Chr$(0)
   
   'MsgBox "StrPtr(m_sMainString)=" & Hex(StrPtr(m_sMainString))
   
   If LenB(m_sMainString) Then Repl m_sMainString, 0, 42
   
   MsgBox ">" + m_sMainString + "<" + vbNewLine + "LenB=" + CStr(LenB(m_sMainString))
End Sub

'Функция Хакера быстрой замены символов (http://bbs.vbstreets.ru/viewtopic.php?t=36100)
Function Repl(sString As String, _
              ByVal Search As Integer, _
              ByVal Replacement As Integer, _
              Optional ByVal Stub As Long, _
              Optional ByRef Replacer As Integer) As Long
             
'    sString = Replace$(sString, ChrW(0), ChrW(42))
'    Exit Function
   
    ' По поводу аргументов:
    '  sString     - строка, в которой производится замена
    '  Search      - что ищем
    '  Replacement - чем заменяем
    '     Stub - заглушка, Replacer - наш самодельный указатель
   
   Dim CurPos As Long
   Dim EndPos As Long
   Dim ptrAddress As Long  ' Здесь будем хранить VarPtr(Stub)+4
                           ' чтобы каждый раз не считать
   
   CurPos = StrPtr(sString)
   'MsgBox "StrPtr(sString)=" & Hex(CurPos)
   EndPos = CurPos + LenB(sString)
   
   ptrAddress = VarPtr(Stub) + 4
   
   Do
      PutMem4 ByVal ptrAddress, CurPos
      ' Момент истины:
      If Replacer = Search Then Replacer = Replacement ' А вы думали? ;)
       
      CurPos = CurPos + 2     ' Переходим к обработке след. символа
   Loop Until CurPos = EndPos
   'MsgBox sString
End Function


[The trick]

Это из-за оптимизаций которые проводит компилятор. Компилируй с No optimizations и все будет работать.

[The trick]

Вот попробуй другой вариант, но он работает только в скомпилированном виде, зато быстрее. Нужно скомпилировать с отключенной проверкой границ массивов.

Код: Выделить всё

Option Explicit

Private m_sMainString As String
Dim tmp(0)   As Integer

Sub Main()
   m_sMainString = "asd" + Chr$(0) + "zxc" + Chr$(0) + "qwe" + Chr$(0)
   
   'MsgBox "StrPtr(m_sMainString)=" & Hex(StrPtr(m_sMainString))
   
   If LenB(m_sMainString) Then Repl2 m_sMainString, 0, 42
   
   MsgBox ">" + m_sMainString + "<" + vbNewLine + "LenB=" + CStr(LenB(m_sMainString))
End Sub

Function Repl2(sString As String, _
              ByVal Search As Integer, _
              ByVal Replacement As Integer) As Long
    Dim idx      As Long
    Dim endIdx   As Long
   
    idx = (StrPtr(sString) - VarPtr(tmp(0))) \ 2
    endIdx = idx + Len(sString)
   
    Do While idx < endIdx
       
        If tmp(idx) = Search Then tmp(idx) = Replacement
        idx = idx + 1
       
    Loop
   
End Function

[Адская_Капча]

И правда, теперь стало работать)) Спаситель The trick!

Радиокнопка стояла на "Optimize for Fast Code". А что именно делает этот режим оптимизации и дает ли он реальный прирост быстроты? Или идеала нет и придется выбирать компромиссы? Либо можно ли как-то подшаманить с функцией Repl, чтобы оптимизатор не портил код?

[Хакер]

О боже мой. Да тот кусочек кода ни разу не предназначался для реальной жизни (для использования для замены символов). Это была демонстрация фишки.

Если цель в очень быстрой замене символов, то существуют куда более годные варианты. Например с использованием «At».

[Адская_Капча]

The trick, прием "с массивом" крут и работает, только не совсем понятно как
А при обращении к элементу массива он не будет ArrayLock и потом ArrayUnlock, ведь это замедляет время? Или блокировка происходит, если только в API передавать?
И ничего не будет страшного, если tmp(0) объявить локально, а не глобально?

Хакер, по-поводу использования TLB у меня есть целый ряд вопросов, можно ли их вам задать? И если да, то где лучше задать, здесь или новую тему для этого сделать, или присоединиться к какой-либо теме про TLB?

В итоге удалось создать вставку для быстрой замены определенного символа в BSTR-строке, может кому понадобится
Пример вставки приведен для патчинга функции в модуле класса и работает как в Native, так и под IDE. Под обычный модуль будет немного по другому и меньше (инстанс не будет передаваться, ну и XOR можно убрать в конце).

Примечание: мне внутри цикла нужны были некоторые действия, как при Current <> Search, так и при Current = Search, поэтому сделано без REPNE. Чтобы избавиться от лишнего JMP, переход на суслинг-метку (LOOP Cycling) присутствует дважды.

Хорошая вставка?

Код: Выделить всё

PUSH edi
MOV edi, [esp+12]    ;lpStr
MOV eax, [esp+16]    ;Search
MOV ebx, [esp+20]    ;Replacer

MOV ecx, [edi-4]     ;LenB
SHR ecx, 1           ;Len
XOR edx, edx         ;Replaced count

TEST ecx, ecx        ;If Len=0 GoTo ExitProc
JZ ExitProc

CLD                  ;Forward Scan

Cycling:
   SCASW
   JE Equal
      ;Some Actions, If Current <> Search
      ;;---
LOOP Cycling
JMP short ExitProc
   Equal:
      ;Some Actions, If Current = Search
      INC edx
      MOV [edi-2], bx
      ;---
LOOP Cycling

ExitProc:
XOR eax, eax
XOR ebx, ebx
POP edi
MOV ecx, [esp+20]
MOV [ecx], edx
RET 20

Строковый хексдамп вставки, как он есть, разбитый на блоки:

Код: Выделить всё

578B7C24 0C8B4424 108B5C24 148B4FFC D1E931D2 85C97410 FC66AF74 04E2FAEB 07426689 5FFEE2F1 31C031DB 5F8B4C24 148911C2 14000000

Код: Выделить всё

'Прототип функции от Адской Капчи для быстрой замены символа в BSTR-строке.
'Возвращает число замененных символов.
'Топик для обсуждений функции - http://bbs.vbstreets.ru/viewtopic.php?f=1&t=50816
Function ReplCharW(ByVal lpBStr As Long, _
                   ByVal wCharSrc As Integer, _
                   ByVal wCharRepl As Integer) As Long
End Function

[The trick]

The trick, прием "с массивом" крут и работает, только не совсем понятно как

Да очень просто. Если отключена проверка индексов, то я могу обращаться к любой ячейки памяти используя смещение относительно первого элемента. К примеру если VarPtr(arr(0)) = 100, то если я напишу Arr(-5) то получу значение по адресу 95 (это при условии использования байтового массива).

А при обращении к элементу массива он не будет ArrayLock и потом ArrayUnlock, ведь это замедляет время?

Не будет. Вот код, цикл минимален, даже быстрее использования PutMem:

Repl2_asm_code.PNG (18.01 Кб) Просмотров: 2595

И ничего не будет страшного, если tmp(0) объявить локально, а не глобально?

Ну это просто увеличит время, т.к. при каждом вызове функции будет создаваться и удалятся массив. Можешь еще увеличить производительность задействовав пользовательский тип:

Код: Выделить всё

Option Explicit

Private Type QPtr
    tmp(0)   As Integer
End Type

Private m_sMainString As String

Sub Main()
   m_sMainString = "asd" + Chr$(0) + "zxc" + Chr$(0) + "qwe" + Chr$(0)
   
   'MsgBox "StrPtr(m_sMainString)=" & Hex(StrPtr(m_sMainString))
   
   If LenB(m_sMainString) Then Repl2 m_sMainString, 0, 42
   
   MsgBox ">" + m_sMainString + "<" + vbNewLine + "LenB=" + CStr(LenB(m_sMainString))
End Sub

Function Repl2(sString As String, _
              ByVal Search As Integer, _
              ByVal Replacement As Integer) As Long
    Dim idx      As Long
    Dim endIdx   As Long
    Dim ptr      As QPtr
   
    idx = (StrPtr(sString) - VarPtr(ptr.tmp(0))) \ 2
    endIdx = idx + Len(sString)
   
    Do While idx < endIdx
       
        If ptr.tmp(idx) = Search Then ptr.tmp(idx) = Replacement
        idx = idx + 1
       
    Loop
   
End Function


Цикл сократился еще больше:

Repl2_asm_code_improved.PNG (18.05 Кб) Просмотров: 2595