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&apos;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&apos;	If bStartUp Then
64&apos;		bStartUp = false
65&apos;		Exit Sub
66&apos;	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&apos;						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&apos;		Else
83&apos;			DialogModel.lstTables.StringItemList = Array(sSelectDBTable)
84&apos;			EmptyFieldsListboxes()
85&apos;		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&apos;	If Not oDBContext.hasbyName(sDBName) Then
102&apos;		GetConnection() = False
103&apos;		Exit Function
104&apos;	End If
105	If Not oDataSource.IsPasswordRequired Then
106		oDBConnection = oDBContext.GetByName(sDBName).GetConnection(&quot;&quot;,&quot;&quot;)
107		GetConnection() = True
108	Else
109		oInteractionHandler = createUnoService(&quot;com.sun.star.task.InteractionHandler&quot;)
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	&apos; Build a structure which maps the position of a selected field (within the selection) to the column position within
166	&apos; 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&lt; 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&apos;		If oField.Description &lt;&gt; &quot;&quot; Then
192&apos;&apos; Todo: What&apos;s wrong with this line?
193&apos;			Msgbox oField.Helptext
194&apos;		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()) &gt; -1 Then
213		FieldNames() = oColumns.GetElementNames()
214		MaxIndex = Ubound(FieldNames())
215		If MaxIndex &lt;&gt; -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) &lt;&gt; -1 Then
223					ResultFieldNames(m) = FieldNames(n)
224					m = m + 1
225				End If
226				If GetIndexInMultiArray(ImgWidthList(), iType, 0) &lt;&gt; -1 Then
227					ImgFieldNames(s) = FieldNames(n)
228					s = s + 1
229				End If
230			Next n
231			If s &lt;&gt; 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 &lt;&gt; 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(&quot;com.sun.star.form.component.Form&quot;)
256		oDrawpage.Forms.InsertByIndex (0, oDBForm)
257	Else
258		oDBForm = oDrawPage.Forms.GetByIndex(0)
259	End If
260	oDBForm.Name = &quot;Standard&quot;
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 &lt;&gt; 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 &gt; -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 &gt;= 65535 Then
345		AssignFieldLength() = -1
346	Else
347		AssignFieldLength() = FieldLength
348	End If
349End Function
350</script:module>
351