126 lines
4.2 KiB
QBasic
126 lines
4.2 KiB
QBasic
Attribute VB_Name = "ex_Python"
|
|
' ======== Python runner extension ========
|
|
' Shared module version: 20240330
|
|
' Tested in: PythonManager
|
|
' Depends on: ex_VBA, ex_WinAPI, API_Config
|
|
' Required reference: Scripting
|
|
Option Private Module
|
|
Option Explicit
|
|
|
|
' Switch flag for Debug purposes
|
|
Private Const SHOW_PYTHON = False
|
|
|
|
Public Const PY_KEY_INTERPRETER = "Python3"
|
|
Public Const PY_KEY_SOURCE_PATH = "PythonImports"
|
|
|
|
Public Const PY_MODULE_TEXT = "cctext"
|
|
Public Const PY_MODULE_UTILS = "vbatopy"
|
|
|
|
Public Const PY_DEFVALUE_INTERPRETER = "C:\Tools\Python312-venv\Scripts\python.exe"
|
|
|
|
Public Function AccessPython() As API_Python
|
|
Static s_Python As API_Python
|
|
If s_Python Is Nothing Then
|
|
Set s_Python = New API_Python
|
|
Call s_Python.Init( _
|
|
iPython:=ConceptConfig.GetValue(PY_KEY_INTERPRETER), _
|
|
sModules:=OfficeActivePath & ";" & ConceptConfig.GetValue(PY_KEY_SOURCE_PATH), _
|
|
bDoDebug:=SHOW_PYTHON)
|
|
End If
|
|
Set AccessPython = s_Python
|
|
End Function
|
|
|
|
Public Function ConceptConfig() As API_Config
|
|
Dim iConfig As New API_Config
|
|
Set ConceptConfig = iConfig
|
|
If Not iConfig.LoadFromFile(ConceptConfigPath()) Then _
|
|
Call LoadDefaultConfig(iConfig)
|
|
End Function
|
|
|
|
' Runs the Python command, e.g.: Call RunPython("import bar; bar.foo()", ThisWorkbook.Path)
|
|
Public Function RunPyStandalone(sPyCommand$, Optional sWorkDir$ = vbNullString) As Long
|
|
Dim iConfig As API_Config: Set iConfig = ConceptConfig
|
|
Dim iPython$: iPython = iConfig.GetValue(PY_KEY_INTERPRETER)
|
|
Dim sSource$
|
|
If Not sWorkDir = vbNullString Then _
|
|
sSource = sWorkDir & ";"
|
|
sSource = sSource & iConfig.GetValue(PY_KEY_SOURCE_PATH)
|
|
If sSource <> "" Then _
|
|
sSource = sSource & ";"
|
|
sSource = VBA.Replace(sSource, "&", "^&")
|
|
sSource = VBA.Replace(sSource, "\", "\\")
|
|
|
|
Dim sChangeDir$: sChangeDir = GenerateCDCommandFor(iPython)
|
|
Dim sExtendedPyCommand$: sExtendedPyCommand = Fmt( _
|
|
"{1} & ""{2}"" -B -c " & _
|
|
"""import sys, os; sys.path[0:0]=os.path.normcase(os.path.expandvars(\""{3}\"")).split(';'); " & _
|
|
"{4}""", _
|
|
sChangeDir, iPython, sSource, sPyCommand)
|
|
|
|
RunPyStandalone = PyExecute(sExtendedPyCommand)
|
|
End Function
|
|
|
|
' Runs a Python executable that has been frozen by PyInstaller and the like
|
|
' Call RunFrozenPython("C:\path\to\frozen_executable.exe", "arg1 arg2")
|
|
Public Function RunPyFrozen(iPython$, Optional sArgs$ = vbNullString) As Long
|
|
Dim sChangeDir$: sChangeDir = GenerateCDCommandFor(iPython)
|
|
Dim sPyCommand$: sPyCommand = Fmt("{1} & ""{2}"" {3}", sChangeDir, iPython, sArgs)
|
|
RunPyFrozen = PyExecute(sPyCommand)
|
|
End Function
|
|
|
|
Public Function ConceptConfigPath() As String
|
|
ConceptConfigPath = VBA.Environ$("USERPROFILE") & "\.concept\concept-options.json"
|
|
End Function
|
|
|
|
' ========
|
|
Private Function PyExecute(sPyCommand$) As Long
|
|
Dim sLog$: sLog = GetLogFile()
|
|
|
|
Dim sShellCommand$: sShellCommand = Fmt("cmd.exe /C {1} 2> ""{3}""", _
|
|
sPyCommand, sLog)
|
|
|
|
Dim nWindowStyle%: nWindowStyle = IIf(SHOW_PYTHON, 1, 0)
|
|
Dim iShell As Object: Set iShell = CreateObject("WScript.Shell")
|
|
Dim nExitCode&: nExitCode = iShell.Run(sShellCommand, nWindowStyle, True)
|
|
|
|
If nExitCode <> 0 Then
|
|
Call MsgBox(ReadTextFile(sLog), vbCritical)
|
|
PyExecute = -1
|
|
End If
|
|
|
|
On Error Resume Next
|
|
Call Kill(sLog)
|
|
On Error GoTo 0
|
|
|
|
Set iShell = Nothing
|
|
End Function
|
|
|
|
Private Function LoadDefaultConfig(ByRef iConfig As API_Config)
|
|
Call iConfig.SetValue(PY_KEY_INTERPRETER, PY_DEFVALUE_INTERPRETER)
|
|
Call iConfig.SetValue(PY_KEY_SOURCE_PATH, "")
|
|
End Function
|
|
|
|
Private Function GenerateCDCommandFor(sFile$) As String
|
|
Dim fso As New Scripting.FileSystemObject
|
|
GenerateCDCommandFor = Fmt("{1} & cd ""{2}""", VBA.Left(sFile, 2), fso.GetParentFolderName(sFile$))
|
|
End Function
|
|
|
|
Private Function GetLogFile() As String
|
|
GetLogFile = Fmt("{1}\pymanager-{2}.log", VBA.Environ("Temp"), GetCurrentProcessId())
|
|
End Function
|
|
|
|
Private Function ReadTextFile(sFile$) As String
|
|
Dim adoStream As Object: Set adoStream = CreateObject("ADODB.Stream")
|
|
adoStream.Charset = "utf-8"
|
|
Call adoStream.Open
|
|
|
|
On Error GoTo ERROR_FILE
|
|
Call adoStream.LoadFromFile(sFile)
|
|
On Error GoTo 0
|
|
|
|
ReadTextFile = adoStream.ReadText
|
|
|
|
ERROR_FILE:
|
|
Call adoStream.Close
|
|
End Function
|