Código: Seleccionar todo

'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

Código: Seleccionar todo

'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

Código: Seleccionar todo

'---------------------------------------------------------------------------------------
' Module      : cCallAPIByName
' DateTime    : 31/08/2008 19:40
' Author      : Cobein
' Mail        : [email protected]
' WebPage     : http://www.advancevb.com.ar
' 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

Código: Seleccionar todo

'Necesitas ver el post original: http://foro.elhacker.net/programacion_visual_basic'/asmvb6invoke_llamas_apis_sin_declararlas_kinvokebas-t290072.0.html
'---------------------------------------------------------------------------------------
' 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 = "<PUSHES>B8<API_PTR>FFD0C3"
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, "<PUSHES>", sThunk), "<API_PTR>", 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
 

Código: Seleccionar todo

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