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