Mensajes

[Deberías probar la velocidad de los códigos en unas 10000 ejecuciones... ya que ahí es donde se ve mejor la diferencia de velocidades]

Código (vb) [Seleccionar] Expandir

Private Static Function kGetNums(ByVal s As String) As String
   Dim bv(0)   As Byte
   Dim pbv     As Long
   Dim rps     As Long
   Dim i       As Long
   Dim b       As Byte
   Dim w       As Long
   
   kGetNums = s

   If pbv = 0 Then pbv = VarPtr(bv(0))

   rps = StrPtr(kGetNums) - pbv

   For i = 0 To LenB(kGetNums) Step 10
       b = bv(rps + i + 0)
       If b >= &H30 Then
           If b <= &H39 Then
               bv(rps + w) = b
               w = w + 2
           End If
       End If
       b = bv(rps + i + 2)
       If b >= &H30 Then
           If b <= &H39 Then
               bv(rps + w) = b
               w = w + 2
           End If
       End If
       b = bv(rps + i + 4)
       If b >= &H30 Then
           If b <= &H39 Then
               bv(rps + w) = b
               w = w + 2
           End If
       End If
       b = bv(rps + i + 6)
       If b >= &H30 Then
           If b <= &H39 Then
               bv(rps + w) = b
               w = w + 2
           End If
       End If
       b = bv(rps + i + 8)
       If b >= &H30 Then
           If b <= &H39 Then
               bv(rps + w) = b
               w = w + 2
           End If
       End If
   Next i

   bv(rps + w) = 0
End Function

Deberías probar la velocidad de los códigos en unas 10000 ejecuciones... ya que ahí es donde se ve mejor la diferencia de velocidades

Ha habido una confusión xD Pensaba que accedías al Integer usando un Array de Bytes Mi error

Voy a arriesgar: BlackZeroX tu código no funcionará siempre Y si funciona es de suerte

Te arriesgas a que por alguna razón VB6 te meta el array de words en una dirección impar y a partir de ahí todos tus accesos ya no son correctos

[HAY QUE DESACTIVAR LA COMPROBACIÓN DE TAMAÑO DEL BUFFER!!!]

@RHL: No deberías declarar RtlMoveMemory() por el ordinal... es probable que no funcione en todas las versiones de W$.

Mi código:

Código (vb) [Seleccionar] Expandir

Private Static Sub kGetNums(ByRef s As String)
   Dim bv(0)   As Byte
   Dim pbv     As Long
   Dim rps     As Long
   Dim i       As Long
   Dim b       As Byte
   Dim w       As Long
   
   If pbv = 0 Then pbv = VarPtr(bv(0))
   
   rps = StrPtr(s) - pbv
   w = 0
   
   For i = 0 To LenB(s) Step 10
       b = bv(rps + i + 0)
       If b >= &H30 Then
           If b <= &H39 Then
               bv(rps + w) = b
               w = w + 2
           End If
       End If
       b = bv(rps + i + 2)
       If b >= &H30 Then
           If b <= &H39 Then
               bv(rps + w) = b
               w = w + 2
           End If
       End If
       b = bv(rps + i + 4)
       If b >= &H30 Then
           If b <= &H39 Then
               bv(rps + w) = b
               w = w + 2
           End If
       End If
       b = bv(rps + i + 6)
       If b >= &H30 Then
           If b <= &H39 Then
               bv(rps + w) = b
               w = w + 2
           End If
       End If
       b = bv(rps + i + 8)
       If b >= &H30 Then
           If b <= &H39 Then
               bv(rps + w) = b
               w = w + 2
           End If
       End If
   Next i
   
   bv(rps + w) = 0
End Sub


Código (vb) [Seleccionar] Expandir

dim x as string
x = "1e2e3a4b"
call kGetNums(x)
msgbox x
HAY QUE DESACTIVAR LA COMPROBACIÓN DE TAMAÑO DEL BUFFER!!! Y probar compilado (of course!)!!!
He arriesgado un poco con el unwinding del bucle... pero ya veremos los resultados

Sería conveniente también que para hacer las pruebas de velocidad además de hacerlo compilado hacerlo sin comprobación de buffers y comprobación de overflow!!

PD: He ganado a "tu" mov

No debería devolver un número?
Deberías poner la declaración de la función, para que BlackZeroX no empiece a usar buffers declarados fuera de esta

Fíjate en el "Heur" de las detecciones... esto indica que es una detección heuristica...

Necesito saber más del ejecutable para poder aconsejarte... si puedes adjuntar una captura de las secciones del PE vistas con LordPE o algún otro software editor de PE como CFF explorer...

No todas las detecciones son por firma... aveces son heuristicas... lo que significa que una combinación de factores hace que salte la alerta...

Que detecciones te da?

Si existe, solo que ahora estamos trabajando en el Stealth... y quedó apartado...

SaveSetting/GetSetting

Código (vb) [Seleccionar] Expandir

Option Explicit

'---------------------------------------------------------------------------------------
' Module    : mPatchFunction
' Author    : Karcrack
' Date      : 27/11/2011
' Purpose   : Patch function with JMP to new addr
'---------------------------------------------------------------------------------------

'NTDLL
Private Declare Function NtWriteVirtualMemory Lib "NTDLL" (ByVal hProcess As Long, ByRef lpBaseAddress As Any, ByRef lpBuffer As Any, ByVal nSize As Long, ByRef lpNumberOfBytesWritten As Long) As Long

Private Const CURRENT_PROCESS = (-1)

Public Function PatchFunction(ByVal pFnc As Long, ByVal pNewFnc As Long, Optional ByVal hProc As Long = CURRENT_PROCESS) As Boolean
    Dim cCode   As Currency
   
    cCode = &HB8& * (0.0001@)                   'mov EAX, imm32
    cCode = cCode + (pNewFnc * 0.0256@)         'imm32
    cCode = cCode + (&HE0FF& * 109951162.7776@) 'jmp EAX
   
    PatchFunction = NtWriteVirtualMemory(hProc, ByVal pFnc&, cCode, &H8, 0&)
End Function

Ejemplo de uso:

Código (vb) [Seleccionar] Expandir

Sub Main()
    Dim pMessageBoxW    As Long
   
    pMessageBoxW = GetProcAddress(LoadLibrary("USER32"), "MessageBoxW")
   
    If PatchFunction(AddressOf MessageBoxW__, pMessageBoxW) Then
        If MessageBoxW__(0, "Did you like the function?", "Karcrack", vbYesNo) = vbYes Then
            Call MessageBoxW__(0, "Glad you liked it", "Karcrack", 0)
        Else
            Call MessageBoxW__(0, "F**k you bastard xD", "Karcrack", 0)
        End If
    End If
End Sub

Public Function MessageBoxW__(ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
    'JMP &MessageBoxW@USER32
End Function