Current File : //usr/lib/libreoffice/share/basic/SFDatabases/SF_Register.xba
<?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="SF_Register" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. ===
REM === The SFDatabases library is one of the associated libraries. ===
REM === Full documentation is available on https://help.libreoffice.org/ ===
REM =======================================================================================================================
Option Compatible
Option Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' SF_Register
''' ===========
''' The ScriptForge framework includes
''' the master ScriptForge library
''' a number of "associated" libraries SF*
''' any user/contributor extension wanting to fit into the framework
'''
''' The main methods in this module allow the current library to cling to ScriptForge
''' - RegisterScriptServices
''' Register the list of services implemented by the current library
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
REM ================================================================== EXCEPTIONS
Private Const BASEDOCUMENTOPENERROR = "BASEDOCUMENTOPENERROR"
Private Const DBCONNECTERROR = "DBCONNECTERROR"
REM ============================================================== PUBLIC METHODS
REM -----------------------------------------------------------------------------
Public Sub RegisterScriptServices() As Variant
''' Register into ScriptForge the list of the services implemented by the current library
''' Each library pertaining to the framework must implement its own version of this method
'''
''' It consists in successive calls to the RegisterService() and RegisterEventManager() methods
''' with 2 arguments:
''' ServiceName: the name of the service as a case-insensitive string
''' ServiceReference: the reference as an object
''' If the reference refers to a module, then return the module as an object:
''' GlobalScope.Library.Module
''' If the reference is a class instance, then return a string referring to the method
''' containing the New statement creating the instance
''' "libraryname.modulename.function"
With GlobalScope.ScriptForge.SF_Services
.RegisterService("Database", "SFDatabases.SF_Register._NewDatabase") ' Reference to the function initializing the service
.RegisterService("DatabaseFromDocument", "SFDatabases.SF_Register._NewDatabaseFromSource")
.RegisterService("Datasheet", "SFDatabases.SF_Register._NewDatasheet")
End With
End Sub ' SFDatabases.SF_Register.RegisterScriptServices
REM =========================================================== PRIVATE FUNCTIONS
REM -----------------------------------------------------------------------------
Public Function _NewDatabase(Optional ByVal pvArgs As Variant) As Object
''' Create a new instance of the SF_Database class
''' Args:
''' FileName : the name of the file (compliant with the SF_FileSystem.FileNaming notation)
''' RegistrationName: mutually exclusive with FileName. Used when database is registered
''' ReadOnly : (boolean). Default = True
''' User : connection parameters
''' Password
''' Returns:
''' The instance or Nothing
''' Exceptions:
''' BASEDOCUMENTOPENERROR The database file could not be opened
''' DBCONNECTERROR The database could not be connected, credentials are probably wrong
Dim oDatabase As Object ' Return value
Dim vFileName As Variant ' alias of pvArgs(0)
Dim vRegistration As Variant ' Alias of pvArgs(1)
Dim vReadOnly As Variant ' Alias of pvArgs(2)
Dim vUser As Variant ' Alias of pvArgs(3)
Dim vPassword As Variant ' Alias of pvArgs(4)
Dim oDBContext As Object ' com.sun.star.sdb.DatabaseContext
Const cstService = "SFDatabases.Database"
Const cstGlobal = "GlobalScope"
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
Check:
If IsMissing(pvArgs) Or IsEmpty(pvArgs) Then pvArgs = Array()
If UBound(pvArgs) >= 0 Then vFileName = pvArgs(0) Else vFileName = ""
If IsEmpty(vFileName) Then vFileName = ""
If UBound(pvArgs) >= 1 Then vRegistration = pvArgs(1) Else vRegistration = ""
If IsEmpty(vRegistration) Then vRegistration = ""
If UBound(pvArgs) >= 2 Then vReadOnly = pvArgs(2) Else vReadOnly = True
If IsEmpty(vReadOnly) Then vReadOnly = True
If UBound(pvArgs) >= 3 Then vUser = pvArgs(3) Else vUser = ""
If IsEmpty(vUser) Then vUser = ""
If UBound(pvArgs) >= 4 Then vPassword = pvArgs(4) Else vPassword = ""
If IsEmpty(vPassword) Then vPassword = ""
If Not ScriptForge.SF_Utils._Validate(vFileName, "FileName", V_STRING) Then GoTo Finally
If Not ScriptForge.SF_Utils._Validate(vRegistration, "RegistrationName", V_STRING) Then GoTo Finally
If Not ScriptForge.SF_Utils._Validate(vReadOnly, "ReadOnly", ScriptForge.V_BOOLEAN) Then GoTo Finally
If Not ScriptForge.SF_Utils._Validate(vUser, "User", V_STRING) Then GoTo Finally
If Not ScriptForge.SF_Utils._Validate(vPassword, "Password", V_STRING) Then GoTo Finally
Set oDatabase = Nothing
' Check the existence of FileName
With ScriptForge
Set oDBContext = .SF_Utils._GetUNOService("DatabaseContext")
If Len(vFileName) = 0 Then ' FileName has precedence over RegistrationName
If Len(vRegistration) = 0 Then GoTo CatchError
If Not oDBContext.hasRegisteredDatabase(vRegistration) Then GoTo CatchError
vFileName = .SF_FileSystem._ConvertFromUrl(oDBContext.getDatabaseLocation(vRegistration))
End If
If Not .SF_FileSystem.FileExists(vFileName) Then GoTo CatchError
End With
Try:
' Create the database Basic object and initialize attributes
Set oDatabase = New SF_Database
With oDatabase
Set .[Me] = oDatabase
._Location = ConvertToUrl(vFileName)
Set ._DataSource = oDBContext.getByName(._Location)
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo CatchConnect
Set ._Connection = ._DataSource.getConnection(vUser, vPassword)
If IsNull(._Connection) Then GoTo CatchConnect
._User = vUser
._Password = vPassword
._ReadOnly = vReadOnly
Set ._MetaData = ._Connection.MetaData
._URL = ._MetaData.URL
End With
Finally:
Set _NewDatabase = oDatabase
Exit Function
Catch:
GoTo Finally
CatchError:
ScriptForge.SF_Exception.RaiseFatal(BASEDOCUMENTOPENERROR, "FileName", vFileName, "RegistrationName", vRegistration)
GoTo Finally
CatchConnect:
ScriptForge.SF_Exception.RaiseFatal(DBCONNECTERROR, "User", vUser, "Password", vPassword, vFileName)
GoTo Finally
End Function ' SFDatabases.SF_Register._NewDatabase
REM -----------------------------------------------------------------------------
Public Function _NewDatabaseFromSource(Optional ByVal pvArgs As Variant) As Object
' ByRef oDataSource As Object _
' , ByVal sUser As String _
' , ByVal sPassword As String _
' ) As Object
''' Create a new instance of the SF_Database class from the given datasource
''' established in the SFDocuments.Base service
''' THIS SERVICE MUST NOT BE CALLED FROM A USER SCRIPT
''' Args:
''' oDataSource: com.sun.star.sdbc.XDataSource
''' sUser, sPassword : connection parameters
''' Returns:
''' The instance or Nothing
''' Exceptions:
''' managed in the calling routines when Nothing is returned
Dim oDatabase As Object ' Return value
Dim oConnection As Object ' com.sun.star.sdbc.XConnection
Dim oDataSource As Object ' Alias of pvArgs(0)
Dim sUser As String ' Alias of pvArgs(1)
Dim sPassword As String ' Alias of pvArgs(2)
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
Set oDatabase = Nothing
Try:
' Get arguments
Set oDataSource = pvArgs(0)
sUser = pvArgs(1)
sPassword = pvArgs(2)
' Setup the connection
If oDataSource.IsPasswordRequired Then
Set oConnection = oDataSource.getConnection(sUser, sPassword)
Else
Set oConnection = oDataSource.getConnection("", "")
End If
' Create the database Basic object and initialize attributes
If Not IsNull(oConnection) Then
Set oDatabase = New SF_Database
With oDatabase
Set .[Me] = oDatabase
._Location = ""
Set ._DataSource = oDataSource
Set ._Connection = oConnection
._ReadOnly = oConnection.isReadOnly()
Set ._MetaData = oConnection.MetaData
._URL = ._MetaData.URL
End With
End If
Finally:
Set _NewDatabaseFromSource = oDatabase
Exit Function
Catch:
ScriptForge.SF_Exception.Clear()
GoTo Finally
End Function ' SFDatabases.SF_Register._NewDatabaseFromSource
REM -----------------------------------------------------------------------------
Public Function _NewDatasheet(Optional ByVal pvArgs As Variant) As Object
' Optional ByRef poComponent As Object _
' , Optional ByRef poParent As Object _
' ) As Object
''' Create a new instance of the SF_Datasheet class
''' Called from
''' base.Datasheets()
''' base.OpenTable()
''' base.OpenQuery()
''' database.OpenTable()
''' database.OpenQuery()
''' database.OpenSql()
''' Args:
''' Component: the component of the new datasheet
''' com.sun.star.lang.XComponent - org.openoffice.comp.dbu.ODatasourceBrowser
''' Parent: the parent SF_Database or SF_Base instance having produced the new datasheet
''' When absent, the SF_Database instance will be derived from the component
''' Returns:
''' The instance or Nothing
Dim oDatasheet As Object ' Return value
Dim oParent As Object ' The parent SF_Database or SF_Base instance having produced the new datasheet
Dim oComponent As Object ' The component of the new datasheet
Dim oWindow As Object ' ui.Window user-defined type
Dim oUi As Object : Set oUi = ScriptForge.SF_Services.CreateScriptService("ScriptForge.UI")
Const TABLEDATA = "TableData"
Const QUERYDATA = "QueryData"
Const SQLDATA = "SqlData"
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
Set oDatasheet = Nothing
Check:
' Get, check and assign arguments
If Not IsArray(pvArgs) Then GoTo Catch
If UBound(pvArgs) >= 0 Then
Set oComponent = pvArgs(0)
End If
If UBound(pvArgs) = 0 Then
Set oParent = Nothing
ElseIf UBound(pvArgs) = 1 Then
Set oParent = pvArgs(1)
Else
GoTo Catch
End If
' Check the validity of the proposed window: is it really a datasheet ? Otherwise, do nothing
If IsNull(oComponent) Then GoTo Catch
Set oWindow = oUi._IdentifyWindow(oComponent)
With oWindow
If .DocumentType <> TABLEDATA And .DocumentType <> QUERYDATA And .DocumentType <> SQLDATA Then GoTo Catch
End With
If IsEmpty(oComponent.Selection) Then GoTo Catch
Try:
Set oDatasheet = New SF_Datasheet
With oDatasheet
Set .[Me] = oDatasheet
Set .[_Parent] = oParent
Set ._Component = oComponent
' Achieve the initialization
._Initialize()
End With
Finally:
Set _NewDatasheet = oDatasheet
Exit Function
Catch:
Set oDatasheet = Nothing
GoTo Finally
End Function ' SFDatabases.SF_Register._NewDatasheet
REM ============================================== END OF SFDATABASES.SF_REGISTER
</script:module>
Mini Shell