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