home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Kompuutteri Kaikille K-CD 2002 #3
/
K-CD_2002-03.iso
/
OpenOffice
/
f_0018
/
DBMeta.xba
next >
Wrap
Extensible Markup Language
|
2001-10-12
|
8KB
|
256 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
Dim oDataSource as Object
Public bEnableBinaryOptionGroup as Boolean
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 oInteractionHandler 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
oDataSource = oDBContext.GetByName(sDBName)
If Not oDataSource.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
Dim oField as Object
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)
oField = oColumns.GetByName(sFieldName)
iType = oField.Type
FieldMetaValues(n,0) = iType
FieldMetaValues(n,1) = oField.Precision
FieldMetaValues(n,2) = GetValueoutofList(iType, WidthList(),1, WidthIndex)
FieldMetaValues(n,3) = WidthList(WidthIndex,3)
Next
ReDim oDBShapeList(MaxIndex) as Object
ReDim oTCShapeList(MaxIndex) as Object
ReDim oDBModelList(MaxIndex) as Object
End Sub
Sub GetSpecificFieldNames()
Dim n as Integer
Dim m as Integer
Dim s 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)
ReDim ImgFieldNames(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
If GetIndexInMultiArray(ImgWidthList(), iType, 0) <> -1 Then
ImgFieldNames(s) = FieldNames(n)
s = s + 1
End If
Next n
If s <> 0 Then
Redim Preserve ImgFieldNames(s-1)
bEnableBinaryOptionGroup = True
Else
bEnableBinaryOptionGroup = False
End If
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 AddOrRemoveBinaryFieldsToWidthList()
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.
If oDialogModel.optBinariesasGraphics.State = 1 Then
' MaxIndex = Ubound(WidthList(),1) + Ubound(ImgWidthList(),1) + 1
' OldMaxIndex = Ubound(WidthList(),1)
ReDim Preserve WidthList(18,4)
s = 0
For n = OldMaxIndex + 1 To MaxIndex
For m = 0 To 3
WidthList(n,m) = ImgWidthList(s,m)
Next m
s = s + 1
Next n
MergeList(oDialogModel.lstFields, ImgFieldNames())
Else
ReDim Preserve WidthList(15, 4)
RemoveListItems(oDialogModel.lstFields(), oDialogModel.lstSelFields(), ImgFieldNames())
End If
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
Sub GetCurrentMetaValues(Index as Integer)
CurFieldType = FieldMetaValues(Index,0)
CurFieldLength = FieldMetaValues(Index,1)
CurControlType = FieldMetaValues(Index,2)
CurControlName = FieldMetaValues(Index,3)
CurFieldName = FieldNames(Index)
End Sub</script:module>