forked from amazingfate/loongoffice
cd6abead39
The generic css.task.InteractionHandler implementation in module uui is now able to instantiate "sub handlers", i.e. components to delegate a request to, based on the type of the request, and some configuration data. The "old" (and now deprecated) configuration scheme at org.openoffice.ucb.InteractionHandler did not contain type information, so any handlers registered there were always called when no default implementation for a given request was available. The "new" configuration scheme at org.openoffice.Interaction contains UNO type information. That is, a given handler implementation can declare itself responsible for an arbitrary set of UNO types, and for each of those types, whether it is also responsible for sub types. The generic interaction handler implementation uses this configuration data, when it encounteres an interaction request it cannot fullfill itself, to instantiate a component to delegate the request to. As with the "old" data, such a component is required to support the css.task.XInteractionHandler2 interface. Also, if it supports css.lang.XInitialization, then it will be initialized with a name-value pair, the name being "Parent", the value being the XWindow interface of the parent window for any message boxes. As an examplary implementation for this feature, the css.sdb.InteractionHandler has been deprecated. Now the css.sdb.DatabaseInteractionHandler is reponsible for database-related interactions, and the new configuration scheme is pre-filled with data assigning this responsibility. Consequently, a lot of places previously creating an css.sdb.InteractionHandler have been modified to create the default css.task.InteractionHandler.
330 lines
9.3 KiB
XML
330 lines
9.3 KiB
XML
<?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 iCommandTypes() as Integer
|
|
Public CurCommandType as Integer
|
|
Public oDataSource as Object
|
|
Public bEnableBinaryOptionGroup as Boolean
|
|
'Public bSelectContent as Boolean
|
|
|
|
|
|
Function GetDatabaseNames(baddFirstListItem as Boolean)
|
|
Dim sDatabaseList()
|
|
If oDBContext.HasElements Then
|
|
Dim LocDBList() as String
|
|
Dim MaxIndex as Integer
|
|
Dim i as Integer
|
|
LocDBList = oDBContext.ElementNames()
|
|
MaxIndex = Ubound(LocDBList())
|
|
If baddfirstListItem Then
|
|
ReDim Preserve sDatabaseList(MaxIndex + 1)
|
|
sDatabaseList(0) = sSelectDatasource
|
|
a = 1
|
|
Else
|
|
ReDim Preserve sDatabaseList(MaxIndex)
|
|
a = 0
|
|
End If
|
|
For i = 0 To MaxIndex
|
|
sDatabaseList(a) = oDBContext.ElementNames(i)
|
|
a = a + 1
|
|
Next i
|
|
End If
|
|
GetDatabaseNames() = sDatabaseList()
|
|
End Function
|
|
|
|
|
|
Sub GetSelectedDBMetaData(sDBName as String)
|
|
Dim OldsDBname as String
|
|
Dim DBIndex as Integer
|
|
Dim LocList() as String
|
|
' If bStartUp Then
|
|
' bStartUp = false
|
|
' Exit Sub
|
|
' End Sub
|
|
ToggleDatabasePage(False)
|
|
With DialogModel
|
|
If GetConnection(sDBName) Then
|
|
If GetDBMetaData() Then
|
|
LocList() = AddListToList(Array(sSelectDBTable), TableNames())
|
|
.lstTables.StringItemList() = AddListToList(LocList(), QueryNames())
|
|
' bSelectContent = True
|
|
.lstTables.SelectedItems() = Array(0)
|
|
iCommandTypes() = CreateCommandTypeList()
|
|
EmptyFieldsListboxes()
|
|
End If
|
|
End If
|
|
bEnableBinaryOptionGroup = False
|
|
.lstTables.Enabled = True
|
|
.lblTables.Enabled = True
|
|
' Else
|
|
' DialogModel.lstTables.StringItemList = Array(sSelectDBTable)
|
|
' EmptyFieldsListboxes()
|
|
' End If
|
|
ToggleDatabasePage(True)
|
|
End With
|
|
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 oDBContext.hasbyName(sDBName) Then
|
|
' GetConnection() = False
|
|
' Exit Function
|
|
' End If
|
|
If Not oDataSource.IsPasswordRequired Then
|
|
oDBConnection = oDBContext.GetByName(sDBName).GetConnection("","")
|
|
GetConnection() = True
|
|
Else
|
|
oInteractionHandler = createUnoService("com.sun.star.task.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)
|
|
bExitLoop = iMsg = SBCANCEL
|
|
Resume CLERROR
|
|
CLERROR:
|
|
End If
|
|
Loop Until bExitLoop
|
|
On Local Error Goto 0
|
|
If Not bGetConnection Then
|
|
DialogModel.lstTables.StringItemList() = Array(sSelectDBTable)
|
|
DialogModel.lstFields.StringItemList() = NullList()
|
|
DialogModel.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(DialogModel.lstSelFields.StringItemList())
|
|
Dim ColumnMap(MaxIndex)as Integer
|
|
FieldNames() = DialogModel.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) = oField.Type
|
|
FieldMetaValues(n,1) = AssignFieldLength(oField.Precision)
|
|
FieldMetaValues(n,2) = GetValueoutofList(iType, WidthList(),1, WidthIndex)
|
|
FieldMetaValues(n,3) = WidthList(WidthIndex,3)
|
|
FieldMetaValues(n,4) = oField.FormatKey
|
|
FieldMetaValues(n,5) = oField.DefaultValue
|
|
FieldMetaValues(n,6) = oField.IsCurrency
|
|
FieldMetaValues(n,7) = oField.Scale
|
|
' If oField.Description <> "" Then
|
|
'' Todo: What's wrong with this line?
|
|
' Msgbox oField.Helptext
|
|
' End If
|
|
FieldMetaValues(n,8) = oField.Description
|
|
Next
|
|
ReDim oDBShapeList(MaxIndex) as Object
|
|
ReDim oTCShapeList(MaxIndex) as Object
|
|
ReDim oDBModelList(MaxIndex) as Object
|
|
ReDim oGroupShapeList(MaxIndex) as Object
|
|
End Sub
|
|
|
|
|
|
Function GetSpecificFieldNames() as Integer
|
|
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(DialogModel.lstTables.StringItemList()) > -1 Then
|
|
FieldNames() = oColumns.GetElementNames()
|
|
MaxIndex = Ubound(FieldNames())
|
|
If MaxIndex <> -1 Then
|
|
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
|
|
If (DialogModel.optBinariesasGraphics.State = 1) And (s <> 0) Then
|
|
ResultFieldNames() = AddListToList(ResultFieldNames(), ImgFieldNames())
|
|
Else
|
|
Redim Preserve ResultFieldNames(m-1)
|
|
End If
|
|
FieldNames() = ResultFieldNames()
|
|
DialogModel.lstFields.StringItemList = FieldNames()
|
|
InitializeListboxProcedures(DialogModel, DialogModel.lstFields, DialogModel.lstSelFields)
|
|
End If
|
|
GetSpecificFieldNames = MaxIndex
|
|
Else
|
|
GetSpecificFieldNames = -1
|
|
End If
|
|
End Function
|
|
|
|
|
|
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
|
|
If Not bDebug Then
|
|
On Local Error GoTo WIZARDERROR
|
|
End If
|
|
If DialogModel.optBinariesasGraphics.State = 1 Then
|
|
OldMaxIndex = Ubound(WidthList(),1)
|
|
If OldMaxIndex = 15 Then
|
|
MaxIndex = Ubound(WidthList(),1) + Ubound(ImgWidthList(),1) + 1
|
|
ReDim Preserve WidthList(MaxIndex,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(DialogModel.lstFields, ImgFieldNames())
|
|
End If
|
|
Else
|
|
ReDim Preserve WidthList(15, 4)
|
|
RemoveListItems(DialogModel.lstFields(), DialogModel.lstSelFields(), ImgFieldNames())
|
|
End If
|
|
DialogModel.lstSelFields.Tag = True
|
|
WIZARDERROR:
|
|
If Err <> 0 Then
|
|
Msgbox(sMsgErrMsg, 16, GetProductName())
|
|
Resume LOCERROR
|
|
LOCERROR:
|
|
End If
|
|
End Sub
|
|
|
|
|
|
Function CreateCommandTypeList()
|
|
Dim MaxTableIndex as Integer
|
|
Dim MaxQueryIndex as Integer
|
|
Dim MaxIndex as Integer
|
|
Dim i as Integer
|
|
Dim a as Integer
|
|
MaxTableIndex = Ubound(TableNames()
|
|
MaxQueryIndex = Ubound(QueryNames()
|
|
MaxIndex = MaxTableIndex + MaxQueryIndex + 1
|
|
If MaxIndex > -1 Then
|
|
Dim LocCommandTypes(MaxIndex) 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
|
|
a = a + 1
|
|
Next i
|
|
End If
|
|
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)
|
|
CurFormatKey = FieldMetaValues(Index,4)
|
|
CurDefaultValue = FieldMetaValues(Index,5)
|
|
CurIsCurrency = FieldMetaValues(Index,6)
|
|
CurScale = FieldMetaValues(Index,7)
|
|
CurHelpText = FieldMetaValues(Index,8)
|
|
CurFieldName = FieldNames(Index)
|
|
End Sub
|
|
|
|
|
|
Function AssignFieldLength(FieldLength as Long) as Integer
|
|
If FieldLength >= 65535 Then
|
|
AssignFieldLength() = -1
|
|
Else
|
|
AssignFieldLength() = FieldLength
|
|
End If
|
|
End Function
|
|
</script:module> |