• Earn real money by being active: Hello Guest, earn real money by simply being active on the forum — post quality content, get reactions, and help the community. Once you reach the minimum credit amount, you’ll be able to withdraw your balance directly. Learn how it works.

Visual Basic Varios CallApiName

Status
Not open for further replies.

Expermicid

Leech
User
Joined
Oct 23, 2011
Messages
285
Reputation
0
Reaction score
255
Points
63
Credits
0
‎13 Years of Service‎
95%
Esta recompilacion tambien esta hecha por DarkCompany sobre diferentes call Apis.

mDrinky

[lenguaje=vb]'Creado por mDrinky

Option Explicit

Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long

Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long

Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long

Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Any, ByVal wParam As Any, ByVal lParam As Any) As Long

Private Const MB_ICONEXCLAMATION = &H30&

Private Sub Form_Load()

Dim id As Long

Dim direccion As Long

id = LoadLibrary("user32") 'Cargamos la libreria

direccion = GetProcAddress(id, "MessageBoxA") 'obtenemos la direccion em memoria

CallWindowProc direccion, Me.hWnd, "cuerpo", "Titulo", MB_ICONEXCLAMATION ' llamamos a la funcion

FreeLibrary id ' liberamos la dll

End Sub[/lenguaje]

Karcrack

[lenguaje=vb]'Creado por Karcrack

'Ejemplo de uso

'Private Declare Function LoadLibrary Lib "kernel32.dll" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long

'Private Declare Function GetProcAddress Lib "kernel32.dll" (ByVal hModule As Long, ByVal lpProcName As String) As Long

'

'Private Sub Form_Load()

' Dim hMod As Long

'

' hMod = GetProcAddress(LoadLibrary("KERNEL32"), "Beep")

' Call Invoke(hMod, 200, 500)

'End Sub

Option Explicit

'KERNEL32

Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

Private Declare Function CallWindowProc Lib "USER32" Alias "CallWindowProcW" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Public Function Invoke(ByVal lpCode As Long, ParamArray vParams() As Variant) As Long

Dim i As Long

Dim lPtr As Long

Dim bvASM(&HFF) As Long

lPtr = VarPtr(bvASM(&H0))

Call AddByte(&H58, lPtr) '//POP EAX

Call AddLong(&H59595959, lPtr) '//POP ECX (x4)

Call AddByte(&H50, lPtr) '//PUSH EAX

For i = UBound(vParams) To LBound(vParams) Step -1

Call AddByte(&H68, lPtr) '//PUSH ________

Call AddLong(CLng(vParams(i)), lPtr) '//____ XXXXXXXX

Next i

Call AddCall(lpCode, lPtr) '//CALL lpCode

Call AddByte(&HC3, lPtr) '//RET

Invoke = CallWindowProc(VarPtr(bvASM(&H0)), ByVal 0&, ByVal 0&, ByVal 0&, ByVal 0&)

End Function

Private Sub AddCall(ByVal lpPtrCall As Long, ByRef lPtr As Long)

Call AddByte(&HE8, lPtr) '//CALL ________

Call AddLong(lpPtrCall - lPtr - 4, lPtr) '//____ XXXXXXXX

End Sub

Private Sub AddLong(ByVal lLong As Long, ByRef lPtr As Long)

Call CopyMemory(ByVal lPtr&, lLong, &H4)

lPtr = lPtr + &H4

End Sub

Private Sub AddByte(ByVal bByte As Byte, ByRef lPtr As Long)

Call CopyMemory(ByVal lPtr&, bByte, &H1)

lPtr = lPtr + &H1

End Sub[/lenguaje]

Cobein

[lenguaje=vb]'---------------------------------------------------------------------------------------

' Module : cCallAPIByName

' DateTime : 31/08/2008 19:40

' Author : Cobein

' Mail : [email protected]

' WebPage :
This link is hidden for visitors. Please Log in or register now.


' Purpose : Call APIs by name

' Usage : At your own risk

' Requirements: None

' Distribution: You can freely use this code in your own

' applications, but you may not reproduce

' or publish this code on any web site,

' online service, or distribute as source

' on any media without express permission.

'

' Credits : Arne Elster, original callpointer function.

'

' History : 31/08/2008 First Cut....................................................

'---------------------------------------------------------------------------------------

'Ejemplo de uso

'Option Explicit

'

'Private Sub Form_Load()

' Dim c As New cCallAPIByName

'

' c.CallAPIByName "user32", "MessageBoxW", 0, VarPtr(ByVal "Test"), VarPtr(ByVal "Test"), 0

'

'End Sub

Option Explicit

Private Declare Sub CpyMem Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal dlen As Long)

Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long

Private Declare Function LoadLibraryA Lib "kernel32" (ByVal lpLibFileName As String) As Long

Public Function DoNotCall() As Long

'

End Function

Public Function CallAPIByName(ByVal sLib As String, ByVal sMod As String, ParamArray Params()) As Long

Dim lPtr As Long

Dim bvASM(&HEC00& - 1) As Byte

Dim i As Long

Dim lMod As Long

lMod = GetProcAddress(LoadLibraryA(sLib), sMod)

If lMod = 0 Then Exit Function

lPtr = VarPtr(bvASM(0))

CpyMem ByVal lPtr, &H59595958, &H4: lPtr = lPtr + 4

CpyMem ByVal lPtr, &H5059, &H2: lPtr = lPtr + 2

For i = UBound(Params) To 0 Step -1

CpyMem ByVal lPtr, &H68, &H1: lPtr = lPtr + 1

CpyMem ByVal lPtr, CLng(Params(i)), &H4: lPtr = lPtr + 4

Next

CpyMem ByVal lPtr, &HE8, &H1: lPtr = lPtr + 1

CpyMem ByVal lPtr, lMod - lPtr - 4, &H4: lPtr = lPtr + 4

CpyMem ByVal lPtr, &HC3, &H1

Dim lVTE As Long

Dim lRet As Long

CpyMem lVTE, ByVal ObjPtr(Me), &H4

lVTE = lVTE + &H1C

CpyMem lRet, ByVal lVTE, &H4

CpyMem ByVal lVTE, VarPtr(bvASM(0)), &H4

CallAPIByName = DoNotCall

CpyMem ByVal lVTE, lRet, &H4

End Function[/lenguaje]

Karcrack

[lenguaje=vb]'---------------------------------------------------------------------------------------

' Module : kInvoke

' Author : Karcrack

' Date : 09/04/2010

' Purpose : Call APIs By Hash

'---------------------------------------------------------------------------------------

Option Explicit

'USER32

Private Declare Function CallWindowProcW Lib "USER32" (ByVal lpCode As Long, Optional ByVal lParam1 As Long, Optional ByVal lParam2 As Long, Optional ByVal lParam3 As Long, Optional ByVal lParam4 As Long) As Long

Private Const THUNK_GETAPIPTR As String = "E82200000068A44E0EEC50E84300000083C408FF742404FFD0FF74240850E83000000083C408C3565531C0648B70308B760C8B761C8B6E088B7E208B3638471875F3803F6B7407803F4B7402EBE789E85D5EC35552515356578B6C241C85ED74438B453C8B54057801EA8B4A188B5A2001EBE330498B348B01EE31FF31C0FCAC84C07407C1CF0D01C7EBF43B7C242075E18B5A2401EB668B0C4B8B5A1C01EB8B048B01E85F5E5B595A5DC3"

Private Const THUNK_CALLCODE As String = "B8FFD0C3"

Private ASM_GETAPIPTR(0 To 170) As Byte

Private ASM_CALLCODE(0 To 255) As Byte

Public Function Invoke(ByVal sDLL As String, ByVal hHash As Long, ParamArray vParams() As Variant) As Long

Dim vItem As Variant

Dim lAPI As Long

Dim sThunk As String

Call PutThunk(THUNK_GETAPIPTR, ASM_GETAPIPTR)

lAPI = CallWindowProcW(VarPtr(ASM_GETAPIPTR(0)), StrPtr(sDLL), hHash)

If lAPI Then

For Each vItem In vParams

sThunk = "68" & GetLng(CLng(vItem)) & sThunk

Next vItem

sThunk = Replace$(Replace$(THUNK_CALLCODE, "", sThunk), "", GetLng(lAPI))

Call PutThunk(sThunk, ASM_CALLCODE)

Invoke = CallWindowProcW(VarPtr(ASM_CALLCODE(0)))

Else

Invoke = -1

Err.Raise -1, , "Bad Hash or wrong DLL"

End If

End Function

Private Function GetLng(ByVal lLng As Long) As String

Dim lTMP As Long

lTMP = (((lLng And &HFF000000) \ &H1000000) And &HFF&) Or ((lLng And &HFF0000) \ &H100&) Or ((lLng And &HFF00&) * &H100&) Or ((lLng And &H7F&) * &H1000000) ' by Mike D Sutton

If (lLng And &H80&) Then lTMP = lTMP Or &H80000000

GetLng = String$(8 - Len(Hex$(lTMP)), "0") & Hex$(lTMP)

End Function

Private Sub PutThunk(ByVal sThunk As String, ByRef bvRet() As Byte)

Dim i As Long

For i = 0 To Len(sThunk) - 1 Step 2

bvRet((i / 2)) = CByte("&H" & Mid$(sThunk, i + 1, 2))

Next i

End Sub[/lenguaje]

Karcrack

[lenguaje=vb]'---------------------------------------------------------------------------------------

' Module : mZombieInvoke

' Author : Karcrack

' Now : 09/08/2010 13:37

' Purpose : Calling API without declaring

' Only uses VB6 functions :)

' History : 20100908 First cut .......................................................

'---------------------------------------------------------------------------------------

'Uso: Invoke "USER32", "MessageBoxW", 0, StrPtr("Karcrack FTW!!!"), StrPtr("Fuck yeah!"), 0

Option Explicit

Private Type Zombie_STRUCT1

cNull As Currency 'Must be 0

ppS2 As Long 'Pointer to pointer to Zombie_STRUCT2

End Type

Private Type Zombie_STRUCT2

lNull As Long 'Must be 0

lAddr As Long 'The Addr

End Type

Private Type tAPICall

ptsLIB As Long ' Pointer to ANSI String that contains Library (NULL TERMINATED!)

ptsProc As Long ' Pointer to ANSI String that contains Procedure(NULL TERMINATED!)

lReserved As Long ' Just reserved...

lPointer As Long ' Pointer to the buffer that will contain temp variables from DllFunctionCall

lpBuffer(3) As Long ' Buffer that will contain temp variables

End Type

Private Type DUMB_LONG

lLNG As Long

End Type

Private Type BYTES_LONG

b1 As Byte: b2 As Byte

b3 As Byte: b4 As Byte

End Type

'MSVBVM60

Private Declare Function DllFunctionCall Lib "MSVBVM60" (ByRef typeAPI As tAPICall) As Long

Private Declare Function Zombie_AddRef Lib "MSVBVM60" (ByRef tStructure As Zombie_STRUCT1) As Long

Private bvASM(&HFF) As Byte

Public Function Invoke(ByVal sLibName As String, ByVal sProcName As String, ParamArray vParams() As Variant) As Long

Dim hMod As Long

Dim S1 As Zombie_STRUCT1

Dim S2 As Zombie_STRUCT2

Dim i As Long

Dim iCount As Long

hMod = GetPointer(sLibName, sProcName)

'//POP EAX '//POP EBX '//PUSH EAX

Call AddByte(&H58, iCount): Call AddByte(&H5B, iCount): Call AddByte(&H50, iCount)

For i = UBound(vParams) To LBound(vParams) Step -1

'//PUSH CLng(vParams(i))

Call AddPush(CLng(vParams(i)), iCount)

Next i

'//CALL hMod '//RET

Call AddCall(hMod, iCount): Call AddByte(&HC3, iCount)

S2.lAddr = VarPtr(bvASM(0))

S1.ppS2 = VarPtr(VarPtr(S2))

Invoke = Zombie_AddRef(S1)

End Function

Private Function GetPointer(ByVal sLib As String, ByVal sProc As String) As Long

Dim tAPI As tAPICall

Dim bvLib() As Byte

Dim bvMod() As Byte

bvLib = StrConv(sLib + vbNullChar, vbFromUnicode): bvMod = StrConv(sProc + vbNullChar, vbFromUnicode)

With tAPI

.ptsLIB = VarPtr(bvLib(0)): .ptsProc = VarPtr(bvMod(0))

.lReserved = &H40000: .lPointer = VarPtr(.lpBuffer(0))

End With

GetPointer = DllFunctionCall(tAPI)

End Function

Private Sub AddCall(ByVal lpPtrCall As Long, ByRef iCount As Long)

Call AddByte(&HB8, iCount) '//MOV EAX, ________

Call AddLong(lpPtrCall, iCount) '//_______, XXXXXXXX

Call AddByte(&HFF, iCount) '//CALL EXX

Call AddByte(&HD0, iCount) '//____ EAX

End Sub

Private Sub AddPush(ByVal lLong As Long, ByRef iCount As Long)

Call AddByte(&H68, iCount) '//PUSH, ________

Call AddLong(lLong, iCount) '//____, XXXXXXXX

End Sub

Private Sub AddLong(ByVal lLong As Long, ByRef iCount As Long)

'Swap Endian (Ej: 0xDEADBEEF <-> 0xEFBEADDE)

Dim tDL As DUMB_LONG

Dim tBL As BYTES_LONG

tDL.lLNG = lLong

LSet tBL = tDL

Call AddByte(tBL.b1, iCount): Call AddByte(tBL.b2, iCount)

Call AddByte(tBL.b3, iCount): Call AddByte(tBL.b4, iCount)

End Sub

Private Sub AddByte(ByVal bByte As Byte, ByRef iCount As Long)

bvASM(iCount) = bByte: iCount = iCount + 1

End Sub[/lenguaje]

Espero que les sirva, saludos

 
Last edited by a moderator:
Status
Not open for further replies.
Back
Top