mAPIScramble - Cifra la declaracion de tus APIs :)

[Karcrack]

Es una optimizacion de este codigo:

Código [Seleccionar] Expandir

http://foro.elhacker.net/programacion_vb/newmapiobfuscation_ofuscar_strings_de_las_apis_no_callapibyname-t265942.0.html

Código (vb) [Seleccionar] Expandir

'---------------------------------------------------------------------------------------
' Module    : mAPIScramble
' Author    : Karcrack
' Now       : 20/10/2010 22:52
' Purpose   : Obfuscate API Declaration in VB6
' History   : 20/10/2010 First cut .........................................................
'---------------------------------------------------------------------------------------

Option Explicit

'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

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
   Call WriteProcessMemory(-1, ReadDWORD, ByVal lPtr&, &H4, ByVal 0&)
End Function

Private Sub WriteDWORD(ByVal lPtr As Long, ByVal lLng As Long)
   Call WriteProcessMemory(-1, ByVal lPtr&, lLng, &H4, ByVal 0&)
End Sub

Private Function ReadString(ByVal lPtr As Long) As String
   Dim i               As Long
   Dim b               As Byte
   
   Do
       Call WriteProcessMemory(-1, b, ByVal lPtr& + i, &H1, ByVal 0&)
       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&)
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

Ejemplo:

Código [Seleccionar] Expandir

http://www.box.net/shared/sr8rky5tku

Agradecimientos a BlackZeroX, que puso las estructuras que me ayudaron a acabar este code

Saludos

[BlackZeroX]

.
Muy bueno, pero me parece ue todavía hay otro estructura para leer las APIS (Puntero y longitud) asis e evitaria ese ReadString... al rato me pongo a experimentar de nuevo con el PE de VB6!¡.

Dulce Infierno Lunar!¡.