| <?xml version="1.0" encoding="UTF-8"?> |
| <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> |
| <!--*********************************************************** |
| * |
| * Licensed to the Apache Software Foundation (ASF) under one |
| * or more contributor license agreements. See the NOTICE file |
| * distributed with this work for additional information |
| * regarding copyright ownership. The ASF licenses this file |
| * to you under the Apache License, Version 2.0 (the |
| * "License"); you may not use this file except in compliance |
| * with the License. You may obtain a copy of the License at |
| * |
| * http://www.apache.org/licenses/LICENSE-2.0 |
| * |
| * Unless required by applicable law or agreed to in writing, |
| * software distributed under the License is distributed on an |
| * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY |
| * KIND, either express or implied. See the License for the |
| * specific language governing permissions and limitations |
| * under the License. |
| * |
| ***********************************************************--> |
| <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)) |
| SearchPos = EndPos + PostLen |
| Else |
| Msgbox("No final tag for '" & PreString & "' existing", 16, GetProductName()) |
| FindPartString = "" |
| End If |
| Else |
| FindPartString = "" |
| End If |
| End Function |
| |
| |
| ' Note iCompare = 0 (Binary comparison) |
| ' iCompare = 1 (Text comparison) |
| Function PartStringInArray(BigArray(), SearchString as String, iCompare as Integer) as Integer |
| Dim MaxIndex as Integer |
| Dim i as Integer |
| MaxIndex = Ubound(BigArray()) |
| For i = 0 To MaxIndex |
| If Instr(1, BigArray(i), SearchString, iCompare) <> 0 Then |
| PartStringInArray() = i |
| Exit Function |
| End If |
| Next i |
| PartStringInArray() = -1 |
| 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 Instr(1,BigString, SmallString) <> 0 Then |
| If Mid(BigString,BigLen + 1 - SmallLen, SmallLen) = SmallString Then |
| RTrimStr = Mid(BigString,1,BigLen - SmallLen) |
| Else |
| RTrimStr = BigString |
| End If |
| 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 MaxIndex delivers the highest Index of this Array |
| Function ArrayOutOfString(BigString, Separator as String, Optional MaxIndex as Integer) |
| Dim LocList() as String |
| LocList=Split(BigString,Separator) |
| |
| If not isMissing(MaxIndex) then maxIndex=ubound(LocList()) |
| |
| 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 |
| |
| |
| ' Searches for a Value in multidimensial Array by querying all Searchindices of the passed dimension |
| ' and delivers the Index where it is found. |
| Function GetIndexInMultiArray(SearchList(), SearchValue, SearchIndex as Integer) as Integer |
| Dim i as integer |
| Dim MaxIndex as Integer |
| Dim CurFieldValue |
| MaxIndex = Ubound(SearchList(),1) |
| For i = Lbound(SearchList()) to MaxIndex |
| CurFieldValue = SearchList(i,SearchIndex) |
| If CurFieldValue = SearchValue Then |
| GetIndexInMultiArray() = i |
| Exit Function |
| End if |
| Next |
| GetIndexInMultiArray() = -1 |
| End Function |
| |
| |
| ' Searches for a Value in multidimensial Array by querying all Searchindices of the passed dimension |
| ' and delivers the Index where the Searchvalue is found as a part string |
| Function GetIndexForPartStringinMultiArray(SearchList(), SearchValue, SearchIndex as Integer) as Integer |
| Dim i as integer |
| Dim MaxIndex as Integer |
| Dim CurFieldValue |
| MaxIndex = Ubound(SearchList(),1) |
| For i = Lbound(SearchList()) to MaxIndex |
| CurFieldValue = SearchList(i,SearchIndex) |
| If Instr(CurFieldValue, SearchValue) > 0 Then |
| GetIndexForPartStringinMultiArray() = i |
| Exit Function |
| End if |
| Next |
| GetIndexForPartStringinMultiArray = -1 |
| End Function |
| |
| |
| Function ArrayfromMultiArray(MultiArray as String, iDim as Integer) |
| Dim MaxIndex as Integer |
| Dim i as Integer |
| MaxIndex = Ubound(MultiArray()) |
| Dim ResultArray(MaxIndex) as String |
| For i = 0 To MaxIndex |
| ResultArray(i) = MultiArray(i,iDim) |
| Next i |
| ArrayfromMultiArray() = ResultArray() |
| End Function |
| |
| |
| ' Replaces the string "OldReplace" through the String "NewReplace" in the String |
| ' 'BigString' |
| Function ReplaceString(ByVal Bigstring, NewReplace, OldReplace as String) as String |
| ReplaceString=join(split(BigString,OldReplace),NewReplace) |
| 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, Optional Separator as String) as String |
| Dim i as Integer |
| Dim SepList() as String |
| If IsMissing(Separator) Then |
| Path = ConvertFromUrl(Path) |
| Separator = GetPathSeparator() |
| End If |
| SepList() = ArrayoutofString(Path, Separator,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) |
| 'This function bubble sorts an array of maximum 2 dimensions. |
| 'The default sorting order is the first dimension |
| 'Only if sort2ndValue is True the second dimension is the relevant for the sorting order |
| Dim s as Integer |
| Dim t as Integer |
| Dim i as Integer |
| Dim k as Integer |
| Dim dimensions as Integer |
| Dim sortvalue as Integer |
| Dim DisplayDummy |
| dimensions = 2 |
| |
| On Local Error Goto No2ndDim |
| k = Ubound(SortList(),2) |
| No2ndDim: |
| If Err <> 0 Then dimensions = 1 |
| |
| i = Ubound(SortList(),1) |
| If ismissing(sort2ndValue) then |
| sortvalue = 0 |
| else |
| sortvalue = 1 |
| end if |
| |
| For s = 1 to i - 1 |
| For t = 0 to i-s |
| Select Case dimensions |
| Case 1 |
| If SortList(t) > SortList(t+1) Then |
| DisplayDummy = SortList(t) |
| SortList(t) = SortList(t+1) |
| SortList(t+1) = DisplayDummy |
| End If |
| Case 2 |
| If SortList(t,sortvalue) > SortList(t+1,sortvalue) Then |
| For k = 0 to UBound(SortList(),2) |
| DisplayDummy = SortList(t,k) |
| SortList(t,k) = SortList(t+1,k) |
| SortList(t+1,k) = DisplayDummy |
| Next k |
| End If |
| End Select |
| Next t |
| Next s |
| BubbleSortList = SortList() |
| End Function |
| |
| |
| Function GetValueoutofList(SearchValue, BigList(), iDim as Integer, Optional ValueIndex) |
| Dim i as Integer |
| Dim MaxIndex as Integer |
| MaxIndex = Ubound(BigList(),1) |
| For i = 0 To MaxIndex |
| If BigList(i,0) = SearchValue Then |
| If Not IsMissing(ValueIndex) Then |
| ValueIndex = i |
| End If |
| GetValueOutOfList() = BigList(i,iDim) |
| End If |
| Next i |
| End Function |
| |
| |
| Function AddListtoList(ByVal FirstArray(), ByVal SecondArray(), Optional StartIndex) |
| Dim n as Integer |
| Dim m as Integer |
| Dim MaxIndex as Integer |
| MaxIndex = Ubound(FirstArray()) + Ubound(SecondArray()) + 1 |
| If MaxIndex > -1 Then |
| Dim ResultArray(MaxIndex) |
| For m = 0 To Ubound(FirstArray()) |
| ResultArray(m) = FirstArray(m) |
| Next m |
| For n = 0 To Ubound(SecondArray()) |
| ResultArray(m) = SecondArray(n) |
| m = m + 1 |
| Next n |
| AddListToList() = ResultArray() |
| Else |
| Dim NullArray() |
| AddListToList() = NullArray() |
| End If |
| End Function |
| |
| |
| Function CheckDouble(DoubleString as String) |
| On Local Error Goto WRONGDATATYPE |
| CheckDouble() = CDbl(DoubleString) |
| WRONGDATATYPE: |
| If Err <> 0 Then |
| CheckDouble() = 0 |
| Resume NoErr: |
| End If |
| NOERR: |
| End Function |
| </script:module> |