Call API by Name by Cobein

call-api-by-name-2.bas

'---------------------------------------------------------------------------------------
' Module      : cCallAPIByName
' DateTime    : 31/08/2008 19:40
' Author      : Cobein
' Mail        : cobein27@hotmail.com
' 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

call-api-by-name.bas

Declare Sub RtlMoveMemory Lib "kernel32" (dest As Any, src As Any, ByVal L As Long)
Declare Function CallWindowProcA Lib "user32" (ByVal addr As Long, ByVal p1 As Long, ByVal p2 As Long, ByVal p3 As Long, ByVal p4 As Long) As Long
Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Declare Function LoadLibraryA Lib "kernel32" (ByVal lpLibFileName As String) As Long

Function CallApiByName(ByVal sLib As String, ByVal sMod As String, ParamArray Params()) As Long
On Error Resume Next
    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))
    RtlMoveMemory ByVal lPtr, &H59595958, &H4:              lPtr = lPtr + 4
    RtlMoveMemory ByVal lPtr, &H5059, &H2:                  lPtr = lPtr + 2
    For I = UBound(Params) To 0 Step -1
        RtlMoveMemory ByVal lPtr, &H68, &H1:                lPtr = lPtr + 1
        RtlMoveMemory ByVal lPtr, CLng(Params(I)), &H4:     lPtr = lPtr + 4
    Next
    RtlMoveMemory ByVal lPtr, &HE8, &H1:                    lPtr = lPtr + 1
    RtlMoveMemory ByVal lPtr, lMod - lPtr - 4, &H4:         lPtr = lPtr + 4
    RtlMoveMemory ByVal lPtr, &HC3, &H1:                    lPtr = lPtr + 1
    CallApiByName = CallWindowProcA(VarPtr(bvASM(0)), 0, 0, 0, 0)

End Function

example.bas

lRet = CallApiByName("urlmon", "URLDownloadToFileW", 0, StrPtr("http://server.com/test.exe"), StrPtr("C:\test.exe"), 0, 0)
lRet = CopyFile("C:\test.exe", "c:\test2.exe", False)

Function CopyFile(src As String, dest As String, Optional FailIfDestExists As Boolean) As Boolean
Dim lRet As Long
    lRet = CallApiByName("kernel32", "CopyFileW", StrPtr(src), StrPtr(dest), VarPtr(FailIfDestExists))
    CopyFile = (lRet > 0)
End Function
msgbox GetSysDir

Function GetSysDir() As String
On Error Resume Next
Dim Location(512) As Byte

    Call CallApiByName("kernel32", "GetSystemDirectoryW", VarPtr(Location(0)), 512)
    GetSysDir = Left$(Location, InStr(Location, Chr$(0)) - 1)

End Function
Call CallApiByName("kernel32", "Sleep", 1000)
Call CallApiByName("shell32", "ShellExecuteW", 0, 0, StrPtr("C:\file.exe"), 0, 0, 0)