1<?xml version="1.0" encoding="UTF-8"?> 2<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> 3<script:module xmlns:script="http://openoffice.org/2000/script" script:name="DBMeta" script:language="StarBasic">REM ***** BASIC ***** 4Option Explicit 5 6 7Public iCommandTypes() as Integer 8Public CurCommandType as Integer 9Public oDataSource as Object 10Public bEnableBinaryOptionGroup as Boolean 11'Public bSelectContent as Boolean 12 13 14Function GetDatabaseNames(baddFirstListItem as Boolean) 15Dim sDatabaseList() 16 If oDBContext.HasElements Then 17 Dim LocDBList() as String 18 Dim MaxIndex as Integer 19 Dim i as Integer 20 LocDBList = oDBContext.ElementNames() 21 MaxIndex = Ubound(LocDBList()) 22 If baddfirstListItem Then 23 ReDim Preserve sDatabaseList(MaxIndex + 1) 24 sDatabaseList(0) = sSelectDatasource 25 a = 1 26 Else 27 ReDim Preserve sDatabaseList(MaxIndex) 28 a = 0 29 End If 30 For i = 0 To MaxIndex 31 sDatabaseList(a) = oDBContext.ElementNames(i) 32 a = a + 1 33 Next i 34 End If 35 GetDatabaseNames() = sDatabaseList() 36End Function 37 38 39Sub GetSelectedDBMetaData(sDBName as String) 40Dim OldsDBname as String 41Dim DBIndex as Integer 42Dim LocList() as String 43' If bStartUp Then 44' bStartUp = false 45' Exit Sub 46' End Sub 47 ToggleDatabasePage(False) 48 With DialogModel 49 If GetConnection(sDBName) Then 50 If GetDBMetaData() Then 51 LocList() = AddListToList(Array(sSelectDBTable), TableNames()) 52 .lstTables.StringItemList() = AddListToList(LocList(), QueryNames()) 53' bSelectContent = True 54 .lstTables.SelectedItems() = Array(0) 55 iCommandTypes() = CreateCommandTypeList() 56 EmptyFieldsListboxes() 57 End If 58 End If 59 bEnableBinaryOptionGroup = False 60 .lstTables.Enabled = True 61 .lblTables.Enabled = True 62' Else 63' DialogModel.lstTables.StringItemList = Array(sSelectDBTable) 64' EmptyFieldsListboxes() 65' End If 66 ToggleDatabasePage(True) 67 End With 68End Sub 69 70 71Function GetConnection(sDBName as String) 72Dim oInteractionHandler as Object 73Dim bExitLoop as Boolean 74Dim bGetConnection as Boolean 75Dim iMsg as Integer 76Dim Nulllist() 77 If Not IsNull(oDBConnection) Then 78 oDBConnection.Dispose() 79 End If 80 oDataSource = oDBContext.GetByName(sDBName) 81' If Not oDBContext.hasbyName(sDBName) Then 82' GetConnection() = False 83' Exit Function 84' End If 85 If Not oDataSource.IsPasswordRequired Then 86 oDBConnection = oDBContext.GetByName(sDBName).GetConnection("","") 87 GetConnection() = True 88 Else 89 oInteractionHandler = createUnoService("com.sun.star.task.InteractionHandler") 90 oDataSource = oDBContext.GetByName(sDBName) 91 On Local Error Goto NOCONNECTION 92 Do 93 bExitLoop = True 94 oDBConnection = oDataSource.ConnectWithCompletion(oInteractionHandler) 95 NOCONNECTION: 96 bGetConnection = Err = 0 97 If bGetConnection Then 98 bGetConnection = Not IsNull(oDBConnection) 99 If Not bGetConnection Then 100 Exit Do 101 End If 102 End If 103 If Not bGetConnection Then 104 iMsg = Msgbox (sMsgNoConnection,32 + 2, sMsgWizardName) 105 bExitLoop = iMsg = SBCANCEL 106 Resume CLERROR 107 CLERROR: 108 End If 109 Loop Until bExitLoop 110 On Local Error Goto 0 111 If Not bGetConnection Then 112 DialogModel.lstTables.StringItemList() = Array(sSelectDBTable) 113 DialogModel.lstFields.StringItemList() = NullList() 114 DialogModel.lstSelFields.StringItemList() = NullList() 115 End If 116 GetConnection() = bGetConnection 117 End If 118End Function 119 120 121Function GetDBMetaData() 122 If oDBContext.HasElements Then 123 Tablenames() = oDBConnection.Tables.ElementNames() 124 Querynames() = oDBConnection.Queries.ElementNames() 125 GetDBMetaData = True 126 Else 127 MsgBox(sMsgErrNoDatabase, 64, sMsgWizardName) 128 GetDBMetaData = False 129 End If 130End Function 131 132 133Sub GetTableMetaData() 134Dim iType as Long 135Dim m as Integer 136Dim Found as Boolean 137Dim i as Integer 138Dim sFieldName as String 139Dim n as Integer 140Dim WidthIndex as Integer 141Dim oField as Object 142 MaxIndex = Ubound(DialogModel.lstSelFields.StringItemList()) 143 Dim ColumnMap(MaxIndex)as Integer 144 FieldNames() = DialogModel.lstSelFields.StringItemList() 145 ' Build a structure which maps the position of a selected field (within the selection) to the the column position within 146 ' the table. So we ensure that the controls are placed in the same order the according fields are selected. 147 For i = 0 To Ubound(FieldNames()) 148 sFieldName = FieldNames(i) 149 Found = False 150 n = 0 151 While (n< MaxIndex And (Not Found)) 152 If (FieldNames(n) = sFieldName) Then 153 Found = True 154 ColumnMap(n) = i 155 End If 156 n = n + 1 157 Wend 158 Next i 159 For n = 0 to MaxIndex 160 sFieldname = FieldNames(n) 161 oField = oColumns.GetByName(sFieldName) 162 iType = oField.Type 163 FieldMetaValues(n,0) = oField.Type 164 FieldMetaValues(n,1) = AssignFieldLength(oField.Precision) 165 FieldMetaValues(n,2) = GetValueoutofList(iType, WidthList(),1, WidthIndex) 166 FieldMetaValues(n,3) = WidthList(WidthIndex,3) 167 FieldMetaValues(n,4) = oField.FormatKey 168 FieldMetaValues(n,5) = oField.DefaultValue 169 FieldMetaValues(n,6) = oField.IsCurrency 170 FieldMetaValues(n,7) = oField.Scale 171' If oField.Description <> "" Then 172'' Todo: What's wrong with this line? 173' Msgbox oField.Helptext 174' End If 175 FieldMetaValues(n,8) = oField.Description 176 Next 177 ReDim oDBShapeList(MaxIndex) as Object 178 ReDim oTCShapeList(MaxIndex) as Object 179 ReDim oDBModelList(MaxIndex) as Object 180 ReDim oGroupShapeList(MaxIndex) as Object 181End Sub 182 183 184Function GetSpecificFieldNames() as Integer 185Dim n as Integer 186Dim m as Integer 187Dim s as Integer 188Dim iType as Integer 189Dim oField as Object 190Dim MaxIndex as Integer 191Dim EmptyList() 192 If Ubound(DialogModel.lstTables.StringItemList()) > -1 Then 193 FieldNames() = oColumns.GetElementNames() 194 MaxIndex = Ubound(FieldNames()) 195 If MaxIndex <> -1 Then 196 Dim ResultFieldNames(MaxIndex) 197 ReDim ImgFieldNames(MaxIndex) 198 m = 0 199 For n = 0 To MaxIndex 200 oField = oColumns.GetByName(FieldNames(n)) 201 iType = oField.Type 202 If GetIndexInMultiArray(WidthList(), iType, 0) <> -1 Then 203 ResultFieldNames(m) = FieldNames(n) 204 m = m + 1 205 End If 206 If GetIndexInMultiArray(ImgWidthList(), iType, 0) <> -1 Then 207 ImgFieldNames(s) = FieldNames(n) 208 s = s + 1 209 End If 210 Next n 211 If s <> 0 Then 212 Redim Preserve ImgFieldNames(s-1) 213 bEnableBinaryOptionGroup = True 214 Else 215 bEnableBinaryOptionGroup = False 216 End If 217 If (DialogModel.optBinariesasGraphics.State = 1) And (s <> 0) Then 218 ResultFieldNames() = AddListToList(ResultFieldNames(), ImgFieldNames()) 219 Else 220 Redim Preserve ResultFieldNames(m-1) 221 End If 222 FieldNames() = ResultFieldNames() 223 DialogModel.lstFields.StringItemList = FieldNames() 224 InitializeListboxProcedures(DialogModel, DialogModel.lstFields, DialogModel.lstSelFields) 225 End If 226 GetSpecificFieldNames = MaxIndex 227 Else 228 GetSpecificFieldNames = -1 229 End If 230End Function 231 232 233Sub CreateDBForm() 234 If oDrawPage.Forms.Count = 0 Then 235 oDBForm = oDocument.CreateInstance("com.sun.star.form.component.Form") 236 oDrawpage.Forms.InsertByIndex (0, oDBForm) 237 Else 238 oDBForm = oDrawPage.Forms.GetByIndex(0) 239 End If 240 oDBForm.Name = "Standard" 241 oDBForm.DataSourceName = sDBName 242 oDBForm.Command = TableName 243 oDBForm.CommandType = CurCommandType 244End Sub 245 246 247Sub AddOrRemoveBinaryFieldsToWidthList() 248Dim LocWidthList() 249Dim MaxIndex as Integer 250Dim OldMaxIndex as Integer 251Dim s as Integer 252Dim n as Integer 253Dim m as Integer 254 If Not bDebug Then 255 On Local Error GoTo WIZARDERROR 256 End If 257 If DialogModel.optBinariesasGraphics.State = 1 Then 258 OldMaxIndex = Ubound(WidthList(),1) 259 If OldMaxIndex = 15 Then 260 MaxIndex = Ubound(WidthList(),1) + Ubound(ImgWidthList(),1) + 1 261 ReDim Preserve WidthList(MaxIndex,4) 262 s = 0 263 For n = OldMaxIndex + 1 To MaxIndex 264 For m = 0 To 3 265 WidthList(n,m) = ImgWidthList(s,m) 266 Next m 267 s = s + 1 268 Next n 269 MergeList(DialogModel.lstFields, ImgFieldNames()) 270 End If 271 Else 272 ReDim Preserve WidthList(15, 4) 273 RemoveListItems(DialogModel.lstFields(), DialogModel.lstSelFields(), ImgFieldNames()) 274 End If 275 DialogModel.lstSelFields.Tag = True 276WIZARDERROR: 277 If Err <> 0 Then 278 Msgbox(sMsgErrMsg, 16, GetProductName()) 279 Resume LOCERROR 280 LOCERROR: 281 End If 282End Sub 283 284 285Function CreateCommandTypeList() 286Dim MaxTableIndex as Integer 287Dim MaxQueryIndex as Integer 288Dim MaxIndex as Integer 289Dim i as Integer 290Dim a as Integer 291 MaxTableIndex = Ubound(TableNames() 292 MaxQueryIndex = Ubound(QueryNames() 293 MaxIndex = MaxTableIndex + MaxQueryIndex + 1 294 If MaxIndex > -1 Then 295 Dim LocCommandTypes(MaxIndex) as Integer 296 For i = 0 To MaxTableIndex 297 LocCommandTypes(i) = com.sun.star.sdb.CommandType.TABLE 298 Next i 299 a = i 300 For i = 0 To MaxQueryIndex 301 LocCommandTypes(a) = com.sun.star.sdb.CommandType.QUERY 302 a = a + 1 303 Next i 304 End If 305 CreateCommandTypeList() = LocCommandTypes() 306End Function 307 308 309Sub GetCurrentMetaValues(Index as Integer) 310 CurFieldType = FieldMetaValues(Index,0) 311 CurFieldLength = FieldMetaValues(Index,1) 312 CurControlType = FieldMetaValues(Index,2) 313 CurControlName = FieldMetaValues(Index,3) 314 CurFormatKey = FieldMetaValues(Index,4) 315 CurDefaultValue = FieldMetaValues(Index,5) 316 CurIsCurrency = FieldMetaValues(Index,6) 317 CurScale = FieldMetaValues(Index,7) 318 CurHelpText = FieldMetaValues(Index,8) 319 CurFieldName = FieldNames(Index) 320End Sub 321 322 323Function AssignFieldLength(FieldLength as Long) as Integer 324 If FieldLength >= 65535 Then 325 AssignFieldLength() = -1 326 Else 327 AssignFieldLength() = FieldLength 328 End If 329End Function 330</script:module>