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