com!online 2001 December/COMCD1201.iso/openoffice/f_0020/DBMeta.xba

Extensible Markup Language | 2001-08-24 | 7.0 KB | 237 lines

<?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()) > -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("","")
        GetConnection() = True
    Else
        oInteractionHandler = createUnoService("com.sun.star.sdb.InteractionHandler")
        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)    ' '?' & ' Repeat and Cancel'
                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()

    ' Build a structure which maps the position of a selected field (within the selection) to the the column position within
    ' 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< 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()) > -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) <> -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("com.sun.star.form.component.Form")
        oDrawpage.Forms.InsertByIndex (0, oDBForm)
    Else
        oDBForm = oDrawPage.Forms.GetByIndex(0)
    End If
    oDBForm.Name = "Standard"
    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
' Todo: Die folgenden Zeilen k├╢nnten in einer allgemeinen Routine
' bearbeitet werden, z. B. durch Umschreiben von AddListToList, wobei
' 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
    For i = 0 To MaxQueryIndex
        LocCommandTypes(a) = com.sun.star.sdb.CommandType.QUERY
    Next i
    CreateCommandTypeList() = LocCommandTypes()
End Function</script:module>