## several changes

2 files changed, 76 insertions, 198 deletions

diff --git a/wizards/source/tools/Misc.xba b/wizards/source/tools/Misc.xba
index 1e99ed8cf448..576bc58c525c 100644
--- a/wizards/source/tools/Misc.xba
+++ b/wizards/source/tools/Misc.xba
@@ -7,18 +7,69 @@ Const SBUSER = 1
 Dim Taskindex as Integer
 Dim oResSrv as Object
 
+Sub Main()
+Dim PropList(3,1)' as String
+	PropList(0,0) = "URL"
+	PropList(0,1) = "sdbc:odbc:Erica_Test_Unicode"
+	PropList(1,0) = "User"
+	PropList(1,1) = "extra"
+	PropList(2,0) = "Password"
+	PropList(2,1) = "extra"
+	PropList(3,0) = "IsPasswordRequired"
+	PropList(3,1) = True
+'	RegisterNewDataSource("Doc_Erica_Test_Unicode", PropList())
+End Sub
+
+
+Function RegisterNewDataSource(DSName as  String, PropertyList(), Optional DriverProperties() as New com.sun.star.beans.PropertyValue)
+Dim oDataSource as Object
+Dim oDBContext as Object
+Dim oPropInfo as Object
+Dim i as Integer
+    oDBContext = createUnoService("com.sun.star.sdb.DatabaseContext")
+    oDataSource = createUnoService("com.sun.star.sdb.DataSource")
+	For i = 0 To Ubound(PropertyList(), 1)
+		sPropName = PropertyList(i,0)
+		sPropValue = PropertyList(i,1)
+		oDataSource.SetPropertyValue(sPropName,sPropValue) 'GetByName(sPropName) = sPropValue 'oPropInfo.GetPropertyByName(sPropName)) = sPropValue '  PropertyList(i,0))) = PropertyList(i,1)
+	Next i
+	If Not IsMissing(DriverProperties()) Then
+		oDataSource.Info() = DriverProperties()
+	End If
+    oDBContext.RegisterObject(DSName, oDataSource)
+	RegisterNewDataSource () = oDataSource
+End Function
+
+
 ' Connects to a registered Database
-Function ConnecttoDatabase(DBName as String, UserID as String, Password as String )
+Function ConnecttoDatabase(DSName as String, UserID as String, Password as String, Optional Propertylist(), Optional DriverProperties() as New com.sun.star.beans.PropertyValue)
 Dim oDBContext as Object
 Dim oDBSource as Object
+	On Local Error Goto NOCONNECTION
 	oDBContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
-	If oDBContext.HasbyName(DBName) Then
-		oDBSource = oDBContext.GetByName(DBName)
+	If oDBContext.HasbyName(DSName) Then
+		oDBSource = oDBContext.GetByName(DSName)
 		ConnectToDatabase = oDBSource.GetConnection(UserID, Password)
 	Else
-		Msgbox("DataSource " & DBName & " is not registered" , 16, GetProductname)
-		ConnectToDatabase() = NULL
+		If Not IsMissing(Namelist()) Then
+			If Not IsMissing(DriverProperties()) Then
+				RegisterNewDataSource(DSName, PropertyList(), DriverProperties())
+			Else
+				RegisterNewDataSource(DSName, PropertyList())
+			End If
+			oDBSource = oDBContext.GetByName(DSName)
+			ConnectToDatabase = oDBSource.GetConnection(UserID, Password)		
+		Else
+			Msgbox("DataSource " & DSName & " is not registered" , 16, GetProductname())
+			ConnectToDatabase() = NULL
+		End If
 	End If
+NOCONNECTION:
+	If Err <> 0 Then
+		Msgbox(Error$, 16, GetProductName())
+		Resume LEAVESUB
+		LEAVESUB:
+	End If	
 End Function
 
 
@@ -107,98 +158,6 @@ Dim MaxArrIndex as integer
 End Function
 
 
-' clears up a Listbox and refills it with the delivered Array 'ValList()'
-Sub FillUpCombo(LocListbox as Object, ValList() as String)
-Dim i as integer
-Dim a as Integer
-	LocListbox.Clear
-	' Trage die ??bersetzungsrelevanten Verzeichnisnamen in die Listbox ein
-	a = 0
-	For i = 0 to Ubound(ValList())
-		If ValList(i) <> "" Then
-			LocListbox.List(a) = ValList(i)
-			a = a + 1
-		End If
-	Next
-End Sub
-
-
-Sub WritedbgInfo(LocObject as Object)
-Dim locUrl as String
-Dim oLocDocument as Object
-Dim oLocText as Object
-Dim oLocCursor as Object
-Dim NoArgs()
-Dim sObjectStrings(2) as String
-Dim sProperties() as String
-Dim n as Integer
-Dim m as Integer
-	sObjectStrings(0) = LocObject.dbg_Properties
-	sObjectStrings(1) = LocObject.dbg_Methods
-	sObjectStrings(2) = LocObject.dbg_SupportedInterfaces
-	LocUrl = "private:factory/swriter"
-	oLocDocument = StarDesktop.LoadComponentFromURL(LocUrl,"_blank",0,NoArgs)
-	oLocText = oLocDocument.text
-	oLocCursor = oLocText.createTextCursor()
-	oLocCursor.gotoStart(False)
-	If Vartype(LocObject) = 9 then	' an Object Variable
-		For n = 0 To 2
-			sProperties() = ArrayoutofString(sObjectStrings(n),";", MaxIndex)
-			For m = 0 To MaxIndex
-				oLocText.insertString(oLocCursor,sProperties(m),False)
-				oLocText.insertControlCharacter(oLocCursor,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False)
-			Next m
-		Next n
-	Elseif Vartype(LocObject) = 8 Then	' a String Variable
-		oLocText.insertString(oLocCursor,LocObject,False)
-	ElseIf Vartype(LocObject) = 1 Then
-		Msgbox("Variable is Null!", 16, GetProductName())
-	End If
-End Sub
-
-
-Sub WriteDbgString(LocString as string)
-Dim oLocDesktop as object
-Dim LocUrl as String
-Dim oLocDocument as Object
-Dim oLocCursor as Object
-Dim oLocText as Object
-
-	LocUrl = "private:factory/swriter"
-	oLocDocument = StarDesktop.LoadComponentFromURL(LocUrl,"_blank",0,NoArgs)
-	oLocText = oLocDocument.text
-	oLocCursor = oLocText.createTextCursor()
-	oLocCursor.gotoStart(False)
-	oLocText.insertString(oLocCursor,LocString,False)
-End Sub
-
-
-Sub printdbgInfo(LocObject)
-	If Vartype(LocObject) = 9 then
-		Msgbox LocObject.dbg_properties
-		Msgbox LocObject.dbg_methods
-		Msgbox LocObject.dbg_supportedinterfaces
-	Elseif Vartype(LocObject) = 8 Then	' a String Variable
-		Msgbox LocObject
-	ElseIf Vartype(LocObject) = 0 Then
-		Msgbox("Variable is Null!", 16, GetProductName())
-	Else
-		Msgbox("Type of Variable: " & Typename(LocObject), 48, GetProductName())
-	End If
-End Sub
-
-
-Sub ShowArray(LocArray())
-Dim i as integer
-Dim msgstring
-	msgstring = ""
-	For i = Lbound(LocArray()) to Ubound(LocArray())
-		msgstring = msgstring + LocArray(i) + chr(13)
-	Next
-	Msgbox msgstring
-End Sub
-
-
 ' Gets a special configured PathSetting
 Function GetPathSettings(sPathType as String,  Optional bshowall as Boolean, Optional ListIndex as integer) as String
 Dim oSettings, oPathSettings as Object
@@ -268,103 +227,6 @@ Dim MaxIndex as Integer
 End Function
 
 
-Sub ShowPropertyValues(oLocObject as Object)
-Dim PropName as String
-Dim sValues as String
-	On Local Error Goto NOPROPERTYSETINFO:
-	sValues = ""
-	For i = 0 To Ubound(oLocObject.PropertySetInfo.Properties)
-		Propname = oLocObject.PropertySetInfo.Properties(i).Name
-		sValues = sValues & PropName & " = " & oLocObject.GetPropertyValue(PropName) & chr(13)
-	Next i
-	Msgbox(sValues , 64, GetProductName())
-	Exit Sub
-
-NOPROPERTYSETINFO:
-	Msgbox("Sorry, No PropertySetInfo attached to the object", 16, GetProductName())
-	Resume LEAVEPROC
-	LEAVEPROC:
-End Sub
-
-
-Sub ShowNameValuePair(Pair())
-Dim i as Integer
-Dim ShowString as String
-	ShowString = ""
-	On Local Error Resume Next
-	For i = 0 To Ubound(Pair())
-		ShowString = ShowString & Pair(i).Name & " = "
-		ShowString = ShowString & Pair(i).Value & chr(13)
-	Next i
-	Msgbox ShowString
-End Sub
-
-
-' Retrieves all the Elements of aSequence of an object, with the
-' possibility to define a filter(sfilter <> "")
-Sub ShowElementNames(oLocElements() as Object, Optional sFiltername as String)
-Dim i as Integer
-Dim NameString as String
-	NameString = ""
-	For i = 0 To Ubound(oLocElements())
-		If Not IsMissIng(sFilterName) Then
-			If Instr(1, oLocElements(i), sFilterName) Then
-				NameString = NameString & oLocElements(i) & chr(13)
-			End If
-		Else
-			NameString = NameString & oLocElements(i) & chr(13)
-		End If
-	Next i
-	Msgbox(NameString, 64, GetProductName())
-End Sub
-
-
-' Retrieves all the supported servicenames of an object, with the
-' possibility to define a filter(sfilter <> "")
-Sub ShowSupportedServiceNames(oLocObject as Object, Optional sFilterName as String)
-	On Local Error Goto NOSERVICENAMES
-	If IsMissing(sFilterName) Then
-		ShowElementNames(oLocobject.SupportedServiceNames())
-	Else
-		ShowElementNames(oLocobject.SupportedServiceNames(), sFilterName)
-	End If
-	Exit Sub
-
-	NOSERVICENAMES:
-	Msgbox("Sorry, No 'SupportedServiceNames' - Property attached to the object", 16, GetProductName())
-	Resume LEAVEPROC
-	LEAVEPROC:
-End Sub
-
-
-' Retrieves all the available Servicenames of an object, with the
-' possibility to define a filter(sfilter <> "")
-Sub ShowAvailableServiceNames(oLocObject as Object, Optional sFilterName as String)
-	On Local Error Goto NOSERVICENAMES
-	If IsMissing(sFilterName) Then
-		ShowElementNames(oLocobject.AvailableServiceNames)
-	Else
-		ShowElementNames(oLocobject.AvailableServiceNames, sFilterName)
-	End If
-	Exit Sub
-
-	NOSERVICENAMES:
-	Msgbox("Sorry, No 'AvailableServiceNames' - Property attached to the object", 16, GetProductName())
-	Resume LEAVEPROC
-	LEAVEPROC:
-End Sub
-
-
-Sub ShowCommands(oLocObject as Object)
-	On Local Error Goto NOCOMMANDS
-	ShowElementNames(oLocObject.QueryCommands)
-	Exit Sub
-	NOCOMMANDS:
-	Msgbox("Sorry, No 'QueryCommands' - Property attached to the object", 16, GetProductName())
-	Resume LEAVEPROC
-	LEAVEPROC:
-End Sub
-
 
 Function InitResources(Description, ShortDescription as String) as boolean
 	On Error Goto ErrorOcurred
@@ -534,6 +396,7 @@ Function GetDocumentType(oDocument)
 End Function
 
 
+
 Function GetNumberFormatType(oDocFormats, oFormatObject as Object) as Integer
 Dim ThisFormatKey as Long
 Dim oObjectFormat as Object
@@ -729,6 +592,7 @@ Dim PropValue(1) as new com.sun.star.beans.PropertyValue
 End Sub
 
 
+
 Function ModifyPropertyValue(oContent() as Object, TargetProperties() as New com.sun.star.beans.PropertyValue )
 Dim MaxIndex as Integer
 Dim i as Integer
@@ -794,4 +658,19 @@ Dim oDisp as Object
 	oDisp.dispatch(oUrl, oArg())
 End Sub
 
+
+'returns the type of the office application
+'FatOffice = 0, WebTop = 1
+'This routine has to be changed if the Product Name is being changed!
+Function IsFatOffice() As Boolean
+  If sProductname = "" Then
+    sProductname = GetProductname()
+  End If
+  IsFatOffice = TRUE
+  'The following line has to include the current productname
+  If Instr(1,sProductname,"WebTop",1) <> 0 Then
+    IsFatOffice = FALSE
+  End If
+End Function
+
 </script:module>
\ No newline at end of file
diff --git a/wizards/source/tools/Strings.xba b/wizards/source/tools/Strings.xba
index c478804e5f08..2e70535b9d49 100644
--- a/wizards/source/tools/Strings.xba
+++ b/wizards/source/tools/Strings.xba
@@ -58,7 +58,6 @@ Dim BigLen%,PreLen%,PostLen%
 End Function
 
 
-
 &apos; Deletes the String &apos;SmallString&apos; out of the String &apos;BigString&apos;
 &apos; in case SmallString&apos;s Position in BigString is right at the end
 Function RTrimStr(ByVal BigString, SmallString as String) as String
@@ -247,7 +246,7 @@ Dim Separator as String
 		sProductname = GetProductname()
 	End If
 	If BigString &lt;&gt; &quot;&quot; Then
-		If Instr(1,sProductname,&quot;Sun Webtop&quot;) = 0 Then
+		If IsFatOffice() Then
 			Separator = GetPathSeparator()
 			&apos; Is the delivered Path already a URL
 			If Instr(1,UCase(BigString),&quot;FILE:///&quot;) = 0 Then
@@ -333,10 +332,10 @@ Dim SepList() as String
 End Function
 
 
-Function DirectorynameoutofPath(sPath as String, Separator as String) as String
+Function DirectoryNameoutofPath(sPath as String, Separator as String) as String
 Dim LocFileName as String
 	LocFileName = FileNameoutofPath(sPath, Separator)
-	DirectoryNameoutofPath = DeleteStr(sPath, Separator &amp; LocFileName)
+	DirectoryNameoutofPath = RTrimStr(sPath, Separator &amp; LocFileName)
 End Function