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