| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270 |
- <?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"
- 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 or connected
- 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)
- Set ._Connection = ._DataSource.getConnection(vUser, 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
- End Function ' SFDatabases.SF_Register._NewDatabase
- REM -----------------------------------------------------------------------------
- Public Function _NewDatabaseFromSource(Optional ByVal pvArgs As Variant) As Object
- ' ByRef poDataSource As Object _
- ' , ByVal psUser As String _
- ' , ByVal psPassword 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:
- ''' DataSource: com.sun.star.sdbc.XDataSource
- ''' User, Password : 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:
- 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>
|
