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