mirror of
https://gitee.com/kekingcn/file-online-preview.git
synced 2026-03-22 09:03:50 +08:00
移除office-plugin, 使用新版jodconverter
This commit is contained in:
陈精华
311
server/windows-office/share/basic/Access2Base/Root_.xba
Normal file
311
server/windows-office/share/basic/Access2Base/Root_.xba
Normal file
@@ -0,0 +1,311 @@
|
||||
<?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="Root_" 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 ClassModule
|
||||
|
||||
Option Explicit
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- FOR INTERNAL USE ONLY ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS ROOT FIELDS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Private ErrorHandler As Boolean
|
||||
Private MinimalTraceLevel As Integer
|
||||
Private TraceLogs() As Variant
|
||||
Private TraceLogCount As Integer
|
||||
Private TraceLogLast As Integer
|
||||
Private TraceLogMaxEntries As Integer
|
||||
Private LastErrorCode As Integer
|
||||
Private LastErrorLevel As String
|
||||
Private ErrorText As String
|
||||
Private ErrorLongText As String
|
||||
Private CalledSub As String
|
||||
Private DebugPrintShort As Boolean
|
||||
Private Introspection As Object ' com.sun.star.beans.Introspection
|
||||
Private VersionNumber As String ' Actual Access2Base version number
|
||||
Private Locale As String
|
||||
Private ExcludeA2B As Boolean
|
||||
Private TextSearch As Object
|
||||
Private SearchOptions As Variant
|
||||
Private FindRecord As Object
|
||||
Private StatusBar As Object
|
||||
Private Dialogs As Object ' Collection
|
||||
Private TempVars As Object ' Collection
|
||||
Private CurrentDoc() As Variant ' Array of document containers - [0] = Base document, [1 ... N] = other documents
|
||||
Private PythonCache() As Variant ' Array of objects created in Python scripts
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CONSTRUCTORS / DESTRUCTORS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Sub Class_Initialize()
|
||||
VersionNumber = Access2Base_Version
|
||||
ErrorHandler = True
|
||||
MinimalTraceLevel = 0
|
||||
TraceLogs() = Array()
|
||||
TraceLogCount = 0
|
||||
TraceLogLast = 0
|
||||
TraceLogMaxEntries = 0
|
||||
LastErrorCode = 0
|
||||
LastErrorLevel = ""
|
||||
ErrorText = ""
|
||||
ErrorLongText = ""
|
||||
CalledSub = ""
|
||||
DebugPrintShort = True
|
||||
Locale = L10N._GetLocale()
|
||||
ExcludeA2B = True
|
||||
Set Introspection = CreateUnoService("com.sun.star.beans.Introspection")
|
||||
Set TextSearch = CreateUnoService("com.sun.star.util.TextSearch")
|
||||
SearchOptions = New com.sun.star.util.SearchOptions
|
||||
With SearchOptions
|
||||
.algorithmType = com.sun.star.util.SearchAlgorithms.REGEXP
|
||||
.searchFlag = 0
|
||||
.transliterateFlags = com.sun.star.i18n.TransliterationModules.IGNORE_CASE
|
||||
End With
|
||||
Set FindRecord = Nothing
|
||||
Set StatusBar = Nothing
|
||||
Set Dialogs = New Collection
|
||||
Set TempVars = New Collection
|
||||
CurrentDoc = Array()
|
||||
ReDim CurrentDoc(0 To 0)
|
||||
Set CurrentDoc(0) = Nothing
|
||||
PythonCache = Array()
|
||||
End Sub ' Constructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Sub Class_Terminate()
|
||||
Call Class_Initialize()
|
||||
End Sub ' Destructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Sub Dispose()
|
||||
Call Class_Terminate()
|
||||
End Sub ' Explicit destructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS GET/LET/SET PROPERTIES ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS METHODS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function AddPython(ByRef pvObject As Variant) As Long
|
||||
' Store the object as a new entry in PythonCache and return its entry number
|
||||
|
||||
Dim lVars As Long, vObject As Variant
|
||||
|
||||
lVars = UBound(PythonCache) + 1
|
||||
ReDim Preserve PythonCache(0 To lVars)
|
||||
PythonCache(lVars) = pvObject
|
||||
|
||||
AddPython = lVars
|
||||
|
||||
End Function ' AddPython V6.4
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Sub CloseConnection()
|
||||
' Close all connections established by current document to free memory.
|
||||
' - if Base document => close the one concerned database connection
|
||||
' - if non-Base documents => close the connections of each individual standalone form
|
||||
|
||||
Dim i As Integer, iCurrentDoc As Integer
|
||||
Dim vDbContainer As Variant, vDbContainers() As Variant, vDocContainer As Variant
|
||||
|
||||
If ErrorHandler Then On Local Error Goto Error_Sub
|
||||
|
||||
If Not IsArray(CurrentDoc) Then Goto Exit_Sub
|
||||
If UBound(CurrentDoc) < 0 Then Goto Exit_Sub
|
||||
iCurrentDoc = CurrentDocIndex( , False) ' False prevents error raising if not found
|
||||
If iCurrentDoc < 0 Then GoTo Exit_Sub ' If not found ignore
|
||||
|
||||
vDocContainer = CurrentDocument(iCurrentDoc)
|
||||
With vDocContainer
|
||||
If Not .Active Then GoTo Exit_Sub ' e.g. if multiple calls to CloseConnection()
|
||||
For i = 0 To UBound(.DbContainers)
|
||||
If Not IsNull(.DbContainers(i).Database) Then
|
||||
.DbContainers(i).Database.Dispose()
|
||||
Set .DbContainers(i).Database = Nothing
|
||||
End If
|
||||
TraceLog(TRACEANY, UCase(CalledSub) & " " & .URL & Iif(i = 0, "", " Form=" & .DbContainers(i).FormName), False)
|
||||
Set .DbContainers(i) = Nothing
|
||||
Next i
|
||||
.DbContainers = Array()
|
||||
.URL = ""
|
||||
.DbConnect = 0
|
||||
.Active = False
|
||||
Set .Document = Nothing
|
||||
End With
|
||||
CurrentDoc(iCurrentDoc) = vDocContainer
|
||||
|
||||
Exit_Sub:
|
||||
Exit Sub
|
||||
Error_Sub:
|
||||
TraceError(TRACEABORT, Err, CalledSub, Erl, False) ' No error message addressed to the user, only stored in console
|
||||
GoTo Exit_Sub
|
||||
End Sub ' CloseConnection
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function CurrentDb() As Object
|
||||
' Returns _A2B_.CurrentDocument().Database as an object to allow access to its properties
|
||||
|
||||
Dim iCurrentDoc As Integer
|
||||
|
||||
Set CurrentDb = Nothing
|
||||
|
||||
If Not IsArray(CurrentDoc) Then Goto Exit_Function
|
||||
If UBound(CurrentDoc) < 0 Then Goto Exit_Function
|
||||
iCurrentDoc = CurrentDocIndex(, False) ' False = no abort
|
||||
If iCurrentDoc >= 0 Then
|
||||
If UBound(CurrentDoc(iCurrentDoc).DbContainers) >= 0 Then Set CurrentDb = CurrentDoc(iCurrentDoc).DbContainers(0).Database
|
||||
End If
|
||||
|
||||
Exit_Function:
|
||||
Exit Function
|
||||
End Function ' CurrentDb
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function CurrentDocIndex(Optional pvURL As Variant, Optional pbAbort As Variant) As Integer
|
||||
' Returns the entry in CurrentDoc(...) referring to the current document
|
||||
|
||||
Dim i As Integer, bFound As Boolean, sURL As String
|
||||
Const cstBase = "com.sun.star.comp.dba.ODatabaseDocument"
|
||||
|
||||
bFound = False
|
||||
CurrentDocIndex = -1
|
||||
|
||||
If Not IsArray(CurrentDoc) Then Goto Trace_Error
|
||||
If UBound(CurrentDoc) < 0 Then Goto Trace_Error
|
||||
For i = 1 To UBound(CurrentDoc) ' [0] reserved to database .odb document
|
||||
If IsMissing(pvURL) Then ' Not on 1 single line ?!?
|
||||
If Utils._hasUNOProperty(ThisComponent, "URL") Then
|
||||
sURL = ThisComponent.URL
|
||||
Else
|
||||
Exit For ' f.i. ThisComponent = Basic IDE ...
|
||||
End If
|
||||
Else
|
||||
sURL = pvURL ' To support the SelectObject action
|
||||
End If
|
||||
If CurrentDoc(i).Active And CurrentDoc(i).URL = sURL Then
|
||||
CurrentDocIndex = i
|
||||
bFound = True
|
||||
Exit For
|
||||
End If
|
||||
Next i
|
||||
|
||||
If Not bFound Then
|
||||
If IsNull(CurrentDoc(0)) Then GoTo Trace_Error
|
||||
With CurrentDoc(0)
|
||||
If Not .Active Then GoTo Trace_Error
|
||||
If IsNull(.Document) Then GoTo Trace_Error
|
||||
End With
|
||||
CurrentDocIndex = 0
|
||||
End If
|
||||
|
||||
Exit_Function:
|
||||
Exit Function
|
||||
Trace_Error:
|
||||
If IsMissing(pbAbort) Then pbAbort = True
|
||||
If pbAbort Then TraceError(TRACEABORT, ERRDBNOTCONNECTED, Utils._CalledSub(), 0, 1) Else CurrentDocIndex = -1
|
||||
Goto Exit_Function
|
||||
End Function ' CurrentDocIndex
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function CurrentDocument(ByVal Optional piDocIndex As Integer) As Variant
|
||||
' Returns the CurrentDoc(...) referring to the current document or to the argument
|
||||
|
||||
Dim iDocIndex As Integer
|
||||
If IsMissing(piDocIndex) Then iDocIndex = CurrentDocIndex(, False) Else iDocIndex = piDocIndex
|
||||
If iDocIndex >= 0 And iDocIndex <= UBound(CurrentDoc) Then Set CurrentDocument = CurrentDoc(iDocIndex) Else Set CurrentDocument = Nothing
|
||||
|
||||
End Function
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Sub Dump()
|
||||
' For debugging purposes
|
||||
Dim i As Integer, j As Integer, vCurrentDoc As Variant
|
||||
On Local Error Resume Next
|
||||
|
||||
DebugPrint "Version", VersionNumber
|
||||
DebugPrint "TraceLevel", MinimalTraceLevel
|
||||
DebugPrint "TraceCount", TraceLogCount
|
||||
DebugPrint "CalledSub", CalledSub
|
||||
If IsArray(CurrentDoc) Then
|
||||
For i = 0 To UBound(CurrentDoc)
|
||||
vCurrentDoc = CurrentDoc(i)
|
||||
If Not IsNull(vCurrentDoc) Then
|
||||
DebugPrint i, "URL", vCurrentDoc.URL
|
||||
For j = 0 To UBound(vCurrentDoc.DbContainers)
|
||||
DebugPrint i, j, "Form", vCurrentDoc.DbContainers(j).FormName
|
||||
DebugPrint i, j, "Database", vCurrentDoc.DbContainers(j).Database.Title
|
||||
Next j
|
||||
End If
|
||||
Next i
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function hasItem(psCollType As String, ByVal psName As String) As Boolean
|
||||
' Return True if psName if in the collection
|
||||
|
||||
Dim oItem As Object
|
||||
On Local Error Goto Error_Function ' Whatever ErrorHandler !
|
||||
|
||||
hasItem = True
|
||||
Select Case psCollType
|
||||
Case COLLALLDIALOGS
|
||||
Set oItem = Dialogs.Item(UCase(psName))
|
||||
Case COLLTEMPVARS
|
||||
Set oItem = TempVars.Item(UCase(psName))
|
||||
Case Else
|
||||
hasItem = False
|
||||
End Select
|
||||
|
||||
Exit_Function:
|
||||
Exit Function
|
||||
Error_Function: ' Item by key aborted
|
||||
hasItem = False
|
||||
GoTo Exit_Function
|
||||
End Function ' hasItem
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- PRIVATE FUNCTIONS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function _CurrentDb(ByVal Optional piDocEntry As Integer, ByVal Optional piDbEntry As Integer) As Variant
|
||||
REM Without arguments same as CurrentDb() except that it generates an error if database not connected (internal use)
|
||||
REM With 2 arguments return the corresponding entry in Root
|
||||
|
||||
Dim odbDatabase As Variant
|
||||
If IsMissing(piDocEntry) Then
|
||||
Set odbDatabase = CurrentDb()
|
||||
Else
|
||||
If Not IsArray(CurrentDoc) Then Goto Trace_Error
|
||||
If piDocEntry < 0 Or piDbEntry < 0 Then Goto Trace_Error
|
||||
If piDocEntry > UBound(CurrentDoc) Then Goto Trace_Error
|
||||
If piDbEntry > UBound(CurrentDoc(piDocEntry).DbContainers) Then Goto Trace_Error
|
||||
Set odbDatabase = CurrentDoc(piDocEntry).DbContainers(piDbEntry).Database
|
||||
End If
|
||||
If IsNull(odbDatabase) Then GoTo Trace_Error
|
||||
|
||||
Exit_Function:
|
||||
Set _CurrentDb = odbDatabase
|
||||
Exit Function
|
||||
Trace_Error:
|
||||
TraceError(TRACEABORT, ERRDBNOTCONNECTED, Utils._CalledSub(), 0, 1)
|
||||
Goto Exit_Function
|
||||
End Function ' _CurrentDb
|
||||
|
||||
</script:module>
|
||||
Reference in New Issue
Block a user