mMemory - WriteProcessMemory/vbaCopyBytes/RtlMoveMemory replacement [NOAPI!!!]

[BlackZeroX]

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

Código (Vb) [Seleccionar] Expandir



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!¡.

[x64core]

 
hablemos en chino pues  
...

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

Código [Seleccionar] Expandir

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

Grandes ustedes dos 

[BlackZeroX]

hablemos en chino pues 

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)

Dulces Lunas!¡.

[scapula]

BlackZeroX thanks for you help 

[TVFürer]

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.

[Slek Hacker]

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

Con Desbloquear la memoria te refieres a usar allocMem?

Saludos!

[BlackZeroX]

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

Dulces Lunas!¡.

[runman]

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

[Swellow]

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

I'm getting that message...

[Slek Hacker]

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...

Código (vb) [Seleccionar] Expandir

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

Código (vb) [Seleccionar] Expandir

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!