path: root/wizards/source/formwizard/DBMeta.xba

<?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="DBMeta" script:language="StarBasic">REM  *****  BASIC  *****
Option Explicit

Public sDatabaseList()
Public iCommandTypes() as Integer
Public CurCommandType as Integer

Sub GetDatabaseNames()
	If oDBContext.HasElements Then
		sDatabaseList() = oDBContext.ElementNames()
	End If
End Sub


Sub GetSelectedDBMetaData()
Dim NullList()
Dim OldsDBname as String
Dim bGetMetaData as Boolean
Dim DBIndex as Integer
	If Ubound(oDialogModel.lstDatabases.SelectedItems()) &gt; -1 Then
		ToggleDatabasePage(False)
		DBIndex = oDialogModel.lstDatabases.SelectedItems(0)
		sDBName = sDatabaseList(DBIndex)
		If GetConnection(sDBName) Then
			bGetMetaData = GetDBMetaData()
		End If
		If bGetMetaData Then
			With oDialogModel
				.lstTables.Enabled = True
				.lblTables.Enabled = True
				.lstTables.StringItemList() = AddListToList(TableNames(), QueryNames())
				iCommandTypes() = CreateCommandTypeList()
				.lstFields.StringItemList() = NullList()
				.lstSelFields.StringItemList() = NullList()
			End With
		End If
		ToggleDatabasePage(True)
	End If
End Sub


Function GetConnection(sDBName as String)
Dim oDatabase as Object
Dim oInteractionHandler as Object
Dim oDataSource as Object
Dim bExitLoop as Boolean
Dim bGetConnection as Boolean
Dim iMsg as Integer
Dim Nulllist()
	If Not IsNull(oDBConnection) Then
		oDBConnection.Dispose()
	End If
	oDatabase = oDBContext.GetByName(sDBName)
	If Not oDatabase.IsPasswordRequired Then
		oDBConnection = oDBContext.GetByName(sDBName).GetConnection(&quot;&quot;,&quot;&quot;)
		GetConnection() = True
	Else
		oInteractionHandler = createUnoService(&quot;com.sun.star.sdb.InteractionHandler&quot;)
		oDataSource = oDBContext.GetByName(sDBName)
		On Local Error Goto NOCONNECTION
		Do
			bExitLoop = True
			oDBConnection = oDataSource.ConnectWithCompletion(oInteractionHandler)
			NOCONNECTION:
			bGetConnection = Err = 0
			If bGetConnection Then
				bGetConnection = Not IsNull(oDBConnection)
				If Not bGetConnection Then
					Exit Do
				End If
			End If
			If Not bGetConnection Then
				iMsg = Msgbox (sMsgNoConnection,32 + 2, sMsgWizardName)	&apos; &apos;?&apos; &amp; &apos; Repeat and Cancel&apos;
				bExitLoop = iMsg = SBCANCEL
				Resume CLERROR
				CLERROR:
			End If
		Loop Until bExitLoop
		On Local Error Goto 0
		If Not bGetConnection Then
			oDialogModel.lstDatabases.SelectedItems() = Nulllist()
			oDialogModel.lstTables.StringItemList() = NullList()
			oDialogModel.lstFields.StringItemList() = NullList()
			oDialogModel.lstSelFields.StringItemList() = NullList()
		End If
		GetConnection() = bGetConnection
	End If
End Function


Function GetDBMetaData()
	If oDBContext.HasElements Then
		Tablenames() = oDBConnection.Tables.ElementNames()
		Querynames() = oDBConnection.Queries.ElementNames()
		GetDBMetaData = True
	Else
		MsgBox(sMsgErrNoDatabase, 64, sMsgWizardName)
		GetDBMetaData = False
	End If
End Function


Sub GetTableMetaData()
Dim iType as Long
Dim m as Integer
Dim Found as Boolean
Dim i as Integer
Dim sFieldName as String
Dim n as Integer
Dim WidthIndex as Integer
	MaxIndex = Ubound(oDialogModel.lstSelFields.StringItemList())
	Dim ColumnMap(MaxIndex)as Integer	
	FieldNames() = oDialogModel.lstSelFields.StringItemList()

	&apos; Build a structure which maps the position of a selected field (within the selection) to the the column position within
	&apos; the table. So we ensure that the controls are placed in the same order the according fields are selected.
	For i = 0 To Ubound(FieldNames())
		sFieldName = FieldNames(i)
		Found = False
		n = 0
		While (n&lt; MaxIndex And (Not Found))
			If (FieldNames(n) = sFieldName) Then
				Found = True
				ColumnMap(n) = i
			End If
			n = n + 1
		Wend
	Next i

	For n = 0 to MaxIndex
		sFieldname = FieldNames(n)
		iType = oColumns.GetByName(sFieldName).Type
		FieldMetaValues(n,0) = iType
		FieldMetaValues(n,1) = GetValueoutofList(iType, WidthList(),1, WidthIndex)		
		FieldMetaValues(n,2) = WidthList(WidthIndex,2)
		FieldMetaValues(n,3) = WidthList(WidthIndex,4)
	Next
	ReDim oDBShapeList(MaxIndex) as Object
	ReDim oTCShapeList(MaxIndex) as Object
End Sub


Sub GetSpecificFieldNames()
Dim n as Integer
Dim m as Integer
Dim iType as Integer
Dim oField as Object
Dim MaxIndex as Integer
Dim EmptyList()
	If Ubound(oDialogModel.lstTables.StringItemList()) &gt; -1 Then
		FieldNames() = oColumns.GetElementNames()
		MaxIndex = Ubound(FieldNames())
		Dim ResultFieldNames(MaxIndex)
		m = 0
		For n = 0 To MaxIndex
			oField = oColumns.GetByName(FieldNames(n))
			iType = oField.Type
			If GetIndexInMultiArray(WidthList(), iType, 0) &lt;&gt; -1 Then
				ResultFieldNames(m) = FieldNames(n)
				m = m + 1
			End If
		Next n
		Redim Preserve ResultFieldNames(m-1)
		Redim Preserve FieldNames(m-1)
		FieldNames() = ResultFieldNames()
		oDialogModel.lstFields.StringItemList = FieldNames()
		InitializeListboxProcedures(oDialogModel, oDialogModel.lstFields, oDialogModel.lstSelFields)
	End If
End Sub


Sub CreateDBForm()
	If oDrawPage.Forms.Count = 0 Then
	  	oDBForm = oDocument.CreateInstance(&quot;com.sun.star.form.component.Form&quot;)
		oDrawpage.Forms.InsertByIndex (0, oDBForm)
	Else
		oDBForm = oDrawPage.Forms.GetByIndex(0)
	End If
	oDBForm.Name = &quot;Standard&quot;
	oDBForm.DataSourceName = sDBName
	oDBForm.Command = TableName
	oDBForm.CommandType = CurCommandType
End Sub


Sub AddBinaryFieldsToWidthList()
Dim LocWidthList()
Dim MaxIndex as Integer
Dim OldMaxIndex as Integer
Dim s as Integer
Dim n as Integer
Dim m as Integer
&apos; Todo: Die folgenden Zeilen könnten in einer allgemeinen Routine 
&apos; bearbeitet werden, z. B. durch Umschreiben von AddListToList, wobei
&apos; beim Abfragen des Ubounds der zweiten Dimension eine Fehlerabfrage nötig wäre.
	MaxIndex = Ubound(WidthList(),1) + Ubound(ImgWidthList(),1) + 1
	OldMaxIndex = Ubound(WidthList(),1)
	ReDim Preserve WidthList(MaxIndex,4)
	s = 0
	For n = OldMaxIndex + 1 To MaxIndex
		For m = 0 To 4
			WidthList(n,m) = ImgWidthList(s,m)
		Next m
		s = s + 1
	Next n
	FillUpFieldsListbox(True)
End Sub


Sub RemoveBinaryFieldsFromWidthList()
Dim MaxIndex as Integer
	MaxIndex = Ubound(WidthList(),1) - Ubound(ImgWidthList(),1) - 1
	ReDim Preserve WidthList(MaxIndex, 4)
	FillUpFieldsListbox(True)
End Sub


Function CreateCommandTypeList()
Dim MaxTableIndex as Integer
Dim MaxQueryIndex as Integer
Dim i as Integer
Dim a as Integer
	MaxTableIndex = Ubound(TableNames()
	MaxQueryIndex = Ubound(QueryNames()
Dim LocCommandTypes(MaxTableIndex + MaxQueryIndex + 1) as Integer
	For i = 0 To MaxTableIndex
		LocCommandTypes(i) = com.sun.star.sdb.CommandType.TABLE
	Next i  	
	a = i + 1
	For i = 0 To MaxQueryIndex
		LocCommandTypes(a) = com.sun.star.sdb.CommandType.QUERY
	Next i
	CreateCommandTypeList() = LocCommandTypes()
End Function</script:module>