' Test.vbs

' [Defaults] in the read table columns properties :
   ' [Default1] Precision returns max Precision for char types.
   ' [Default2] DefaultValue create error.
   ' [Default3] Description create error.

' What is wrong in my code ?

' Libre Office 7.3.0.3 (x64) Windows

option explicit

Dim cDbFile
Dim cTable
Dim cDbUrl
Dim oServiceManager
Dim oDesktop
Dim oContext
Dim oDb
Dim oCon
Dim oTableDescriptor
Dim oCols
Dim oDoc
Dim oStatement
Dim oTables
Dim sSql
Dim oResult
Dim nRecords
Dim cMessage
Dim i
Dim oCol
Dim nError
Dim cVersion
Dim oProvider
Dim args1( 0 )
Dim oVersion

cDbFile = bv_FileToFullName( "_Result_Test28.odb" )
cTable  = "TEST"
cDbUrl  = bv_FileToUrl( cDbFile )

Set oServiceManager = CreateObject( "com.sun.star.ServiceManager" )

On Error Resume Next
   oProvider = oServiceManager.CreateInstance( "com.sun.star.configuration.ConfigurationProvider" )
   nError    = Err.Number
On Error GoTo 0

If nError = 0 Then
   Set args1( 0 )   = oServiceManager.Bridge_GetStruct( "com.sun.star.beans.PropertyValue" )
   args1( 0 ).Name  = "nodepath"
   args1( 0 ).Value = "/org.openoffice.Setup/Product"
   oVersion         = oProvider.createInstanceWithArguments( "com.sun.star.configuration.ConfigurationAccess", args1 )
   cVersion = oVersion.ooName
Else
   cVersion = "Open Office"
End If

If cVersion <> "LibreOffice" Then
   msgbox "This script works only in Libre Office", 0, "Test.vbs"
   Set oServiceManager = Nothing
   wscript.quit
End If

Set oDesktop = oServiceManager.createInstance( "com.sun.star.frame.Desktop"  )

If lo_ShowAllFrames( oDesktop ) > 0 Then msgbox "Close all your Libre Office Work(s)", 0, "Test.vbs"

If Not CreateObject( "Scripting.FileSystemObject" ).FileExists( cDbFile ) Then
   msgbox "Create the database and the table", 0, "Test.vbs"
   Set oContext = oServiceManager.createInstance( "com.sun.star.sdb.DatabaseContext" )
   Set oDb      = oContext.createInstance()
   oDb.URL      = "sdbc:embedded:hsqldb"
   oDb.DatabaseDocument.storeAsURL cDbUrl, Array()

   Set oCon              = oDb.getConnection("", "")
   Set oTables           = oCon.getTables()
   Set oTableDescriptor  = oTables.createDataDescriptor()
   oTableDescriptor.Name = cTable
   Set oCols             = oTableDescriptor.getColumns()

   Set oCol = oCols.createDataDescriptor()
   oCol.Name            = "ID"
   oCol.Type            = 4    ' INTEGER
   oCol.IsNullable      = 0    ' NO_NULLS
   oCol.IsAutoIncrement = True
   oCol.Precision       = 10
   oCol.Description     = "Primary Key"
   oCols.appendByDescriptor( oCol )

   Set oCol = oCols.createDataDescriptor()
   oCol.Name            = "NAME"
   oCol.Type            = 12    'VARCHAR
   oCol.Description     = "Name of person"
   oCol.Precision       = 24
   oCol.IsAutoIncrement = False
   oCols.appendByDescriptor( oCol )

   oTables.appendByDescriptor( oTableDescriptor )

   Set oStatement = oCon.createStatement()
   sSql           = "INSERT INTO " + cTable + " VALUES ( NULL, 'Bernard' )"
   Set oResult    = oStatement.executeQuery( sSql )

   oDb.DatabaseDocument.store()
   oCon.close()

   Set oDb = Nothing
End If

Set oDoc        = oDesktop.loadComponentFromURL( cDbUrl, "_blank", 0, Array() )
Set oDb         = oDoc.Datasource
Set oCon        = oDb.getConnection( "","" )
Set oStatement  = oCon.createStatement()
Set oTables     = oCon.getTables()

sSql        = "SELECT COUNT(*) FROM " + cTable
Set oResult = oStatement.executeQuery( sSql )
oResult.next()
nRecords = oResult.getLong( 1 )

sSql        = "SELECT * FROM " + cTable
Set oResult = oStatement.executeQuery( sSql )
Set oCols = oResult.Columns

cMessage = ""
cMessage = cMessage & "Fields : "  & oCols.Count & chr(10 )
cMessage = cMessage & "Records : " & nRecords & chr(10 )
msgbox cMessage, 0, "Table " & cTable

For i = 0 to oCols.Count - 1
   cMessage = ""
   oCol = oCols.getByIndex( i )
   cMessage = cMessage & "Name : "            & oCol.Name            & chr( 10 )
   cMessage = cMessage & "TypeName : "        & oCol.TypeName        & chr( 10 )

   '[Default1] Precision returns max Precision for char types.
   cMessage = cMessage & "Precision : "       & oCol.Precision       & chr( 10 )
   '[/Default1]

   cMessage = cMessage & "Scale : "           & oCol.Scale           & chr( 10 )
   cMessage = cMessage & "IsNullable : "      & oCol.IsNullable      & chr( 10 )
   cMessage = cMessage & "IsAutoIncrement : " & oCol.IsAutoIncrement & chr( 10 )
   cMessage = cMessage & "Type : "            & oCol.Type            & chr( 10 )
   cMessage = cMessage & "IsCurrency : "      & oCol.IsCurrency      & chr( 10 )
   cMessage = cMessage & "IsRowVersion : "    & oCol.IsRowVersion    & chr( 10 )

   '[Default2] DefaultValue create error.
   cMessage = cMessage & "DefaultValue : "
   On Error Resume Next
      cMessage = cMessage & oCol.DefaultValue
      If err.number <> 0 Then cMessage = cMessage & "*** Error ***"
   On Error goto 0
   cMessage = cMessage & chr( 10 )
   '[/Default2]

   '[Default3] Description create error.
   cMessage = cMessage & "Description : "
   On Error Resume Next
      cMessage = cMessage & oCol.Description
      If err.number <> 0 Then cMessage = cMessage & "*** Error ***"
   On Error goto 0
   '[/Default3]

   msgbox cMessage, 0, "Record N° " & i
Next

oCon.close()
oDoc.close( True )
oDesktop.Terminate()
Set oServiceManager = Nothing

msgbox "End of script", 0, "Test.vbs"

Function lo_ShowAllFrames( oDesktop )
   Dim oFrames
   Dim nFrames
   Dim oFrame
   Set oFrames = oDesktop.Frames
   nFrames = oFrames.getCount()
   If nFrames > 0 Then
      for i = 0 to nFrames - 1
         Set oFrame = oFrames.getByIndex( i )
         If oFrame.IsHidden Then
            oFrame.ContainerWindow.Visible = True
         End If 
      Next
   End If 
   lo_ShowAllFrames = nFrames
End Function

Function bv_FileToFullName( cFile )
   Dim cFullName
   cFullName = cFile
   If InStr( cFullName, "\" ) = 0 Then
      cFullName = Left( WScript.ScriptFullName, InStrRev( WScript.ScriptFullName, "\" ) ) & cFullName
   ElseIf Left( cFullName, 1 ) = "\" Then
      cFullName = Left( WScript.ScriptFullName, 2 ) & cFullName
   End If
   bv_FileToFullName = cFullName
End Function

Function bv_FileToUrl( cFile )
   Dim cUrl
   cUrl = cFile
   If InStr( cUrl, "/" ) = 0 Then
      If InStr( cUrl, "\" ) = 0 Then
         cUrl = Left( WScript.ScriptFullName, InStrRev( WScript.ScriptFullName, "\" ) ) & cUrl
      ElseIf Left( cUrl, 1 ) = "\" Then
         cUrl = Left( WScript.ScriptFullName, 2 ) & cUrl
      End If
      cUrl = Replace( cUrl, "\", "/" )
      cUrl = Replace( cUrl, ":", "|" )
      cUrl = Replace( cUrl, " ", "%20" )
      cUrl = "file:///" & cUrl
   End If
   bv_FileToUrl = cUrl
End Function