VBCommons/api/ex_Python.bas

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