Attribute VB_Name = "hlp_CallFunction"
Option Explicit
Option Base 0

'#CallFunction_FlagA:
' 0/1 = CallFunctionFast
'   2 = CallFunction
'   4 = CallFunctionFull
' 100 = stdoptional

Private sByteA1() As Byte
Private sLongA1() As Long
Private sByteA1Pos As Long
'Private Declare Function CallWindowProcA Lib "user32" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
'Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long


#If (CallFunction_FlagA And &H4&) = &H4& Then
  #If (CallFunction_FlagA And &H100&) = &H100& Then
  Public Function CallFunctionFull(ByVal DllFilename As String, ByVal FunctionName As String, ByVal IsStdCall As Boolean, ParamArray FunctionParams()) As Long
  #Else
  Public Function CallFunctionFull(ByVal DllFilename As String, ByVal FunctionName As String, ParamArray FunctionParams()) As Long
  #End If
    Dim xLong1 As Long
    Dim xLong2 As Long
    
    ReDim sLongA1(UBound(FunctionParams()) + 1&)
    For xLong1 = 0& To UBound(FunctionParams())
      sLongA1(xLong1) = FunctionParams(xLong1)
      Next
    
    xLong1 = LoadLibrary(DllFilename)
    If Not xLong1 = 0& Then
      'CallFunctionFull = CallFunction(xLong1, FunctionName, IsStdCall, FunctionParams())
      If Not VarType(FunctionName) = vbString Then FunctionName = "#" + CStr(Val(FunctionName))
      xLong2 = GetProcAddress(xLong1, CStr(FunctionName))
      If Not xLong2 = 0& Then
        #If (CallFunction_FlagA And &H100&) = &H100& Then
          CallFunctionFull = CallWindowProcAnsi(PrepareCode(xLong2, IsStdCall), 0, 0, 0, 0)
          #Else
          CallFunctionFull = CallWindowProcAnsi(PrepareCode(xLong2), 0, 0, 0, 0)
          #End If
        End If
      End If
    
    
    ReDim sLongA1(0&)
    ReDim sByteA1(0&)
    End Function
  #End If

#If (CallFunction_FlagA And &H2&) = &H2& Then
  #If (CallFunction_FlagA And &H100&) = &H100& Then
  Public Function CallFunction(ByVal DllHandle As Long, ByVal FunctionName As Variant, ByVal IsStdCall As Boolean, ParamArray FunctionParams()) As Long
  #Else
  Public Function CallFunction(ByVal DllHandle As Long, ByVal FunctionName As Variant, ParamArray FunctionParams()) As Long
  #End If
    Dim xLong1 As Long
    
'    If DllHandle = 0& Then
'      Stop
'      Exit Function
'      End If
    
    ReDim sLongA1(UBound(FunctionParams()) + 1&)
    For xLong1 = 0& To UBound(FunctionParams())
      sLongA1(xLong1) = FunctionParams(xLong1)
      Next
    
    If Not VarType(FunctionName) = vbString Then FunctionName = "#" + CStr(Val(FunctionName))
    xLong1 = GetProcAddress(DllHandle, CStr(FunctionName))
    If Not xLong1 = 0& Then
      #If (CallFunction_FlagA And &H100&) = &H100& Then
        CallFunction = CallWindowProcAnsi(PrepareCode(xLong1, IsStdCall), 0, 0, 0, 0)
        #Else
        CallFunction = CallWindowProcAnsi(PrepareCode(xLong1), 0, 0, 0, 0)
        #End If
      End If
    
    ReDim sLongA1(0&)
    ReDim sByteA1(0&)
    End Function
  #End If

#If (CallFunction_FlagA And &H1&) = &H1& Or CallFunction_FlagA = 0& Then
  #If (CallFunction_FlagA And &H100&) = &H100& Then
  Public Function CallFunctionFast(ByVal FunctionAddress As Long, ByVal IsStdCall As Boolean, ParamArray FunctionParams()) As Long
  #Else
  Public Function CallFunctionFast(ByVal FunctionAddress As Long, ParamArray FunctionParams()) As Long
  #End If
    Dim xLong1 As Long
    
'    If FunctionAddress = 0& Then
'      Stop
'      Exit Function
'      End If
    
    ReDim sLongA1(UBound(FunctionParams()) + 1&)
    For xLong1 = 0& To UBound(FunctionParams())
      sLongA1(xLong1) = FunctionParams(xLong1)
      Next
    
    #If (CallFunction_FlagA And &H100&) = &H100& Then
      CallFunctionFast = CallWindowProcAnsi(PrepareCode(FunctionAddress, IsStdCall), 0, 0, 0, 0)
      #Else
      CallFunctionFast = CallWindowProcAnsi(PrepareCode(FunctionAddress), 0, 0, 0, 0)
      #End If
    ReDim sLongA1(0&)
    ReDim sByteA1(0&)
    End Function
  #End If

#If (CallFunction_FlagA And &H100&) = &H100& Then
Private Function PrepareCode(ByVal mlngAddress As Long, ByVal IsStdCall As Boolean) As Long
#Else
Private Function PrepareCode(ByVal mlngAddress As Long) As Long
#End If
  Dim xLong1 As Long
  Dim codeStart As Long
  
  #If (CallFunction_FlagA And &H100&) = &H100& Then
    ReDim sByteA1(50& + (6& + CLng(IsStdCall)) * (UBound(sLongA1()))) '5x due no cdll
    #Else
    ReDim sByteA1(50& + 5& * (UBound(sLongA1())))  '5x due no cdll
    #End If
  codeStart = GetAlignedCodeStart(VarPtr(sByteA1(0)))
  sByteA1Pos = codeStart - VarPtr(sByteA1(0))
  For xLong1 = 0& To sByteA1Pos - 1&
    sByteA1(xLong1) = &HCC&
    Next
  AddLongToCode &H58&, &H59595959
  'AddByteToCode &H50&
  sByteA1(sByteA1Pos) = &H50&
  sByteA1Pos = sByteA1Pos + 1&
  
  For xLong1 = UBound(sLongA1()) - 1& To 0& Step -1&
    AddLongToCode &H68&, sLongA1(xLong1)
    Next
  AddCallToCode mlngAddress
  
  #If (CallFunction_FlagA And &H100&) = &H100& Then
    Stop
    If Not IsStdCall Then
      For xLong1 = sByteA1Pos To sByteA1Pos + UBound(sLongA1())
        sByteA1(xLong1) = &H59&
        Next
      sByteA1Pos = sByteA1Pos + UBound(sLongA1()) + 1&
      End If
    #End If
  
  'AddByteToCode &HC3&
  'AddByteToCode &HCC&
  sByteA1(sByteA1Pos) = &HC3&
  sByteA1Pos = sByteA1Pos + 1&
  sByteA1(sByteA1Pos) = &HCC&
  sByteA1Pos = sByteA1Pos + 1&
  
  PrepareCode = codeStart
  On Error Resume Next
  codeStart = Timer
  'Call GetTickCount
  On Error GoTo 0
'  Stop
  End Function

Private Function GetAlignedCodeStart(ByVal lngAddress As Long) As Long
  GetAlignedCodeStart = lngAddress + (15& - (lngAddress - 1&) Mod 16&)
  If (15& - (lngAddress - 1&) Mod 16&) = 0& Then GetAlignedCodeStart = GetAlignedCodeStart + 16&
  End Function

Private Sub AddLongToCode(ByVal preByte As Long, ByVal xLong1 As Long)
  sByteA1(sByteA1Pos) = preByte
  Call RtlMoveMemory(sByteA1(sByteA1Pos + 1&), ByVal VarPtr(xLong1), 4&)
  sByteA1Pos = sByteA1Pos + 5&
  End Sub

Private Sub AddCallToCode(lngAddress As Long)
  AddLongToCode &HE8&, lngAddress - VarPtr(sByteA1(sByteA1Pos + 1&)) - 4&
  End Sub
