2001-04-23 04:46:42 -05:00
<?xml version="1.0" encoding="UTF-8"?>
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Strings" script:language="StarBasic">Option Explicit
Public sProductname as String
' Deletes out of a String 'BigString' all possible PartStrings, that are summed up
' in the Array 'ElimArray'
Function ElimChar(ByVal BigString as String, ElimArray() as String)
Dim i% ,n%
For i = 0 to Ubound(ElimArray)
BigString = DeleteStr(BigString,ElimArray(i)
Next
ElimChar = BigString
End Function
' Deletes out of a String 'BigString' a possible Partstring 'CompString'
Function DeleteStr(ByVal BigString,CompString as String) as String
Dim i%, CompLen%, BigLen%
CompLen = Len(CompString)
i = 1
While i <> 0
i = Instr(i, BigString,CompString)
If i <> 0 then
BigLen = Len(BigString)
BigString = Mid(BigString,1,i-1) + Mid(BigString,i+CompLen,BigLen-i+1-CompLen)
End If
Wend
DeleteStr = BigString
End Function
' Finds a PartString, that is framed by the Strings 'Prestring' and 'PostString'
Function FindPartString(BigString, PreString, PostString as String, SearchPos as Integer) as String
Dim StartPos%, EndPos%
Dim BigLen%,PreLen%,PostLen%
StartPos = Instr(SearchPos,BigString,PreString)
If StartPos <> 0 Then
PreLen = Len(PreString)
EndPos = Instr(StartPos + PreLen,BigString,PostString)
If EndPos <> 0 Then
BigLen = Len(BigString)
PostLen = Len(PostString)
FindPartString = Mid(BigString,StartPos + PreLen, EndPos - (StartPos + PreLen))
' Da diese Funktion daf?r programmiert wurde, in einer Schleife abgearbeitet zu werden
' muss die initiale Suchposition hinter die Position des gefundenen Teilstrings gesetzt werden.
SearchPos = EndPos + PostLen
Else
Msgbox("No final tag for '" & PreString & "' existing", 16, GetProductName())
FindPartString = ""
End If
Else
FindPartString = ""
End If
End Function
' Deletes the String 'SmallString' out of the String 'BigString'
' in case SmallString's Position in BigString is right at the end
Function RTrimStr(ByVal BigString, SmallString as String) as String
Dim SmallLen%
Dim BigLen%
SmallLen = Len(SmallString)
BigLen = Len(BigString)
If Mid(BigString,BigLen + 1 - SmallLen, SmallLen) = SmallString Then
RTrimStr = Mid(BigString,1,BigLen - SmallLen)
Else
RTrimStr = BigString
End If
End Function
' Deletes the Char 'CompChar' out of the String 'BigString'
' in case CompChar's Position in BigString is right at the beginning
Function LTRimChar(ByVal BigString as String,CompChar as String) as String
Dim BigLen as integer
BigLen = Len(BigString)
If BigLen > 1 Then
If Left(BigString,1) = CompChar then
BigString = Mid(BigString,2,BigLen-1)
End If
ElseIf BigLen = 1 Then
BigString = ""
End If
LTrimChar = BigString
End Function
' Retrieves an Array out of a String.
' The fields of the Array are separated by the parameter 'Separator', that is contained
' in the Array
' The Array MaxLocindex delivers the highest Index of this Array
Function ArrayOutOfString(BigString, Separator as String, Optional MaxIndex as integer)
Dim i%, OldPos%, Pos%, SepLen%, BigLen%
Dim LocList(200) as string
OldPos = 1
i = -1
SepLen = Len(Separator)
BigLen = Len(BigString)
Do
Pos = Instr(OldPos,BigString,Separator)
i = i + 1
If Pos = 0 Then
LocList(i) = Mid(BigString,OldPos,BigLen - OldPos + 1 )
Else
LocList(i) = Mid(BigString,OldPos,Pos-OldPos )
OldPos = Pos + SepLen
End If
Loop until Pos = 0
If Vartype(Maxindex) <> 0 Then
MaxIndex = i
End If
ArrayoutofString = LocList()
End Function
' Deletes all fieldvalues in one-dimensional Array
Sub ClearArray(BigArray)
Dim i as integer
For i = Lbound(BigArray()) to Ubound(BigArray())
BigArray(i) = ""
Next
End Sub
' Deletes all fieldvalues in a multidimensional Array
Sub ClearMultiDimArray(BigArray,DimCount as integer)
Dim n%, m%
For n = Lbound(BigArray(),1) to Ubound(BigArray(),1)
For m = 0 to Dimcount - 1
BigArray(n,m) = ""
Next m
Next n
End Sub
' Checks if a Field (LocField) is already defined in an Array
' Returns 'True' or 'False'
Function FieldinArray(LocArray(), MaxIndex as integer, LocField as String) As Boolean
Dim i as integer
For i = Lbound(LocArray()) to MaxIndex
If Ucase(LocArray(i)) = Ucase(LocField) Then
FieldInArray = True
Exit Function
End if
Next
FieldInArray = False
End Function
' Checks if a Field (LocField) is already defined in an Array
' Returns 'True' or 'False'
Function FieldinList(LocField, BigList()) As Boolean
Dim i as integer
For i = Lbound(BigList()) to Ubound(BigList())
If LocField = BigList(i) Then
FieldInList = True
Exit Function
End if
Next
FieldInList = False
End Function
' Retrieves the Index of the delivered String 'SearchString' in
' the Array LocList()'
Function IndexinArray(SearchString as String, LocList()) as Integer
Dim i as integer
For i = Lbound(LocList(),1) to Ubound(LocList(),1)
If Ucase(LocList(i,0)) = Ucase(SearchString) Then
IndexinArray = i
Exit Function
End if
Next
IndexinArray = -1
End Function
Sub MultiArrayInListbox(oDialog as Object, ListboxName as String, ValList(), iDim as Integer)
Dim oListbox as Object
Dim i as integer
Dim a as Integer
a = 0
oListbox = oDialog.GetControl(ListboxName)
oListbox.RemoveItems(0, oListbox.GetItemCount)
For i = 0 to Ubound(ValList(), 1)
If ValList(i) <> "" Then
oListbox.AddItem(ValList(i, iDim-1), a)
a = a + 1
End If
Next
End Sub
2001-04-30 05:45:28 -05:00
' Searches for a String in a two-dimensional Array by querying all Searchindexex of the second dimension
' and delivers the specific String of the ReturnIndex in the second dimension of the Searchlist()
Function StringInMultiArray(SearchList(), SearchString as String, SearchIndex as Integer, ReturnIndex as Integer, Optional MaxIndex as Integer) as String
Dim i as integer
Dim CurFieldString as String
If IsMissing(MaxIndex) Then
MaxIndex = Ubound(SearchList(),1)
End If
For i = Lbound(SearchList()) to MaxIndex
CurFieldString = SearchList(i,SearchIndex)
If Ucase(CurFieldString) = Ucase(SearchString) Then
StringInMultiArray() = SearchList(i,ReturnIndex)
Exit Function
End if
Next
StringInMultiArray() = ""
End Function
2001-04-23 04:46:42 -05:00
' Replaces the string "OldReplace" through the String "NewReplace" in the String
' 'BigString'
Function ReplaceString(ByVal Bigstring, NewReplace, OldReplace as String) as String
Dim i%, OldReplLen%, BigLen%
If NewReplace <> OldReplace Then
OldReplLen = Len(OldReplace)
i = 1
Do
Biglen = Len(BigString)
i = Instr(i,BigString,OldReplace)
If i <> 0 then
BigString = Mid(BigString,1,i-1) & NewReplace & Mid(BigString,i + OldReplLen,BigLen - i + 1 - OldReplLen
i = i + Len(NewReplace)
End If
Loop until i = 0
End If
ReplaceString = BigString
End Function
' Converts an "ordinary" path to a "URL-Path"
Function ConverttoURL(ByVal BigString as String) as String
Dim Separator as String
If sProductname = "" Then
sProductname = GetProductname()
End If
If BigString <> "" Then
If Instr(1,sProductname,"Sun Webtop") = 0 Then
Separator = GetPathSeparator()
' Is the delivered Path already a URL
If Instr(1,UCase(BigString),"FILE:///") = 0 Then
BigString = ReplaceString(BigString,"/",Separator)
BigString = ReplaceString(BigString,"|",":")
BigString = "file:///" & BigString
End If
End If
ConvertToURL = BigString
Else
ConvertToUrl = ""
End If
End Function
' Converts an "URL-Path" to an ordinary "Path"
Function ConvertfromURL(ByVal BigString as String) as String
Dim Separator as String
Separator = GetPathSeparator()
If Left(Ucase(BigString),8)= "FILE:///" Then
BigString = Mid(BigString, 9, Len(BigString)-8)
BigString = ReplaceString(BigString,Separator,"/")
BigString = ReplaceString(BigString,":","|")
ConvertFromUrl = BigString
End If
End Function
' Retrieves the second value for a next to 'SearchString' in
' a two-dimensional string-Array
Function FindSecondValue(SearchString as String, TwoDimList() as String ) as String
Dim i as Integer
For i = 0 To Ubound(TwoDimList,1)
If Ucase(SearchString) = Ucase(TwoDimList(i,0)) Then
FindSecondValue = TwoDimList(i,1)
Exit For
End If
Next
End Function
' raises a base to a certain power
Function Power(Basis as Double, Exponent as Double) as Double
Power = Exp(Exponent*Log(Basis))
End Function
' rounds a Real to a given Number of Decimals
Function Round(BaseValue as Double, Decimals as Integer) as Double
Dim Multiplicator as Long
Dim DblValue#, RoundValue#
Multiplicator = Power(10,Decimals)
RoundValue = Int(BaseValue * Multiplicator)
Round = RoundValue/Multiplicator
End Function
'Retrieves the mere filename out of a whole path
Function FileNameoutofPath(ByVal Path as String, Separator as String) as String
Dim i as Integer
Dim SepList() as String
SepList() = ArrayoutofString(Path,"/",i)
FileNameoutofPath = SepList(i)
End Function
Function GetFileNameExtension(ByVal FileName as String)
Dim MaxIndex as Integer
Dim SepList() as String
SepList() = ArrayoutofString(FileName,".", MaxIndex)
GetFileNameExtension = SepList(MaxIndex)
End Function
Function GetFileNameWithoutExtension(ByVal FileName as String, Optional Separator as String)
Dim MaxIndex as Integer
Dim SepList() as String
If not IsMissing(Separator) Then
FileName = FileNameoutofPath(FileName, Separator)
End If
SepList() = ArrayoutofString(FileName,".", MaxIndex)
GetFileNameWithoutExtension = RTrimStr(FileName, "." & SepList(MaxIndex)
End Function
Function DirectorynameoutofPath(sPath as String, Separator as String) as String
Dim LocFileName as String
LocFileName = FileNameoutofPath(sPath, Separator)
DirectoryNameoutofPath = DeleteStr(sPath, Separator & LocFileName)
End Function
Function CountCharsinString(BigString, LocChar as String, ByVal StartPos as Integer) as Integer
Dim LocCount%, LocPos%
LocCount = 0
Do
LocPos = Instr(StartPos,BigString,LocChar)
If LocPos <> 0 Then
LocCount = LocCount + 1
StartPos = LocPos+1
End If
Loop until LocPos = 0
CountCharsInString = LocCount
End Function
Function BubbleSortList(ByVal SortList())
Dim s as Integer
Dim t as Integer
Dim i as Integer
Dim DisplayDummy as String
i = Val(SortList(0,0))
For s = 1 to i - 1
For t = 0 to i-s
If SortList(t,0) > SortList(t+1, 0) Then
DisplayDummy = SortList(t,0)
SortList(t,0) = SortList(t+1,0)
SortList(t+1,0) = DisplayDummy
DisplayDummy = SortList(t,1)
SortList(t,1) = SortList(t+1,1)
SortList(t+1,1) = DisplayDummy
End If
Next t
Next s
BubbleSortList = SortList()
End Function
</script:module>
