222 lines
6.6 KiB
OpenEdge ABL
222 lines
6.6 KiB
OpenEdge ABL
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
|
|
|