Results 1 to 15 of 15

Thread: Call BAS Procedure By Address

  1. #1

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    Call BAS Procedure By Address

    This comes up occasionally, and it's probably been done before ... but I developed it for testing some other code I've been working on. So, I thought I'd post it.

    It's all fairly well outlined in the comments to the procedure, so just read those. This code can be placed anywhere, but probably best in a BAS module somewhere.

    Code:
    
    Option Explicit
    '
    Private Declare Function DispCallFunc Lib "oleaut32" (ByVal pvInstance As Long, ByVal offsetinVft As Long, ByVal CallConv As Long, ByVal retTYP As Integer, ByVal paCNT As Long, ByRef paTypes As Integer, ByRef paValues As Long, ByRef retVAR As Variant) As Long
    '
    
    Public Function CallBasProcedureByAddress(ByVal ProcAddress As Long, _
                                              ByVal ReturnType As VbVarType, _
                                              ByRef vReturn As Variant, _
                                              ParamArray vProcArguments() As Variant) As Boolean
        '
        ' Regarding the actual procedure's address (ProcAddress), Private or Public
        ' doesn't matter, so long as you can get the procedure's address.
        ' This is typically done with the AddressOf operator.
        '
        ' If there's any problem that can be trapped, this function returns FALSE.
        ' Caller is totally responsible for passing correct arguments,
        ' and correctly specifying the return type for Function or Property Get (ReturnType),
        ' or probable crash.  Read on.
        '
        ' If it's a Function or Property Get, the return is returned in vReturn.
        ' Otherwise, ReturnType should be specified as vbEmpty (vbEmpty=0&).
        '
        ' vProcArguments:
        '   These MUST match the procedure being called.
        '   Be SURE to pass the correct variable TYPE.  (or crash)
        '   If it's ByRef, pass VarPtr(value).          (or crash)
        '   If it's ByVal, pass it directly.            (or crash)
        '   Not tested for String, Array, UDT, or Object arguments (including when in a Variant).
        '   Variant arguments may also present challenges not considered herein,
        '   but they should work if they don't contain an address reference (i.e., String, Array, or Object).
        '
        ' Get arguments into a more manageable array.
        Dim vParams() As Variant: vParams() = vProcArguments()
        ' Figure out how many actual arguments we're passing to DispCallFunc.
        Dim iParamCount As Long: iParamCount = Abs(UBound(vParams) - LBound(vParams) + 1&)
        '
        ' Setup memory pointers and types for DispCallFunc call.
        Dim vParamPtr() As Long, vParamType() As Integer
        If iParamCount Then
            ReDim vParamPtr(iParamCount - 1&)
            ReDim vParamType(iParamCount - 1&)
        Else
            ReDim vParamPtr(0&)
            ReDim vParamType(0&)
        End If
        Dim iParamIndex As Long
        For iParamIndex = 0& To iParamCount - 1&    ' If iParamCount = 0& then loop won't execute.
            vParamPtr(iParamIndex) = VarPtr(vParams(iParamIndex))
            vParamType(iParamIndex) = VarType(vParams(iParamIndex))
        Next
        '
        ' Make our DispCallFunc call.  Return value takes care of itself if it was specified correctly.
        Const CC_STDCALL As Long = 4&
        Dim iRet As Long
        ' Since it's a non-Object, we specify 0 for the pvInstance, so DispCallFunc understands.
        iRet = DispCallFunc(0&, ProcAddress, CC_STDCALL, ReturnType, iParamCount, vParamType(0&), vParamPtr(0&), vReturn)
        If iRet = 0& Then CallBasProcedureByAddress = True
    End Function
    
    ---------------------------------

    Here's a test of it with a Sub Main project and a single Sub procedure:

    Code:
    
    Private Sub Main()
    
    
        Dim vRet As Variant ' Not used but needed for call.
        ' Notice that I'm careful that the TYPEs and Varptr (or not) are correct, or crash.
        CallBasProcedureByAddress AddressOf TestSub1, vbEmpty, vRet, VarPtr(111), 222&, VarPtr(333!), 444#
    
    
    End Sub
    
    Private Sub TestSub1(ByRef arg1 As Integer, ByVal arg2 As Long, ByRef arg3 As Single, ByVal arg4 As Double)
        ' Notice that the arguments are a mixture of ByRef & ByVal.
        ' There is also a hodpodge of types.
        '
        Debug.Print TypeName(arg1); ":"; arg1, TypeName(arg2); ":"; arg2, TypeName(arg3); ":"; arg3, TypeName(arg4); ":"; arg4
        ' Prints:   Integer: 111   Long: 222      Single: 333     Double: 444
    End Sub
    
    ---------------------------------

    Here's another test with a Sub Main project calling a Function:

    Code:
    
    Option Explicit
    
    Private Sub Main()
    
    
        Dim vRet As Variant
        Dim arg1 As Integer: arg1 = 111
        CallBasProcedureByAddress AddressOf TestFn1, vbDouble, vRet, VarPtr(arg1), 222&
        Debug.Print "Return: "; TypeName(vRet); ":"; vRet, "Arg1: "; TypeName(arg1); ":"; arg1
        ' Prints:   Return: Double: 333          Arg1: Integer: 999
    
    
    End Sub
    
    Private Function TestFn1(ByRef arg1 As Integer, ByVal arg2 As Long) As Double
        TestFn1 = arg1 + arg2
        arg1 = 999
        ' We can change arg2 but change won't be returned because it's ByVal.
    End Function
    
    ---------------------------------

    Feel free to test with Property procedures or other procedures with different types of arguments. It does have some limitations, and those are listed in the comments.
    Last edited by Elroy; Oct 27th, 2022 at 01:22 PM.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  2. #2
    Hyperactive Member
    Join Date
    Jan 2015
    Posts
    323

    Re: Call BAS Procedure By Address

    what is the advantage of this vs Call bas.SubRoutine

  3. #3

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    Re: Call BAS Procedure By Address

    Quote Originally Posted by loquat View Post
    what is the advantage of this vs Call bas.SubRoutine
    None, other than the fact that you can use a memory pointer address, rather than the procedure's name. It just occasionally comes up (someone asking for a "Call by Address" procedure).
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  4. #4
    Frenzied Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    1,289

    Re: Call BAS Procedure By Address

    Not working with strings by ref

  5. #5

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    Re: Call BAS Procedure By Address

    Georgekar, please give an example of the code you're using.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  6. #6
    Frenzied Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    1,289

    Re: Call BAS Procedure By Address

    Code:
    a = "hello"
    CallBasProcedureByAddress AddressOf Test4, vbEmpty, vRet, 100&, StrPtr(a)  ' works
    CallBasProcedureByAddress AddressOf Test4, vbEmpty, vRet, 100&, a  ' works 
    
    
    Private Sub Test4(ByVal a As Long, ByVal m As String)
    Debug.Print a, m
    End Sub

    if we delete byval on second parameter, vb6 close..,

  7. #7

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    Re: Call BAS Procedure By Address

    Ok, to pass a String as ByRef, you've got to pass a pointer to the entire BSTR, and not just the string's data. So, we've got to use VarPtr, and not StrPtr.

    Using the above CallBasProcedureByAddress, I placed the following in a BAS module:

    Code:
    Option Explicit
    
    Public Sub Test4(ByVal a As Long, ByRef m As String)
        Debug.Print a, m
    End Sub
    And then did the following:

    Code:
    Option Explicit
    
    Private Sub Form_Load()
        Dim a As String
        Dim vRet As Variant
        
        a = "hello"
        CallBasProcedureByAddress AddressOf Test4, vbEmpty, vRet, 100&, VarPtr(a)
    
    
    End Sub
    And it all worked fine.

    This is all a good exercise for those wanting to know how all this works "under the hood".
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  8. #8
    Frenzied Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    1,289

    Re: Call BAS Procedure By Address

    No good. Because you can't change the string in Test4 and get it back from the caller side.

  9. #9
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: Call BAS Procedure By Address

    Quote Originally Posted by georgekar View Post
    No good. Because you can't change the string in Test4 and get it back from the caller side.
    Good enough for me. It works here as expected and any string modification reaches the caller back.

    cheers,
    </wqw>

  10. #10
    Frenzied Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    1,289

    Re: Call BAS Procedure By Address

    Ok ! I check it again and now seams to work good.
    And now works for CallPointer


    Code:
    Public btASM As Long
    Private Declare Function GetMem4 Lib "msvbvm60" ( _
                             ByRef Src As Any, _
                             ByRef Dst As Any) As Long
    Public Declare Sub CpyMem Lib "kernel32" Alias "RtlMoveMemory" ( _
        pDst As Any, pSrc As Any, ByVal dwLen As Long)
    
    
    Public Declare Sub FillMem Lib "kernel32" Alias "RtlFillMemory" ( _
        pDst As Any, ByVal dlen As Long, ByVal Fill As Byte)
    
    
    Private Declare Function VirtualAlloc Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
    Private Declare Function VirtualFree Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
    Private Declare Function VirtualLock Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long) As Long
    Private Declare Function VirtualUnlock Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long) As Long
    Private Const MEM_DECOMMIT = &H4000
    Private Const MEM_RELEASE = &H8000
    Private Const MEM_COMMIT = &H1000
    Private Const MEM_RESERVE = &H2000
    Private Const PAGE_EXECUTE_READWRITE = &H40
    Private Const MAXCODE   As Long = &HEC00&
    Private Declare Function CallWindowProcA Lib "user32" ( _
        ByVal adr As Long, ByVal p1 As Long, ByVal p2 As Long, _
        ByVal p3 As Long, ByVal p4 As Long) As Long
    Private Declare Function EbGetExecutingProj Lib "vba6.dll" ( _
                             ByRef hProject As Long) As Long
    Private Declare Function TipGetFunctionId Lib "vba6.dll" ( _
                             ByVal hProject As Long, _
                             ByVal strFunctionName As String, _
                             ByRef strFunctionId As String) As Long
    Private Declare Function TipGetLpfnOfFunctionId Lib "vba6.dll" ( _
                             ByVal hProject As Long, _
                             ByVal strFunctionId As String, _
                             ByRef lpfn As Long) As Long
    
    
    Public Function AddrOf( _
                    ByRef sFuncName As String) As Long
        Dim hProject    As Long
        Dim lResult     As Long
        Dim sID         As String
        Dim pfn         As Long
        Dim sUnicode    As String
    
    
        sUnicode = StrConv(sFuncName, vbUnicode)
        
        EbGetExecutingProj hProject
        
        If hProject <> 0 Then
            If TipGetFunctionId(hProject, sUnicode, sID) = 0 Then
                If TipGetLpfnOfFunctionId(hProject, sID, pfn) = 0 Then
                    AddrOf = pfn
                End If
            End If
        End If
    
    
    End Function
    Public Function CallPointer(ByVal fnc As Long, ParamArray params()) As Long
    If fnc = 0 Then Exit Function
    If btASM = 0 Then
     btASM = VirtualAlloc(ByVal 0&, MAXCODE, MEM_COMMIT, PAGE_EXECUTE_READWRITE)
     End If
     If btASM = 0 Then
      CallPointer = -1
     Exit Function
     End If
        VirtualLock btASM, MAXCODE
        Dim pASM                As Long
        Dim i                   As Integer
        Dim Addr1               As Long
        pASM = btASM
    
    
        FillMem ByVal pASM, MAXCODE, &HCC
    
    
        AddByte pASM, &H58                  ' POP EAX
        AddByte pASM, &H59                  ' POP ECX
        AddByte pASM, &H59                  ' POP ECX
        AddByte pASM, &H59                  ' POP ECX
        AddByte pASM, &H59                  ' POP ECX
        AddByte pASM, &H50                  ' PUSH EAX
    
    
        If UBound(params) = 0 Then
            If IsArray(params(0)) Then
                For i = UBound(params(0)) To 0 Step -1
                    AddPush pASM, CLng(params(0)(i))    ' PUSH dword
                Next
            Else
               AddPush pASM, CLng(params(0))       ' PUSH dword
            End If
        Else
            For i = UBound(params) To 0 Step -1
            
               AddPush pASM, CLng(params(i))           ' PUSH dword
                
            Next
        End If
    
    
        AddCall pASM, fnc                   ' CALL rel addr
        AddByte pASM, &HC3                  ' RET
    
    
        CallPointer = CallWindowProcA(btASM, _
                                      0, 0, 0, 0)
                
                 VirtualUnlock btASM, MAXCODE
    
    
    
    
    End Function
    Public Sub ReleaseMem()
    If btASM <> 0 Then
            VirtualFree btASM, MAXCODE, MEM_DECOMMIT
            VirtualFree btASM, 0, MEM_RELEASE
    End If
    End Sub
    Private Sub AddPush(pASM As Long, lng As Long)
        AddByte pASM, &H68
        AddLong pASM, lng
    End Sub
    
    
    Private Sub AddCall(pASM As Long, addr As Long)
        AddByte pASM, &HE8
        AddLong pASM, addr - pASM - 4
    End Sub
    
    
    Private Sub AddLong(pASM As Long, lng As Long)
        CpyMem ByVal pASM, lng, 4
        pASM = pASM + 4
    End Sub
    
    
    Private Sub AddByte(pASM As Long, bt As Byte)
        CpyMem ByVal pASM, bt, 1
        pASM = pASM + 1
    End Sub
    
    
    Public Function CallCdecl( _
        ByVal lpfn As Long, _
        ParamArray Args() As Variant _
    ) As Long
    
    
        Dim btASM(&HEC00& - 1)  As Byte
        Dim pASM                As Long
        Dim btArgSize           As Byte
        Dim i                   As Integer
    
    
        pASM = VarPtr(btASM(0))
    
    
        If UBound(Args) = 0 Then
            If IsArray(Args(0)) Then
                For i = UBound(Args(0)) To 0 Step -1
                    AddPush pASM, CLng(Args(0)(i))    ' PUSH dword
                    btArgSize = btArgSize + 4
                Next
            Else
                For i = UBound(Args) To 0 Step -1
                    AddPush pASM, CLng(Args(i))       ' PUSH dword
                    btArgSize = btArgSize + 4
                Next
            End If
        Else
            For i = UBound(Args) To 0 Step -1
                AddPush pASM, CLng(Args(i))           ' PUSH dword
                btArgSize = btArgSize + 4
            Next
        End If
    
    
        AddByte pASM, &HB8
        AddLong pASM, lpfn
        AddByte pASM, &HFF
        AddByte pASM, &HD0
        AddByte pASM, &H83
        AddByte pASM, &HC4
        AddByte pASM, btArgSize
        AddByte pASM, &HC2
        AddByte pASM, &H10
        AddByte pASM, &H0
    
    
        CallCdecl = CallWindowProcA(VarPtr(btASM(0)), _
                                   0, 0, 0, 0)
    End Function
    Last edited by georgekar; Nov 6th, 2022 at 12:27 PM.

  11. #11
    Hyperactive Member
    Join Date
    Jan 2015
    Posts
    323

    Re: Call BAS Procedure By Address

    two questions
    1.will you update code to support x64, such as office vba and twinbasic
    2.can you achieve CallBasProcedureByName

  12. #12

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    Re: Call BAS Procedure By Address

    Quote Originally Posted by loquat View Post
    two questions
    1.will you update code to support x64, such as office vba and twinbasic
    2.can you achieve CallBasProcedureByName
    Oh dear, loquat. I've got no interest in doing the first one, although I do believe it could be done. Maybe ask over in the VBA forum.

    Regarding the second one, two thoughts: 1) If you mean the procedure's name in a string variable, that can't be done. Once BAS procedures are compiled, their name is gone gone gone. All the calls of the procedure are reduced to simple addresses. That's why you actually can call them by address.

    And here's my second thought: Isn't that what we're doing when we just call it the way we always do? But I suspect you do mean calling it with the name in a string variable.

    --------

    Now interestingly, within the VBA (not compiled VB6 code), there probably is a way to get the procedure names within BAS modules. But again, that's just not my interest.

    Good Luck.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  13. #13
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,647

    Re: Call BAS Procedure By Address

    With the code in the original post I don't see anything you'd need to do for x64 other than update the DispCallFunc def...

    Public Declare PtrSafe Function DispCallFunc Lib "oleaut32" (ByVal pvInstance As LongPtr, ByVal oVft As LongPtr, ByVal cc As Integer, ByVal vtReturn As Integer, ByVal cActuals As Long, ByRef prgvt As Any, ByRef prgpvarg As Any, ByRef pvargResult As Any) As Long

    Assembly thunks like georgekar posted on the other hand, would need major changes. Only know of a couple people who have done any x64 asm work in VB; The trick might help.
    Last edited by fafalone; Apr 15th, 2023 at 06:06 PM.

  14. #14

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    Re: Call BAS Procedure By Address

    Quote Originally Posted by fafalone View Post
    With the code in the original post I don't see anything you'd need to do for x64 other than update the DispCallFunc def...

    Public Declare PtrSafe Function DispCallFunc Lib "oleaut32" (ByVal pvInstance As LongPtr, ByVal oVft As LongPtr, ByVal cc As Integer, ByVal vtReturn As Integer, ByVal cActuals As Long, ByRef prgvt As Any, ByRef prgpvarg As Any, ByRef pvargResult As Any) As Long

    Assembly thunks like georgekar posted on the other hand, would need major changes. Only know of a couple people who have done any x64 asm work in VB; The trick might help.
    Well, the passed-in ProcAddress would have to be declared as a LongPtr. But, without thorough testing, I'm not sure if that's all or not.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  15. #15
    Hyperactive Member
    Join Date
    Jan 2015
    Posts
    323

    Re: Call BAS Procedure By Address

    Regarding the second one, two thoughts: 1) If you mean the procedure's name in a string variable, that can't be done. Once BAS procedures are compiled, their name is gone gone gone. All the calls of the procedure are reduced to simple addresses. That's why you actually can call them by address.
    And here's my second thought: Isn't that what we're doing when we just call it the way we always do? But I suspect you do mean calling it with the name in a string variable.
    I guess with the trick's code GetCallingProcName, we should have a trick to make that done with a compiled debug symbol attached.
    Now interestingly, within the VBA (not compiled VB6 code), there probably is a way to get the procedure names within BAS modules. But again, that's just not my interest.
    i have seen some demo for vba to do CallBasProcByName, like CallByName but can call proc in stdModule
    CallBasProcByName "modFunction", "SubProcedure1"
    https://github.com/Greedquest/CodeReviewFiles
    and
    https://github.com/Greedquest/vbInvoke

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width