SF_Database.xba 44 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996
  1. <?xml version="1.0" encoding="UTF-8"?>
  2. <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
  3. <script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Database" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
  4. REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. ===
  5. REM === The SFDatabases library is one of the associated libraries. ===
  6. REM === Full documentation is available on https://help.libreoffice.org/ ===
  7. REM =======================================================================================================================
  8. Option Compatible
  9. Option ClassModule
  10. Option Explicit
  11. &apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;
  12. &apos;&apos;&apos; SF_Database
  13. &apos;&apos;&apos; ===========
  14. &apos;&apos;&apos; Management of databases embedded in or related to Base documents
  15. &apos;&apos;&apos; Each instance of the current class represents a single database, with essentially its tables, queries and data
  16. &apos;&apos;&apos;
  17. &apos;&apos;&apos; The exchanges with the database are done in SQL only.
  18. &apos;&apos;&apos; To make them more readable, use optionally square brackets to surround table/query/field names
  19. &apos;&apos;&apos; instead of the (RDBMS-dependent) normal surrounding character (usually, double-quote, single-quote or other).
  20. &apos;&apos;&apos; SQL statements may be run in direct or indirect mode. In direct mode the statement is transferred literally
  21. &apos;&apos;&apos; without syntax checking nor review to the database system.
  22. &apos;&apos;&apos;
  23. &apos;&apos;&apos; The provided interfaces include simple tables, queries and fields lists, and access to database metadata.
  24. &apos;&apos;&apos;
  25. &apos;&apos;&apos; Service invocation and usage:
  26. &apos;&apos;&apos; 1) To access any database at anytime
  27. &apos;&apos;&apos; Dim myDatabase As Object
  28. &apos;&apos;&apos; Set myDatabase = CreateScriptService(&quot;SFDatabases.Database&quot;, FileName, , [ReadOnly], [User, [Password]])
  29. &apos;&apos;&apos; &apos; Args:
  30. &apos;&apos;&apos; &apos; FileName: the name of the Base file compliant with the SF_FileSystem.FileNaming notation
  31. &apos;&apos;&apos; &apos; RegistrationName: the name of a registered database (mutually exclusive with FileName)
  32. &apos;&apos;&apos; &apos; ReadOnly: Default = True
  33. &apos;&apos;&apos; &apos; User, Password: additional connection arguments to the database server
  34. &apos;&apos;&apos; &apos; ... Run queries, SQL statements, ...
  35. &apos;&apos;&apos; myDatabase.CloseDatabase()
  36. &apos;&apos;&apos;
  37. &apos;&apos;&apos; 2) To access the database related to the current Base document
  38. &apos;&apos;&apos; Dim myDoc As Object, myDatabase As Object, ui As Object
  39. &apos;&apos;&apos; Set ui = CreateScriptService(&quot;UI&quot;)
  40. &apos;&apos;&apos; Set myDoc = ui.OpenBaseDocument(&quot;myDb.odb&quot;)
  41. &apos;&apos;&apos; Set myDatabase = myDoc.GetDatabase() &apos; user and password are supplied here, if needed
  42. &apos;&apos;&apos; &apos; ... Run queries, SQL statements, ...
  43. &apos;&apos;&apos; myDoc.CloseDocument()
  44. &apos;&apos;&apos;
  45. &apos;&apos;&apos; Detailed user documentation:
  46. &apos;&apos;&apos; https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_database.html?DbPAR=BASIC
  47. &apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;&apos;
  48. REM ================================================================== EXCEPTIONS
  49. Private Const DBREADONLYERROR = &quot;DBREADONLYERROR&quot;
  50. Private Const SQLSYNTAXERROR = &quot;SQLSYNTAXERROR&quot;
  51. REM ============================================================= PRIVATE MEMBERS
  52. Private [Me] As Object
  53. Private [_Parent] As Object
  54. Private ObjectType As String &apos; Must be DATABASE
  55. Private ServiceName As String
  56. Private _DataSource As Object &apos; com.sun.star.comp.dba.ODatabaseSource
  57. Private _Connection As Object &apos; com.sun.star.sdbc.XConnection
  58. Private _URL As String &apos; Text on status bar
  59. Private _Location As String &apos; File name
  60. Private _ReadOnly As Boolean
  61. Private _MetaData As Object &apos; com.sun.star.sdbc.XDatabaseMetaData
  62. REM ============================================================ MODULE CONSTANTS
  63. REM ===================================================== CONSTRUCTOR/DESTRUCTOR
  64. REM -----------------------------------------------------------------------------
  65. Private Sub Class_Initialize()
  66. Set [Me] = Nothing
  67. Set [_Parent] = Nothing
  68. ObjectType = &quot;DATABASE&quot;
  69. ServiceName = &quot;SFDatabases.Database&quot;
  70. Set _DataSource = Nothing
  71. Set _Connection = Nothing
  72. _URL = &quot;&quot;
  73. _Location = &quot;&quot;
  74. _ReadOnly = True
  75. Set _MetaData = Nothing
  76. End Sub &apos; SFDatabases.SF_Database Constructor
  77. REM -----------------------------------------------------------------------------
  78. Private Sub Class_Terminate()
  79. Call Class_Initialize()
  80. End Sub &apos; SFDatabases.SF_Database Destructor
  81. REM -----------------------------------------------------------------------------
  82. Public Function Dispose() As Variant
  83. Call Class_Terminate()
  84. Set Dispose = Nothing
  85. End Function &apos; SFDatabases.SF_Database Explicit Destructor
  86. REM ================================================================== PROPERTIES
  87. REM -----------------------------------------------------------------------------
  88. Property Get Queries() As Variant
  89. &apos;&apos;&apos; Return the list of available queries in the database
  90. Queries = _PropertyGet(&quot;Queries&quot;)
  91. End Property &apos; SFDatabases.SF_Database.Queries (get)
  92. REM -----------------------------------------------------------------------------
  93. Property Get Tables() As Variant
  94. &apos;&apos;&apos; Return the list of available Tables in the database
  95. Tables = _PropertyGet(&quot;Tables&quot;)
  96. End Property &apos; SFDatabases.SF_Database.Tables (get)
  97. REM -----------------------------------------------------------------------------
  98. Property Get XConnection() As Variant
  99. &apos;&apos;&apos; Return a com.sun.star.sdbc.XConnection UNO object
  100. XConnection = _PropertyGet(&quot;XConnection&quot;)
  101. End Property &apos; SFDatabases.SF_Database.XConnection (get)
  102. REM -----------------------------------------------------------------------------
  103. Property Get XMetaData() As Variant
  104. &apos;&apos;&apos; Return a com.sun.star.sdbc.XDatabaseMetaData UNO object
  105. XMetaData = _PropertyGet(&quot;XMetaData&quot;)
  106. End Property &apos; SFDatabases.SF_Database.XMetaData (get)
  107. REM ===================================================================== METHODS
  108. REM -----------------------------------------------------------------------------
  109. Public Sub CloseDatabase()
  110. &apos;&apos;&apos; Close the current database connection
  111. Const cstThisSub = &quot;SFDatabases.Database.CloseDatabase&quot;
  112. Const cstSubArgs = &quot;&quot;
  113. On Local Error GoTo 0 &apos; Disable useless error checking
  114. Check:
  115. ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
  116. Try:
  117. With _Connection
  118. If Not IsNull(_Connection) Then
  119. If ScriptForge.SF_Session.HasUnoMethod(_Connection, &quot;flush&quot;) Then .flush()
  120. .close()
  121. .dispose()
  122. End If
  123. Dispose()
  124. End With
  125. Finally:
  126. ScriptForge.SF_Utils._ExitFunction(cstThisSub)
  127. Exit Sub
  128. End Sub
  129. REM -----------------------------------------------------------------------------
  130. Public Function DAvg(Optional ByVal Expression As Variant _
  131. , Optional ByVal TableName As Variant _
  132. , Optional ByVal Criteria As Variant _
  133. ) As Variant
  134. &apos;&apos;&apos; Compute the aggregate function AVG() on a field or expression belonging to a table
  135. &apos;&apos;&apos; filtered by a WHERE-clause.
  136. &apos;&apos;&apos; Args:
  137. &apos;&apos;&apos; Expression: an SQL expression
  138. &apos;&apos;&apos; TableName: the name of a table
  139. &apos;&apos;&apos; Criteria: an optional WHERE clause without the word WHERE
  140. DAvg = _DFunction(&quot;Avg&quot;, Expression, TableName, Criteria)
  141. End Function &apos; SFDatabases.SF_Database.DAvg
  142. REM -----------------------------------------------------------------------------
  143. Public Function DCount(Optional ByVal Expression As Variant _
  144. , Optional ByVal TableName As Variant _
  145. , Optional ByVal Criteria As Variant _
  146. ) As Variant
  147. &apos;&apos;&apos; Compute the aggregate function COUNT() on a field or expression belonging to a table
  148. &apos;&apos;&apos; filtered by a WHERE-clause.
  149. &apos;&apos;&apos; Args:
  150. &apos;&apos;&apos; Expression: an SQL expression
  151. &apos;&apos;&apos; TableName: the name of a table
  152. &apos;&apos;&apos; Criteria: an optional WHERE clause without the word WHERE
  153. DCount = _DFunction(&quot;Count&quot;, Expression, TableName, Criteria)
  154. End Function &apos; SFDatabases.SF_Database.DCount
  155. REM -----------------------------------------------------------------------------
  156. Public Function DLookup(Optional ByVal Expression As Variant _
  157. , Optional ByVal TableName As Variant _
  158. , Optional ByVal Criteria As Variant _
  159. , Optional ByVal OrderClause As Variant _
  160. ) As Variant
  161. &apos;&apos;&apos; Compute the aggregate function Lookup() on a field or expression belonging to a table
  162. &apos;&apos;&apos; filtered by a WHERE-clause.
  163. &apos;&apos;&apos; To order the results, a pvOrderClause may be precised. The 1st record will be retained.
  164. &apos;&apos;&apos; Args:
  165. &apos;&apos;&apos; Expression: an SQL expression
  166. &apos;&apos;&apos; TableName: the name of a table
  167. &apos;&apos;&apos; Criteria: an optional WHERE clause without the word WHERE
  168. &apos;&apos;&apos; pvOrderClause: an optional order clause incl. &quot;DESC&quot; if relevant
  169. DLookup = _DFunction(&quot;Lookup&quot;, Expression, TableName, Criteria, OrderClause)
  170. End Function &apos; SFDatabases.SF_Database.DLookup
  171. REM -----------------------------------------------------------------------------
  172. Public Function DMax(Optional ByVal Expression As Variant _
  173. , Optional ByVal TableName As Variant _
  174. , Optional ByVal Criteria As Variant _
  175. ) As Variant
  176. &apos;&apos;&apos; Compute the aggregate function MAX() on a field or expression belonging to a table
  177. &apos;&apos;&apos; filtered by a WHERE-clause.
  178. &apos;&apos;&apos; Args:
  179. &apos;&apos;&apos; Expression: an SQL expression
  180. &apos;&apos;&apos; TableName: the name of a table
  181. &apos;&apos;&apos; Criteria: an optional WHERE clause without the word WHERE
  182. DMax = _DFunction(&quot;Max&quot;, Expression, TableName, Criteria)
  183. End Function &apos; SFDatabases.SF_Database.DMax
  184. REM -----------------------------------------------------------------------------
  185. Public Function DMin(Optional ByVal Expression As Variant _
  186. , Optional ByVal TableName As Variant _
  187. , Optional ByVal Criteria As Variant _
  188. ) As Variant
  189. &apos;&apos;&apos; Compute the aggregate function MIN() on a field or expression belonging to a table
  190. &apos;&apos;&apos; filtered by a WHERE-clause.
  191. &apos;&apos;&apos; Args:
  192. &apos;&apos;&apos; Expression: an SQL expression
  193. &apos;&apos;&apos; TableName: the name of a table
  194. &apos;&apos;&apos; Criteria: an optional WHERE clause without the word WHERE
  195. DMin = _DFunction(&quot;Min&quot;, Expression, TableName, Criteria)
  196. End Function &apos; SFDatabases.SF_Database.DMin
  197. REM -----------------------------------------------------------------------------
  198. Public Function DSum(Optional ByVal Expression As Variant _
  199. , Optional ByVal TableName As Variant _
  200. , Optional ByVal Criteria As Variant _
  201. ) As Variant
  202. &apos;&apos;&apos; Compute the aggregate function Sum() on a field or expression belonging to a table
  203. &apos;&apos;&apos; filtered by a WHERE-clause.
  204. &apos;&apos;&apos; Args:
  205. &apos;&apos;&apos; Expression: an SQL expression
  206. &apos;&apos;&apos; TableName: the name of a table
  207. &apos;&apos;&apos; Criteria: an optional WHERE clause without the word WHERE
  208. DSum = _DFunction(&quot;Sum&quot;, Expression, TableName, Criteria)
  209. End Function &apos; SFDatabases.SF_Database.DSum
  210. REM -----------------------------------------------------------------------------
  211. Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
  212. &apos;&apos;&apos; Return the actual value of the given property
  213. &apos;&apos;&apos; Args:
  214. &apos;&apos;&apos; PropertyName: the name of the property as a string
  215. &apos;&apos;&apos; Returns:
  216. &apos;&apos;&apos; The actual value of the property
  217. &apos;&apos;&apos; Exceptions:
  218. &apos;&apos;&apos; ARGUMENTERROR The property does not exist
  219. &apos;&apos;&apos; Examples:
  220. &apos;&apos;&apos; myDatabase.GetProperty(&quot;Queries&quot;)
  221. Const cstThisSub = &quot;SFDatabases.Database.GetProperty&quot;
  222. Const cstSubArgs = &quot;&quot;
  223. If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
  224. GetProperty = Null
  225. Check:
  226. If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  227. If Not ScriptForge.SF_Utils._Validate(PropertyName, &quot;PropertyName&quot;, V_STRING, Properties()) Then GoTo Catch
  228. End If
  229. Try:
  230. GetProperty = _PropertyGet(PropertyName)
  231. Finally:
  232. ScriptForge.SF_Utils._ExitFunction(cstThisSub)
  233. Exit Function
  234. Catch:
  235. GoTo Finally
  236. End Function &apos; SFDatabases.SF_Database.GetProperty
  237. REM -----------------------------------------------------------------------------
  238. Public Function GetRows(Optional ByVal SQLCommand As Variant _
  239. , Optional ByVal DirectSQL As Variant _
  240. , Optional ByVal Header As Variant _
  241. , Optional ByVal MaxRows As Variant _
  242. ) As Variant
  243. &apos;&apos;&apos; Return the content of a table, a query or a SELECT SQL statement as an array
  244. &apos;&apos;&apos; Args:
  245. &apos;&apos;&apos; SQLCommand: a table name, a query name or a SELECT SQL statement
  246. &apos;&apos;&apos; DirectSQL: when True, no syntax conversion is done by LO. Default = False
  247. &apos;&apos;&apos; Ignored when SQLCommand is a table or a query name
  248. &apos;&apos;&apos; Header: When True, a header row is inserted on the top of the array with the column names. Default = False
  249. &apos;&apos;&apos; MaxRows: The maximum number of returned rows. If absent, all records are returned
  250. &apos;&apos;&apos; Returns:
  251. &apos;&apos;&apos; a 2D array(row, column), even if only 1 column and/or 1 record
  252. &apos;&apos;&apos; an empty array if no records returned
  253. &apos;&apos;&apos; Example:
  254. &apos;&apos;&apos; Dim a As Variant
  255. &apos;&apos;&apos; a = myDatabase.GetRows(&quot;SELECT [First Name], [Last Name] FROM [Employees] ORDER BY [Last Name]&quot;, Header := True)
  256. Dim vResult As Variant &apos; Return value
  257. Dim oResult As Object &apos; com.sun.star.sdbc.XResultSet
  258. Dim oQuery As Object &apos; com.sun.star.ucb.XContent
  259. Dim sSql As String &apos; SQL statement
  260. Dim bDirect &apos; Alias of DirectSQL
  261. Dim lCols As Long &apos; Number of columns
  262. Dim lRows As Long &apos; Number of rows
  263. Dim oColumns As Object
  264. Dim i As Long
  265. Const cstThisSub = &quot;SFDatabases.Database.GetRows&quot;
  266. Const cstSubArgs = &quot;SQLCommand, [DirectSQL=False], [Header=False], [MaxRows=0]&quot;
  267. If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
  268. vResult = Array()
  269. Check:
  270. If IsMissing(DirectSQL) Or IsEmpty(DirectSQL) Then DirectSQL = False
  271. If IsMissing(Header) Or IsEmpty(Header) Then Header = False
  272. If IsMissing(MaxRows) Or IsEmpty(MaxRows) Then MaxRows = 0
  273. If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  274. If Not ScriptForge.SF_Utils._Validate(SQLCommand, &quot;SQLCommand&quot;, V_STRING) Then GoTo Finally
  275. If Not ScriptForge.SF_Utils._Validate(DirectSQL, &quot;DirectSQL&quot;, ScriptForge.V_BOOLEAN) Then GoTo Finally
  276. If Not ScriptForge.SF_Utils._Validate(Header, &quot;Header&quot;, ScriptForge.V_BOOLEAN) Then GoTo Finally
  277. If Not ScriptForge.SF_Utils._Validate(MaxRows, &quot;MaxRows&quot;, ScriptForge.V_NUMERIC) Then GoTo Finally
  278. End If
  279. Try:
  280. &apos; Table, query of SQL ? Prepare resultset
  281. If ScriptForge.SF_Array.Contains(Tables, SQLCommand, CaseSensitive := True, SortOrder := &quot;ASC&quot;) Then
  282. sSql = &quot;SELECT * FROM [&quot; &amp; SQLCommand &amp; &quot;]&quot;
  283. bDirect = True
  284. ElseIf ScriptForge.SF_Array.Contains(Queries, SQLCommand, CaseSensitive := True, SortOrder := &quot;ASC&quot;) Then
  285. Set oQuery = _Connection.Queries.getByName(SQLCommand)
  286. sSql = oQuery.Command
  287. bDirect = Not oQuery.EscapeProcessing
  288. ElseIf ScriptForge.SF_String.StartsWith(SQLCommand, &quot;SELECT&quot;, CaseSensitive := False) Then
  289. sSql = SQLCommand
  290. bDirect = DirectSQL
  291. Else
  292. GoTo Finally
  293. End If
  294. &apos; Execute command
  295. Set oResult = _ExecuteSql(sSql, bDirect)
  296. If IsNull(oResult) Then GoTo Finally
  297. With oResult
  298. &apos;Initialize output array with header row
  299. Set oColumns = oResult.getColumns()
  300. lCols = oColumns.Count - 1
  301. If Header Then
  302. lRows = 0
  303. ReDim vResult(0 To lRows, 0 To lCols)
  304. For i = 0 To lCols
  305. vResult(lRows, i) = oColumns.getByIndex(i).Name
  306. Next i
  307. If MaxRows &gt; 0 Then MaxRows = MaxRows + 1
  308. Else
  309. lRows = -1
  310. End If
  311. &apos; Load data
  312. .first()
  313. Do While Not .isAfterLast() And (MaxRows = 0 Or lRows &lt; MaxRows - 1)
  314. lRows = lRows + 1
  315. If lRows = 0 Then
  316. ReDim vResult(0 To lRows, 0 To lCols)
  317. Else
  318. ReDim Preserve vResult(0 To lRows, 0 To lCols)
  319. End If
  320. For i = 0 To lCols
  321. vResult(lRows, i) = _GetColumnValue(oResult, i + 1)
  322. Next i
  323. .next()
  324. Loop
  325. End With
  326. Finally:
  327. GetRows = vResult
  328. ScriptForge.SF_Utils._ExitFunction(cstThisSub)
  329. Exit Function
  330. Catch:
  331. GoTo Finally
  332. End Function &apos; SFDatabases.SF_Database.GetRows
  333. REM -----------------------------------------------------------------------------
  334. Public Function Methods() As Variant
  335. &apos;&apos;&apos; Return the list of public methods of the Database service as an array
  336. Methods = Array( _
  337. &quot;CloseDatabase&quot; _
  338. , &quot;DAvg&quot; _
  339. , &quot;DCount&quot; _
  340. , &quot;DLookup&quot; _
  341. , &quot;DMax&quot; _
  342. , &quot;DMin&quot; _
  343. , &quot;DSum&quot; _
  344. , &quot;GetRows&quot; _
  345. , &quot;OpenQuery&quot; _
  346. , &quot;OpenSql&quot; _
  347. , &quot;OpenTable&quot; _
  348. , &quot;RunSql&quot; _
  349. )
  350. End Function &apos; SFDatabases.SF_Database.Methods
  351. REM -----------------------------------------------------------------------------
  352. Public Function OpenQuery(Optional ByVal QueryName As Variant) As Object
  353. &apos;&apos;&apos; Open the query given by its name
  354. &apos;&apos;&apos; The datasheet will live independently from any other (typically Base) component
  355. &apos;&apos;&apos; Args:
  356. &apos;&apos;&apos; QueryName: a valid query name as a case-sensitive string
  357. &apos;&apos;&apos; Returns:
  358. &apos;&apos;&apos; A Datasheet class instance if the query could be opened, otherwise Nothing
  359. &apos;&apos;&apos; Exceptions:
  360. &apos;&apos;&apos; Query name is invalid
  361. &apos;&apos;&apos; Example:
  362. &apos;&apos;&apos; oDb.OpenQuery(&quot;myQuery&quot;)
  363. Dim oOpen As Object &apos; Return value
  364. Const cstThisSub = &quot;SFDatabases.Database.OpenQuery&quot;
  365. Const cstSubArgs = &quot;QueryName&quot;
  366. If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
  367. Set oOpen = Nothing
  368. Check:
  369. If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  370. If Not ScriptForge.SF_Utils._Validate(QueryName, &quot;QueryName&quot;, V_STRING, Queries) Then GoTo Finally
  371. End If
  372. Try:
  373. Set oOpen = _OpenDatasheet(QueryName, com.sun.star.sdb.CommandType.QUERY _
  374. , _Connection.Queries.getByName(QueryName).EscapeProcessing)
  375. Finally:
  376. Set OpenQuery = oOpen
  377. ScriptForge.SF_Utils._ExitFunction(cstThisSub)
  378. Exit Function
  379. Catch:
  380. GoTo Finally
  381. End Function &apos; SFDocuments.SF_Base.OpenQuery
  382. REM -----------------------------------------------------------------------------
  383. Public Function OpenSql(Optional ByRef Sql As Variant _
  384. , Optional ByVal DirectSql As Variant _
  385. ) As Object
  386. &apos;&apos;&apos; Open the datasheet based on a SQL SELECT statement.
  387. &apos;&apos;&apos; The datasheet will live independently from any other (typically Base) component
  388. &apos;&apos;&apos; Args:
  389. &apos;&apos;&apos; Sql: a valid Sql statement as a case-sensitive string.
  390. &apos;&apos;&apos; Identifiers may be surrounded by square brackets
  391. &apos;&apos;&apos; DirectSql: when True, the statement is processed by the targeted RDBMS
  392. &apos;&apos;&apos; Returns:
  393. &apos;&apos;&apos; A Datasheet class instance if it could be opened, otherwise Nothing
  394. &apos;&apos;&apos; Example:
  395. &apos;&apos;&apos; oDb.OpenSql(&quot;SELECT * FROM [Customers] ORDER BY [CITY]&quot;)
  396. Dim oOpen As Object &apos; Return value
  397. Const cstThisSub = &quot;SFDatabases.Database.OpenSql&quot;
  398. Const cstSubArgs = &quot;Sql, [DirectSql=False]&quot;
  399. If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
  400. Set oOpen = Nothing
  401. Check:
  402. If IsMissing(DirectSql) Or IsEmpty(DirectSql) Then DirectSql = False
  403. If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  404. If Not ScriptForge.SF_Utils._Validate(Sql, &quot;Sql&quot;, V_STRING) Then GoTo Finally
  405. If Not ScriptForge.SF_Utils._Validate(DirectSql, &quot;DirectSql&quot;, ScriptForge.V_BOOLEAN) Then GoTo Finally
  406. End If
  407. Try:
  408. Set oOpen = _OpenDatasheet(_ReplaceSquareBrackets(Sql), com.sun.star.sdb.CommandType.COMMAND, Not DirectSql)
  409. Finally:
  410. Set OpenSql = oOpen
  411. ScriptForge.SF_Utils._ExitFunction(cstThisSub)
  412. Exit Function
  413. Catch:
  414. GoTo Finally
  415. End Function &apos; SFDocuments.SF_Base.OpenSql
  416. REM -----------------------------------------------------------------------------
  417. Public Function OpenTable(Optional ByVal TableName As Variant) As Object
  418. &apos;&apos;&apos; Open the table given by its name
  419. &apos;&apos;&apos; The datasheet will live independently from any other (typically Base) component
  420. &apos;&apos;&apos; Args:
  421. &apos;&apos;&apos; TableName: a valid table name as a case-sensitive string
  422. &apos;&apos;&apos; Returns:
  423. &apos;&apos;&apos; A Datasheet class instance if the table could be opened, otherwise Nothing
  424. &apos;&apos;&apos; Exceptions:
  425. &apos;&apos;&apos; Table name is invalid
  426. &apos;&apos;&apos; Example:
  427. &apos;&apos;&apos; oDb.OpenTable(&quot;myTable&quot;)
  428. Dim oOpen As Object &apos; Return value
  429. Const cstThisSub = &quot;SFDatabases.Database.OpenTable&quot;
  430. Const cstSubArgs = &quot;TableName&quot;
  431. If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
  432. Set oOpen = Nothing
  433. Check:
  434. If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  435. If Not ScriptForge.SF_Utils._Validate(TableName, &quot;TableName&quot;, V_STRING, Tables) Then GoTo Finally
  436. End If
  437. Try:
  438. Set oOpen = _OpenDatasheet(TableName, com.sun.star.sdb.CommandType.TABLE, True)
  439. Finally:
  440. Set OpenTable = oOpen
  441. ScriptForge.SF_Utils._ExitFunction(cstThisSub)
  442. Exit Function
  443. Catch:
  444. GoTo Finally
  445. End Function &apos; SFDocuments.SF_Base.OpenTable
  446. REM -----------------------------------------------------------------------------
  447. Public Function Properties() As Variant
  448. &apos;&apos;&apos; Return the list or properties of the Database class as an array
  449. Properties = Array( _
  450. &quot;Queries&quot; _
  451. , &quot;Tables&quot; _
  452. , &quot;XConnection&quot; _
  453. , &quot;XMetaData&quot; _
  454. )
  455. End Function &apos; SFDatabases.SF_Database.Properties
  456. REM -----------------------------------------------------------------------------
  457. Public Function RunSql(Optional ByVal SQLCommand As Variant _
  458. , Optional ByVal DirectSQL As Variant _
  459. ) As Boolean
  460. &apos;&apos;&apos; Execute an action query (table creation, record insertion, ...) or SQL statement on the current database
  461. &apos;&apos;&apos; Args:
  462. &apos;&apos;&apos; SQLCommand: a query name or an SQL statement
  463. &apos;&apos;&apos; DirectSQL: when True, no syntax conversion is done by LO. Default = False
  464. &apos;&apos;&apos; Ignored when SQLCommand is a query name
  465. &apos;&apos;&apos; Exceptions:
  466. &apos;&apos;&apos; DBREADONLYERROR The method is not applicable on a read-only database
  467. &apos;&apos;&apos; Example:
  468. &apos;&apos;&apos; myDatabase.RunSql(&quot;INSERT INTO [EMPLOYEES] VALUES(25, &apos;SMITH&apos;, &apos;John&apos;)&quot;, DirectSQL := True)
  469. Dim bResult As Boolean &apos; Return value
  470. Dim oStatement As Object &apos; com.sun.star.sdbc.XStatement
  471. Dim oQuery As Object &apos; com.sun.star.ucb.XContent
  472. Dim sSql As String &apos; SQL statement
  473. Dim bDirect &apos; Alias of DirectSQL
  474. Const cstQuery = 2, cstSql = 3
  475. Const cstThisSub = &quot;SFDatabases.Database.RunSql&quot;
  476. Const cstSubArgs = &quot;SQLCommand, [DirectSQL=False]&quot;
  477. If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
  478. bResult = False
  479. Check:
  480. If IsMissing(DirectSQL) Or IsEmpty(DirectSQL) Then DirectSQL = False
  481. If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  482. If Not ScriptForge.SF_Utils._Validate(SQLCommand, &quot;SQLCommand&quot;, V_STRING) Then GoTo Finally
  483. If Not ScriptForge.SF_Utils._Validate(DirectSQL, &quot;DirectSQL&quot;, ScriptForge.V_BOOLEAN) Then GoTo Finally
  484. End If
  485. If _ReadOnly Then GoTo Catch_ReadOnly
  486. Try:
  487. &apos; Query of SQL ?
  488. If ScriptForge.SF_Array.Contains(Queries, SQLCommand, CaseSensitive := True, SortOrder := &quot;ASC&quot;) Then
  489. Set oQuery = _Connection.Queries.getByName(SQLCommand)
  490. sSql = oQuery.Command
  491. bDirect = Not oQuery.EscapeProcessing
  492. ElseIf Not ScriptForge.SF_String.StartsWith(SQLCommand, &quot;SELECT&quot;, CaseSensitive := False) Then
  493. sSql = SQLCommand
  494. bDirect = DirectSQL
  495. Else
  496. GoTo Finally
  497. End If
  498. &apos; Execute command
  499. bResult = _ExecuteSql(sSql, bDirect)
  500. Finally:
  501. RunSql = bResult
  502. ScriptForge.SF_Utils._ExitFunction(cstThisSub)
  503. Exit Function
  504. Catch:
  505. GoTo Finally
  506. Catch_ReadOnly:
  507. ScriptForge.SF_Exception.RaiseFatal(DBREADONLYERROR)
  508. GoTo Finally
  509. End Function &apos; SFDatabases.SF_Database.RunSql
  510. REM -----------------------------------------------------------------------------
  511. Public Function SetProperty(Optional ByVal PropertyName As Variant _
  512. , Optional ByRef Value As Variant _
  513. ) As Boolean
  514. &apos;&apos;&apos; Set a new value to the given property
  515. &apos;&apos;&apos; Args:
  516. &apos;&apos;&apos; PropertyName: the name of the property as a string
  517. &apos;&apos;&apos; Value: its new value
  518. &apos;&apos;&apos; Exceptions
  519. &apos;&apos;&apos; ARGUMENTERROR The property does not exist
  520. Const cstThisSub = &quot;SFDatabases.Database.SetProperty&quot;
  521. Const cstSubArgs = &quot;PropertyName, Value&quot;
  522. If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
  523. SetProperty = False
  524. Check:
  525. If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  526. If Not SF_Utils._Validate(PropertyName, &quot;PropertyName&quot;, V_STRING, Properties()) Then GoTo Catch
  527. End If
  528. Try:
  529. Select Case UCase(PropertyName)
  530. Case Else
  531. End Select
  532. Finally:
  533. SF_Utils._ExitFunction(cstThisSub)
  534. Exit Function
  535. Catch:
  536. GoTo Finally
  537. End Function &apos; SFDatabases.SF_Database.SetProperty
  538. REM =========================================================== PRIVATE FUNCTIONS
  539. REM -----------------------------------------------------------------------------------------------------------------------
  540. Private Function _DFunction(ByVal psFunction As String _
  541. , Optional ByVal pvExpression As Variant _
  542. , Optional ByVal pvTableName As Variant _
  543. , Optional ByVal pvCriteria As Variant _
  544. , Optional ByVal pvOrderClause As Variant _
  545. ) As Variant
  546. &apos;&apos;&apos; Build and execute a SQL statement computing the aggregate function psFunction
  547. &apos;&apos;&apos; on a field or expression pvExpression belonging to a table pvTableName
  548. &apos;&apos;&apos; filtered by a WHERE-clause pvCriteria.
  549. &apos;&apos;&apos; To order the results, a pvOrderClause may be precised.
  550. &apos;&apos;&apos; Only the 1st record will be retained anyway.
  551. &apos;&apos;&apos; Args:
  552. &apos;&apos;&apos; psFunction an optional aggregate function: SUM, COUNT, AVG, LOOKUP
  553. &apos;&apos;&apos; pvExpression: an SQL expression
  554. &apos;&apos;&apos; pvTableName: the name of a table, NOT surrounded with quoting char
  555. &apos;&apos;&apos; pvCriteria: an optional WHERE clause without the word WHERE
  556. &apos;&apos;&apos; pvOrderClause: an optional order clause incl. &quot;DESC&quot; if relevant
  557. &apos;&apos;&apos; (meaningful only for LOOKUP)
  558. Dim vResult As Variant &apos; Return value
  559. Dim oResult As Object &apos; com.sun.star.sdbc.XResultSet
  560. Dim sSql As String &apos; SQL statement.
  561. Dim sExpr As String &apos; For inclusion of aggregate function
  562. Dim sTarget as String &apos; Alias of pvExpression
  563. Dim sWhere As String &apos; Alias of pvCriteria
  564. Dim sOrderBy As String &apos; Alias of pvOrderClause
  565. Dim sLimit As String &apos; TOP 1 clause
  566. Dim sProductName As String &apos; RDBMS as a string
  567. Const cstAliasField = &quot;[&quot; &amp; &quot;TMP_ALIAS_ANY_FIELD&quot; &amp; &quot;]&quot; &apos; Alias field in SQL expression
  568. Dim cstThisSub As String : cstThisSub = &quot;SFDatabases.SF_Database.D&quot; &amp; psFunction
  569. Const cstSubArgs = &quot;Expression, TableName, [Criteria=&quot;&quot;&quot;&quot;], [OrderClause=&quot;&quot;&quot;&quot;]&quot;
  570. Const cstLookup = &quot;Lookup&quot;
  571. If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
  572. vResult = Null
  573. Check:
  574. If IsMissing(pvCriteria) Or IsEmpty(pvCriteria) Then pvCriteria = &quot;&quot;
  575. If IsMissing(pvOrderClause) Or IsEmpty(pvOrderClause) Then pvOrderClause = &quot;&quot;
  576. If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  577. If Not ScriptForge.SF_Utils._Validate(pvExpression, &quot;Expression&quot;, V_STRING) Then GoTo Finally
  578. If Not ScriptForge.SF_Utils._Validate(pvTableName, &quot;TableName&quot;, V_STRING, Tables) Then GoTo Finally
  579. If Not ScriptForge.SF_Utils._Validate(pvCriteria, &quot;Criteria&quot;, V_STRING) Then GoTo Finally
  580. If Not ScriptForge.SF_Utils._Validate(pvOrderClause, &quot;OrderClause&quot;, V_STRING) Then GoTo Finally
  581. End If
  582. Try:
  583. If pvCriteria &lt;&gt; &quot;&quot; Then sWhere = &quot; WHERE &quot; &amp; pvCriteria Else sWhere = &quot;&quot;
  584. If pvOrderClause &lt;&gt; &quot;&quot; Then sOrderBy = &quot; ORDER BY &quot; &amp; pvOrderClause Else sOrderBy = &quot;&quot;
  585. sLimit = &quot;&quot;
  586. pvTableName = &quot;[&quot; &amp; pvTableName &amp; &quot;]&quot;
  587. sProductName = UCase(_MetaData.getDatabaseProductName())
  588. Select Case sProductName
  589. Case &quot;MYSQL&quot;, &quot;SQLITE&quot;
  590. If psFunction = cstLookup Then
  591. sTarget = pvExpression
  592. sLimit = &quot; LIMIT 1&quot;
  593. Else
  594. sTarget = UCase(psFunction) &amp; &quot;(&quot; &amp; pvExpression &amp; &quot;)&quot;
  595. End If
  596. sSql = &quot;SELECT &quot; &amp; sTarget &amp; &quot; AS &quot; &amp; cstAliasField &amp; &quot; FROM &quot; &amp; psTableName &amp; sWhere &amp; sOrderBy &amp; sLimit
  597. Case &quot;FIREBIRD (ENGINE12)&quot;
  598. If psFunction = cstLookup Then sTarget = &quot;FIRST 1 &quot; &amp; pvExpression Else sTarget = UCase(psFunction) &amp; &quot;(&quot; &amp; pvExpression &amp; &quot;)&quot;
  599. sSql = &quot;SELECT &quot; &amp; sTarget &amp; &quot; AS &quot; &amp; cstAliasField &amp; &quot; FROM &quot; &amp; pvTableName &amp; sWhere &amp; sOrderBy
  600. Case Else &apos; Standard syntax - Includes HSQLDB
  601. If psFunction = cstLookup Then sTarget = &quot;TOP 1 &quot; &amp; pvExpression Else sTarget = UCase(psFunction) &amp; &quot;(&quot; &amp; pvExpression &amp; &quot;)&quot;
  602. sSql = &quot;SELECT &quot; &amp; sTarget &amp; &quot; AS &quot; &amp; cstAliasField &amp; &quot; FROM &quot; &amp; pvTableName &amp; sWhere &amp; sOrderBy
  603. End Select
  604. &apos; Execute the SQL statement and retain the first column of the first record
  605. Set oResult = _ExecuteSql(sSql, True)
  606. If Not IsNull(oResult) And Not IsEmpty(oResult) Then
  607. If Not oResult.first() Then Goto Finally
  608. If oResult.isAfterLast() Then GoTo Finally
  609. vResult = _GetColumnValue(oResult, 1, True) &apos; Force return of binary field
  610. End If
  611. Set oResult = Nothing
  612. Finally:
  613. _DFunction = vResult
  614. ScriptForge.SF_Utils._ExitFunction(cstThisSub)
  615. Exit Function
  616. Catch:
  617. GoTo Finally
  618. End Function &apos; SFDatabases.SF_Database._DFunction
  619. REM -----------------------------------------------------------------------------
  620. Private Function _ExecuteSql(ByVal psSql As String _
  621. , ByVal pbDirect As Boolean _
  622. ) As Variant
  623. &apos;&apos;&apos; Return a read-only Resultset based on a SELECT SQL statement or execute the given action SQL (INSERT, CREATE TABLE, ...)
  624. &apos;&apos;&apos; The method raises a fatal error when the SQL statement cannot be interpreted
  625. &apos;&apos;&apos; Args:
  626. &apos;&apos;&apos; psSql : the SQL statement. Square brackets are replaced by the correct field surrounding character
  627. &apos;&apos;&apos; pbDirect: when True, no syntax conversion is done by LO. Default = False
  628. &apos;&apos;&apos; Exceptions
  629. &apos;&apos;&apos; SQLSYNTAXERROR The given SQL statement is incorrect
  630. Dim vResult As Variant &apos; Return value - com.sun.star.sdbc.XResultSet or Boolean
  631. Dim oStatement As Object &apos; com.sun.star.sdbc.XStatement
  632. Dim sSql As String &apos; Alias of psSql
  633. Dim bSelect As Boolean &apos; True when SELECT statement
  634. Dim bErrorHandler As Boolean &apos; Can be set off to ease debugging of complex SQL statements
  635. Set vResult = Nothing
  636. bErrorHandler = ScriptForge.SF_Utils._ErrorHandling()
  637. If bErrorHandler Then On Local Error GoTo Catch
  638. Try:
  639. sSql = _ReplaceSquareBrackets(psSql)
  640. bSelect = ScriptForge.SF_String.StartsWith(sSql, &quot;SELECT&quot;, CaseSensitive := False)
  641. Set oStatement = _Connection.createStatement()
  642. With oStatement
  643. If bSelect Then
  644. .ResultSetType = com.sun.star.sdbc.ResultSetType.SCROLL_INSENSITIVE
  645. .ResultSetConcurrency = com.sun.star.sdbc.ResultSetConcurrency.READ_ONLY
  646. End If
  647. .EscapeProcessing = Not pbDirect
  648. &apos; Setup the result set
  649. If bErrorHandler Then On Local Error GoTo Catch_Sql
  650. If bSelect Then Set vResult = .executeQuery(sSql) Else vResult = .execute(sSql)
  651. End With
  652. Finally:
  653. _ExecuteSql = vResult
  654. Set oStatement = Nothing
  655. Exit Function
  656. Catch_Sql:
  657. ScriptForge.SF_Exception.RaiseFatal(SQLSYNTAXERROR, sSql)
  658. GoTo Finally
  659. Catch:
  660. GoTo Finally
  661. End Function &apos; SFDatabases.SF_Database._ExecuteSql
  662. REM -----------------------------------------------------------------------------
  663. Private Function _GetColumnValue(ByRef poResultSet As Object _
  664. , ByVal plColIndex As Long _
  665. , Optional ByVal pbReturnBinary As Boolean _
  666. ) As Variant
  667. &apos;&apos;&apos; Get the data stored in the current record of a result set in a given column
  668. &apos;&apos;&apos; The type of the column is found in the resultset&apos;s metadata
  669. &apos;&apos;&apos; Args:
  670. &apos;&apos;&apos; poResultSet: com.sun.star.sdbc.XResultSet or com.sun.star.awt.XTabControllerModel
  671. &apos;&apos;&apos; plColIndex: the index of the column to extract the value from. Starts at 1
  672. &apos;&apos;&apos; pbReturnBinary: when True, the method returns the content of a binary field,
  673. &apos;&apos;&apos; as long as its length does not exceed a maximum length.
  674. &apos;&apos;&apos; Default = False: binary fields are not returned, only their length
  675. &apos;&apos;&apos; Returns:
  676. &apos;&apos;&apos; The Variant value found in the column
  677. &apos;&apos;&apos; Dates and times are returned as Basic dates
  678. &apos;&apos;&apos; Null values are returned as Null
  679. &apos;&apos;&apos; Errors or strange data types are returned as Null as well
  680. Dim vValue As Variant &apos; Return value
  681. Dim lType As Long &apos; SQL column type: com.sun.star.sdbc.DataType
  682. Dim vDateTime As Variant &apos; com.sun.star.util.DateTime
  683. Dim oStream As Object &apos; Long character or binary streams
  684. Dim bNullable As Boolean &apos; The field is defined as accepting Null values
  685. Dim lSize As Long &apos; Binary field length
  686. Const cstMaxBinlength = 2 * 65535
  687. On Local Error Goto 0 &apos; Disable error handler
  688. vValue = Empty &apos; Default value if error
  689. If IsMissing(pbReturnBinary) Then pbReturnBinary = False
  690. With com.sun.star.sdbc.DataType
  691. lType = poResultSet.MetaData.getColumnType(plColIndex)
  692. bNullable = ( poResultSet.MetaData.IsNullable(plColIndex) = com.sun.star.sdbc.ColumnValue.NULLABLE )
  693. Select Case lType
  694. Case .ARRAY : vValue = poResultSet.getArray(plColIndex)
  695. Case .BINARY, .VARBINARY, .LONGVARBINARY, .BLOB
  696. Set oStream = poResultSet.getBinaryStream(plColIndex)
  697. If bNullable Then
  698. If Not poResultSet.wasNull() Then
  699. If Not ScriptForge.SF_Session.HasUNOMethod(oStream, &quot;getLength&quot;) Then &apos; When no recordset
  700. lSize = cstMaxBinLength
  701. Else
  702. lSize = CLng(oStream.getLength())
  703. End If
  704. If lSize &lt;= cstMaxBinLength And pbReturnBinary Then
  705. vValue = Array()
  706. oStream.readBytes(vValue, lSize)
  707. Else &apos; Return length of field, not content
  708. vValue = lSize
  709. End If
  710. End If
  711. End If
  712. If Not IsNull(oStream) Then oStream.closeInput()
  713. Case .BIT, .BOOLEAN : vValue = poResultSet.getBoolean(plColIndex)
  714. Case .DATE
  715. vDateTime = poResultSet.getDate(plColIndex)
  716. If Not poResultSet.wasNull() Then vValue = DateSerial(CInt(vDateTime.Year), CInt(vDateTime.Month), CInt(vDateTime.Day))
  717. Case .DISTINCT, .OBJECT, .OTHER, .STRUCT
  718. vValue = Null
  719. Case .DOUBLE, .REAL : vValue = poResultSet.getDouble(plColIndex)
  720. Case .FLOAT : vValue = poResultSet.getFloat(plColIndex)
  721. Case .INTEGER, .SMALLINT : vValue = poResultSet.getInt(plColIndex)
  722. Case .BIGINT : vValue = CLng(poResultSet.getLong(plColIndex))
  723. Case .DECIMAL, .NUMERIC : vValue = poResultSet.getDouble(plColIndex)
  724. Case .SQLNULL : vValue = poResultSet.getNull(plColIndex)
  725. Case .OBJECT, .OTHER, .STRUCT : vValue = Null
  726. Case .REF : vValue = poResultSet.getRef(plColIndex)
  727. Case .TINYINT : vValue = poResultSet.getShort(plColIndex)
  728. Case .CHAR, .VARCHAR : vValue = poResultSet.getString(plColIndex)
  729. Case .LONGVARCHAR, .CLOB
  730. If bNullable Then
  731. If Not poResultSet.wasNull() Then vValue = poResultSet.getString(plColIndex)
  732. Else
  733. vValue = &quot;&quot;
  734. End If
  735. Case .TIME
  736. vDateTime = poResultSet.getTime(plColIndex)
  737. If Not poResultSet.wasNull() Then vValue = TimeSerial(vDateTime.Hours, vDateTime.Minutes, vDateTime.Seconds)&apos;, vDateTime.HundredthSeconds)
  738. Case .TIMESTAMP
  739. vDateTime = poResultSet.getTimeStamp(plColIndex)
  740. If Not poResultSet.wasNull() Then vValue = DateSerial(CInt(vDateTime.Year), CInt(vDateTime.Month), CInt(vDateTime.Day)) _
  741. + TimeSerial(vDateTime.Hours, vDateTime.Minutes, vDateTime.Seconds)&apos;, vDateTime.HundredthSeconds)
  742. Case Else
  743. vValue = poResultSet.getString(plColIndex) &apos;GIVE STRING A TRY
  744. If IsNumeric(vValue) Then vValue = Val(vValue) &apos;Required when type = &quot;&quot;, sometimes numeric fields are returned as strings (query/MSAccess)
  745. End Select
  746. If bNullable Then
  747. If poResultSet.wasNull() Then vValue = Null
  748. End If
  749. End With
  750. _GetColumnValue = vValue
  751. End Function &apos; SFDatabases.SF_Database.GetColumnValue
  752. REM -----------------------------------------------------------------------------
  753. Public Function _OpenDatasheet(Optional ByVal psCommand As Variant _
  754. , piDatasheetType As Integer _
  755. , pbEscapeProcessing As Boolean _
  756. ) As Object
  757. &apos;&apos;&apos; Open the datasheet given by its name and its type
  758. &apos;&apos;&apos; The datasheet will live independently from any other component
  759. &apos;&apos;&apos; Args:
  760. &apos;&apos;&apos; psCommand: a valid table or query name or an SQL statement as a case-sensitive string
  761. &apos;&apos;&apos; piDatasheetType: one of the com.sun.star.sdb.CommandType constants
  762. &apos;&apos;&apos; pbEscapeProcessing: == Not DirectSql
  763. &apos;&apos;&apos; Returns:
  764. &apos;&apos;&apos; A Datasheet class instance if the datasheet could be opened, otherwise Nothing
  765. Dim oOpen As Object &apos; Return value
  766. Dim oNewDatasheet As Object &apos; com.sun.star.lang.XComponent
  767. Dim oURL As Object &apos; com.sun.star.util.URL
  768. Dim oDispatch As Object &apos; com.sun.star.frame.XDispatch
  769. Dim vArgs As Variant &apos; Array of property values
  770. On Local Error GoTo Catch
  771. Set oOpen = Nothing
  772. Try:
  773. &apos; Setup the dispatcher
  774. Set oURL = New com.sun.star.util.URL
  775. oURL.Complete = &quot;.component:DB/DataSourceBrowser&quot;
  776. Set oDispatch = StarDesktop.queryDispatch(oURL, &quot;_blank&quot;, com.sun.star.frame.FrameSearchFlag.CREATE)
  777. &apos; Setup the arguments of the component to create
  778. With ScriptForge.SF_Utils
  779. vArgs = Array( _
  780. ._MakePropertyValue(&quot;ActiveConnection&quot;, _Connection) _
  781. , ._MakePropertyValue(&quot;CommandType&quot;, piDatasheetType) _
  782. , ._MakePropertyValue(&quot;Command&quot;, psCommand) _
  783. , ._MakePropertyValue(&quot;ShowMenu&quot;, True) _
  784. , ._MakePropertyValue(&quot;ShowTreeView&quot;, False) _
  785. , ._MakePropertyValue(&quot;ShowTreeViewButton&quot;, False) _
  786. , ._MakePropertyValue(&quot;Filter&quot;, &quot;&quot;) _
  787. , ._MakePropertyValue(&quot;ApplyFilter&quot;, False) _
  788. , ._MakePropertyValue(&quot;EscapeProcessing&quot;, pbEscapeProcessing) _
  789. )
  790. End With
  791. &apos; Open the targeted datasheet
  792. Set oNewDatasheet = oDispatch.dispatchWithReturnValue(oURL, vArgs)
  793. If Not IsNull(oNewDatasheet) Then Set oOpen = ScriptForge.SF_Services.CreateScriptService(&quot;SFDatabases.Datasheet&quot;, oNewDatasheet, [Me])
  794. Finally:
  795. Set _OpenDatasheet = oOpen
  796. Exit Function
  797. Catch:
  798. GoTo Finally
  799. End Function &apos; SFDocuments.SF_Base._OpenDatasheet
  800. REM -----------------------------------------------------------------------------
  801. Private Function _PropertyGet(Optional ByVal psProperty As String) As Variant
  802. &apos;&apos;&apos; Return the value of the named property
  803. &apos;&apos;&apos; Args:
  804. &apos;&apos;&apos; psProperty: the name of the property
  805. Dim cstThisSub As String
  806. Const cstSubArgs = &quot;&quot;
  807. cstThisSub = &quot;SFDatabases.Database.get&quot; &amp; psProperty
  808. If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
  809. ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
  810. Select Case psProperty
  811. Case &quot;Queries&quot;
  812. If Not IsNull(_Connection) Then _PropertyGet = _Connection.Queries.getElementNames() Else _PropertyGet = Array()
  813. Case &quot;Tables&quot;
  814. If Not IsNull(_Connection) Then _PropertyGet = _Connection.Tables.getElementNames() Else _PropertyGet = Array()
  815. Case &quot;XConnection&quot;
  816. Set _PropertyGet = _Connection
  817. Case &quot;XMetaData&quot;
  818. Set _PropertyGet = _MetaData
  819. Case Else
  820. _PropertyGet = Null
  821. End Select
  822. Finally:
  823. ScriptForge.SF_Utils._ExitFunction(cstThisSub)
  824. Exit Function
  825. Catch:
  826. GoTo Finally
  827. End Function &apos; SFDatabases.SF_Database._PropertyGet
  828. REM -----------------------------------------------------------------------------
  829. Private Function _ReplaceSquareBrackets(ByVal psSql As String) As String
  830. &apos;&apos;&apos; Returns the input SQL command after replacement of square brackets by the table/field names quoting character
  831. Dim sSql As String &apos; Return value
  832. Dim sQuote As String &apos; RDBMS specific table/field surrounding character
  833. Dim sConstQuote As String &apos; Delimiter for string constants in SQL - usually the single quote
  834. Const cstDouble = &quot;&quot;&quot;&quot; : Const cstSingle = &quot;&apos;&quot;
  835. Try:
  836. sQuote = _MetaData.IdentifierQuoteString
  837. sConstQuote = Iif(sQuote = cstSingle, cstDouble, cstSingle)
  838. &apos; Replace the square brackets
  839. sSql = Join(ScriptForge.SF_String.SplitNotQuoted(psSql, &quot;[&quot;, , sConstQuote), sQuote)
  840. sSql = Join(ScriptForge.SF_String.SplitNotQuoted(sSql, &quot;]&quot;, , sConstQuote), sQuote)
  841. Finally:
  842. _ReplaceSquareBrackets = sSql
  843. Exit Function
  844. End Function &apos; SFDatabases.SF_Database._ReplaceSquareBrackets
  845. REM -----------------------------------------------------------------------------
  846. Private Function _Repr() As String
  847. &apos;&apos;&apos; Convert the Database instance to a readable string, typically for debugging purposes (DebugPrint ...)
  848. &apos;&apos;&apos; Args:
  849. &apos;&apos;&apos; Return:
  850. &apos;&apos;&apos; &quot;[DATABASE]: Location (Statusbar)&quot;
  851. _Repr = &quot;[DATABASE]: &quot; &amp; _Location &amp; &quot; (&quot; &amp; _URL &amp; &quot;)&quot;
  852. End Function &apos; SFDatabases.SF_Database._Repr
  853. REM ============================================ END OF SFDATABASES.SF_DATABASE
  854. </script:module>