415 lines
No EOL
12 KiB
XML
415 lines
No EOL
12 KiB
XML
<?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 as Integer
|
|
Dim BigLen as Integer
|
|
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 CurUbound as Integer
|
|
Dim StartUbound as Integer
|
|
StartUbound = 50
|
|
Dim LocList(StartUbound) as String
|
|
CurUbound = StartUbound
|
|
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
|
|
If i = CurUbound Then
|
|
CurUbound = CurUbound + StartUbound
|
|
ReDim Preserve LocList(CurUbound) as String
|
|
End If
|
|
Loop until Pos = 0
|
|
If Not IsMissing(Maxindex) Then
|
|
MaxIndex = i
|
|
End If
|
|
ReDim Preserve LocList(i) as String
|
|
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
|
|
|
|
|
|
' 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
|
|
|
|
|
|
' 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 IsFatOffice() 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 = RTrimStr(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(),optional sort2ndValue as Boolean)
|
|
Dim s as Integer
|
|
Dim t as Integer
|
|
Dim i,k as Integer
|
|
Dim bJustOneDim, bSort2nd as Boolean
|
|
Dim DisplayDummy as String
|
|
bJustOneDim = false
|
|
bSort2nd = false
|
|
On Local Error Goto No2ndDim
|
|
k = Ubound(SortList(),2)
|
|
No2ndDim:
|
|
bJustOneDim = Err <> 0
|
|
i = Ubound(SortList(),1)
|
|
If ismissing(sort2ndValue) then
|
|
bSort2nd = false
|
|
else
|
|
bSort2nd = sort2ndValue
|
|
end if
|
|
|
|
For s = 1 to i - 1
|
|
For t = 0 to i-s
|
|
If bJustOneDim Then
|
|
If SortList(t) > SortList(t+1) Then
|
|
DisplayDummy = SortList(t)
|
|
SortList(t) = SortList(t+1)
|
|
SortList(t+1) = DisplayDummy
|
|
End If
|
|
Else
|
|
If bSort2nd Then
|
|
If SortList(t,1) > SortList(t+1,1) 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
|
|
Else
|
|
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
|
|
End If
|
|
End If
|
|
Next t
|
|
Next s
|
|
BubbleSortList = SortList()
|
|
End Function
|
|
</script:module> |