1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
|
<?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>
|
