Quelle  Field.xba   Sprache: unbekannt

<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Field" script:language="StarBasic">
REM =======================================================================================================================
REM ===     The Access2Base library is a part of the LibreOffice project.         ===
REM ===     Full documentation is available on http://www.access2base.com         ===
REM =======================================================================================================================

Option Compatible
Option ClassModule

Option Explicit

REM -----------------------------------------------------------------------------------------------------------------------
REM --- CLASS ROOT FIELDS                               ---
REM -----------------------------------------------------------------------------------------------------------------------

Private _Type     As String    ' Must be FIELD
Private _This     As Object    ' Workaround for absence of This builtin function
Private _Parent     As Object
Private _Name     As String
Private _Precision    As Long
Private _ParentName    As String
Private _ParentType    As String
Private _ParentDatabase   As Object
Private _ParentRecordset  As Object
Private _DefaultValue   As String
Private _DefaultValueSet  As Boolean
Private Column     As Object    ' com.sun.star.sdb.OTableColumnWrapper
           '   or org.openoffice.comp.dbaccess.OQueryColumn
           '   or com.sun.star.sdb.ODataColumn

REM -----------------------------------------------------------------------------------------------------------------------
REM --- CONSTRUCTORS / DESTRUCTORS                            ---
REM -----------------------------------------------------------------------------------------------------------------------
Private Sub Class_Initialize()
 _Type = OBJFIELD
 Set _This = Nothing
 Set _Parent = Nothing
 _Name = ""
 _ParentName = ""
 _ParentType = ""
 _DefaultValue = ""
 _DefaultValueSet = False
 Set Column = Nothing
End Sub  ' Constructor

REM -----------------------------------------------------------------------------------------------------------------------
Private Sub Class_Terminate()
 On Local Error Resume Next
 Call Class_Initialize()
End Sub  ' Destructor

REM -----------------------------------------------------------------------------------------------------------------------
Public Sub Dispose()
 Call Class_Terminate()
End Sub  ' Explicit destructor

REM -----------------------------------------------------------------------------------------------------------------------
REM --- CLASS GET/LET/SET PROPERTIES                           ---
REM -----------------------------------------------------------------------------------------------------------------------

Property Get DataType() As Long  ' AOO/LibO type
 DataType = _PropertyGet("DataType")
End Property  ' DataType (get)

Property Get DataUpdatable() As Boolean
 DataUpdatable = _PropertyGet("DataUpdatable")
End Property  ' DataUpdatable (get)

REM -----------------------------------------------------------------------------------------------------------------------
Property Get DbType() As Long  ' MSAccess type
 DbType = _PropertyGet("DbType")
End Property  ' DbType (get)

REM -----------------------------------------------------------------------------------------------------------------------
Property Get DefaultValue() As Variant
 DefaultValue = _PropertyGet("DefaultValue")
End Property  ' DefaultValue (get)

Property Let DefaultValue(ByVal pvDefaultValue As Variant)
 Call _PropertySet("DefaultValue", pvDefaultValue)
End Property  ' DefaultValue (set)

REM -----------------------------------------------------------------------------------------------------------------------
Property Get Description() As Variant
 Description = _PropertyGet("Description")
End Property  ' Description (get)

Property Let Description(ByVal pvDescription As Variant)
 Call _PropertySet("Description", pvDescription)
End Property  ' Description (set)

REM -----------------------------------------------------------------------------------------------------------------------
Property Get FieldSize() As Long
 FieldSize = _PropertyGet("FieldSize")
End Property  ' FieldSize (get)

REM -----------------------------------------------------------------------------------------------------------------------
Property Get Name() As String
 Name = _PropertyGet("Name")
End Property  ' Name (get)

REM -----------------------------------------------------------------------------------------------------------------------
Property Get ObjectType() As String
 ObjectType = _PropertyGet("ObjectType")
End Property  ' ObjectType (get)

REM -----------------------------------------------------------------------------------------------------------------------
Property Get Size() As Long
 Size = _PropertyGet("Size")
End Property  ' Size (get)

REM -----------------------------------------------------------------------------------------------------------------------
Property Get SourceField() As String
 SourceField = _PropertyGet("SourceField")
End Property  ' SourceField (get)

REM -----------------------------------------------------------------------------------------------------------------------
Property Get SourceTable() As String
 SourceTable = _PropertyGet("SourceTable")
End Property  ' SourceTable (get)

REM -----------------------------------------------------------------------------------------------------------------------
Property Get TypeName() As String
 TypeName = _PropertyGet("TypeName")
End Property  ' TypeName (get)

REM -----------------------------------------------------------------------------------------------------------------------
Property Get Value() As Variant
 Value = _PropertyGet("Value")
End Property  ' Value (get)

Property Let Value(ByVal pvValue As Variant)
 Call _PropertySet("Value", pvValue)
End Property  ' Value (set)

REM -----------------------------------------------------------------------------------------------------------------------
REM --- CLASS METHODS                                ---
REM -----------------------------------------------------------------------------------------------------------------------

REM -----------------------------------------------------------------------------------------------------------------------
Public Function AppendChunk(ByRef Optional pvValue As Variant) As Boolean
' Store a chunk of string or binary characters into the current field, presumably a large object (CLOB or BLOB)

 If _ErrorHandler() Then On Local Error Goto Error_Function
Const cstThisSub = "Field.AppendChunk"
 Utils._SetCalledSub(cstThisSub)
 AppendChunk = False

 If IsMissing(pvValue) Then Call _TraceArguments()

 If _ParentType <> OBJRECORDSET Then Goto Trace_Error  ' Not on table- or querydefs ... !
 If Not Column.IsWritable Then Goto Trace_Error_Updatable
 If Column.IsReadOnly Then Goto Trace_Error_Updatable
 If _ParentDatabase.Recordsets(_ParentName)._EditMode = dbEditNone Then Goto Trace_Error_Update

Dim iChunkType As Integer

 With com.sun.star.sdbc.DataType
  Select Case Column.Type   ' DOES NOT WORK FOR CHARACTER TYPES
'   Case .CHAR, .VARCHAR, .LONGVARCHAR, .CLOB
'    iChunkType = vbString
   Case .BINARY, .VARBINARY, .LONGVARBINARY, .BLOB, .CHAR ' .CHAR added for Sqlite3
    iChunkType = vbByte
   Case Else
    Goto Trace_Error
  End Select
 End With
 
 AppendChunk = _ParentRecordset._AppendChunk(_Name, pvValue, iChunkType)

Exit_Function:
 Utils._ResetCalledSub(cstThisSub)
 Exit Function
Trace_Error_Update:
 TraceError(TRACEFATAL, ERRUPDATESEQUENCE, Utils._CalledSub(), 0, 1)
 _PropertySet = False
 Goto Exit_Function
Trace_Error_Updatable:
 TraceError(TRACEFATAL, ERRNOTUPDATABLE, Utils._CalledSub(), 0, 1)
 _PropertySet = False
 Goto Exit_Function
Trace_Error:
 TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, , cstThisSub)
 Goto Exit_Function
Error_Function:
 TraceError(TRACEABORT, Err, cstThisSub, Erl)
 _PropertySet = False
 GoTo Exit_Function
End Function  ' AppendChunk V1.5.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function GetChunk(ByVal Optional pvOffset As Variant, ByVal Optional pvBytes As Variant) As Variant
' Get a chunk of string or binary characters from the current field, presumably a large object (CLOB or BLOB)

 If _ErrorHandler() Then On Local Error Goto Error_Function
Const cstThisSub = "Field.GetChunk"
 Utils._SetCalledSub(cstThisSub)

Dim oValue As Object, bNullable As Boolean, bNull As Boolean, vValue() As Variant
Dim lLength As Long, lOffset As Long, lValue As Long

 If IsMissing(pvOffset) Or IsMissing(pvBytes) Then Call _TraceArguments()
 If Not Utils._CheckArgument(pvOffset, 1, _AddNumeric()) Then Goto Exit_Function
 If pvOffset < 0 Then
  TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, , Array(1, pvOffset))
  Goto Exit_Function
 End If
 If Not Utils._CheckArgument(pvBytes, 2, _AddNumeric()) Then Goto Exit_Function
 If pvBytes < 0 Then
  TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, , Array(2, pvBytes))
  Goto Exit_Function
 End If

 bNullable = ( Column.IsNullable = com.sun.star.sdbc.ColumnValue.NULLABLE )
 bNull = False
 GetChunk = Null
 vValue = Array()
 With com.sun.star.sdbc.DataType
  Select Case Column.Type   ' DOES NOT WORK FOR CHARACTER TYPES
'   Case .CHAR, .VARCHAR, .LONGVARCHAR
'    Set oValue = Column.getCharacterStream()
'   Case .CLOB
'    Set oValue = Column.getClob.getCharacterStream()
   Case .BINARY, .VARBINARY, .LONGVARBINARY
    Set oValue = Column.getBinaryStream()
   Case .BLOB
    Set oValue = Column.getBlob.getBinaryStream()
   Case Else
    Goto Trace_Error
  End Select
  If bNullable Then bNull = Column.wasNull()
  If Not bNull Then
   lOffset = CLng(pvOffset)
   If lOffset > 0 Then oValue.skipBytes(lOffset)
   lValue = oValue.readBytes(vValue, pvBytes)
  End If
  oValue.closeInput()
 End With
 GetChunk = vValue

Exit_Function:
 Utils._ResetCalledSub(cstThisSub)
 Exit Function
Trace_Error:
 TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, , cstThisSub)
 Goto Exit_Function
Trace_Argument:
 TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, , Array(iArg, pvIndex))
 Set vForms = Nothing
 Goto Exit_Function
Error_Function:
 TraceError(TRACEABORT, Err, cstThisSub, Erl)
 GoTo Exit_Function
End Function  ' GetChunk V1.5.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
' Return property value of psProperty property name

Const cstThisSub = "Field.getProperty"
 Utils._SetCalledSub(cstThisSub)
 If IsMissing(pvProperty) Then Call _TraceArguments()
 getProperty = _PropertyGet(pvProperty)
 Utils._ResetCalledSub(cstThisSub)
 
End Function  ' getProperty

REM -----------------------------------------------------------------------------------------------------------------------
Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
' Return True if object has a valid property called pvProperty (case-insensitive comparison !)

Const cstThisSub = "Field.hasProperty"
 Utils._SetCalledSub(cstThisSub)
 If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty)
 Utils._ResetCalledSub(cstThisSub)
 Exit Function
 
End Function ' hasProperty

REM -----------------------------------------------------------------------------------------------------------------------
Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
' Return
'  a Collection object if pvIndex absent
'  a Property object otherwise

Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String, sName As String
Const cstThisSub = "Field.Properties"
 Utils._SetCalledSub(cstThisSub)
 vPropertiesList = _PropertiesList()
 sObject = Utils._PCase(_Type)
 sName = _ParentType & "/" & _ParentName & "/" & _Name
 If IsMissing(pvIndex) Then
  vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList)
 Else
  vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList, pvIndex)
  vProperty._Value = _PropertyGet(vPropertiesList(pvIndex))
  Set vProperty._ParentDatabase = _ParentDatabase
 End If
 
Exit_Function:
 Set Properties = vProperty
 Utils._ResetCalledSub(cstThisSub)
 Exit Function
End Function ' Properties

REM -----------------------------------------------------------------------------------------------------------------------
Public Function ReadAllBytes(ByVal Optional pvFile As Variant) As Boolean
' Read the whole content of a file into Long Binary Field object

Const cstThisSub = "Field.ReadAllBytes"
 Utils._SetCalledSub(cstThisSub)
 If Not Utils._CheckArgument(pvFile, 1, vbString) Then Goto Exit_Function
 ReadAllBytes = _ReadAll(pvFile, "ReadAllBytes")

Exit_Function:
 Utils._ResetCalledSub(cstThisSub)
 Exit Function
End Function  ' ReadAllBytes

REM -----------------------------------------------------------------------------------------------------------------------
Public Function ReadAllText(ByVal Optional pvFile As Variant) As Boolean
' Read the whole content of a file into a Long Char Field object

Const cstThisSub = "Field.ReadAllText"
 Utils._SetCalledSub(cstThisSub)
 If Not Utils._CheckArgument(pvFile, 1, vbString) Then Goto Exit_Function
 ReadAllText = _ReadAll(pvFile, "ReadAllText")

Exit_Function:
 Utils._ResetCalledSub(cstThisSub)
 Exit Function
End Function  ' ReadAllText

REM -----------------------------------------------------------------------------------------------------------------------
Public Function setProperty(ByVal Optional psProperty As String, ByVal Optional pvValue As Variant) As Boolean
' Return True if property setting OK
Const cstThisSub = "Field.setProperty"
 Utils._SetCalledSub(cstThisSub)
 setProperty = _PropertySet(psProperty, pvValue)
 Utils._ResetCalledSub(cstThisSub)
End Function

REM -----------------------------------------------------------------------------------------------------------------------
Public Function WriteAllBytes(ByVal Optional pvFile As Variant) As Boolean
' Write the whole content of a Long Binary Field object to a file

Const cstThisSub = "Field.WriteAllBytes"
 Utils._SetCalledSub(cstThisSub)
 If Not Utils._CheckArgument(pvFile, 1, vbString) Then Goto Exit_Function
 WriteAllBytes = _WriteAll(pvFile, "WriteAllBytes")

Exit_Function:
 Utils._ResetCalledSub(cstThisSub)
 Exit Function
End Function  ' WriteAllBytes

REM -----------------------------------------------------------------------------------------------------------------------
Public Function WriteAllText(ByVal Optional pvFile As Variant) As Boolean
' Write the whole content of a Long Char Field object to a file

Const cstThisSub = "Field.WriteAllText"
 Utils._SetCalledSub(cstThisSub)
 If Not Utils._CheckArgument(pvFile, 1, vbString) Then Goto Exit_Function
 WriteAllText = _WriteAll(pvFile, "WriteAllText")

Exit_Function:
 Utils._ResetCalledSub(cstThisSub)
 Exit Function
End Function  ' WriteAllText

REM -----------------------------------------------------------------------------------------------------------------------
REM --- PRIVATE FUNCTIONS                               ---
REM -----------------------------------------------------------------------------------------------------------------------

REM -----------------------------------------------------------------------------------------------------------------------
Private Function _PropertiesList() As Variant

 Select Case _ParentType
  Case OBJTABLEDEF
   _PropertiesList =Array("DataType", "dbType", "DefaultValue" _
        , "Description", "Name", "ObjectType", "Size", "SourceField", "SourceTable" _
        , "TypeName" _
        )
  Case OBJQUERYDEF
   _PropertiesList = Array("DataType", "dbType", "DefaultValue" _
        , "Description", "Name", "ObjectType", "Size", "SourceField", "SourceTable" _
        , "TypeName" _
        )
  Case OBJRECORDSET
   _PropertiesList = Array("DataType", "DataUpdatable",  "dbType", "DefaultValue" _
        , "Description" , "FieldSize", "Name", "ObjectType" _
        , "Size", "SourceTable", "TypeName", "Value" _
        )
 End Select

End Function ' _PropertiesList

REM -----------------------------------------------------------------------------------------------------------------------
Private Function _PropertyGet(ByVal psProperty As String) As Variant
' Return property value of the psProperty property name

 If _ErrorHandler() Then On Local Error Goto Error_Function
Dim cstThisSub As String
 cstThisSub = "Field.get" & psProperty
 Utils._SetCalledSub(cstThisSub)

 If Not hasProperty(psProperty) Then Goto Trace_Error

Dim bCond1 As Boolean, bCond2 As Boolean, vValue As Variant, oValue As Object, sValue As String
Dim oSize As Object, lSize As Long, bNullable As Boolean, bNull As Boolean
Const cstMaxBinlength = 2 * 65535

 _PropertyGet = EMPTY
 
 Select Case UCase(psProperty)
  Case UCase("DataType")
   _PropertyGet = Column.Type
  Case UCase("DbType")
   With com.sun.star.sdbc.DataType
    Select Case Column.Type
     Case .BIT    : _PropertyGet = dbBoolean
     Case .TINYINT   : _PropertyGet = dbInteger
     Case .SMALLINT   : _PropertyGet = dbLong
     Case .INTEGER   : _PropertyGet = dbLong
     Case .BIGINT   : _PropertyGet = dbBigInt
     Case .FLOAT    : _PropertyGet = dbFloat
     Case .REAL    : _PropertyGet = dbSingle
     Case .DOUBLE   : _PropertyGet = dbDouble
     Case .NUMERIC   : _PropertyGet = dbNumeric
     Case .DECIMAL   : _PropertyGet = dbDecimal
     Case .CHAR    : _PropertyGet = dbChar
     Case .VARCHAR   : _PropertyGet = dbText
     Case .LONGVARCHAR  : _PropertyGet = dbMemo
     Case .CLOB    : _PropertyGet = dbMemo
     Case .DATE    : _PropertyGet = dbDate
     Case .TIME    : _PropertyGet = dbTime
     Case .TIMESTAMP   : _PropertyGet = dbTimeStamp
     Case .BINARY   : _PropertyGet = dbBinary
     Case .VARBINARY   : _PropertyGet = dbVarBinary
     Case .LONGVARBINARY  : _PropertyGet = dbLongBinary
     Case .BLOB    : _PropertyGet = dbLongBinary
     Case .BOOLEAN   : _PropertyGet = dbBoolean
     Case Else    : _PropertyGet = dbUndefined
    End Select
   End With
  Case UCase("DataUpdatable")
   If Utils._hasUNOProperty(Column, "IsWritable") Then
    _PropertyGet = Column.IsWritable
   ElseIf Utils._hasUNOProperty(Column, "IsReadOnly") Then
    _PropertyGet = Not Column.IsReadOnly
   ElseIf Utils._hasUNOProperty(Column, "IsDefinitelyWritable") Then
    _PropertyGet = Column.IsDefinitelyWritable
   Else
    _PropertyGet = False
   End If
   If Utils._hasUNOProperty(Column, "IsAutoIncrement") Then
    If Column.IsAutoIncrement Then _PropertyGet = False   ' Forces False if auto-increment (MSAccess)
   End If
  Case UCase("DefaultValue")
   ' default value buffered to avoid multiple calls
   If Not _DefaultValueSet Then
    If Utils._hasUNOProperty(Column, "DefaultValue") Then   ' Default value in database set via SQL statement
     _DefaultValue = Column.DefaultValue
    ElseIf Utils._hasUNOProperty(Column, "ControlDefault") Then  ' Default value set in Base via table edition
      If IsEmpty(Column.ControlDefault) Then _DefaultValue = "" Else _DefaultValue = Column.ControlDefault
    Else
      _DefaultValue = ""
    End If
    _DefaultValueSet = True
   End If
   _PropertyGet = _DefaultValue
  Case UCase("Description")
   bCond1 = Utils._hasUNOProperty(Column, "Description")
   bCond2 = Utils._hasUNOProperty(Column, "HelpText")
   Select Case True
    Case ( bCond1 And bCond2 )
     If IsEmpty(Column.HelpText) Then _PropertyGet = Column.Description Else _PropertyGet = Column.HelpText
    Case ( bCond1 And ( Not bCond2 ) )
     _PropertyGet = Column.Description
    Case ( ( Not bCond1 ) And bCond2 )
     _PropertyGet = Column.HelpText
    Case Else
     _PropertyGet = ""
   End Select
  Case UCase("FieldSize")
   With com.sun.star.sdbc.DataType
    Select Case Column.Type
     Case .VARCHAR, .LONGVARCHAR, .CLOB
      Set oSize = Column.getCharacterStream
     Case .LONGVARBINARY, .VARBINARY, .BINARY, .BLOB
      Set oSize = Column.getBinaryStream
     Case Else
      Set oSize = Nothing
    End Select
   End With
   If Not IsNull(oSize) Then
    bNullable = ( Column.IsNullable = com.sun.star.sdbc.ColumnValue.NULLABLE )
    If bNullable Then
     If Column.wasNull() Then _PropertyGet = 0 Else _PropertyGet = CLng(oSize.getLength())
    Else
     _PropertyGet = CLng(oSize.getLength())
    End If
    oSize.closeInput()
   Else
    _PropertyGet = EMPTY
   End If
  Case UCase("Name")
   _PropertyGet = _Name
  Case UCase("ObjectType")
   _PropertyGet = _Type
  Case UCase("Size")
   With com.sun.star.sdbc.DataType
    Select Case Column.Type
     Case .LONGVARCHAR, .LONGVARBINARY, .VARBINARY, .BINARY, .BLOB, .CLOB
      _PropertyGet = 0           ' Always 0 (MSAccess)
     Case Else
      If Utils._hasUNOProperty(Column, "Precision") Then _PropertyGet = Column.Precision Else _PropertyGet = 0
    End Select
   End With
  Case UCase("SourceField")
   Select Case _ParentType
    Case OBJTABLEDEF
     _PropertyGet = _Name
    Case OBJQUERYDEF    ' RealName = not documented ?!?
     If Utils._hasUNOProperty(Column, "RealName") Then _PropertyGet = Column.RealName Else _PropertyGet = _Name
   End Select
  Case UCase("SourceTable")
   Select Case _ParentType
    Case OBJTABLEDEF
     _PropertyGet = _ParentName
    Case OBJQUERYDEF, OBJRECORDSET
     _PropertyGet = Column.TableName
   End Select
  Case UCase("TypeName")
   _PropertyGet = Column.TypeName
  Case UCase("Value")
   bNullable = ( Column.IsNullable = com.sun.star.sdbc.ColumnValue.NULLABLE )
   bNull = False
   With com.sun.star.sdbc.DataType
    Select Case Column.Type
     Case .BIT, .BOOLEAN  : vValue = Column.getBoolean()   ' vbBoolean
     Case .TINYINT   : vValue = Column.getShort()    ' vbInteger   
     Case .SMALLINT, .INTEGER: vValue = Column.getInt()    ' vbLong
     Case .BIGINT   : vValue = Column.getLong()    ' vbBigint
     Case .FLOAT    : vValue = Column.getFloat()    ' vbSingle
     Case .REAL, .DOUBLE  : vValue = Column.getDouble()    ' vbDouble
     Case .NUMERIC, .DECIMAL
      If Utils._hasUNOProperty(Column, "Scale") Then
       If Column.Scale > 0 Then
        vValue = Column.getDouble()
       Else ' Try Long otherwise Double (CDec not implemented anymore in LO ?!?)
        On Local Error Resume Next ' Avoid overflow error
        ' CLng checks local decimal point, getString does not !
        sValue = Join(Split(Column.getString(), "."), Utils._DecimalPoint())
        vValue = CLng(sValue)
        If Err <> 0 Then
         vValue = CDbl(sValue)
         Err.Clear
         On Local Error Goto Error_Function
        End If
       End If
      Else
       vValue = CDbl(Column.getString())
      End If
     Case .CHAR    : vValue = Column.getString()
     Case .VARCHAR   : vValue = Column.getString()    ' vbString
     Case .LONGVARCHAR, .CLOB
      Set oValue = Column.getCharacterStream()
      If bNullable Then bNull = Column.wasNull()
      If Not bNull Then
       lSize = CLng(oValue.getLength())
       oValue.closeInput()
       vValue = Column.getString()         ' vbString
      Else
       oValue.closeInput()
      End If
     Case .DATE    : Set oValue = Column.getDate()   ' vbObject with members VarType Unsigned Short = 18
            If bNullable Then bNull = Column.wasNull()
            If Not bNull Then vValue = DateSerial(CInt(oValue.Year), CInt(oValue.Month), CInt(oValue.Day))
     Case .TIME    : Set oValue = Column.getTime()   ' vbObject with members VarType Unsigned Short = 18
            If bNullable Then bNull = Column.wasNull()
            If Not bNull Then vValue = TimeSerial(oValue.Hours, oValue.Minutes, oValue.Seconds)', oValue.HundredthSeconds)
     Case .TIMESTAMP   : Set oValue = Column.getTimeStamp()
            If bNullable Then bNull = Column.wasNull()
            If Not bNull Then vValue = DateSerial(CInt(oValue.Year), CInt(oValue.Month), CInt(oValue.Day)) _
               + TimeSerial(oValue.Hours, oValue.Minutes, oValue.Seconds)', oValue.HundredthSeconds)
     Case .BINARY, .VARBINARY, .LONGVARBINARY, .BLOB
      Set oValue = Column.getBinaryStream()
      If bNullable Then bNull = Column.wasNull()
      If Not bNull Then
       lSize = CLng(oValue.getLength())        ' vbLong => equivalent to FieldSize
       If lSize > cstMaxBinlength Then Goto Trace_Length
       vValue = Array()
       oValue.readBytes(vValue, lSize)
      End If
      oValue.closeInput()
     Case Else
      vValue = Column.getString()       'GIVE STRING A TRY
      If IsNumeric(vValue) Then vValue = Val(vValue)  'Required when type = "", sometimes numeric fields are returned as strings (query/MSAccess)
    End Select
    If bNullable Then
     If Column.wasNull() Then vValue = Null    'getXXX must precede wasNull()
    End If
   End With
   _PropertyGet = vValue
  Case Else
   Goto Trace_Error
 End Select
 
Exit_Function:
 Utils._ResetCalledSub(cstThisSub)
 Exit Function
Trace_Error:
 TraceError(TRACEWARNING, ERRPROPERTY, Utils._CalledSub(), 0, , psProperty)
 _PropertyGet = EMPTY
 Goto Exit_Function
Trace_Length:
 TraceError(TRACEFATAL, ERROVERFLOW, Utils._CalledSub(), 0, , Array(lSize, "GetChunk"))
 _PropertyGet = EMPTY
 Goto Exit_Function
Error_Function:
 TraceError(TRACEABORT, Err, cstThisSub, Erl)
 _PropertyGet = EMPTY
 GoTo Exit_Function
End Function  ' _PropertyGet V1.1.0

REM -----------------------------------------------------------------------------------------------------------------------
Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Variant) As Boolean
' Return True if property setting OK

 If _ErrorHandler() Then On Local Error Goto Error_Function
Dim cstThisSub As String
 cstThisSub = "Field.set" & psProperty
 Utils._SetCalledSub(cstThisSub)
 _PropertySet = True
Dim iArgNr As Integer, vTemp As Variant
Dim oParent As Object

 Select Case UCase(_A2B_.CalledSub)
  Case UCase("setProperty")   : iArgNr = 3
  Case UCase("Field.setProperty")  : iArgNr = 2
  Case UCase(cstThisSub)    : iArgNr = 1
 End Select
 
 If Not hasProperty(psProperty) Then Goto Trace_Error

 Select Case UCase(psProperty)
  Case UCase("DefaultValue")
   If _ParentType <> OBJTABLEDEF Then Goto Trace_Error
   If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
   If Utils._hasUNOProperty(Column, "ControlDefault") Then   ' Default value set in Base via table edition
     Column.ControlDefault = pvValue
     _DefaultValue = pvValue
     _DefaultValueSet = True
   End If
  Case UCase("Description")
   If _ParentType <> OBJTABLEDEF Then Goto Trace_Error
   If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
   Column.HelpText = pvValue
  Case UCase("Value")
   If _ParentType <> OBJRECORDSET Then Goto Trace_Error  ' Not on table- or querydefs ... !
   If Not Column.IsWritable Then Goto Trace_Error_Updatable
   If Column.IsReadOnly Then Goto Trace_Error_Updatable
   If _ParentDatabase.Recordsets(_ParentName)._EditMode = dbEditNone Then Goto Trace_Error_Update
   With com.sun.star.sdbc.DataType
    If IsNull(pvValue) Then
     If Column.IsNullable = com.sun.star.sdbc.ColumnValue.NULLABLE Then Column.updateNull() Else Goto Trace_Null
    Else
     Select Case Column.Type
      Case .BIT, .BOOLEAN
       If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value
       Column.updateBoolean(pvValue)
      Case .TINYINT
       If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
       If pvValue < -128 Or pvValue > +127 Then Goto Trace_Error_Value
       Column.updateShort(CInt(pvValue))
      Case .SMALLINT
       If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
       If pvValue < -32768 Or pvValue > 32767 Then Goto trace_Error_Value
       Column.updateInt(CLng(pvValue))
      Case .INTEGER
       If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
       If pvValue < -2147483648 Or pvValue > 2147483647 Then Goto trace_Error_Value
       Column.updateInt(CLng(pvValue))
      Case .BIGINT
       If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
       Column.updateLong(pvValue)  ' No proper type conversion for HYPER data type
      Case .FLOAT
       If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
       If Abs(pvValue) < 3.402823E38 And Abs(pvValue) > 1.401298E-45 Then Column.updateFloat(CSng(pvValue)) Else Goto trace_Error_Value
      Case .REAL, .DOUBLE
       If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
       'If Abs(pvValue) < 1.79769313486232E308 And Abs(pvValue) > 4.94065645841247E-307 Then Column.updateDouble(CDbl(pvValue)) Else Goto trace_Error_Value
       Column.updateDouble(CDbl(pvValue))
      Case .NUMERIC, .DECIMAL
       If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
       If Utils._hasUNOProperty(Column, "Scale") Then
        If Column.Scale > 0 Then
         'If Abs(pvValue) < 1.79769313486232E308 And Abs(pvValue) > 4.94065645841247E-307 Then Column.updateDouble(CDbl(pvValue)) Else Goto trace_Error_Value
         Column.updateDouble(CDbl(pvValue))
        Else
         Column.updateString(CStr(pvValue))
        End If
       Else
        Column.updateString(CStr(pvValue))
       End If
      Case .CHAR, .VARCHAR, .LONGVARCHAR, .CLOB
       If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
       If _Precision > 0 And Len(pvValue) > _Precision Then Goto Trace_Error_Length
       Column.updateString(pvValue)      ' vbString
      Case .DATE
       If Not Utils._CheckArgument(pvValue, iArgNr, vbDate, , False) Then Goto Trace_Error_Value
       vTemp = New com.sun.star.util.Date
       With vTemp
        .Day = Day(pvValue)
        .Month = Month(pvValue)
        .Year = Year(pvValue)
       End With
       Column.updateDate(vTemp)
      Case .TIME
       If Not Utils._CheckArgument(pvValue, iArgNr, vbDate, , False) Then Goto Trace_Error_Value
       vTemp = New com.sun.star.util.Time
       With vTemp
        .Hours = Hour(pvValue)
        .Minutes = Minute(pvValue)
        .Seconds = Second(pvValue)
        '.HundredthSeconds = 0  ' replaced with Long nanoSeconds in LO 4.1 ??
       End With
       Column.updateTime(vTemp)
      Case .TIMESTAMP
       If Not Utils._CheckArgument(pvValue, iArgNr, vbDate, , False) Then Goto Trace_Error_Value
       vTemp = New com.sun.star.util.DateTime
       With vTemp
        .Day = Day(pvValue)
        .Month = Month(pvValue)
        .Year = Year(pvValue)
        .Hours = Hour(pvValue)
        .Minutes = Minute(pvValue)
        .Seconds = Second(pvValue)
        '.HundredthSeconds = 0
       End With
       Column.updateTimestamp(vTemp)
      Case .BINARY, .VARBINARY, .LONGVARBINARY, .BLOB
       If Not IsArray(pvValue) Then Goto Trace_Error_Value
       If UBound(pvValue) < LBound(pvValue) Then Goto Trace_Error_Value
       If Not Utils._CheckArgument(pvValue(LBound(pvValue)), iArgNr, vbInteger, , False) Then Goto Trace_Error_Value
       Column.updateBytes(pvValue)
      Case Else
       Goto trace_Error
     End Select
    End If
   End With
  Case Else
   Goto Trace_Error
 End Select
 
Exit_Function:
 Utils._ResetCalledSub(cstThisSub)
 Exit Function
Trace_Error:
 TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, , psProperty)
 _PropertySet = False
 Goto Exit_Function
Trace_Error_Value:
 TraceError(TRACEFATAL, ERRPROPERTYVALUE, Utils._CalledSub(), 0, 1, Array(pvValue, psProperty))
 _PropertySet = False
 Goto Exit_Function
Trace_Null:
 TraceError(TRACEFATAL, ERRNOTNULLABLE, Utils._CalledSub(), 0, 1, _Name)
 _PropertySet = False
 Goto Exit_Function
Trace_Error_Update:
 TraceError(TRACEFATAL, ERRUPDATESEQUENCE, Utils._CalledSub(), 0, 1)
 _PropertySet = False
 Goto Exit_Function
Trace_Error_Updatable:
 TraceError(TRACEFATAL, ERRNOTUPDATABLE, Utils._CalledSub(), 0, 1)
 _PropertySet = False
 Goto Exit_Function
Trace_Error_Length:
 TraceError(TRACEFATAL, ERROVERFLOW, Utils._CalledSub(), 0, , Array(Len(pvValue), "AppendChunk"))
 _PropertySet = False
 Goto Exit_Function
Error_Function:
 TraceError(TRACEABORT, Err, cstThisSub, Erl)
 _PropertySet = False
 GoTo Exit_Function
End Function   ' _PropertySet

REM -----------------------------------------------------------------------------------------------------------------------
Public Function _ReadAll(ByVal psFile As String, ByVal psMethod As String) As Boolean
' Write the whole content of a file into a stream object

 If _ErrorHandler() Then On Local Error Goto Error_Function
 _ReadAll = False

 If _ParentType <> OBJRECORDSET Then Goto Trace_Error  ' Not on table- or querydefs ... !
 If Not Column.IsWritable Then Goto Trace_Error_Updatable
 If Column.IsReadOnly Then Goto Trace_Error_Updatable
 If _ParentDatabase.Recordsets(_ParentName)._EditMode = dbEditNone Then Goto Trace_Error_Update

Dim sFile As String, oSimpleFileAccess As Object, sMethod As String, oStream As Object
Dim lFileLength As Long, sBuffer As String, sMemo As String, iFile As Integer
Const cstMaxLength = 64000
 sFile = ConvertToURL(psFile)

 oSimpleFileAccess = CreateUnoService("com.sun.star.ucb.SimpleFileAccess")
 If Not oSimpleFileAccess.exists(sFile) Then Goto Trace_File

 With com.sun.star.sdbc.DataType
  Select Case Column.Type
   Case .BINARY, .VARBINARY, .LONGVARBINARY, .BLOB
    If psMethod <> "ReadAllBytes" Then Goto Trace_Error
    Set oStream = oSimpleFileAccess.openFileRead(sFile)
    lFileLength = oStream.getLength()
    If lFileLength = 0 Then Goto Trace_File
    Column.updateBinaryStream(oStream, lFileLength)
    oStream.closeInput()
   Case .VARCHAR, .LONGVARCHAR, .CLOB
    If psMethod <> "ReadAllText" Then Goto Trace_Error
    sMemo = ""
    lFileLength = 0
    iFile = FreeFile()
    Open sFile For Input Access Read Shared As iFile
    Do While Not Eof(iFile)
     Line Input #iFile, sBuffer
     lFileLength = lFileLength + Len(sBuffer) + 1
     If lFileLength > cstMaxLength Then Exit Do
     sMemo = sMemo & sBuffer & vbNewLine
    Loop
    If lFileLength = 0 Or lFileLength > cstMaxLength Then
     Close #iFile
     Goto Trace_File
    End If
    sMemo = Left(sMemo, lFileLength - 1)
    Column.updateString(sMemo)    
    'Column.updateCharacterStream(oStream, lFileLength)  ' DOES NOT WORK ?!?
   Case Else
    Goto Trace_Error
  End Select
 End With

 _ReadAll = True
 
Exit_Function:
 Exit Function
Trace_Error:
 TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, , psMethod)
 Goto Exit_Function
Trace_File:
 TraceError(TRACEFATAL, ERRFILEACCESS, Utils._CalledSub(), 0, , sFile)
 If Not IsNull(oStream) Then oStream.closeInput()
 Goto Exit_Function
Trace_Error_Update:
 TraceError(TRACEFATAL, ERRUPDATESEQUENCE, Utils._CalledSub(), 0, 1)
 If Not IsNull(oStream) Then oStream.closeInput()
 Goto Exit_Function
Trace_Error_Updatable:
 TraceError(TRACEFATAL, ERRNOTUPDATABLE, Utils._CalledSub(), 0, 1)
 If Not IsNull(oStream) Then oStream.closeInput()
 Goto Exit_Function
Error_Function:
 TraceError(TRACEABORT, Err, _CalledSub, Erl)
 GoTo Exit_Function
End Function  ' ReadAll

REM -----------------------------------------------------------------------------------------------------------------------
Public Function _WriteAll(ByVal psFile As String, ByVal psMethod As String) As Boolean
' Write the whole content of a stream object to a file

 If _ErrorHandler() Then On Local Error Goto Error_Function
 _WriteAll = False

Dim sFile As String, oSimpleFileAccess As Object, sMethod As String, oStream As Object
 sFile = ConvertToURL(psFile)

 oSimpleFileAccess = CreateUnoService("com.sun.star.ucb.SimpleFileAccess")
 With com.sun.star.sdbc.DataType
  Select Case Column.Type
   Case .BINARY, .VARBINARY, .LONGVARBINARY, .BLOB
    If psMethod <> "WriteAllBytes" Then Goto Trace_Error
    Set oStream = Column.getBinaryStream()
   Case .VARCHAR, .LONGVARCHAR, .CLOB
    If psMethod <> "WriteAllText" Then Goto Trace_Error
    Set oStream = Column.getCharacterStream()
   Case Else
    Goto Trace_Error
  End Select
 End With

 If Column.IsNullable = com.sun.star.sdbc.ColumnValue.NULLABLE Then
  If Column.wasNull() Then Goto Trace_Null
 End If
 If oStream.getLength() = 0 Then Goto Trace_Null
 On Local Error Goto Trace_File
 If oSimpleFileAccess.exists(sFile) Then oSimpleFileAccess.kill(sFile)
 oSimpleFileAccess.writeFile(sFile, oStream)
 On Local Error Goto Error_Function
 oStream.closeInput()

 _WriteAll = True
 
Exit_Function:
 Exit Function
Trace_Error:
 TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, , psMethod)
 Goto Exit_Function
Trace_File:
 TraceError(TRACEFATAL, ERRFILEACCESS, Utils._CalledSub(), 0, , sFile)
 If Not IsNull(oStream) Then oStream.closeInput()
 Goto Exit_Function
Trace_Null:
 TraceError(TRACEFATAL, ERRFIELDNULL, _CalledSub, 0)
 If Not IsNull(oStream) Then oStream.closeInput()
 Goto Exit_Function
Error_Function:
 TraceError(TRACEABORT, Err, _CalledSub, Erl)
 GoTo Exit_Function
End Function  ' WriteAll

</script:module>