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 <script:module xmlns:script="http://openoffice.org/2000/script" script:name="DBMeta" script:language="StarBasic">REM  *****  BASIC  *****
   4 Option Explicit
   5
   6
   7 Public iCommandTypes() as Integer
   8 Public CurCommandType as Integer
   9 Public oDataSource as Object
  10 Public bEnableBinaryOptionGroup as Boolean
  11 &apos;Public bSelectContent as Boolean
  12
  13
  14 Function GetDatabaseNames(baddFirstListItem as Boolean)
  15 Dim 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()
  36 End Function
  37
  38
  39 Sub GetSelectedDBMetaData(sDBName as String)
  40 Dim OldsDBname as String
  41 Dim DBIndex as Integer
  42 Dim LocList() as String
  43 &apos;  If bStartUp Then
  44 &apos;          bStartUp = false
  45 &apos;          Exit Sub
  46 &apos;  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 &apos;                                          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 &apos;          Else
  63 &apos;                  DialogModel.lstTables.StringItemList = Array(sSelectDBTable)
  64 &apos;                  EmptyFieldsListboxes()
  65 &apos;          End If
  66                 ToggleDatabasePage(True)
  67         End With
  68 End Sub
  69
  70
  71 Function GetConnection(sDBName as String)
  72 Dim oInteractionHandler as Object
  73 Dim bExitLoop as Boolean
  74 Dim bGetConnection as Boolean
  75 Dim iMsg as Integer
  76 Dim Nulllist()
  77         If Not IsNull(oDBConnection) Then
  78                 oDBConnection.Dispose()
  79         End If
  80         oDataSource = oDBContext.GetByName(sDBName)
  81 &apos;  If Not oDBContext.hasbyName(sDBName) Then
  82 &apos;          GetConnection() = False
  83 &apos;          Exit Function
  84 &apos;  End If
  85         If Not oDataSource.IsPasswordRequired Then
  86                 oDBConnection = oDBContext.GetByName(sDBName).GetConnection(&quot;&quot;,&quot;&quot;)
  87                 GetConnection() = True
  88         Else
  89                 oInteractionHandler = createUnoService(&quot;com.sun.star.sdb.InteractionHandler&quot;)
  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
 118 End Function
 119
 120
 121 Function 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
 130 End Function
 131
 132
 133 Sub GetTableMetaData()
 134 Dim iType as Long
 135 Dim m as Integer
 136 Dim Found as Boolean
 137 Dim i as Integer
 138 Dim sFieldName as String
 139 Dim n as Integer
 140 Dim WidthIndex as Integer
 141 Dim oField as Object
 142         MaxIndex = Ubound(DialogModel.lstSelFields.StringItemList())
 143         Dim ColumnMap(MaxIndex)as Integer
 144         FieldNames() = DialogModel.lstSelFields.StringItemList()
 145         &apos; Build a structure which maps the position of a selected field (within the selection) to the the column position within
 146         &apos; 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&lt; 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 &apos;          If oField.Description &lt;&gt; &quot;&quot; Then
 172 &apos;&apos; Todo: What&apos;s wrong with this line?
 173 &apos;                  Msgbox oField.Helptext
 174 &apos;          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
 181 End Sub
 182
 183
 184 Function GetSpecificFieldNames() as Integer
 185 Dim n as Integer
 186 Dim m as Integer
 187 Dim s as Integer
 188 Dim iType as Integer
 189 Dim oField as Object
 190 Dim MaxIndex as Integer
 191 Dim EmptyList()
 192         If Ubound(DialogModel.lstTables.StringItemList()) &gt; -1 Then
 193                 FieldNames() = oColumns.GetElementNames()
 194                 MaxIndex = Ubound(FieldNames())
 195                 If MaxIndex &lt;&gt; -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) &lt;&gt; -1 Then
 203                                         ResultFieldNames(m) = FieldNames(n)
 204                                         m = m + 1
 205                                 End If
 206                                 If GetIndexInMultiArray(ImgWidthList(), iType, 0) &lt;&gt; -1 Then
 207                                         ImgFieldNames(s) = FieldNames(n)
 208                                         s = s + 1
 209                                 End If
 210                         Next n
 211                         If s &lt;&gt; 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 &lt;&gt; 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
 230 End Function
 231
 232
 233 Sub CreateDBForm()
 234         If oDrawPage.Forms.Count = 0 Then
 235                 oDBForm = oDocument.CreateInstance(&quot;com.sun.star.form.component.Form&quot;)
 236                 oDrawpage.Forms.InsertByIndex (0, oDBForm)
 237         Else
 238                 oDBForm = oDrawPage.Forms.GetByIndex(0)
 239         End If
 240         oDBForm.Name = &quot;Standard&quot;
 241         oDBForm.DataSourceName = sDBName
 242         oDBForm.Command = TableName
 243         oDBForm.CommandType = CurCommandType
 244 End Sub
 245
 246
 247 Sub AddOrRemoveBinaryFieldsToWidthList()
 248 Dim LocWidthList()
 249 Dim MaxIndex as Integer
 250 Dim OldMaxIndex as Integer
 251 Dim s as Integer
 252 Dim n as Integer
 253 Dim 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
 276 WIZARDERROR:
 277         If Err &lt;&gt; 0 Then
 278                 Msgbox(sMsgErrMsg, 16, GetProductName())
 279                 Resume LOCERROR
 280                 LOCERROR:
 281         End If
 282 End Sub
 283
 284
 285 Function CreateCommandTypeList()
 286 Dim MaxTableIndex as Integer
 287 Dim MaxQueryIndex as Integer
 288 Dim MaxIndex as Integer
 289 Dim i as Integer
 290 Dim a as Integer
 291         MaxTableIndex = Ubound(TableNames()
 292         MaxQueryIndex = Ubound(QueryNames()
 293         MaxIndex = MaxTableIndex + MaxQueryIndex + 1
 294         If MaxIndex &gt; -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()
 306 End Function
 307
 308
 309 Sub 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)
 320 End Sub
 321
 322
 323 Function AssignFieldLength(FieldLength as Long) as Integer
 324         If FieldLength &gt;= 65535 Then
 325                 AssignFieldLength() = -1
 326         Else
 327                 AssignFieldLength() = FieldLength
 328         End If
 329 End Function
 330 </script:module>