Foro de elhacker.net

Hace mucho tiempo que no toqueteaba a mi querido VB6 :P Así que aquí estoy con otra primicia chicoooos!!! :laugh: :laugh:

Este modulito que os presento permite trabajar con la memoria sin el uso de ningún API!!!!

Eso sí! Tenéis que desactivar la comprobación de límites de matrices :P Os pongo una foto:
(http://i44.tinypic.com/nbouww.png)
Además solo funciona compilado, como muchos otros hacks el IDE no permite tocar demasiado :-\ :xD

Y como todos estáis deseando aquí viene el sencillo pero eficaz código :)

'---------------------------------------------------------------------------------------
' Module    : mMemory
' Author    : Karcrack
' Date      : 20/09/2011
' Purpose   : Work with memory withouth using any API
' History   : 20/09/2011 First cut .....................................................
'---------------------------------------------------------------------------------------
 
Option Explicit
 
Private bvHack(0)               As Byte
Private lHackDelta              As Long
Private bInitialized            As Boolean
 
Public Function Initialize() As Boolean
    On Error GoTo Error_Handle
 
    bvHack(-1) = bvHack(-1) 'Error check
    lHackDelta = VarPtr(bvHack(0))
 
    Initialize = True
    bInitialized = Initialize
    Exit Function
Error_Handle:
    If Err.Number = 9 Then Debug.Print "Remember to tick 'Remove array boundary check' and compile before using"
    End
End Function
 
Public Function GetByte(ByVal lPtr As Long) As Byte
    If bInitialized Then GetByte = bvHack(lPtr - lHackDelta)
End Function
 
Public Function GetWord(ByVal lPtr As Long) As Integer
    If bInitialized Then GetWord = MakeWord(GetByte(lPtr + &H0), GetByte(lPtr + &H1))
End Function
 
Public Function GetDWord(ByVal lPtr As Long) As Long
    If bInitialized Then GetDWord = MakeDWord(GetWord(lPtr + &H0), GetWord(lPtr + &H2))
End Function
 
Public Sub PutByte(ByVal lPtr As Long, ByVal bByte As Byte)
    If bInitialized Then bvHack(lPtr - lHackDelta) = bByte
End Sub
 
Public Sub PutWord(ByVal lPtr As Long, ByVal iWord As Integer)
    If bInitialized Then Call PutByte(lPtr + &H0, iWord And &HFF): Call PutByte(lPtr + &H1, (iWord And &HFF00&) \ &H100)
End Sub
 
Public Sub PutDWord(ByVal lPtr As Long, ByVal lDWord As Long)
    If bInitialized Then Call PutWord(lPtr + &H0, IIf(lDWord And &H8000&, lDWord Or &HFFFF0000, lDWord And &HFFFF&)): Call PutWord(lPtr + &H2, (lDWord And &HFFFF0000) \ &H10000)
End Sub
 
Private Function MakeWord(ByVal loByte As Byte, ByVal hiByte As Byte) As Integer '[http://www.xbeat.net/vbspeed/c_MakeWord.htm#MakeWord02]
    If hiByte And &H80 Then
        MakeWord = ((hiByte * &H100&) Or loByte) Or &HFFFF0000
    Else
        MakeWord = (hiByte * &H100) Or loByte
    End If
End Function
 
Private Function MakeDWord(ByVal LoWord As Integer, ByVal HiWord As Integer) As Long '[http://www.xbeat.net/vbspeed/c_MakeDWord.htm#MakeDWord05]
    MakeDWord = (HiWord * &H10000) Or (LoWord And &HFFFF&)
End Function

Si saco un poco de tiempo libre hago una clase chuli piruli con este mismo sistema :)

Happy codin' ::)

Ejemplo de uso:

Private Sub Form_Load()
    Dim x       As Long
    Dim y       As Long
 
    Call mMemory.Initialize
 
    x = &H1337
    y = 0
    MsgBox x & vbCrLf & y
    y = mMemory.GetDWord(VarPtr(x))
    MsgBox x & vbCrLf & y
End Sub
 

;)

 ;-) ;-) ;-) ;-)
Grande Karcrack!  ;D
lo estudiare, me imagino que es mas rapido que las apis,rtlmovememory?

Sipi ;D Básicamente son movs en ASM... el compilador se encarga del asunto ;)

Karcrack estudie tu code ;D
y pues tengo unas dudas lo segui con el dbg en el ide me las arregle como pude :P
y veo que los haces como en el "aire de la memoria" podria colgarse la app si en el array en las posiciones (-xxxxxx) se encuentre ya ocupada ? :P

Bueno ya, me saco la duda...

¿que podria hacer con esto? :B

@Raul100: Todas las posiciones ya existen, el array solo ocupa 1 byte... el resto de indices se salen del array, es por eso que hay que indicarle al compilador que no queremos que compruebe si el indice es mayor que el tamaño del array... De esta forma podemos movernos a cualquier posición de memoria utilizando como referencia la posicion del unico byte que hemos reservado en memoria. :)

@nukje:De todo. :xD Básicamente es para eliminar el uso de funciones para el acceso de memoria.. así se pueden crear RunPEs y Invokes indetectables aún más fácilmente :D

Dioooss Karcrack!!! Eres el amoo!! +100000
Muchas Graciaas!!
 ;-)

Edit: el PutDWord me da error >,<

¿Podrías ponerme un ejemplo en el que te dé error? Las funciones put las hice un poco rápido y no testee, pero debe ir correctamente :P Comprueba que no estas intentando escribir en una zona no Writeable de la memoria.

Se me habia ocurrido algo casi igual hace rato cuando vi esa opcion... pero nunca para algo tan asi como lo que te rifaste... esto esta bueno!¡.

Dulces Lunas!¡.

Public Sub PutDWord(ByVal lPtr As Long, ByVal lDWord As Long)
    If bInitialized Then Call PutWord(lPtr + &H0, IIf(lDWord And &H8000&, lDWord Or &HFFFF0000, lDWord And &HFFFF&)): Call PutWord(lPtr + &H2, (lDWord And &HFFFF0000) \ &H10000)
End Sub

Arreglado :D

Saludos!

Puse el low donde iba el hi y viceversa jaja gracias Slek :) Lo corrijo :-*

Thanks so much for this, I've tried to use it on your PatchAPI function but I can't get it working :( Could you give us a sample please?

You won't be able to write there because the memory section isn't writeable... you must use VirtualProtect() first...

hello i have a problem with this function



i have use PutByte but i have an error Overflow you can help me please.

@scapula:
Also you must remember that with this method you cannot write in memory regions wich aren't writeable...

.
Agregue mas funciones gracias a las funciones que propuso el compañero Karcrack... como reservar memoria.

 
Option Explicit
 
Private Sub Form_Load()
Dim sStr1   As String
Dim sStr2   As String
Dim lpStr   As Long
 
 
    sStr1 = "BlackZeroX"
    sStr2 = "InfrAngeluX-Soft"
    MsgBox sStr1 & vbCrLf & sStr2
    lpStr = mMemory.cloneString(VarPtr(sStr2), sStr1)       '  <--------------------- clone sStr1.
    MsgBox sStr1 & vbCrLf & sStr2
    Call mMemory.swapVarPtr(VarPtr(lpStr), VarPtr(sStr2))   '   //  restauramos.
    MsgBox sStr1 & vbCrLf & sStr2
    Call mMemory.releaseMemStr(lpStr)                       '   //  liberamos  la copia de sStr1 (release sStr1 clone)
 
    '   //  Other example.
Dim sStr3   As String
Dim lpSafe  As Long
    lpSafe = mMemory.allocMem((LenB(sStr1) + 4 + 2))
    lpStr = (mMemory.getMemData(lpSafe) + 4)
    Call mMemory.writeMemory((lpStr - 4), (StrPtr(sStr1) - 4), (LenB(sStr1) + 4 + 2))
    Call mMemory.swapVarPtr(VarPtr(sStr3), VarPtr(lpStr))
    MsgBox "ejemplo 2: " & sStr3
    Call mMemory.swapVarPtr(VarPtr(sStr3), VarPtr(lpStr))
    mMemory.releaseMem (lpSafe) ' // liberamos la memoria reservada con allocMem()
    MsgBox "ejemplo 2 Finish: " & sStr3
End Sub
 
 

 
Option Explicit
 
Private Sub Form_Load()
Dim sStr1   As String
Dim sStr2   As String
Dim lpStr   As Long
Dim i       As Long
Dim a       As Byte
 
    Call mMemory.Initialize
 
    sStr1 = "BlackZeroX"
    sStr2 = "InfrAngeluX-Soft"
    MsgBox sStr2 & vbCrLf & sStr1
    MsgBox mMemory.writeMemory(StrPtr(sStr2) + 8, StrPtr(sStr1) + 10, 10)
    MsgBox sStr2 & vbCrLf & sStr1
End Sub
 
 

 
'---------------------------------------------------------------------------------------
' Module    : mMemory
' Author    : Karcrack
' Date      : 20/09/2011
' Purpose   : Work with memory withouth using any API
' History   : 20/09/2011 First cut .....................................................
'---------------------------------------------------------------------------------------
 
Option Explicit
 
Public Declare Function VarPtrArr Lib "msvbvm60.dll" Alias "VarPtr" (ByRef Ptr() As Any) As Long
 
Private bvHack(0)               As Byte
Private lHackDelta              As Long
Private bInitialized            As Boolean
 
Public Function Initialize() As Boolean
    On Error GoTo Error_Handle
 
    bvHack(-1) = bvHack(-1) 'Error check
    lHackDelta = VarPtr(bvHack(0))
 
    Initialize = True
    bInitialized = Initialize
    Exit Function
Error_Handle:
    If Err.Number = 9 Then Debug.Print "Remember to tick 'Remove array boundary check' and compile before using"
'    End
End Function
 
Public Function GetByte(ByVal lptr As Long) As Byte
    If bInitialized Then GetByte = bvHack(lptr - lHackDelta)
End Function
 
Public Function GetWord(ByVal lptr As Long) As Integer
    If bInitialized Then GetWord = MakeWord(GetByte(lptr + &H0), GetByte(lptr + &H1))
End Function
 
Public Function GetDWord(ByVal lptr As Long) As Long
    If bInitialized Then GetDWord = MakeDWord(GetWord(lptr + &H0), GetWord(lptr + &H2))
End Function
 
Public Sub PutByte(ByVal lptr As Long, ByVal bByte As Byte)
    If bInitialized Then bvHack(lptr - lHackDelta) = bByte
End Sub
 
Public Sub PutWord(ByVal lptr As Long, ByVal iWord As Integer)
    If bInitialized Then Call PutByte(lptr + &H0, iWord And &HFF): Call PutByte(lptr + &H1, (iWord And &HFF00&) \ &H100)
End Sub
 
Public Sub PutDWord(ByVal lptr As Long, ByVal lDWord As Long)
    If bInitialized Then Call PutWord(lptr + &H0, IIf(lDWord And &H8000&, lDWord Or &HFFFF0000, lDWord And &HFFFF&)): Call PutWord(lptr + &H2, (lDWord And &HFFFF0000) \ &H10000)
End Sub
 
Public Function MakeWord(ByVal loByte As Byte, ByVal hiByte As Byte) As Integer '[http://www.xbeat.net/vbspeed/c_MakeWord.htm#MakeWord02]
    If hiByte And &H80 Then
        MakeWord = ((hiByte * &H100&) Or loByte) Or &HFFFF0000
    Else
        MakeWord = (hiByte * &H100) Or loByte
    End If
End Function
 
Public Function MakeDWord(ByVal LoWord As Integer, ByVal HiWord As Integer) As Long '[http://www.xbeat.net/vbspeed/c_MakeDWord.htm#MakeDWord05]
    MakeDWord = (HiWord * &H10000) Or (LoWord And &HFFFF&)
End Function
 
 
 
 
 
 
'/////////////////////
Public Function allocMem(ByVal lSize As Long) As Long
'   //  By BlackZeroX (Thanks to Karcrack to GetDWord() function and PutDWord() function ).
'   //  Retorna la Dirrecion de un SafeArray.
Dim pBuff()     As Byte
    If (lSize <= &H0) Then Exit Function
    ReDim pBuff(0 To (lSize - 1))
    allocMem = GetDWord(VarPtrArr(pBuff))
    PutDWord VarPtrArr(pBuff), 0
End Function
 
Public Function reallocMem(ByVal lptr As Long, ByVal lSize As Long) As Long
'   //  By BlackZeroX (Thanks to Karcrack to GetDWord() function and PutDWord() function ).
'   //  Retorna la Dirrecion de un SafeArray que se retorno en allocMem()/reallocMem().
Dim pBuff()     As Byte
    PutDWord VarPtrArr(pBuff), lptr
    If not (lSize = &H0) Then
        ReDim Preserve pBuff(0 To (lSize - 1))
    Else
        Erase pBuff
    End If
    reallocMem = GetDWord(VarPtrArr(pBuff))
    PutDWord VarPtrArr(pBuff), 0
End Function
 
Public Function getMemData(ByVal lptr As Long) As Long
'   //  By BlackZeroX (Thanks to Karcrack to GetDWord() function and PutDWord() function ).
'   //  lPtr debe ser el valor (Address) que retorno en allocMem()/reallocMem().
'   //  Esta funcion retorna la Dirrecion de memoria EDITABLE de lPtr (Dirrecion de un SafeArray).
'   //  Referencias.
'   //  http://msdn.microsoft.com/en-us/library/aa908603.aspx
    If (lptr = &H0) Then Exit Function
    getMemData = GetDWord(lptr + &HC)    '   //  obtenemos pvData
End Function
 
Public Sub releaseMem(ByVal lptr As Long)
'   //  By BlackZeroX (Thanks to Karcrack to GetDWord() function and PutDWord() function ).
'   //  lPtr debe ser la Dirrecion que retorno en allocMem()/reallocMem().
Dim pBuff()     As Byte
    PutDWord VarPtrArr(pBuff), lptr
End Sub
 
Public Sub releaseMemStr(ByVal lptr As Long)
'   //  By BlackZeroX (Thanks to Karcrack to GetDWord() function and PutDWord() function ).
'   //  lPtr debe ser la Dirrecion que retorno en cloneString().
Dim sStr        As String
    PutDWord VarPtr(sStr), lptr
End Sub
 
Public Sub swapVarPtr(ByVal lpVar1 As Long, ByVal lpVar2 As Long)
'   //  By BlackZeroX (Thanks to Karcrack to GetDWord() function and PutDWord() function ).
Dim lAux    As Long
    lAux = GetDWord(lpVar1)
    Call PutDWord(lpVar1, GetDWord(lpVar2))
    Call PutDWord(lpVar2, lAux)
End Sub
 
Public Function cloneString(ByVal lpStrDst As Long, ByVal sStrSrc As String) As Long
'   //  By BlackZeroX (Thanks to Karcrack to GetDWord() function and PutDWord() function ).
'   //  lPtr -> Puntero a una variable destino (Preferiblemente String).
'   //  sStr -> Cadena Clonada ( gracias a Byval ).
Dim lpStrSrc        As Long
    If Not (lpStrDst = &H0) And (mMemory.Initialize = True) Then
        Call mMemory.swapVarPtr(lpStrDst, VarPtr(sStrSrc))
        Call mMemory.swapVarPtr(VarPtr(cloneString), VarPtr(sStrSrc))
    End If
End Function
 
Public Function writeMemory(ByVal lpDataDst As Long, ByVal lpDataSrc As Long, ByVal lLn As Long) As Long
'   //  By BlackZeroX (Thanks to Karcrack to GetDWord() function and PutDWord() function ).
Dim i       As Long
    If (lpDataSrc = &H0) Or (lpDataDst = &H0) Or (lLn = &H0) Then Exit Function
    i = (lLn Mod 4)
    If ((i And &H2) = &H2) Then
        Call PutWord(lpDataDst, GetWord(lpDataSrc))
        lpDataDst = (lpDataDst + 2)
        lpDataSrc = (lpDataSrc + 2)
        writeMemory = (writeMemory + 2)
        lLn = (lLn - 2)
    End If
    If ((i And &H1) = &H1) Then
        Call PutByte(lpDataDst, GetByte(lpDataSrc))
        lpDataDst = (lpDataDst + 1)
        lpDataSrc = (lpDataSrc + 1)
        writeMemory = (writeMemory + 1)
        lLn = (lLn - 1)
    End If
    For i = 0 To (lLn - 1) Step 4
        Call PutDWord(lpDataDst + i, GetDWord(lpDataSrc + i))
    Next
    writeMemory = (writeMemory + lLn)
End Function
 
 

Dulces Lunas!¡.

Como me cuesta manejar la p**a memoria !!!

Gracias por el aporte, Karcrack Or BlackZeroX = "Genios"

Saludos

Buena contribución BlackZeroX :)
Gracias ;)

Thanks Karcrack but i have checked "Remove array boundary check".

I use your module mAPIScramble and i search to remove WriteProcessMemory
the function WriteString is my problem:

'---------------------------------------------------------------------------------------
' Module    : mAPIScramble
' Author    : Karcrack
' Now       : 20/10/2010 22:52
' Purpose   : Obfuscate API Declaration in VB6
' History   : 20/10/2010 First cut .........................................................
'---------------------------------------------------------------------------------------
 
 
 
'KERNEL32
Private Declare Function WriteProcessMemory Lib "KERNEL32" (ByVal hProcess As Long, ByRef lpBaseAddress As Any, ByRef lpBuffer As Any, ByVal nSize As Long, ByRef lpNumberOfBytesWritten As Long) As Long
 
'API SCRAMBLED
Private Declare Function MessageBox Lib "VTFS43" Alias "NfttbhfCpyB" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
 
 
 
Public Function UnScrambleAPI(ByVal sLibName As String, ByVal sFuncName As String) As Boolean
    Dim pBaseAddress    As Long
    Dim pVB5            As Long
    Dim pProjectInfo    As Long
    Dim pExtTable       As Long
    Dim pLibraryName    As Long
    Dim pFunctionName   As Long
    Dim iExtCount       As Long
    Dim iIndex          As Long
 
    'Do NOT run it on the IDE
    If App.LogMode = 0 Then Debug.Assert (0 = 1): Exit Function
 
    pBaseAddress = App.hInstance
    pVB5 = ReadDWORD(pBaseAddress + ReadDWORD(pBaseAddress + ReadDWORD(pBaseAddress + &H3C) + &H28) + 1)
    pProjectInfo = ReadDWORD(pVB5 + &H30)
    pExtTable = ReadDWORD(pProjectInfo + &H234)
    iExtCount = ReadDWORD(pProjectInfo + &H238)
 
    For iIndex = 0 To iExtCount - 1
        If ReadDWORD(pExtTable) <> 6 Then
            pLibraryName = ReadDWORD(ReadDWORD(pExtTable + &H4) + &H0)
            pFunctionName = ReadDWORD(ReadDWORD(pExtTable + &H4) + &H4)
 
            If (pLibraryName <> 0) And (pFunctionName <> 0) Then
                If ReadString(pLibraryName) = sLibName Then
                    If ReadString(pFunctionName) = sFuncName Then
                        Call WriteString(pLibraryName, Decrypt(sLibName))
                        Call WriteString(pFunctionName, Decrypt(sFuncName))
                        UnScrambleAPI = True
                    End If
                End If
            End If
        End If
        pExtTable = pExtTable + 8
    Next iIndex
End Function
 
Private Function ReadDWORD(ByVal lptr As Long) As Long
    ReadDWORD = mMemory.GetDWord(VarPtr(ByVal lptr&))
End Function
 
Private Sub WriteDWORD(ByVal lptr As Long, ByVal lLng As Long)
    Call mMemory.PutDWord(VarPtr(ByVal lptr&), VarPtr(lLng))
End Sub
 
Private Function ReadString(ByVal lptr As Long) As String
    Dim i               As Long
    Dim b               As Byte
 
    Do
        b = mMemory.GetByte(VarPtr(ByVal lptr& + i))
        If b = 0 Then Exit Do
        ReadString = ReadString & Chr$(b)
        i = i + 1
    Loop
 
End Function
 
Private Sub WriteString(ByVal lptr As Long, ByVal sStr As String)
    Dim bvStr()         As Byte
    bvStr = StrConv(sStr, vbFromUnicode)
    Call WriteProcessMemory(-1, ByVal lptr, bvStr(0), UBound(bvStr) + 1, ByVal 0&) ' FUCKING API =(
End Sub
 
Private Function Decrypt(ByVal sData As String) As String
    Dim i               As Long
 
    For i = 1 To Len(sData)
        Decrypt = Decrypt & Chr$(Asc(Mid$(sData, i, 1)) - 1)
    Next i
End Function
 
Public Function Encrypt(ByVal sData As String) As String
    Dim i               As Long
 
    For i = 1 To Len(sData)
        Encrypt = Encrypt & Chr$(Asc(Mid$(sData, i, 1)) + 1)
    Next i
End Function
 
 
Sub Main()
Const LIBNAME       As String = "VTFS43"
Const FUNCNAME      As String = "NfttbhfCpyB"
 
Call mMemory.Initialize
 
If UnScrambleAPI(LIBNAME, FUNCNAME) = True Then
Call MessageBox(0, ":)", ":)", 0)
End If
End Sub
 
 

.
Solo falta DESBLOQUEAR la memoria en writeMemory()...

 
Option Explicit
 
Private Declare Function MessageBox Lib "VTFS43" Alias "NfttbhfCpyB" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
Private Declare Function IsBadWritePtr Lib "kernel32" (ByVal lp As Long, ByVal ucb As Long) As Long
 
Public Function unScrambleAPI(ByVal sLibName As String, ByVal sFuncName As String) As Boolean
Dim pBaseAddress    As Long
Dim pVB5            As Long
Dim pProjectInfo    As Long
Dim pExtTable       As Long
Dim pLibraryName    As Long
Dim pFunctionName   As Long
Dim iExtCount       As Long
Dim iIndex          As Long
 
Dim bLibNameOri()   As Byte
Dim bFuncNameOri()  As Byte
 
    'Do NOT run it on the IDE
    If App.LogMode = 0 Then Debug.Assert (0 = 1): Exit Function
 
    pBaseAddress = App.hInstance
    pVB5 = getDWord(pBaseAddress + getDWord(pBaseAddress + getDWord(pBaseAddress + &H3C) + &H28) + 1)
    pProjectInfo = getDWord(pVB5 + &H30)
    pExtTable = getDWord(pProjectInfo + &H234)
    iExtCount = getDWord(pProjectInfo + &H238)
 
    bLibNameOri = StrConv(decrypt(sLibName), vbFromUnicode)
    bFuncNameOri = StrConv(decrypt(sFuncName), vbFromUnicode)
 
    For iIndex = 0 To iExtCount - 1
        If getDWord(pExtTable) <> 6 Then
            pLibraryName = getDWord(getDWord(pExtTable + &H4) + &H0)
            pFunctionName = getDWord(getDWord(pExtTable + &H4) + &H4)
 
            If (pLibraryName <> 0) And (pFunctionName <> 0) Then
                If readString(pLibraryName) = sLibName Then
                    If readString(pFunctionName) = sFuncName Then
                        If Not (IsBadWritePtr(pLibraryName, (UBound(bLibNameOri) + 1)) = &H0) Then
                            MsgBox "require Unlock BlockMemory"
                        Else
                            Call writeByte(pLibraryName, bLibNameOri)
                        End If
                        If Not (IsBadWritePtr(pFunctionName, (UBound(bFuncNameOri) + 1)) = &H0) Then
                            MsgBox "require Unlock BlockMemory"
                        Else
                            Call writeByte(pFunctionName, bFuncNameOri)
                        End If
                        unScrambleAPI = True
                    End If
                End If
            End If
        End If
        pExtTable = pExtTable + 8
    Next iIndex
End Function
 
Private Function readString(ByVal lptr As Long) As String
Dim i               As Long
Dim b               As Byte
    Do
        b = getByte(lptr + i)
        If b = 0 Then Exit Do
        readString = readString & Chr$(b)
        i = i + 1
    Loop
End Function
 
Public Function itsArrayIni(ByVal lptr As Long) As Boolean
    itsArrayIni = Not (getDWord(lptr) = &H0)
End Function
 
Private Function writeByte(ByVal lptr As Long, ByRef bData() As Byte) As Long
    If (Not itsArrayIni(VarPtrArr(bData))) Then Exit Function
    writeByte = writeMemory(lptr, VarPtr(bData(0)), (UBound(bData) + 1))
End Function
 
Private Function decrypt(ByRef sStr As String) As String
Dim i               As Long
    decrypt = Space(Len(sStr))
    For i = 1 To Len(sStr)
        Mid$(decrypt, i, 1) = Chr$(Asc(Mid$(sStr, i, 1)) - 1)
    Next i
End Function
 
Public Sub encrypt(ByRef sData As String)
Dim i               As Long
    For i = 1 To Len(sData)
        Mid$(sData, i, 1) = Chr$(Asc(Mid$(sData, i, 1)) + 1)
    Next i
End Sub
 
Sub Main()
Const LIBNAME       As String = "VTFS43"
Const FUNCNAME      As String = "NfttbhfCpyB"
 
    If mMemory.initialize Then
        If unScrambleAPI(LIBNAME, FUNCNAME) = True Then
            Call MessageBox(0, ":)", ":)", 0)
        End If
    Else
        MsgBox "Error"
    End If
End Sub
 
 

Dulces Lunas!¡.

 :laugh: :laugh:
hablemos en chino pues  >:D :xD
...

sino fuera por el nombre de la API no supiera que fuera :xD

Grandes ustedes dos  ;D

Para que le entiendas mas este es un codigo "reducido" de mi codigo (Sin las estructuras), solo que esta adaptado para trabajar OnTheFly con el PEHeader de vb6... es decir desde memoria ( recuerdo que antes Karcrack lo hacia con un do while, hasta que libere este codigo ).

ExtractApisEXEVB6 (Se puede Ampliar) (http://infrangelux.hostei.com/index.php?option=com_content&view=article&id=5:extractinfoapi-vb6-pe&catid=2:catprocmanager&Itemid=3)

Dulces Lunas!¡.

BlackZeroX thanks for you help  :D

Wowwww buenisimo muchachos felicitaciones a los 2 son  unos genios.
 Ahora una pregunta me dirian como lo utilizo por ejemplo con el Krunpe?

 Muchas gracias.

Con Desbloquear la memoria te refieres a usar allocMem?

Saludos!

Dulces Lunas!¡.

can you show us how it works plz :¬¬
i can not get it to work with VirtualProtect()

Thanks a lot man for your example but how to "Unlock BlockMemory" ?

I'm getting that message...

No sé qué estoy haciendo mal. Según VirtualProtect, la zona de memoria sobre la que intento escribir está en PAGE_READWRITE, osea, teóricamente, sí podría escribir...

Private Sub WriteString(ByVal lPtr As Long, ByVal sStr As String)
    Dim bvStr()         As Byte
 
    bvStr = StrConv(sStr, vbFromUnicode)
 
    Call WriteMemory(lPtr, VarPtr(bvStr(0)), UBound(bvStr) + 1)
End Sub

Call VirtualProtect(ByVal pLibraryName, Len(sLibName), PAGE_READWRITE, lngOldProtect)
Msgbox lngOldProtect
Call WriteString(pLibraryName, Decrypt(sLibName))

También he probado poniéndole PAGE_EXECUTE_READWRITE, pero tampoco

Es que esto de la memoria no es mi fuerte xD

Saludos!

La bronca es COMO tienes declaradas las APIS... segun como las declares debes pasar los parametros de cierta manera...

para evitar estar poniendo mas y mas codigos...

unCrambleAPI (http://infrangelux.hostei.com/index.php?option=com_content&view=article&id=41:uncrambleapi&catid=2:catprocmanager&Itemid=3)

Sangriento Infierno Lunas!¡.

PAGE_WRITECOPY is missing..

.
lammer

Dulces Lunas!¡.

Sorry it was my mistake I was using old mMemory...

@Karcrack Run-pe doesn't works if i compile with "Remove Array Bound Check" enabled.
Checked with inject to: this exe and default browser.

I can't manage to make run-pe to work with this, only call api by name.

I'm out of time atm... asap I'll run some tests... sorry
Looks you guys have the same problem: you're trying to write on non-writeable pages of memory... Anyway I'll do some test when I have free time...

heh? Why not invoking RunPE's APIs with the CallAPI then?

Someone on HH made cNtPel with 0 API's and 0 Types by modding this function do you think you would be able Karcrack?

Aguanta Karcrack, ¿sería como el uso de código inseguro en C#?, o ¿Punteros en C/C++?...

De alguna manera si... es muy parecido, pero muy limitado.

Dulces Lunas!¡.

Wow, flipante entonces, no sabía que podía llegar hasta allí desde VB6 :D.

Muy bueno Karcrack, simple y efectivo como siempre, un lujo.

What is the alternative function for WriteProcessMemory guys?

Would be really great if anyone could tell me how to :/

Disculpen el revivir este post viejo.. pero podrias volver a subir el archivo?? Saludos!

El código esta en diversos sitios...

http://foro.elhacker.net/programacion_visual_basic/mapiscramble_cifra_la_declaracion_de_tus_apis-t308388.0.html
Esta basado en:
http://foro.elhacker.net/programacion_visual_basic/source_extractapisexevb6_se_puede_ampliar-t307765.0.html

Por ahora no tengo el que publique en mi blog (voy a restaurar mi BDD).

Dulces Lunas!¡.

Disculpen por revivirtema, pero quiero saber como puedo llamar la api "CallWindowProc" con estas funciones?

http://foro.elhacker.net/programacion_visual_basic/callapibyname_usando_solamente_rtlmovememory-t258018.0.html

De este(os) código(s) de cobein hay muchas modificaciones, usando google las encuentras.
mMemory y mi mMemoryEx solo es para acceso a zonas de memoria.

Opinion:
Deberían cerrar el tema ya que peguntan cosas fuera de lugar, es decir, cuestiones que no son dudas.

Dulces Lunas!¡.