[Base][VBScript] Defaults read columns properties

[Bernard Mouille]

Hello,

I have some defaults to read table columns properties :
Precision returns max Precision for char types.
DefaultValue create error.
Description create error.

Is somebody has a way to good working ?
Thanks,
Bernard.

Code: Select all

' 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

[Villeroy]

Depending on the connected database and its driver, plain old SQL should work.

[Bernard Mouille]

Thanks for your answer.
The database is a Libre Office database.
Do you know where I can find a documentation for the drivers for this database ?
Thanks,
Bernard.

[Villeroy]

There is no such thing as a "LibreOffice database". Base is only a frontend to some connected database. You can read the connected database from the status bar of your document. In case of a "LibreOffice database" it might be "embedded HSQL" (version 1.8 of 2005). This database is zipped into the office doc and it is installed to a temp. directory when you access it and it is wrapped back into the zip when you close the edit session (form or grid view). This type of embedded database will never be production ready. It is good enough for your private media collection or todo lists but nothing which you should waste too much programming effort on. Sooner or later the whole archive will be corrupted because the database is not ready when you close the laptop lid or when the office crashes.
The embedded database is documented here: http://www.hsqldb.org/doc/1.8/guide/ch09.html and you can ignore the part about groups, privileges and schemas which do not apply to the embedded database.

The SQL dialect conforms to the SQL standard and creating a table with types and defaults is very easy. All names and aliases should be in double-quotes unless they are all upper case without any keyword conflicts.
It is also very easy to convert an embedded HSQLDB into a stand-alone HSQLDB 2.4 which is just a fine little database engine like many others. Version 2.4 is the last version able to convert 1.8 on the fly.

[Bernard Mouille]

Thank you for your explanations.
I understand better now how the Libre Office database works.
Cordially,
Bernard.

[Villeroy]

Code: Select all

   Set oCon              = oDb.getConnection("", "")
s = "CREATE TABLE ""Dummy"" (""Name"" VARCHAR_IGNORECASE(20) DEFAULT 'foo' NOT NULL, TS TIMESTAMP DEFAULT CURRENT_TIMESTAMP, ""ID"" INT IDENTITY)"
oStmt = oCon.prepareStatement(s)
oStmt.execute()

The new table will be visible after clicking menu:View>Refresh Tables (re-read database definitions)

[Bernard Mouille]

Thank you for your code.
I test this.
The 3 defaults arent not solved.
Cordially,
Bernard.