SSL Python.xba   Interaktion und
Portierbarkeitunbekannt

<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Python" script:language="StarBasic">
REM =======================================================================================================================
REM ===     The Access2Base library is a part of the LibreOffice project.         ===
REM ===     Full documentation is available on http://www.access2base.com         ===
REM =======================================================================================================================

Option Compatible
Option Explicit

REM -----------------------------------------------------------------------------------------------------------------------
Public Sub DebugPrint(ParamArray pvArgs() As Variant)

'Print arguments unconditionally in console
'Arguments are separated by a TAB (simulated by spaces)
'Some pvArgs might be missing: a TAB is still generated

Dim vVarTypes() As Variant, i As Integer
Const cstTab = 5
 On Local Error Goto Exit_Sub ' Never interrupt processing
 Utils._SetCalledSub("DebugPrint")
 vVarTypes = Utils._AddNumeric(Array(vbEmpty, vbNull, vbDate, vbString, vbBoolean, vbObject, vbVariant, vbByte, vbArray + vbByte))
 
 If UBound(pvArgs) >= 0 Then
  For i = 0 To UBound(pvArgs)
   If Not Utils._CheckArgument(pvArgs(i), i + 1, vVarTypes(), , False) Then pvArgs(i) = "[TYPE?]"
  Next i
 End If

Dim sOutput As String, sArg As String
 sOutput = "" 
 For i = 0 To UBound(pvArgs)
  sArg = Replace(Utils._CStr(pvArgs(i), _A2B_.DebugPrintShort), "\;", ";")
  ' Add argument to output
  If i = 0 Then
   sOutput = sArg
  Else
   sOutput = sOutput & Space(cstTab - (Len(sOutput) Mod cstTab)) & sArg
  End If
 Next i
 
 TraceLog(TRACEANY, sOutput, False)
 
Exit_Sub:
 Utils._ResetCalledSub("DebugPrint")
 Exit Sub
End Sub   ' DebugPrint  V0.9.5

REM -----------------------------------------------------------------------------------------------------------------------
REM --- PYTHON WRAPPERS                               ---
REM -----------------------------------------------------------------------------------------------------------------------

REM -----------------------------------------------------------------------------------------------------------------------
Public Function PythonEventsWrapper(Optional poEvent As Variant) As Variant
'  Python wrapper when Application.Events() method is invoked
'   The ParamArray mechanism empties UNO objects when they are member of the arguments list
'   As a workaround, the Application.Events function is executed directly

 If _ErrorHandler() Then On Local Error GoTo Exit_Function ' Do never interrupt
 PythonEventsWrapper = Null

Dim vReturn As Variant, vArray As Variant
Const cstObject = 1

 vReturn = Application.Events(poEvent)
 vArray = Array(cstObject, _A2B_.AddPython(vReturn), vReturn._Type)

 PythonEventsWrapper = vArray

Exit_Function:
 Exit Function
End Function ' PythonEventsWrapper V6.4

REM -----------------------------------------------------------------------------------------------------------------------
Public Function PythonWrapper(ByVal pvCallType As Variant _
         , ByVal pvObject As Variant _
         , ByVal pvScript As Variant _
         , ParamArray pvArgs() As Variant _
        ) As Variant
'  Called from Python to apply
'   - on object with entry pvObject in PythonCache
'    Conventionally: -1 = Application
'         -2 = DoCmd
'   - a script pvScript which type is described by pvCallType
'   - with arguments pvArgs(0)... (max. 8 for object methods)
'   The value returned by the method/property is encapsulated in an array
'    [0] => 0 = scalar or array returned by the method
'     => 1 = basic object returned by the method
'     => 2 = a null value
'    [1] => the object reference or the returned value (complemented with arguments passed by reference, if any) or Null
'    [2] => the object type or Null
'    [3] => the object name, if any
'   or, when pvCallType == vbUNO, as the UNO object returned by the property

Dim vReturn As Variant, vArray As Variant
Dim vObject As Variant, sScript As String, sModule As String
Dim i As Integer, iNbArgs As Integer, vArg As Variant, vArgs() As Variant

Const cstApplication = -1, cstDoCmd = -2
Const cstScalar = 0, cstObject = 1, cstNull = 2, cstUNO = 3

'Conventional special values
Const cstNoArgs = "+++NOARGS+++", cstSymEmpty = "+++EMPTY+++", cstSymNull = "+++NULL+++", cstSymMissing = "+++MISSING+++"

'https://support.office.com/en-us/article/CallByName-fonction-49ce9475-c315-4f13-8d35-e98cfe98729a
'Determines the pvCallType
Const vbGet = 2, vbLet = 4, vbMethod = 1, vbSet = 8, vbUNO = 16

 If _ErrorHandler() Then On Local Error GoTo Error_Function
 PythonWrapper = Null

 'Reinterpret arguments one by one into vArgs, examine iso-dates and conventional NoArgs/Empty/Null values
 iNbArgs = -1
 vArgs = Array()
 If UBound(pvArgs) >= 0 Then
  For i = 0 To UBound(pvArgs)
   vArg = pvArgs(i)
   If i = 0 And VarType(vArg) = vbString Then
    If vArg = cstNoArgs Then Exit For
   End If
   If VarType(vArg) = vbString Then
    If vArg = cstSymEmpty Then
     vArg = Empty
    ElseIf vArg = cstSymNull Then
     vArg = Null
    ElseIf vArg = cstSymMissing Then
     Exit For ' Next arguments must be missing also
    Else
     vArg = _CDate(vArg)
    End If
   End If
   iNbArgs = iNbArgs + 1
   ReDim Preserve vArgs(iNbArgs)
   vArgs(iNbArgs) = vArg
  Next i
 End If

 'Check pvObject
 Select Case pvObject ' Always numeric
  Case cstApplication
   sModule = "Application"
   Select Case pvScript
    Case "AllDialogs" : If iNbArgs < 0 Then vReturn = Application.AllDialogs() Else vReturn = Application.AllDialogs(vArgs(0))
    Case "AllForms"  : If iNbArgs < 0 Then vReturn = Application.AllForms() Else vReturn = Application.AllForms(vArgs(0))
    Case "AllModules" : If iNbArgs < 0 Then vReturn = Application.AllModules() Else vReturn = Application.AllModules(vArgs(0))
    Case "CloseConnection"
          vReturn = Application.CloseConnection()
    Case "CommandBars" : If iNbArgs < 0 Then vReturn = Application.CommandBars() Else vReturn = Application.CommandBars(vArgs(0))
    Case "CurrentDb" : vReturn = Application.CurrentDb()
    Case "CurrentUser" : vReturn = Application.CurrentUser()
    Case "DAvg"   : vReturn = Application.DAvg(vArgs(0), vArgs(1), vArgs(2))
    Case "DCount"  : vReturn = Application.DCount(vArgs(0), vArgs(1), vArgs(2))
    Case "DLookup"  : vReturn = Application.DLookup(vArgs(0), vArgs(1), vArgs(2), vArgs(3))
    Case "DMax"   : vReturn = Application.DMax(vArgs(0), vArgs(1), vArgs(2))
    Case "DMin"   : vReturn = Application.DMin(vArgs(0), vArgs(1), vArgs(2))
    Case "DStDev"  : vReturn = Application.DStDev(vArgs(0), vArgs(1), vArgs(2))
    Case "DStDevP"  : vReturn = Application.DStDevP(vArgs(0), vArgs(1), vArgs(2))
    Case "DSum"   : vReturn = Application.DSum(vArgs(0), vArgs(1), vArgs(2))
    Case "DVar"   : vReturn = Application.DVar(vArgs(0), vArgs(1), vArgs(2))
    Case "DVarP"  : vReturn = Application.DVarP(vArgs(0), vArgs(1), vArgs(2))
    Case "Forms"  : If iNbArgs < 0 Then vReturn = Application.Forms() Else vReturn = Application.Forms(vArgs(0))
    Case "getObject" : vReturn = Application.getObject(vArgs(0))
    Case "getValue"  : vReturn = Application.getValue(vArgs(0))
    Case "HtmlEncode" : vReturn = Application.HtmlEncode(vArgs(0), vArgs(1))
    Case "OpenDatabase" : vReturn = Application.OpenDatabase(vArgs(0), vArgs(1), vArgs(2), vArgs(3))
    Case "ProductCode" : vReturn = Application.ProductCode()
    Case "setValue"  : vReturn = Application.setValue(vArgs(0), vArgs(1))
    Case "SysCmd"  : vReturn = Application.SysCmd(vArgs(0), vArgs(1), vARgs(2))
    Case "TempVars"  : If iNbArgs < 0 Then vReturn = Application.TempVars() Else vReturn = Application.TempVars(vArgs(0))
    Case "Version"  : vReturn = Application.Version()
    Case Else
     GoTo Error_Proc
   End Select
  Case cstDoCmd
   sModule = "DoCmd"
   Select Case pvScript
    Case "ApplyFilter" : vReturn = DoCmd.ApplyFilter(vArgs(0), vArgs(1), vArgs(2))
    Case "Close"  : vReturn = DoCmd.mClose(vArgs(0), vArgs(1), vArgs(2))
    Case "CopyObject" : vReturn = DoCmd.CopyObject(vArgs(0), vArgs(1), vArgs(2), vArgs(3))
    Case "FindNext"  : vReturn = DoCmd.FindNext()
    Case "FindRecord" : vReturn = DoCmd.FindRecord(vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4), vArgs(5), vArgs(6))
    Case "GetHiddenAttribute"
          vReturn = DoCmd.GetHiddenAttribute(vArgs(0), vArgs(1))
    Case "GoToControl" : vReturn = DoCmd.GoToControl(vArgs(0))
    Case "GoToRecord" : vReturn = DoCmd.GoToRecord(vArgs(0), vArgs(1), vArgs(2), vArgs(3))
    Case "Maximize"  : vReturn = DoCmd.Maximize()
    Case "Minimize"  : vReturn = DoCmd.Minimize()
    Case "MoveSize"  : vReturn = DoCmd.MoveSize(vArgs(0), vArgs(1), vArgs(2), vArgs(3))
    Case "OpenForm"  : vReturn = DoCmd.OpenForm(vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4), vArgs(5), vArgs(6))
    Case "OpenQuery" : vReturn = DoCmd.OpenQuery(vArgs(0), vArgs(1), vArgs(2))
    Case "OpenReport" : vReturn = DoCmd.OpenReport(vArgs(0), vArgs(1))
    Case "OpenSQL"  : vReturn = DoCmd.OpenSQL(vArgs(0), vArgs(1))
    Case "OpenTable" : vReturn = DoCmd.OpenTable(vArgs(0), vArgs(1), vArgs(2))
    Case "OutputTo"  : vReturn = DoCmd.OutputTo(vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4), vArgs(5), vArgs(6), vArgs(7))
    Case "Quit"   : _A2B_.CalledSub = "Quit" :  GoTo Error_Action
    Case "RunApp"  : vReturn = DoCmd.RunApp(vArgs(0))
    Case "RunCommand" : vReturn = DoCmd.RunCommand(vArgs(0))
    Case "RunSQL"  : vReturn = DoCmd.RunSQL(vArgs(0), vArgs(1))
    Case "SelectObject" : vReturn = DoCmd.SelectObject(vArgs(0), vArgs(1), vArgs(2))
    Case "SendObject" : vReturn = DoCmd.SendObject(vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4), vArgs(5), vArgs(6), vArgs(7), vArgs(8), vArgs(9))
    Case "SetHiddenAttribute"
          vReturn = DoCmd.SetHiddenAttribute(vArgs(0), vArgs(1), vArgs(2))
    Case "SetOrderBy" : vReturn = DoCmd.SetOrderBy(vArgs(0), vArgs(1))
    Case "ShowAllRecords"
          vReturn = DoCmd.ShowAllRecords()
    Case Else
     GoTo Error_Proc
   End Select
  Case Else
  ' Locate targeted object
   If pvObject > UBound(_A2B_.PythonCache) Or pvObject < 0 Then GoTo Error_Object
   Set vObject = _A2B_.PythonCache(pvObject)
   If IsNull(vObject) Then
    If pvScript = "Dispose" Then GoTo Exit_Function Else GoTo Error_Object
   End If
  ' Preprocessing
   sScript = pvScript
   sModule = vObject._Type
   Select Case sScript
    Case "Add"
     If vObject._Type = "COLLECTION" And vObject._CollType = COLLTABLEDEFS Then vArgs = Array(_A2B_.PythonCache(vArgs(0)))
    Case "Close"
     sSCript = "mClose"
    Case "Type"
     sScript = "pType"
    Case Else
   End Select
  ' Execute method
   Select Case UBound(vArgs)  ' Dirty but ... CallByName does not support an array of arguments or return values
    Case -1
     If pvCallType = vbUNO Then
      With vObject
       Select Case sScript     ' List all properties that should be called directly (UNO)
        Case "BoundField"  : vReturn = .BoundField
        Case "Column"   : vReturn = .Column
        Case "Connection"  : vReturn = .Connection
        case "ContainerWindow" : vReturn = .ContainerWindow
        Case "ControlModel"  : vReturn = .ControlModel
        Case "ControlView"  : vReturn = .ControlView
        Case "DatabaseForm"  : vReturn = .DatabaseForm
        Case "Document"   : vReturn = .Document
        Case "FormsCollection" : vReturn = .FormsCollection
        Case "LabelControl"  : vReturn = .LabelControl
        Case "MetaData"   : vReturn = .MetaData
        Case "ParentComponent" : vReturn = .ParentComponent
        Case "Query"   : vReturn = .Query
        Case "RowSet"   : vReturn = .RowSet
        Case "Table"   : vReturn = .Table
        Case "UnoDialog"  : vReturn = .UnoDialog
        Case Else
       End Select
      End With
     ElseIf sScript = "ItemData" Then   ' List all properties that should be called directly (arrays not supported by CallByName)
      vReturn = vObject.ItemData
     ElseIf sScript = "LinkChildFields" Then
      vReturn = vObject.LinkChildFields
     ElseIf sScript = "LinkMasterFields" Then
      vReturn = vObject.LinkMasterFields
     ElseIf sScript = "OpenArgs" Then
      vReturn = vObject.OpenArgs
     ElseIf sScript = "Selected" Then
      vReturn = vObject.Selected
     ElseIf sScript = "Value" Then
      vReturn = vObject.Value
     Else
      vReturn = CallByName(vObject, sScript, pvCallType)
     End If
    Case 0
     Select Case sScript
      Case "AppendChunk"  ' Arg is a vector, not supported by CallByName
       vReturn = vObject.GetChunk(vArgs(0), vArgs(1))
      Case "GetRows"   ' Returns an array, not supported by CallByName
       vReturn = vObject.GetRows(vArgs(0), True)  ' Force iso dates
      Case Else
       vReturn = CallByName(vObject, sScript, pvCallType, vArgs(0))
     End Select
    Case 1
     Select Case sScript
      Case "GetChunk"  ' Returns a vector, not supported by CallByName
       vReturn = vObject.GetChunk(vArgs(0), vArgs(1))
      Case Else
       vReturn = CallByName(vObject, sScript, pvCallType, vArgs(0), vArgs(1))
     End Select
    Case 2  : vReturn = CallByName(vObject, sScript, pvCallType, vArgs(0), vArgs(1), vArgs(2))
    Case 3  : vReturn = CallByName(vObject, sScript, pvCallType, vArgs(0), vArgs(1), vArgs(2), vArgs(3))
    Case 4  : vReturn = CallByName(vObject, sScript, pvCallType, vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4))
    Case 5  : vReturn = CallByName(vObject, sScript, pvCallType, vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4), vArgs(5))
    Case 6  : vReturn = CallByName(vObject, sScript, pvCallType, vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4), vArgs(5), vArgs(6))
    Case 7  : vReturn = CallByName(vObject, sScript, pvCallType, vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4), vArgs(5), vArgs(6), vArgs(7))
   End Select
  ' Postprocessing
   Select Case pvScript
    Case "Close", "Dispose", "Terminate"
     Set _A2B_.PythonCache(pvObject) = Nothing
    Case "Move", "MoveFirst", "MoveLast", "MoveNext", "MovePrevious" ' Pass the new BOF, EOF values (binary format)
     If vObject._Type = "RECORDSET" Then
      vReturn = (Iif(vObject.BOF, 1, 0) * 2 + Iif(vObject.EOF, 1, 0)) * Iif(vReturn, 1, -1)
     End If
    Case "Find"    ' Store in array the arguments passed by reference
     If vObject._Type = "MODULE" And vReturn = True Then
      vReturn = Array(vReturn, vArgs(1), vArgs(2), vArgs(3), vArgs(4))
     End If
    Case "ProcOfLine"  ' Store in array the arguments passed by reference
     vReturn = Array(vReturn, vArgs(1))
    Case Else
   End Select
 End Select

 ' Structure the returned array
 If pvCallType = vbUNO Then
  vArray = vReturn
 Else
  If IsNull(vReturn) Then
   vArray = Array(cstNull, Null, Null)
  ElseIf IsObject(vReturn) Then
   Select Case vReturn._Type
    Case "COLLECTION", "COMMANDBARCONTROL", "EVENT"
     vArray = Array(cstObject, _A2B_.AddPython(vReturn), vReturn._Type)
    Case Else
     vArray = Array(cstObject, _A2B_.AddPython(vReturn), vReturn._Type, vReturn.Name)
   End Select
  Else
   If VarType(vReturn) = vbDate Then
    vArray = Array(cstScalar, _CStr(vReturn), Null)
   ElseIf VarType(vReturn) = vbBigint Then  ' Could happen for big integer database fields
    vArray = Array(cstScalar, CLng(vReturn), Null)
   Else
    vArray = Array(cstScalar, vReturn, Null)
   End If
  End If
 End If

 PythonWrapper = vArray

Exit_Function:
 Exit Function
Error_Function:
 TraceError(TRACEABORT, Err, "PythonWrapper", Erl)
 GoTo Exit_Function
Error_Object:
 TraceError(TRACEFATAL, ERROBJECTNOTFOUND, "Python Wrapper (" & pvScript & ")", 0, , Array(_GetLabel("OBJECT"), "#" & pvObject))
 GoTo Exit_Function
Error_Action:
 TraceError(TRACEFATAL, ERRACTION, Utils._CalledSub(), 0)
 GoTo Exit_Function
Error_Proc:
 TraceError(TRACEFATAL, ERRPROCEDURENOTFOUND, "Python Wrapper", 0, , Array(pvScript, sModule))
 GoTo Exit_Function
End Function ' PythonWrapper V6.4

REM -----------------------------------------------------------------------------------------------------------------------
REM --- PYTHON HELPER FUNCTIONS                             ---
REM -----------------------------------------------------------------------------------------------------------------------

REM -----------------------------------------------------------------------------------------------------------------------
Public Function PyConvertFromUrl(ByVal pvFile As Variant) As String
' Convenient function to have common conversions of filenames from/to url notations both in Python and Basic

 On Local Error GoTo Exit_Function
 PyConvertFromUrl = ""
 If Not Utils._CheckArgument(pvFile, 1, vbString) Then Goto Exit_Function

 PyConvertFromUrl = ConvertFromUrl(pvFile)

Exit_Function:
 Exit Function
End Function ' PyConvertFromUrl V6.4

REM -----------------------------------------------------------------------------------------------------------------------
Public Function PyConvertToUrl(ByVal pvFile As Variant) As String
' Convenient function to have common conversions of filenames from/to url notations both in Python and Basic

 On Local Error GoTo Exit_Function
 PyConvertToUrl = ""
 If Not Utils._CheckArgument(pvFile, 1, vbString) Then Goto Exit_Function

 PyConvertToUrl = ConvertToUrl(pvFile)

Exit_Function:
 Exit Function
End Function ' PyConvertToUrl V6.4

REM -----------------------------------------------------------------------------------------------------------------------
Public Function PyCreateUnoService(ByVal pvService As Variant) As Variant
' Convenient function to create a UNO service in Python

 On Local Error GoTo Exit_Function
 Set PyCreateUnoService = Nothing
 If Not Utils._CheckArgument(pvService, 1, vbString) Then Goto Exit_Function

 Set PyCreateUnoService = CreateUnoService(pvService)

Exit_Function:
 Exit Function
End Function ' PyCreateUnoService V6.4

REM -----------------------------------------------------------------------------------------------------------------------
Public Function PyDateAdd(ByVal pvAdd As Variant _
       , ByVal pvCount As Variant _
       , ByVal pvDate As Variant _
      ) As Variant
' Convenient shortcut to useful and easy-to-use Basic date functions

Dim vDate As Variant, vNewDate As Variant
 On Local Error GoTo Exit_Function
 PyDateAdd = Null

 If Not Utils._CheckArgument(pvAdd, 1, vbString) Then Goto Exit_Function
 If Not Utils._CheckArgument(pvCount, 2, Utils._AddNumeric()) Then Goto Exit_Function
 If Not Utils._CheckArgument(pvDate, 3, vbString) Then Goto Exit_Function

 vDate = _CDate(pvDate)
 vNewDate = DateAdd(pvAdd, pvCount, vDate)
 If VarType(vNewDate) = vbDate Then PyDateAdd = _CStr(vNewDate) Else PyDateAdd = vNewDate

Exit_Function:
 Exit Function
End Function ' PyDateAdd V6.4

REM -----------------------------------------------------------------------------------------------------------------------
Public Function PyDateDiff(ByVal pvAdd As Variant _
       , ByVal pvDate1 As Variant _
       , ByVal pvDate2 As Variant _
       , ByVal pvWeekStart As Variant _
       , ByVal pvYearStart As Variant _
      ) As Variant
' Convenient shortcut to useful and easy-to-use Basic date functions

Dim vDate1 As Variant, vDate2 As Variant
 On Local Error GoTo Exit_Function
 PyDateDiff = Null

 If Not Utils._CheckArgument(pvAdd, 1, vbString) Then Goto Exit_Function
 If Not Utils._CheckArgument(pvDate1, 2, vbString) Then Goto Exit_Function
 If Not Utils._CheckArgument(pvDate2, 3, vbString) Then Goto Exit_Function
 If Not Utils._CheckArgument(pvWeekStart, 4, Utils._AddNumeric()) Then Goto Exit_Function
 If Not Utils._CheckArgument(pvWeekStart, 5, Utils._AddNumeric()) Then Goto Exit_Function

 vDate1 = _CDate(pvDate1)
 vDate2 = _CDate(pvDate2)
 PyDateDiff = DateDiff(pvAdd, vDate1, vDate2, pvWeekStart, pvYearStart)

Exit_Function:
 Exit Function
End Function ' PyDateDiff V6.4

REM -----------------------------------------------------------------------------------------------------------------------
Public Function PyDatePart(ByVal pvAdd As Variant _
       , ByVal pvDate As Variant _
       , ByVal pvWeekStart As Variant _
       , ByVal pvYearStart As Variant _
      ) As Variant
' Convenient shortcut to useful and easy-to-use Basic date functions

Dim vDate As Variant
 On Local Error GoTo Exit_Function
 PyDatePart = Null

 If Not Utils._CheckArgument(pvAdd, 1, vbString) Then Goto Exit_Function
 If Not Utils._CheckArgument(pvDate, 2, vbString) Then Goto Exit_Function
 If Not Utils._CheckArgument(pvWeekStart, 3, Utils._AddNumeric()) Then Goto Exit_Function
 If Not Utils._CheckArgument(pvWeekStart, 4, Utils._AddNumeric()) Then Goto Exit_Function

 vDate = _CDate(pvDate)
 PyDatePart = DatePart(pvAdd, vDate, pvWeekStart, pvYearStart)

Exit_Function:
 Exit Function
End Function ' PyDatePart V6.4

REM -----------------------------------------------------------------------------------------------------------------------
Public Function PyDateValue(ByVal pvDate As Variant) As Variant
' Convenient shortcut to useful and easy-to-use Basic date functions

Dim vDate As Variant
 On Local Error GoTo Exit_Function
 PyDateValue = Null
 If Not Utils._CheckArgument(pvDate, 1, vbString) Then Goto Exit_Function

 vDate = DateValue(pvDate)
 If VarType(vDate) = vbDate Then PyDateValue = _CStr(vDate) Else PyDateValue = vDate

Exit_Function:
 Exit Function
End Function ' PyDateValue V6.4

REM -----------------------------------------------------------------------------------------------------------------------
Public Function PyFormat(ByVal pvValue As Variant, pvFormat As Variant) As String
' Convenient function to format numbers or dates

 On Local Error GoTo Exit_Function
 PyFormat = ""
 If Not Utils._CheckArgument(pvValue, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function
 pvValue = _CDate(pvValue)
 If IsEmpty(pvFormat) Then
  PyFormat = Str(pvValue)
 Else
  If Not Utils._CheckArgument(pvFormat, 2, vbString) Then Goto Exit_Function
  PyFormat = Format(pvValue, pvFormat)
 End If

Exit_Function:
 Exit Function
End Function ' PyFormat V6.4

REM -----------------------------------------------------------------------------------------------------------------------
Public Function PyGetGUIType() As Variant

 PyGetGUIType = GetGUIType()

End Function ' PyGetGUIType V6.4

REM -----------------------------------------------------------------------------------------------------------------------
Public Function PyGetSystemTicks() As Variant

 PyGetSystemTicks = GetSystemTicks()

End Function ' PyGetSystemTicks V6.4

REM -----------------------------------------------------------------------------------------------------------------------
Public Function PyGlobalScope(ByVal pvLib As Variant) As Variant

 Select Case pvLib
  Case "Basic"
   PyGlobalScope = GlobalScope.BasicLibraries()
  Case "Dialog"
   PyGlobalScope = GlobalScope.DialogLibraries()
  Case Else
 End Select

End Function ' PyGlobalScope V6.4

REM -----------------------------------------------------------------------------------------------------------------------
Public Function PyInputBox(ByVal pvText As Variant _
         , ByVal pvTitle As Variant _
         , ByVal pvDefault As Variant _
         , ByVal pvXPos As Variant _
         , ByVal pvYPos As Variant _
         ) As Variant
' Convenient function to open input box from Python

 On Local Error GoTo Exit_Function
 PyInputBox = Null

 If Not Utils._CheckArgument(pvText, 1, vbString) Then Goto Exit_Function
 If IsEmpty(pvTitle) Then pvTitle = ""
 If Not Utils._CheckArgument(pvTitle, 2, vbString) Then Goto Exit_Function
 If IsEmpty(pvDefault) Then pvDefault = ""
 If Not Utils._CheckArgument(pvDefault, 3, vbString) Then Goto Exit_Function

 If IsEmpty(pvXPos) Or IsEmpty(pvYPos) Then
  PyInputBox = InputBox(pvText, pvTitle, pvDefault)
 Else
  If Not Utils._CheckArgument(pvXPos, 4, Utils._AddNumeric()) Then Goto Exit_Function
  If Not Utils._CheckArgument(pvYPos, 5, Utils._AddNumeric()) Then Goto Exit_Function
  PyInputBox = InputBox(pvText, pvTitle, pvDefault, pvXPos, pvYPos)
 End If

Exit_Function:
 Exit Function
End Function ' PyInputBox V6.4.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function PyMsgBox(ByVal pvText As Variant _
         , ByVal pvType As Variant _
         , ByVal pvDialogTitle As Variant _
         ) As Variant
' Convenient function to open message box from Python

 On Local Error GoTo Exit_Function
 PyMsgBox = Null

 If Not Utils._CheckArgument(pvText, 1, vbString) Then Goto Exit_Function
 If IsEmpty(pvType) Then pvType = 0
 If Not Utils._CheckArgument(pvType, 2, Utils._AddNumeric()) Then Goto Exit_Function
 If IsEmpty(pvDialogTitle) Then
  PyMsgBox = MsgBox(pvText, pvType)
 Else
  If Not Utils._CheckArgument(pvDialogTitle, 3, vbString) Then Goto Exit_Function
  PyMsgBox = MsgBox(pvText, pvType, pvDialogTitle)
 End If

Exit_Function:
 Exit Function
End Function ' PyMsgBox V6.4.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function PyTimer() As Long
' Convenient function to call Timer from Python

 PyTimer = Timer

End Function ' PyTimer V6.4

REM -----------------------------------------------------------------------------------------------------------------------
REM --- PRIVATE FUNCTIONS                               ---
REM -----------------------------------------------------------------------------------------------------------------------

REM -----------------------------------------------------------------------------------------------------------------------
Private Function _CDate(ByVal pvValue As Variant) As Variant
' Return a Date type if iso date, otherwise return input

Dim vValue As Variant
 vValue = pvValue
 If VarType(pvValue) = vbString Then
  If pvValue <> "" And IsDate(pvValue) Then vValue = CDate(pvValue)  ' IsDate("") gives True !?
 End If
 _CDate = vValue

End Function

</script:module>