BASIC+Firebird: How to list non-registered .odb's?

[lonk]

This code lists only registered .odb’s.

Sub List_database
'	This procedure lists only registered .odb's.
	Dim dbContext 	As Object : dbContext = createUNOService("com.sun.star.sdb.DatabaseContext")
	Dim dbNames
	Dim i 			As Integer
	Dim dbList 		As String : dbList = "Database found:" & Chr(10) & Chr(10)
	dbNames = dbContext.getElementNames()
	For i = 0 To Ubound(dbNames())
		dbList = dbList + dbNames(i) + Chr(10)
	Next
	MsgBox dbList
End Sub

Are there any ways to modify this code to list non-registered .odb’s in a specific directory ?

[Ratslinger]

Hello,

What is the meaning of;

without using ordinary loops?

From what I recall, will need to get the URL of each .odb in the directory and loop through the registered ones to see if it is there. Report if not.

[lonk]

Dear @Ratslinger,

Sorry for deleting without using ordinary loops from the question.

I found that this following code is slower than in the question.

The code in the question is faster but it works with only registered ones, I also need to list non-registered ones as well.

Sub CheckExistingFirebirdDatabase
	Dim sFileName$, sPath$, t$
'	Directories within this path will not be listed.
	sPath		=	Environ("HOME") & "/" & "Documents" & GetPathSeparator()
	sFileName 	= 	Dir(sPath, 0)
	Do While sFileName <> ""
		If Right(sFileName,4) = ".odb" Then : t = t & sFileName & Chr(10) : End If
   		sFileName	= Dir()
	Loop
	MsgBox t,,sPath
End Sub

[Ratslinger]

Hello @lonk,

Your macro in the question does indeed list the name of registered Base files. It does not mean these are valid. The only way to tell if a registered item is valid is to check the URL against the URL of the Base file. The code you have in the question can get at a URL if it is a valid Base file. If not an error is thrown. So a different method to access these URL’s is needed. This is done with the ConfigurationProvider (or you may know this as the Expert Configuration in Options).

In addition, it is necessary to get the valid Base files from the directory. This is the macro in your comment. Not certain why you mention slow as the entire process is extremely quick.

The process needs to compare all Base files in the selected directory against all URLs registered. Using an array for the Base files, it contains the Base file name and its’ URL. If found in the list, the URL is wiped out. When finished, all items with a URL left are not registered & that is the list provided.

Macro:

Option Explicit

Sub CheckExistingFirebirdDatabase
    Dim sFileName$, sPath$, t$
    Dim x As Integer, y As Integer, z As Integer
    sPath       =   Environ("HOME") & "/" & "Documents" & GetPathSeparator()
    sFileName   =   Dir(sPath, 0)
Rem Build Array of Base files in directory
Rem Array has File name and a URL for comparison
    Dim aFileArray(0,1) As String
    Do While sFileName <> ""
        If Right(sFileName,4) = ".odb" Then
            ReDim Preserve aFileArray(x,1)
            aFileArray(x,0) =sFileName
            aFileArray(x,1) ="file://" & sPath & sFileName
            x=x+1
        End If
        sFileName   = Dir()
    Loop
Rem Get access to Registered databases
    Dim aProps(0) As New com.sun.star.beans.PropertyValue
    aProps(0).Name  = "nodepath"
    aProps(0).Value = "/org.openoffice.Office.DataAccess/RegisteredNames/"
    Dim oConfig As Object, oHistory As Object, oElementNames As Object
    oConfig  = createUnoService( "com.sun.star.configuration.ConfigurationProvider" )
    oHistory = oConfig.createInstanceWithArguments( "com.sun.star.configuration.ConfigurationAccess", aProps() )
Rem Element Names are needed to get access to the names needed
    oElementNames = oHistory.getElementNames()
    Dim sCkURL As String, sRegItems As String, iCount As Integer
    iCount = UBound(oElementNames)
    Dim aRegItems(iCount)
Rem Loop through Base files
	for z = 0 to x-1
        sCkURL = aFileArray(z,1)
Rem Loop through Registered files
        For y = 0 to iCount
            sRegItems = oHistory.getByName(oElementNames(y)).Location
Rem Clear Base file array URL if there is a match - already registered
		    If sRegItems = sCkURL Then aFileArray(z,1) = "" : Exit For
        Next
    Next
Rem Create a list of File array items where URL is NOT empty
	for z = 0 to x-1
	    if aFileArray(z,1) <> "" Then t = t & aFileArray(z,0) & Chr(10)
    Next
Rem Display list
    MsgBox t,,sPath
End Sub

[Ratslinger]

This tested OK in Ubuntu 20.4 & Windows 10 (modify sPath)

[lonk]

Dear @Ratslinger,

Perfect and not to mention so fast.

Thank you so much.

[Ratslinger]

@lonk,

Looked at the code again and realized I never initialized the variable x. The code works as it is set as an Integer but a variable should always be initialized to be safe. Add this line:

x=0

before this line:

Dim aFileArray(0,1) As String