?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
bump product version to 5.0.4.1
[LibreOffice.git] / wizards / source / access2base / Field.xba
blob053245eaa103757af3b855436cbfbd26c367e4b5
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="Field" script:language="StarBasic">REM =======================================================================================================================
4 REM === The Access2Base library is a part of the LibreOffice project. ===
5 REM === Full documentation is available on http://www.access2base.com ===
6 REM =======================================================================================================================
7
8 Option Compatible
9 Option ClassModule
10
11 Option Explicit
12
13 REM -----------------------------------------------------------------------------------------------------------------------
14 REM --- CLASS ROOT FIELDS ---
15 REM -----------------------------------------------------------------------------------------------------------------------
16
17 Private _Type As String &apos; Must be FIELD
18 Private _Name As String
19 Private _ParentName As String
20 Private _ParentType As String
21 Private _ParentDatabase As Object
22 Private Column As Object &apos; com.sun.star.sdb.OTableColumnWrapper
23 &apos; or org.openoffice.comp.dbaccess.OQueryColumn
24 &apos; or com.sun.star.sdb.ODataColumn
25
26 REM -----------------------------------------------------------------------------------------------------------------------
27 REM --- CONSTRUCTORS / DESTRUCTORS ---
28 REM -----------------------------------------------------------------------------------------------------------------------
29 Private Sub Class_Initialize()
30 _Type = OBJFIELD
31 _Name = &quot;&quot;
32 _ParentName = &quot;&quot;
33 _ParentType = &quot;&quot;
34 Set Column = Nothing
35 End Sub &apos; Constructor
36
37 REM -----------------------------------------------------------------------------------------------------------------------
38 Private Sub Class_Terminate()
39 On Local Error Resume Next
40 Call Class_Initialize()
41 End Sub &apos; Destructor
42
43 REM -----------------------------------------------------------------------------------------------------------------------
44 Public Sub Dispose()
45 Call Class_Terminate()
46 End Sub &apos; Explicit destructor
47
48 REM -----------------------------------------------------------------------------------------------------------------------
49 REM --- CLASS GET/LET/SET PROPERTIES ---
50 REM -----------------------------------------------------------------------------------------------------------------------
51
52 Property Get DataType() As Long &apos; AOO/LibO type
53 DataType = _PropertyGet(&quot;DataType&quot;)
54 End Property &apos; DataType (get)
55
56 Property Get DataUpdatable() As Boolean
57 DataUpdatable = _PropertyGet(&quot;DataUpdatable&quot;)
58 End Property &apos; DataUpdatable (get)
59
60 REM -----------------------------------------------------------------------------------------------------------------------
61 Property Get DbType() As Long &apos; MSAccess type
62 DbType = _PropertyGet(&quot;DbType&quot;)
63 End Property &apos; DbType (get)
64
65 REM -----------------------------------------------------------------------------------------------------------------------
66 Property Get DefaultValue() As Variant
67 DefaultValue = _PropertyGet(&quot;DefaultValue&quot;)
68 End Property &apos; DefaultValue (get)
69
70 Property Let DefaultValue(ByVal pvDefaultValue As Variant)
71 Call _PropertySet(&quot;DefaultValue&quot;, pvDefaultValue)
72 End Property &apos; DefaultValue (set)
73
74 REM -----------------------------------------------------------------------------------------------------------------------
75 Property Get Description() As Variant
76 Description = _PropertyGet(&quot;Description&quot;)
77 End Property &apos; Description (get)
78
79 Property Let Description(ByVal pvDescription As Variant)
80 Call _PropertySet(&quot;Description&quot;, pvDescription)
81 End Property &apos; Description (set)
82
83 REM -----------------------------------------------------------------------------------------------------------------------
84 Property Get FieldSize() As Long
85 FieldSize = _PropertyGet(&quot;FieldSize&quot;)
86 End Property &apos; FieldSize (get)
87
88 REM -----------------------------------------------------------------------------------------------------------------------
89 Property Get Name() As String
90 Name = _PropertyGet(&quot;Name&quot;)
91 End Property &apos; Name (get)
92
93 REM -----------------------------------------------------------------------------------------------------------------------
94 Property Get ObjectType() As String
95 ObjectType = _PropertyGet(&quot;ObjectType&quot;)
96 End Property &apos; ObjectType (get)
97
98 REM -----------------------------------------------------------------------------------------------------------------------
99 Property Get Size() As Long
100 Size = _PropertyGet(&quot;Size&quot;)
101 End Property &apos; Size (get)
102
103 REM -----------------------------------------------------------------------------------------------------------------------
104 Property Get SourceField() As String
105 SourceField = _PropertyGet(&quot;SourceField&quot;)
106 End Property &apos; SourceField (get)
107
108 REM -----------------------------------------------------------------------------------------------------------------------
109 Property Get SourceTable() As String
110 SourceTable = _PropertyGet(&quot;SourceTable&quot;)
111 End Property &apos; SourceTable (get)
112
113 REM -----------------------------------------------------------------------------------------------------------------------
114 Property Get TypeName() As String
115 TypeName = _PropertyGet(&quot;TypeName&quot;)
116 End Property &apos; TypeName (get)
117
118 REM -----------------------------------------------------------------------------------------------------------------------
119 Property Get Value() As Variant
120 Value = _PropertyGet(&quot;Value&quot;)
121 End Property &apos; Value (get)
122
123 Property Let Value(ByVal pvValue As Variant)
124 Call _PropertySet(&quot;Value&quot;, pvValue)
125 End Property &apos; Value (set)
126
127 REM -----------------------------------------------------------------------------------------------------------------------
128 REM --- CLASS METHODS ---
129 REM -----------------------------------------------------------------------------------------------------------------------
130
131 REM -----------------------------------------------------------------------------------------------------------------------
132 Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
133 &apos; Return property value of psProperty property name
134
135 Const cstThisSub = &quot;Field.getProperty&quot;
136 Utils._SetCalledSub(cstThisSub)
137 If IsMissing(pvProperty) Then Call _TraceArguments()
138 getProperty = _PropertyGet(pvProperty)
139 Utils._ResetCalledSub(cstThisSub)
140
141 End Function &apos; getProperty
142
143 REM -----------------------------------------------------------------------------------------------------------------------
144 Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
145 &apos; Return True if object has a valid property called pvProperty (case-insensitive comparison !)
146
147 Const cstThisSub = &quot;Field.hasProperty&quot;
148 Utils._SetCalledSub(cstThisSub)
149 If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty)
150 Utils._ResetCalledSub(cstThisSub)
151 Exit Function
152
153 End Function &apos; hasProperty
154
155 REM -----------------------------------------------------------------------------------------------------------------------
156 Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
157 &apos; Return
158 &apos; a Collection object if pvIndex absent
159 &apos; a Property object otherwise
160
161 Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String, sName As String
162 Const cstThisSub = &quot;Field.Properties&quot;
163 Utils._SetCalledSub(cstThisSub)
164 vPropertiesList = _PropertiesList()
165 sObject = Utils._PCase(_Type)
166 sName = _ParentType &amp; &quot;/&quot; &amp; _ParentName &amp; &quot;/&quot; &amp; _Name
167 If IsMissing(pvIndex) Then
168 vProperty = PropertiesGet._Properties(sObject, sName, vPropertiesList)
169 Else
170 vProperty = PropertiesGet._Properties(sObject, sName, vPropertiesList, pvIndex)
171 vProperty._Value = _PropertyGet(vPropertiesList(pvIndex))
172 End If
173 Set vProperty._ParentDatabase = _ParentDatabase
174
175 Exit_Function:
176 Set Properties = vProperty
177 Utils._ResetCalledSub(cstThisSub)
178 Exit Function
179 End Function &apos; Properties
180
181 REM -----------------------------------------------------------------------------------------------------------------------
182 Public Function ReadAllBytes(ByVal Optional pvFile As Variant) As Boolean
183 &apos; Read the whole content of a file into Long Binary Field object
184
185 Const cstThisSub = &quot;Field.ReadAllBytes&quot;
186 Utils._SetCalledSub(cstThisSub)
187 If Not Utils._CheckArgument(pvFile, 1, vbString) Then Goto Exit_Function
188 ReadAllBytes = _ReadAll(pvFile, &quot;ReadAllBytes&quot;)
189
190 Exit_Function:
191 Utils._ResetCalledSub(cstThisSub)
192 Exit Function
193 End Function &apos; ReadAllBytes
194
195 REM -----------------------------------------------------------------------------------------------------------------------
196 Public Function ReadAllText(ByVal Optional pvFile As Variant) As Boolean
197 &apos; Read the whole content of a file into a Long Char Field object
198
199 Const cstThisSub = &quot;Field.ReadAllText&quot;
200 Utils._SetCalledSub(cstThisSub)
201 If Not Utils._CheckArgument(pvFile, 1, vbString) Then Goto Exit_Function
202 ReadAllText = _ReadAll(pvFile, &quot;ReadAllText&quot;)
203
204 Exit_Function:
205 Utils._ResetCalledSub(cstThisSub)
206 Exit Function
207 End Function &apos; ReadAllText
208
209 REM -----------------------------------------------------------------------------------------------------------------------
210 Public Function setProperty(ByVal Optional psProperty As String, ByVal Optional pvValue As Variant) As Boolean
211 &apos; Return True if property setting OK
212 Const cstThisSub = &quot;Field.setProperty&quot;
213 Utils._SetCalledSub(cstThisSub)
214 setProperty = _PropertySet(psProperty, pvValue)
215 Utils._ResetCalledSub(cstThisSub)
216 End Function
217
218 REM -----------------------------------------------------------------------------------------------------------------------
219 Public Function WriteAllBytes(ByVal Optional pvFile As Variant) As Boolean
220 &apos; Write the whole content of a Long Binary Field object to a file
221
222 Const cstThisSub = &quot;Field.WriteAllBytes&quot;
223 Utils._SetCalledSub(cstThisSub)
224 If Not Utils._CheckArgument(pvFile, 1, vbString) Then Goto Exit_Function
225 WriteAllBytes = _WriteAll(pvFile, &quot;WriteAllBytes&quot;)
226
227 Exit_Function:
228 Utils._ResetCalledSub(cstThisSub)
229 Exit Function
230 End Function &apos; WriteAllBytes
231
232 REM -----------------------------------------------------------------------------------------------------------------------
233 Public Function WriteAllText(ByVal Optional pvFile As Variant) As Boolean
234 &apos; Write the whole content of a Long Char Field object to a file
235
236 Const cstThisSub = &quot;Field.WriteAllText&quot;
237 Utils._SetCalledSub(cstThisSub)
238 If Not Utils._CheckArgument(pvFile, 1, vbString) Then Goto Exit_Function
239 WriteAllText = _WriteAll(pvFile, &quot;WriteAllText&quot;)
240
241 Exit_Function:
242 Utils._ResetCalledSub(cstThisSub)
243 Exit Function
244 End Function &apos; WriteAllText
245
246 REM -----------------------------------------------------------------------------------------------------------------------
247 REM --- PRIVATE FUNCTIONS ---
248 REM -----------------------------------------------------------------------------------------------------------------------
249
250 REM -----------------------------------------------------------------------------------------------------------------------
251 Private Function _PropertiesList() As Variant
252
253 Select Case _ParentType
254 Case OBJTABLEDEF
255 _PropertiesList =Array(&quot;DataType&quot;, &quot;dbType&quot;, &quot;DefaultValue&quot; _
256 , &quot;Description&quot;, &quot;Name&quot;, &quot;ObjectType&quot;, &quot;Size&quot;, &quot;SourceField&quot;, &quot;SourceTable&quot; _
257 , &quot;TypeName&quot; _
258 )
259 Case OBJQUERYDEF
260 _PropertiesList = Array(&quot;DataType&quot;, &quot;dbType&quot;, &quot;DefaultValue&quot; _
261 , &quot;Description&quot;, &quot;Name&quot;, &quot;ObjectType&quot;, &quot;Size&quot;, &quot;SourceField&quot;, &quot;SourceTable&quot; _
262 , &quot;TypeName&quot; _
263 )
264 Case OBJRECORDSET
265 _PropertiesList = Array(&quot;DataType&quot;, &quot;DataUpdatable&quot;, &quot;dbType&quot;, &quot;DefaultValue&quot; _
266 , &quot;Description&quot; , &quot;FieldSize&quot;, &quot;Name&quot;, &quot;ObjectType&quot; _
267 , &quot;Size&quot;, &quot;SourceTable&quot;, &quot;TypeName&quot;, &quot;Value&quot; _
268 )
269 End Select
270
271 End Function &apos; _PropertiesList
272
273 REM -----------------------------------------------------------------------------------------------------------------------
274 Private Function _PropertyGet(ByVal psProperty As String) As Variant
275 &apos; Return property value of the psProperty property name
276
277 If _ErrorHandler() Then On Local Error Goto Error_Function
278 Dim cstThisSub As String
279 cstThisSub = &quot;Field.get&quot; &amp; psProperty
280 Utils._SetCalledSub(cstThisSub)
281
282 If Not hasProperty(psProperty) Then Goto Trace_Error
283
284 Dim vEMPTY As Variant, bCond1 As Boolean, bCond2 As Boolean, vValue As Variant, oValue As Object, sValue As String
285 Dim oSize As Object, lSize As Long, bNullable As Boolean, bNull As Boolean
286 Const cstMaxTextLength = 65535
287 _PropertyGet = vEMPTY
288
289 Select Case UCase(psProperty)
290 Case UCase(&quot;DataType&quot;)
291 _PropertyGet = Column.Type
292 Case UCase(&quot;DbType&quot;)
293 With com.sun.star.sdbc.DataType
294 Select Case Column.Type
295 Case .BIT : _PropertyGet = dbUndefined
296 Case .TINYINT : _PropertyGet = dbInteger
297 Case .SMALLINT : _PropertyGet = dbLong
298 Case .INTEGER : _PropertyGet = dbLong
299 Case .BIGINT : _PropertyGet = dbBigInt
300 Case .FLOAT : _PropertyGet = dbFloat
301 Case .REAL : _PropertyGet = dbSingle
302 Case .DOUBLE : _PropertyGet = dbDouble
303 Case .NUMERIC : _PropertyGet = dbNumeric
304 Case .DECIMAL : _PropertyGet = dbDecimal
305 Case .CHAR : _PropertyGet = dbText
306 Case .VARCHAR : _PropertyGet = dbChar
307 Case .LONGVARCHAR : _PropertyGet = dbMemo
308 Case .DATE : _PropertyGet = dbDate
309 Case .TIME : _PropertyGet = dbTime
310 Case .TIMESTAMP : _PropertyGet = dbTimeStamp
311 Case .BINARY : _PropertyGet = dbBinary
312 Case .VARBINARY : _PropertyGet = dbVarBinary
313 Case .LONGVARBINARY : _PropertyGet = dbLongBinary
314 Case .BOOLEAN : _PropertyGet = dbBoolean
315 Case Else : _PropertyGet = dbUndefined
316 End Select
317 End With
318 Case UCase(&quot;DataUpdatable&quot;)
319 If Utils._hasUNOProperty(Column, &quot;IsWritable&quot;) Then
320 _PropertyGet = Column.IsWritable
321 ElseIf Utils._hasUNOProperty(Column, &quot;IsReadOnly&quot;) Then
322 _PropertyGet = Not Column.IsReadOnly
323 ElseIf Utils._hasUNOProperty(Column, &quot;IsDefinitelyWritable&quot;) Then
324 _PropertyGet = Column.IsDefinitelyWritable
325 Else
326 _PropertyGet = False
327 End If
328 If Utils._hasUNOProperty(Column, &quot;IsAutoIncrement&quot;) Then
329 If Column.IsAutoIncrement Then _PropertyGet = False &apos; Forces False if auto-increment (MSAccess)
330 End If
331 Case UCase(&quot;DefaultValue&quot;)
332 If Utils._hasUNOProperty(Column, &quot;DefaultValue&quot;) Then &apos; Default value in database set via SQL statement
333 _PropertyGet = Column.DefaultValue
334 ElseIf Utils._hasUNOProperty(Column, &quot;ControlDefault&quot;) Then &apos; Default value set in Base via table edition
335 If IsEmpty(Column.ControlDefault) Then _PropertyGet = &quot;&quot; Else _PropertyGet = Column.ControlDefault
336 Else
337 _PropertyGet = &quot;&quot;
338 End If
339 Case UCase(&quot;Description&quot;)
340 bCond1 = Utils._hasUNOProperty(Column, &quot;Description&quot;)
341 bCond2 = Utils._hasUNOProperty(Column, &quot;HelpText&quot;)
342 Select Case True
343 Case ( bCond1 And bCond2 )
344 If IsEmpty(Column.HelpText) Then _PropertyGet = Column.Description Else _PropertyGet = Column.HelpText
345 Case ( bCond1 And ( Not bCond2 ) )
346 _PropertyGet = Column.Description
347 Case ( ( Not bCond1 ) And bCond2 )
348 _PropertyGet = Column.HelpText
349 Case Else
350 _PropertyGet = &quot;&quot;
351 End Select
352 Case UCase(&quot;FieldSize&quot;) &apos; Probably physical size = 2 * unicode string length
353 With com.sun.star.sdbc.DataType
354 Select Case Column.Type
355 Case .LONGVARCHAR
356 Set oSize = Column.getCharacterStream
357 Case .LONGVARBINARY, .VARBINARY, .BINARY
358 Set oSize = Column.getBinaryStream
359 Case Else
360 Set oSize = Nothing
361 End Select
362 End With
363 If Not IsNull(oSize) Then
364 bNullable = ( Column.IsNullable = com.sun.star.sdbc.ColumnValue.NULLABLE )
365 If bNullable Then
366 If Column.wasNull() Then _PropertyGet = 0 Else _PropertyGet = CLng(oSize.getLength())
367 Else
368 _PropertyGet = CLng(oSize.getLength())
369 End If
370 oSize.closeInput()
371 Else
372 _PropertyGet = vEMPTY
373 End If
374 Case UCase(&quot;Name&quot;)
375 _PropertyGet = _Name
376 Case UCase(&quot;ObjectType&quot;)
377 _PropertyGet = _Type
378 Case UCase(&quot;Size&quot;)
379 With com.sun.star.sdbc.DataType
380 Select Case Column.Type
381 Case .LONGVARCHAR, .LONGVARBINARY
382 _PropertyGet = 0 &apos; Always 0 (MSAccess)
383 Case Else
384 If Utils._hasUNOProperty(Column, &quot;Precision&quot;) Then _PropertyGet = Column.Precision Else _PropertyGet = 0
385 End Select
386 End With
387 Case UCase(&quot;SourceField&quot;)
388 Select Case _ParentType
389 Case OBJTABLEDEF
390 _PropertyGet = _Name
391 Case OBJQUERYDEF &apos; RealName = not documented ?!?
392 If Utils._hasUNOProperty(Column, &quot;RealName&quot;) Then _PropertyGet = Column.RealName Else _PropertyGet = _Name
393 End Select
394 Case UCase(&quot;SourceTable&quot;)
395 Select Case _ParentType
396 Case OBJTABLEDEF
397 _PropertyGet = _ParentName
398 Case OBJQUERYDEF, OBJRECORDSET
399 _PropertyGet = Column.TableName
400 End Select
401 Case UCase(&quot;TypeName&quot;)
402 _PropertyGet = Column.TypeName
403 Case UCase(&quot;Value&quot;)
404 bNullable = ( Column.IsNullable = com.sun.star.sdbc.ColumnValue.NULLABLE )
405 bNull = False
406 With com.sun.star.sdbc.DataType
407 Select Case Column.Type
408 Case .BIT, .BOOLEAN : vValue = Column.getBoolean() &apos; vbBoolean
409 Case .TINYINT : vValue = Column.getShort() &apos; vbInteger
410 Case .SMALLINT, .INTEGER: vValue = Column.getInt() &apos; vbLong
411 Case .BIGINT : vValue = Column.getLong() &apos; vbBigint
412 Case .FLOAT : vValue = Column.getFloat() &apos; vbSingle
413 Case .REAL, .DOUBLE : vValue = Column.getDouble() &apos; vbDouble
414 Case .NUMERIC, .DECIMAL
415 If Utils._hasUNOProperty(Column, &quot;Scale&quot;) Then
416 If Column.Scale &gt; 0 Then
417 vValue = Column.getDouble()
418 Else &apos; CLng checks local decimal point, getString does not !
419 sValue = Join(Split(Column.getString(), &quot;.&quot;), Utils._DecimalPoint())
420 vValue = CLng(sValue) &apos; CDec disappeared from LO ?!?
421 End If
422 Else
423 vValue = CDec(Column.getString())
424 End If
425 Case .CHAR : vValue = Column.getString()
426 Case .VARCHAR : vValue = Column.getString() &apos; vbString
427 Case .LONGVARCHAR
428 Set oValue = Column.getCharacterStream()
429 If bNullable Then bNull = Column.wasNull()
430 If Not bNull Then
431 lSize = CLng(oValue.getLength())
432 oValue.closeInput()
433 If lSize &gt; cstMaxTextLength Then Goto Trace_Length
434 vValue = Column.getString() &apos; vbString
435 Else
436 oValue.closeInput()
437 End If
438 Case .DATE : Set oValue = Column.getDate() &apos; vbObject with members VarType Unsigned Short = 18
439 If bNullable Then bNull = Column.wasNull()
440 If Not bNull Then vValue = DateSerial(CInt(oValue.Year), CInt(oValue.Month), CInt(oValue.Day))
441 Case .TIME : Set oValue = Column.getTime() &apos; vbObject with members VarType Unsigned Short = 18
442 If bNullable Then bNull = Column.wasNull()
443 If Not bNull Then vValue = TimeSerial(oValue.Hours, oValue.Minutes, oValue.Seconds)&apos;, oValue.HundredthSeconds)
444 Case .TIMESTAMP : Set oValue = Column.getTimeStamp()
445 If bNullable Then bNull = Column.wasNull()
446 If Not bNull Then vValue = DateSerial(CInt(oValue.Year), CInt(oValue.Month), CInt(oValue.Day)) _
447 + TimeSerial(oValue.Hours, oValue.Minutes, oValue.Seconds)&apos;, oValue.HundredthSeconds)
448 Case .BINARY, .VARBINARY, .LONGVARBINARY
449 Set oValue = Column.getBinaryStream()
450 If bNullable Then bNull = Column.wasNull()
451 If Not bNull Then vValue = CLng(oValue.getLength()) &apos; vbLong =&gt; equivalent to FieldSize
452 oValue.closeInput()
453 Case .BLOB : vValue = Column.getBlob() &apos; TBC HSQLDB 2.0 ?
454 Case .CLOB : vValue = Column.getClob()
455 &apos;getArray
456 &apos;getRef
457 Case Else
458 vValue = Column.getString() &apos;GIVE STRING A TRY
459 If IsNumeric(vValue) Then vValue = Val(vValue) &apos;Required when type = &quot;&quot;, sometimes numeric fields are returned as strings (query/MSAccess)
460 End Select
461 If bNullable Then
462 If Column.wasNull() Then vValue = Nothing &apos;getXXX must precede wasNull()
463 End If
464 End With
465 _PropertyGet = vValue
466 Case Else
467 Goto Trace_Error
468 End Select
469
470 Exit_Function:
471 Utils._ResetCalledSub(cstThisSub)
472 Exit Function
473 Trace_Error:
474 TraceError(TRACEWARNING, ERRPROPERTY, Utils._CalledSub(), 0, , psProperty)
475 _PropertyGet = vEMPTY
476 Goto Exit_Function
477 Trace_Length:
478 TraceError(TRACEFATAL, ERRMEMOLENGTH, Utils._CalledSub(), 0, , lSize)
479 _PropertyGet = vEMPTY
480 Goto Exit_Function
481 Error_Function:
482 TraceError(TRACEABORT, Err, cstThisSub, Erl)
483 _PropertyGet = vEMPTY
484 GoTo Exit_Function
485 End Function &apos; _PropertyGet V1.1.0
486
487 REM -----------------------------------------------------------------------------------------------------------------------
488 Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Variant) As Boolean
489 &apos; Return True if property setting OK
490
491 If _ErrorHandler() Then On Local Error Goto Error_Function
492 Dim cstThisSub As String
493 cstThisSub = &quot;Field.set&quot; &amp; psProperty
494 Utils._SetCalledSub(cstThisSub)
495 _PropertySet = True
496 Dim iArgNr As Integer, vTemp As Variant
497 Dim oParent As Object
498
499 Select Case UCase(_A2B_.CalledSub)
500 Case UCase(&quot;setProperty&quot;) : iArgNr = 3
501 Case UCase(&quot;Field.setProperty&quot;) : iArgNr = 2
502 Case UCase(cstThisSub) : iArgNr = 1
503 End Select
504
505 If Not hasProperty(psProperty) Then Goto Trace_Error
506
507 Select Case UCase(psProperty)
508 Case UCase(&quot;DefaultValue&quot;)
509 If _ParentType &lt;&gt; OBJTABLEDEF Then Goto Trace_Error
510 If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
511 If Utils._hasUNOProperty(Column, &quot;ControlDefault&quot;) Then &apos; Default value set in Base via table edition
512 Column.ControlDefault = pvValue
513 End If
514 Case UCase(&quot;Description&quot;)
515 If _ParentType &lt;&gt; OBJTABLEDEF Then Goto Trace_Error
516 If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
517 Column.HelpText = pvValue
518 Case UCase(&quot;Value&quot;)
519 If _ParentType &lt;&gt; OBJRECORDSET Then Goto Trace_Error &apos; Not on table- or querydefs ... !
520 If Not Column.IsWritable Then Goto Trace_Error_Updatable
521 If Column.IsReadOnly Then Goto Trace_Error_Updatable
522 If _ParentDatabase.Recordsets(_ParentName)._EditMode = dbEditNone Then Goto Trace_Error_Update
523 With com.sun.star.sdbc.DataType
524 If IsNull(pvValue) Then
525 If Column.IsNullable = com.sun.star.sdbc.ColumnValue.NULLABLE Then Column.updateNull() Else Goto Trace_Null
526 Else
527 Select Case Column.Type
528 Case .BIT, .BOOLEAN
529 If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value
530 Column.updateBoolean(pvValue)
531 Case .TINYINT
532 If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
533 If pvValue &lt; -128 Or pvValue &gt; +127 Then Goto Trace_Error_Value
534 Column.updateShort(CInt(pvValue))
535 Case .SMALLINT
536 If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
537 If pvValue &lt; -32768 Or pvValue &gt; 32767 Then Goto trace_Error_Value
538 Column.updateInt(CLng(pvValue))
539 Case .INTEGER
540 If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
541 If pvValue &lt; -2147483648 Or pvValue &gt; 2147483647 Then Goto trace_Error_Value
542 Column.updateInt(CLng(pvValue))
543 Case .BIGINT
544 If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
545 Column.updateLong(pvValue) &apos; No proper type conversion for HYPER data type
546 Case .FLOAT
547 If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
548 If Abs(pvValue) &lt; 3.402823E38 And Abs(pvValue) &gt; 1.401298E-45 Then Column.updateFloat(CSng(pvValue)) Else Goto trace_Error_Value
549 Case .REAL, .DOUBLE
550 If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
551 &apos;If Abs(pvValue) &lt; 1.79769313486232E308 And Abs(pvValue) &gt; 4.94065645841247E-307 Then Column.updateDouble(CDbl(pvValue)) Else Goto trace_Error_Value
552 Column.updateDouble(CDbl(pvValue))
553 Case .NUMERIC, .DECIMAL
554 If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
555 If Utils._hasUNOProperty(Column, &quot;Scale&quot;) Then
556 If Column.Scale &gt; 0 Then
557 &apos;If Abs(pvValue) &lt; 1.79769313486232E308 And Abs(pvValue) &gt; 4.94065645841247E-307 Then Column.updateDouble(CDbl(pvValue)) Else Goto trace_Error_Value
558 Column.updateDouble(CDbl(pvValue))
559 Else
560 Column.updateString(CStr(pvValue))
561 End If
562 Else
563 Column.updateString(CStr(pvValue))
564 End If
565 Case .CHAR, .VARCHAR, .LONGVARCHAR
566 If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
567 Column.updateString(pvValue) &apos; vbString
568 Case .DATE
569 If Not Utils._CheckArgument(pvValue, iArgNr, vbDate, , False) Then Goto Trace_Error_Value
570 vTemp = New com.sun.star.util.Date
571 With vTemp
572 .Day = Day(pvValue)
573 .Month = Month(pvValue)
574 .Year = Year(pvValue)
575 End With
576 Column.updateDate(vTemp)
577 Case .TIME
578 If Not Utils._CheckArgument(pvValue, iArgNr, vbDate, , False) Then Goto Trace_Error_Value
579 vTemp = New com.sun.star.util.Time
580 With vTemp
581 .Hours = Hour(pvValue)
582 .Minutes = Minute(pvValue)
583 .Seconds = Second(pvValue)
584 &apos;.HundredthSeconds = 0 &apos; replaced with Long nanoSeconds in LO 4.1 ??
585 End With
586 Column.updateTime(vTemp)
587 Case .TIMESTAMP
588 If Not Utils._CheckArgument(pvValue, iArgNr, vbDate, , False) Then Goto Trace_Error_Value
589 vTemp = New com.sun.star.util.DateTime
590 With vTemp
591 .Day = Day(pvValue)
592 .Month = Month(pvValue)
593 .Year = Year(pvValue)
594 .Hours = Hour(pvValue)
595 .Minutes = Minute(pvValue)
596 .Seconds = Second(pvValue)
597 &apos;.HundredthSeconds = 0
598 End With
599 Column.updateTimestamp(vTemp)
600 &apos; Case .BINARY, .VARBINARY, .LONGVARBINARY
601 &apos; Case .BLOB
602 &apos; Case .CLOB
603 Case Else
604 Goto trace_Error
605 End Select
606 End If
607 End With
608 Case Else
609 Goto Trace_Error
610 End Select
611
612 Exit_Function:
613 Utils._ResetCalledSub(cstThisSub)
614 Exit Function
615 Trace_Error:
616 TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, , psProperty)
617 _PropertySet = False
618 Goto Exit_Function
619 Trace_Error_Value:
620 TraceError(TRACEFATAL, ERRPROPERTYVALUE, Utils._CalledSub(), 0, 1, Array(pvValue, psProperty))
621 _PropertySet = False
622 Goto Exit_Function
623 Trace_Null:
624 TraceError(TRACEFATAL, ERRNOTNULLABLE, Utils._CalledSub(), 0, 1, _Name)
625 _PropertySet = False
626 Goto Exit_Function
627 Trace_Error_Update:
628 TraceError(TRACEFATAL, ERRUPDATESEQUENCE, Utils._CalledSub(), 0, 1)
629 _PropertySet = False
630 Goto Exit_Function
631 Trace_Error_Updatable:
632 TraceError(TRACEFATAL, ERRNOTUPDATABLE, Utils._CalledSub(), 0, 1)
633 _PropertySet = False
634 Goto Exit_Function
635 Error_Function:
636 TraceError(TRACEABORT, Err, cstThisSub, Erl)
637 _PropertySet = False
638 GoTo Exit_Function
639 End Function &apos; _PropertySet
640
641 REM -----------------------------------------------------------------------------------------------------------------------
642 Public Function _ReadAll(ByVal psFile As String, ByVal psMethod As String) As Boolean
643 &apos; Write the whole content of a file into a stream object
644
645 If _ErrorHandler() Then On Local Error Goto Error_Function
646 _ReadAll = False
647
648 If _ParentType &lt;&gt; OBJRECORDSET Then Goto Trace_Error &apos; Not on table- or querydefs ... !
649 If Not Column.IsWritable Then Goto Trace_Error_Updatable
650 If Column.IsReadOnly Then Goto Trace_Error_Updatable
651 If _ParentDatabase.Recordsets(_ParentName)._EditMode = dbEditNone Then Goto Trace_Error_Update
652
653 Dim sFile As String, oSimpleFileAccess As Object, sMethod As String, oStream As Object
654 Dim lFileLength As Long, sBuffer As String, sMemo As String, iFile As Integer
655 Const cstMaxLength = 64000
656 sFile = ConvertToURL(psFile)
657
658 oSimpleFileAccess = CreateUnoService(&quot;com.sun.star.ucb.SimpleFileAccess&quot;)
659 If Not oSimpleFileAccess.exists(sFile) Then Goto Trace_File
660
661 With com.sun.star.sdbc.DataType
662 Select Case Column.Type
663 Case .BINARY, .VARBINARY, .LONGVARBINARY
664 If psMethod &lt;&gt; &quot;ReadAllBytes&quot; Then Goto Trace_Error
665 Set oStream = oSimpleFileAccess.openFileRead(sFile)
666 lFileLength = oStream.getLength()
667 If lFileLength = 0 Then Goto Trace_File
668 Column.updateBinaryStream(oStream, lFileLength)
669 oStream.closeInput()
670 Case .LONGVARCHAR
671 If psMethod &lt;&gt; &quot;ReadAllText&quot; Then Goto Trace_Error
672 sMemo = &quot;&quot;
673 lFileLength = 0
674 iFile = FreeFile()
675 Open sFile For Input Access Read Shared As iFile
676 Do While Not Eof(iFile)
677 Line Input #iFile, sBuffer
678 lFileLength = lFileLength + Len(sBuffer) + 1
679 If lFileLength &gt; cstMaxLength Then Exit Do
680 sMemo = sMemo &amp; sBuffer &amp; Chr(10)
681 Loop
682 If lFileLength = 0 Or lFileLength &gt; cstMaxLength Then
683 Close #iFile
684 Goto Trace_File
685 End If
686 sMemo = Left(sMemo, lFileLength - 1)
687 Column.updateString(sMemo)
688 &apos;Column.updateCharacterStream(oStream, lFileLength) &apos; DOES NOT WORK ?!?
689 Case Else
690 Goto Trace_Error
691 End Select
692 End With
693
694 _ReadAll = True
695
696 Exit_Function:
697 Exit Function
698 Trace_Error:
699 TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, , psMethod)
700 Goto Exit_Function
701 Trace_File:
702 TraceError(TRACEFATAL, ERRFILEACCESS, Utils._CalledSub(), 0, , sFile)
703 If Not IsNull(oStream) Then oStream.closeInput()
704 Goto Exit_Function
705 Trace_Error_Update:
706 TraceError(TRACEFATAL, ERRUPDATESEQUENCE, Utils._CalledSub(), 0, 1)
707 If Not IsNull(oStream) Then oStream.closeInput()
708 Goto Exit_Function
709 Trace_Error_Updatable:
710 TraceError(TRACEFATAL, ERRNOTUPDATABLE, Utils._CalledSub(), 0, 1)
711 If Not IsNull(oStream) Then oStream.closeInput()
712 Goto Exit_Function
713 Error_Function:
714 TraceError(TRACEABORT, Err, _CalledSub, Erl)
715 GoTo Exit_Function
716 End Function &apos; ReadAll
717
718 REM -----------------------------------------------------------------------------------------------------------------------
719 Public Function _WriteAll(ByVal psFile As String, ByVal psMethod As String) As Boolean
720 &apos; Write the whole content of a stream object to a file
721
722 If _ErrorHandler() Then On Local Error Goto Error_Function
723 _WriteAll = False
724
725 Dim sFile As String, oSimpleFileAccess As Object, sMethod As String, oStream As Object
726 sFile = ConvertToURL(psFile)
727
728 oSimpleFileAccess = CreateUnoService(&quot;com.sun.star.ucb.SimpleFileAccess&quot;)
729 With com.sun.star.sdbc.DataType
730 Select Case Column.Type
731 Case .BINARY, .VARBINARY, .LONGVARBINARY
732 If psMethod &lt;&gt; &quot;WriteAllBytes&quot; Then Goto Trace_Error
733 Set oStream = Column.getBinaryStream()
734 Case .LONGVARCHAR
735 If psMethod &lt;&gt; &quot;WriteAllText&quot; Then Goto Trace_Error
736 Set oStream = Column.getCharacterStream()
737 Case Else
738 Goto Trace_Error
739 End Select
740 End With
741
742 If Column.IsNullable = com.sun.star.sdbc.ColumnValue.NULLABLE Then
743 If Column.wasNull() Then Goto Trace_Null
744 End If
745 If oStream.getLength() = 0 Then Goto Trace_Null
746 On Local Error Goto Trace_File
747 If oSimpleFileAccess.exists(sFile) Then oSimpleFileAccess.kill(sFile)
748 oSimpleFileAccess.writeFile(sFile, oStream)
749 On Local Error Goto Error_Function
750 oStream.closeInput()
751
752 _WriteAll = True
753
754 Exit_Function:
755 Exit Function
756 Trace_Error:
757 TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, , psMethod)
758 Goto Exit_Function
759 Trace_File:
760 TraceError(TRACEFATAL, ERRFILEACCESS, Utils._CalledSub(), 0, , sFile)
761 If Not IsNull(oStream) Then oStream.closeInput()
762 Goto Exit_Function
763 Trace_Null:
764 TraceError(TRACEFATAL, ERRFIELDNULL, _CalledSub, 0)
765 If Not IsNull(oStream) Then oStream.closeInput()
766 Goto Exit_Function
767 Error_Function:
768 TraceError(TRACEABORT, Err, _CalledSub, Erl)
769 GoTo Exit_Function
770 End Function &apos; WriteAll
771 </script:module>
FREE OFFICE SUITE