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

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

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.

Dulces Lunas!¡.

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

I'm getting that message...