[SRC] VB6 0 API

Bueno hace poco hice algo para ejecutar APIs sin declararlas, 0 API.

Posteado en http://hackhound.org/forums/topic/6634-0-api/

Código

Option Explicit
 
'You must compile Native and check 'Remove Array Bound Checks'
 
'---------------------------------------------------------------------------------------
' Module    : mMemory
' Author    : Karcrack
' Date      : 20/09/2011
' Purpose   : Work with memory withouth using any API
' History   : 20/09/2011 First cut
'---------------------------------------------------------------------------------------
 
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_MakeD...m#MakeDWord05]
    MakeDWord = (HiWord * &H10000) Or (LoWord And &HFFFF&)
End Function

Código

Option Explicit
 
'Private Declare Function VirtualAlloc Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
 
'Sore wa watashi no monode wa arimasen.
Public Function CallAPI_NotMine(ByVal vForm As Form, ByVal sLib As String, ByVal sProc As String, ParamArray vParams() As Variant) As Long
Dim c_ASM(28) As Currency, bvLib() As Byte, bvProc() As Byte, laParam() As Long, ubParam As Long, bInitialized As Boolean, i As Long
 
If bInitialized = False Then
    c_ASM(0) = 725985647539103.3577@: c_ASM(1) = 465082451154280.4619@: c_ASM(2) = 174754948986808.1932@
    c_ASM(3) = 353151298900331.7606@: c_ASM(4) = -842056535466254.24@: c_ASM(5) = -158485362956912.3259@
    c_ASM(6) = -151289242656700.5557@: c_ASM(7) = -129660215991460.1245@: c_ASM(8) = -457434111994534.3183@
    c_ASM(9) = -145719479559932.942@: c_ASM(10) = -836727781740640.7692@: c_ASM(11) = 540785052671076.873@
    c_ASM(12) = -842945876107851.5061@: c_ASM(13) = -436817922147838.1567@: c_ASM(14) = -36546947.8739@
    c_ASM(15) = 34438797019703.0793@: c_ASM(16) = -190689866724056.7239@: c_ASM(17) = -59310703.0909@
    c_ASM(18) = -26865768425160.8957@: c_ASM(19) = -82935132042744.5623@: c_ASM(20) = -1607042434518.5911@
    c_ASM(21) = -55225496747848.4993@: c_ASM(22) = 850252832244421.5689@: c_ASM(23) = -836310804921489.818@
    c_ASM(24) = 7079432546648.5829@: c_ASM(25) = -748820712252184.718@: c_ASM(26) = -850720513820548.8302@
    c_ASM(27) = -28815265.8452@: c_ASM(28) = -143712485721099.5542@
    bInitialized = True
End If
 
bvLib = StrConv(sLib & vbNullChar, vbFromUnicode): bvProc = StrConv(sProc & vbNullChar, vbFromUnicode): ubParam = UBound(vParams): ReDim laParam(0 To ubParam)
 
For i = 0 To ubParam
    laParam(i) = CLng(vParams(i))
Next i
 
Call NewMisery.CallAPI(NewMisery.FunctionAddress(vForm, "VirtualAlloc"), VarPtr(VarPtr(c_ASM(0))), VarPtr(UBound(c_ASM) + 1), VarPtr(&H1000), VarPtr(&H40))
 
CallAPI_NotMine = MyCallWindowProcA(VarPtr(c_ASM(0)), VarPtr(bvLib(0)), VarPtr(bvProc(0)), ubParam + 1, VarPtr(laParam(0)))
End Function

Código

Option Explicit
 
'---------------------------------------------------------------------------------------
' Don't use VirusTotal, use http://nodistribute.com instead
'
' Module    : NewMisery (Im horrible for names...)
' Author    : Misery (Miseryk) Inspired by OXYMORON
' Date      : 17/07/2014 (Start) | 15/09/2014 (End)
' Purpose   : 0 API
'---------------------------------------------------------------------------------------
 
Public KernelBase As Long
Public Base As Long 'With no use, just test
Public BkAddVal As Long '[Me.Point(8@)] backup => CALL [EAX+2D0]
Public User32 As Long
 
Private Sub Initialize()
Call Karcrack.Initialize
End Sub
 
Public Function GetFuncAddr(ByVal lAddr As Long) As Long
GetFuncAddr = lAddr
End Function
 
Public Sub Init(ByVal vForm As Form)
Call Initialize
 
Dim ASM_c(7) As Currency
 
ASM_c(0) = 259535234953094.8442@
ASM_c(1) = 350419256390428.4982@
ASM_c(2) = 465082451153964.2368@
ASM_c(3) = 117108873756465.8452@
ASM_c(4) = 64246993287716.5497@
ASM_c(5) = -518518030442266.1493@
ASM_c(6) = -30494267.8016@
ASM_c(7) = -801556291178923.7505@
 
BkAddVal = Karcrack.GetDWord(Karcrack.GetDWord(ObjPtr(vForm)) + &H2D0)
 
Call Karcrack.PutDWord(Karcrack.GetDWord(ObjPtr(vForm)) + &H2D0, VarPtr(ASM_c(0)))
 
Call vForm.Point(VarPtr(KernelBase), VarPtr(Base))
 
Call Karcrack.PutDWord(Karcrack.GetDWord(ObjPtr(vForm)) + &H2D0, BkAddVal)
 
Call Patch(vForm)
End Sub
 
Private Sub Patch(ByVal vForm As Form)
Dim ASM_c(5) As Currency
 
ASM_c(0) = 537140736891580.1227@
ASM_c(1) = 583913078498908.8528@
ASM_c(2) = -854952546922381.2279@
ASM_c(3) = -841638429847924.6252@
ASM_c(4) = -116134715448543.5308@
ASM_c(5) = -802975980578020.9409@
 
Dim Address As Long
 
Address = NewMisery.GetFuncAddr(AddressOf CallAPI) + 11
 
Dim MyPushes(6) As Long
 
MyPushes(0) = VarPtr(0)
MyPushes(1) = 51
MyPushes(2) = VarPtr(ASM_c(0))
MyPushes(3) = Address
MyPushes(4) = -1
MyPushes(5) = KernelBase
MyPushes(6) = NewMisery.FunctionAddress(vForm, "WriteProcessMemory")
 
Dim ASM_c2(6) As Currency
 
ASM_c2(0) = -856471559609067.0246@
ASM_c2(1) = 367493325241674.242@
ASM_c2(2) = 828635112938277.7599@
ASM_c2(3) = -842503583785949.618@
ASM_c2(4) = 5202119258820.4106@
ASM_c2(5) = -119118.2336@
ASM_c2(6) = -802970373083417.7606@
 
BkAddVal = Karcrack.GetDWord(Karcrack.GetDWord(ObjPtr(vForm)) + &H2D0)
 
Call Karcrack.PutDWord(Karcrack.GetDWord(ObjPtr(vForm)) + &H2D0, VarPtr(ASM_c2(0)))
 
Call vForm.Point(VarPtr(MyPushes(0)), 0)
 
Call Karcrack.PutDWord(Karcrack.GetDWord(ObjPtr(vForm)) + &H2D0, BkAddVal)
End Sub
 
Public Function ConvertToMisery(ByVal vForm As Form, ByVal AddressSrc As Long, ByVal AddressDst As Long) As Long
Dim c_ASM(2) As Long
 
c_ASM(0) = -64731961
c_ASM(1) = AddressSrc
c_ASM(2) = -64723713
 
ConvertToMisery = NewMisery.CallAPI(NewMisery.FunctionAddress(vForm, "WriteProcessMemory"), VarPtr(-1), AddressDst, VarPtr(VarPtr(c_ASM(0))), VarPtr(12), VarPtr(VarPtr(0)))
End Function
 
Public Function CallAPI(ByVal Address As Long, ParamArray vParams() As Variant) As Long
Address = KernelBase + Address
DoEvents: DoEvents: DoEvents
DoEvents: DoEvents: DoEvents
DoEvents: DoEvents: DoEvents
DoEvents: DoEvents: DoEvents
DoEvents: DoEvents: DoEvents
DoEvents: DoEvents: DoEvents
End Function
 
Public Function MyCallWindowProcA(ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
DoEvents
DoEvents
End Function
 
Public Function MyGetProcAddress(ByVal hModule As Long, ByVal lpProcName As String) As Long
DoEvents
DoEvents
End Function
 
Public Function FunctionAddress(ByVal vForm As Form, ByVal StrFunction As String) As Long
Dim strFunc() As Byte
Dim Offset As Long
 
Dim ASM_c(19) As Currency
 
ASM_c(0) = 814232361510246.7936@
ASM_c(1) = 350419227990245.6828@
ASM_c(2) = 465082451153964.2368@
ASM_c(3) = 117108873756465.8452@
ASM_c(4) = 461280767645907.9819@
ASM_c(5) = -459709328520114.7076@
ASM_c(6) = -118880.7541@
ASM_c(7) = -835887271382144.2318@
ASM_c(8) = 886420572523377.9787@
ASM_c(9) = 839808409003602.7148@
ASM_c(10) = 840567380577989.5332@
ASM_c(11) = -100852514478035.1214@
ASM_c(12) = -428637109111001.2498@
ASM_c(13) = -64280619725626.29@
ASM_c(14) = -273730417291300.9967@
ASM_c(15) = 204338008016006.1199@
ASM_c(16) = -854998653806026.0861@
ASM_c(17) = -511608917668079.9976@
ASM_c(18) = 190267051.2127@
ASM_c(19) = -802975918745080.576@
 
BkAddVal = Karcrack.GetDWord(Karcrack.GetDWord(ObjPtr(vForm)) + &H2D0)
 
Call Karcrack.PutDWord(Karcrack.GetDWord(ObjPtr(vForm)) + &H2D0, VarPtr(ASM_c(0)))
 
strFunc = StrConv(StrFunction & Chr(0), vbFromUnicode)
 
Call vForm.Point(VarPtr(Offset), VarPtr(strFunc(0)))
 
Call Karcrack.PutDWord(Karcrack.GetDWord(ObjPtr(vForm)) + &H2D0, BkAddVal)
 
FunctionAddress = Offset
End Function
 
Public Sub GetUser32(ByVal vForm As Form)
Dim LoadLibrary As Long
Dim ASM_c(9) As Currency
 
LoadLibrary = NewMisery.FunctionAddress(vForm, "LoadLibraryW")
LoadLibrary = LoadLibrary + KernelBase
 
ASM_c(0) = 814232361510246.7936@
ASM_c(1) = 100060056.7804@
ASM_c(2) = 497206524950976.384@
ASM_c(3) = 331470430218173.2864@
ASM_c(4) = 8356415879.68@
ASM_c(5) = -840821747844015.7184@
ASM_c(6) = 654401063636671.802@
ASM_c(7) = 79190153.865@
ASM_c(8) = 12469341468280.2432@
ASM_c(9) = -802991806362733.7728@
 
BkAddVal = Karcrack.GetDWord(Karcrack.GetDWord(ObjPtr(vForm)) + &H2D0)
 
Call Karcrack.PutDWord(Karcrack.GetDWord(ObjPtr(vForm)) + &H2D0, VarPtr(ASM_c(0)))
 
Call vForm.Point(VarPtr(User32), VarPtr(LoadLibrary))
 
Call Karcrack.PutDWord(Karcrack.GetDWord(ObjPtr(vForm)) + &H2D0, BkAddVal)
End Sub

Código

Option Explicit
 
Private Sub Command1_Click()
Call NewMisery.Init(Me)
 
Call NewMisery.GetUser32(Me)
 
Dim User32Add As Long
 
User32Add = NewMisery.User32
 
Call ConvertToMisery(Me, NewMisery.KernelBase + NewMisery.FunctionAddress(Me, "GetProcAddress"), NewMisery.GetFuncAddr(AddressOf MyGetProcAddress))
Call ConvertToMisery(Me, NewMisery.MyGetProcAddress(User32Add, StrConv("CallWindowProcA", vbFromUnicode)), NewMisery.GetFuncAddr(AddressOf MyCallWindowProcA))
 
MsgBox "Done."
End Sub
 
Private Sub Command2_Click()
'My manner of calling API could be a shit, maybe, who knows?, so call this
'This is not mine, but it calls MyCallWindowProcA(overwrite) and NewMisery.CallAPI(VirtualAlloc)
Call NotMine.CallAPI_NotMine(Me, "user32", "MessageBoxW", 0, StrPtr("t_Invoke works"), StrPtr("victory"), &H40)
End Sub

Functiona en XP, 7 y 8, pero en 8 para 64 hay que hacer un mini cambio el cual quedaría funcionando para XP 7 y 8 en 32 y 64, pero hasta el momento lo libero así (Y)

Saludos.