VBCommons/api/API_Python.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "API_Python"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'================ Python process object =========================
' Shared module version: 20220713
' Tested in: PythonManager
' Depends on:
' Required reference:
Option Explicit

Private Const CONCEPT_DLL_LOCATION = "C:\Tools\dll"

#If Win64 Then
  Private Const PY_DLL_NAME As String = "vbatopy-connector64.dll"
  
  Private Declare PtrSafe Function StartPythonServer Lib "vbatopy-connector64.dll" ( _
    ByRef vResult As Variant, _
    ByVal sPython As String, _
    ByVal sModules As String, _
    ByVal bShowConsole As Long) As Long
    
  Private Declare PtrSafe Function KillPythonServer Lib "vbatopy-connector64.dll" Alias "KillServer" () As Long
  Private Declare PtrSafe Function GetServer Lib "vbatopy-connector64.dll" (ByRef vResult As Variant) As Long
#Else
  Private Const PY_DLL_NAME As String = "vbatopy-connector32.dll"
  
  Private Declare PtrSafe Function StartPythonServer Lib "vbatopy-connector32.dll" ( _
    ByRef vResult As Variant, _
    ByVal sPython As String, _
    ByVal sModules As String, _
    ByVal bShowConsole As Long) As Long
    
  Private Declare PtrSafe Function KillPythonServer Lib "vbatopy-connector32.dll" Alias "KillServer" () As Long
  Private Declare PtrSafe Function GetServer Lib "vbatopy-connector32.dll" (ByRef vResult As Variant) As Long
#End If

Private Declare PtrSafe Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal sLibrary As String) As Long
Private Declare PtrSafe Function FreeLibrary Lib "kernel32" (ByVal nLibraryHandle As Long) As Long

Private python_ As Variant
Private pythonPath_ As String
Private modules_ As String
Private showConsole_ As Boolean

Private Sub Class_Initialize()
  Call ClearCahce
End Sub

Private Sub Class_Terminate()
  Call ClearCahce
End Sub

Public Function ClearCahce()
  Set python_ = Nothing
End Function

' Initialize Python process
' iPython - path to python / python command
' sModules - path to python source code modules, delimiter = ';'
' bDoDebug - flag to show console output for python process
Public Function Init(iPython$, sModules$, Optional bDoDebug As Boolean = False)
  Set python_ = Nothing
  pythonPath_ = VBA.LCase(iPython)
  pythonPath_ = VBA.Replace(pythonPath_, "program files (x86)", """program files (x86)""")
  pythonPath_ = VBA.Replace(pythonPath_, "program files", """program files""")
  pythonPath_ = VBA.Replace(pythonPath_, "\", "\\")
  modules_ = sModules
  showConsole_ = bDoDebug
End Function

' Validate server is running
' If @python_ is not setup, then load current server dispatch into @python_
Public Function Validate() As Boolean
  Call LoadDLL
  Call GetServer(python_)
  Validate = Not python_ Is Nothing
End Function

Public Function StartServer()
  Call Validate
  If Not python_ Is Nothing Then _
    Exit Function
    
  If StartPythonServer(python_, pythonPath_, modules_, IIf(showConsole_, 1, 0)) <> 0 Then _
    Call RaiseServerError
  
  If VBA.VarType(python_) = vbString Then
    Call RaiseServerError
    Set python_ = Nothing
  End If
End Function

Public Function KillServer()
  Call Validate
  If python_ Is Nothing Then _
    Exit Function
  If KillPythonServer() <> 0 Then _
    Call RaiseServerError
  Set python_ = Nothing
End Function

' Preload Python module before using it - use if long setup is needed to load module
Public Function LoadModule(sFullPath$) As Boolean
  On Error GoTo HANDLE_ERROR
  LoadModule = Py.ImportModule(sFullPath) <> ""
  On Error GoTo 0
  Exit Function
  
HANDLE_ERROR:
  Debug.Print Err.Description
  LoadModule = False
  On Error GoTo 0
End Function

' Run python command
Public Function Execute(sPyCommand$) As Boolean
  On Error GoTo HANDLE_ERROR
  Call Py.Exec("" & sPyCommand & "")
  On Error GoTo 0
  Execute = True
  Exit Function
  
HANDLE_ERROR:
  Debug.Print Err.Description
  Execute = False
  On Error GoTo 0
End Function

' Evaluate python statement
' Warning! Returns only basic types. Objects are not supported
Public Function Evaluate(sPyStatement$) As Variant
  On Error GoTo HANDLE_ERROR
  Evaluate = Py.Eval("" & sPyStatement & "")
  On Error GoTo 0
  Exit Function
  
HANDLE_ERROR:
  Debug.Print Err.Description
  Evaluate = Err.Description
  On Error GoTo 0
End Function

' Call function from module. Arguments will be available from python including COM wrappers for any Office objects
' Warning! Returns basic types. To get objects from python use CallFunctionReturnObject
Public Function CallFunction(sModule$, sFunc$, Optional vArgs As Variant) As Variant
  On Error GoTo HANDLE_ERROR
  If IsMissing(vArgs) Then
    CallFunction = Py.CallFunction(sModule, sFunc)
  Else
    CallFunction = Py.CallFunction(sModule, sFunc, vArgs)
  End If
  On Error GoTo 0
  Exit Function
  
HANDLE_ERROR:
  Debug.Print Err.Description
  CallFunction = Err.Description
End Function

Public Function CallFunctionReturnObject(sModule$, sFunc$, Optional vArgs As Variant) As Object
  On Error GoTo HANDLE_ERROR
  If IsMissing(vArgs) Then
    Set CallFunctionReturnObject = Py.CallFunction(sModule, sFunc)
  Else
    Set CallFunctionReturnObject = Py.CallFunction(sModule, sFunc, vArgs)
  End If
  On Error GoTo 0
  Exit Function
  
HANDLE_ERROR:
  Debug.Print Err.Description
  Set CallFunctionReturnObject = Nothing
End Function

' Create VBA wrapper for target Python module in destination file path
Public Function WrapPython(sSourceModule$, sDestination$) As String
  WrapPython = Py.WrapPython(sSourceModule, sDestination)
End Function

' Preload @vbatopy DLL
' Note: Mostly usefull for testing setup because it allows using DLL calls without starting a server
Public Function LoadDLL()
  If LoadLibrary(PY_DLL_NAME) <> 0 Then _
    Exit Function
  If LoadLibrary(CONCEPT_DLL_LOCATION & "\" & PY_DLL_NAME) <> 0 Then _
    Exit Function
  ' TODO: remove fallback after some time
  ' fallback path for earlier versions of distribution
  If LoadLibrary(VBA.Environ("USERPROFILE") & "\.concept\dll\" & PY_DLL_NAME) = 0 Then _
    Call Err.Raise(1, Description:="Could not load " & PY_DLL_NAME)
End Function

' Unload DLL - need to call this before replacing dll file
Public Function UnloadDLL()
  Dim nHandle&: nHandle = LoadLibrary(PY_DLL_NAME)
  If nHandle <> 0 Then
    Call KillServer
    Call FreeLibrary(nHandle)
  End If
End Function

' =========
Private Property Get Py() As Variant
  If python_ Is Nothing Then _
    Call StartServer
  Set Py = python_
End Property

Private Function RaiseServerError()
  Dim sErr$: sErr = python_
  Set python_ = Nothing
  Debug.Print sErr
  Call Err.Raise(1000, Description:=sErr)
End Function