wizards/source/formwizard/DBMeta.xba

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