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