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="Strings" script:language="StarBasic">Option Explicit 24Public sProductname as String 25 26 27' Deletes out of a String 'BigString' all possible PartStrings, that are summed up 28' in the Array 'ElimArray' 29Function ElimChar(ByVal BigString as String, ElimArray() as String) 30Dim i% ,n% 31 For i = 0 to Ubound(ElimArray) 32 BigString = DeleteStr(BigString,ElimArray(i) 33 Next 34 ElimChar = BigString 35End Function 36 37 38' Deletes out of a String 'BigString' a possible Partstring 'CompString' 39Function DeleteStr(ByVal BigString,CompString as String) as String 40Dim i%, CompLen%, BigLen% 41 CompLen = Len(CompString) 42 i = 1 43 While i <> 0 44 i = Instr(i, BigString,CompString) 45 If i <> 0 then 46 BigLen = Len(BigString) 47 BigString = Mid(BigString,1,i-1) + Mid(BigString,i+CompLen,BigLen-i+1-CompLen) 48 End If 49 Wend 50 DeleteStr = BigString 51End Function 52 53 54' Finds a PartString, that is framed by the Strings 'Prestring' and 'PostString' 55Function FindPartString(BigString, PreString, PostString as String, SearchPos as Integer) as String 56Dim StartPos%, EndPos% 57Dim BigLen%, PreLen%, PostLen% 58 StartPos = Instr(SearchPos,BigString,PreString) 59 If StartPos <> 0 Then 60 PreLen = Len(PreString) 61 EndPos = Instr(StartPos + PreLen,BigString,PostString) 62 If EndPos <> 0 Then 63 BigLen = Len(BigString) 64 PostLen = Len(PostString) 65 FindPartString = Mid(BigString,StartPos + PreLen, EndPos - (StartPos + PreLen)) 66 SearchPos = EndPos + PostLen 67 Else 68 Msgbox("No final tag for '" & PreString & "' existing", 16, GetProductName()) 69 FindPartString = "" 70 End If 71 Else 72 FindPartString = "" 73 End If 74End Function 75 76 77' Note iCompare = 0 (Binary comparison) 78' iCompare = 1 (Text comparison) 79Function PartStringInArray(BigArray(), SearchString as String, iCompare as Integer) as Integer 80Dim MaxIndex as Integer 81Dim i as Integer 82 MaxIndex = Ubound(BigArray()) 83 For i = 0 To MaxIndex 84 If Instr(1, BigArray(i), SearchString, iCompare) <> 0 Then 85 PartStringInArray() = i 86 Exit Function 87 End If 88 Next i 89 PartStringInArray() = -1 90End Function 91 92 93' Deletes the String 'SmallString' out of the String 'BigString' 94' in case SmallString's Position in BigString is right at the end 95Function RTrimStr(ByVal BigString, SmallString as String) as String 96Dim SmallLen as Integer 97Dim BigLen as Integer 98 SmallLen = Len(SmallString) 99 BigLen = Len(BigString) 100 If Instr(1,BigString, SmallString) <> 0 Then 101 If Mid(BigString,BigLen + 1 - SmallLen, SmallLen) = SmallString Then 102 RTrimStr = Mid(BigString,1,BigLen - SmallLen) 103 Else 104 RTrimStr = BigString 105 End If 106 Else 107 RTrimStr = BigString 108 End If 109End Function 110 111 112' Deletes the Char 'CompChar' out of the String 'BigString' 113' in case CompChar's Position in BigString is right at the beginning 114Function LTRimChar(ByVal BigString as String,CompChar as String) as String 115Dim BigLen as integer 116 BigLen = Len(BigString) 117 If BigLen > 1 Then 118 If Left(BigString,1) = CompChar then 119 BigString = Mid(BigString,2,BigLen-1) 120 End If 121 ElseIf BigLen = 1 Then 122 BigString = "" 123 End If 124 LTrimChar = BigString 125End Function 126 127 128' Retrieves an Array out of a String. 129' The fields of the Array are separated by the parameter 'Separator', that is contained 130' in the Array 131' The Array MaxIndex delivers the highest Index of this Array 132Function ArrayOutOfString(BigString, Separator as String, Optional MaxIndex as Integer) 133Dim LocList() as String 134 LocList=Split(BigString,Separator) 135 136 If not isMissing(MaxIndex) then maxIndex=ubound(LocList()) 137 138 ArrayOutOfString=LocList 139End Function 140 141 142' Deletes all fieldvalues in one-dimensional Array 143Sub ClearArray(BigArray) 144Dim i as integer 145 For i = Lbound(BigArray()) to Ubound(BigArray()) 146 BigArray(i) = "" 147 Next 148End Sub 149 150 151' Deletes all fieldvalues in a multidimensional Array 152Sub ClearMultiDimArray(BigArray,DimCount as integer) 153Dim n%, m% 154 For n = Lbound(BigArray(),1) to Ubound(BigArray(),1) 155 For m = 0 to Dimcount - 1 156 BigArray(n,m) = "" 157 Next m 158 Next n 159End Sub 160 161 162' Checks if a Field (LocField) is already defined in an Array 163' Returns 'True' or 'False' 164Function FieldinArray(LocArray(), MaxIndex as integer, LocField as String) As Boolean 165Dim i as integer 166 For i = Lbound(LocArray()) to MaxIndex 167 If Ucase(LocArray(i)) = Ucase(LocField) Then 168 FieldInArray = True 169 Exit Function 170 End if 171 Next 172 FieldInArray = False 173End Function 174 175 176' Checks if a Field (LocField) is already defined in an Array 177' Returns 'True' or 'False' 178Function FieldinList(LocField, BigList()) As Boolean 179Dim i as integer 180 For i = Lbound(BigList()) to Ubound(BigList()) 181 If LocField = BigList(i) Then 182 FieldInList = True 183 Exit Function 184 End if 185 Next 186 FieldInList = False 187End Function 188 189 190' Retrieves the Index of the delivered String 'SearchString' in 191' the Array LocList()' 192Function IndexinArray(SearchString as String, LocList()) as Integer 193Dim i as integer 194 For i = Lbound(LocList(),1) to Ubound(LocList(),1) 195 If Ucase(LocList(i,0)) = Ucase(SearchString) Then 196 IndexinArray = i 197 Exit Function 198 End if 199 Next 200 IndexinArray = -1 201End Function 202 203 204Sub MultiArrayInListbox(oDialog as Object, ListboxName as String, ValList(), iDim as Integer) 205Dim oListbox as Object 206Dim i as integer 207Dim a as Integer 208 a = 0 209 oListbox = oDialog.GetControl(ListboxName) 210 oListbox.RemoveItems(0, oListbox.GetItemCount) 211 For i = 0 to Ubound(ValList(), 1) 212 If ValList(i) <> "" Then 213 oListbox.AddItem(ValList(i, iDim-1), a) 214 a = a + 1 215 End If 216 Next 217End Sub 218 219 220' Searches for a String in a two-dimensional Array by querying all Searchindexex of the second dimension 221' and delivers the specific String of the ReturnIndex in the second dimension of the Searchlist() 222Function StringInMultiArray(SearchList(), SearchString as String, SearchIndex as Integer, ReturnIndex as Integer, Optional MaxIndex as Integer) as String 223Dim i as integer 224Dim CurFieldString as String 225 If IsMissing(MaxIndex) Then 226 MaxIndex = Ubound(SearchList(),1) 227 End If 228 For i = Lbound(SearchList()) to MaxIndex 229 CurFieldString = SearchList(i,SearchIndex) 230 If Ucase(CurFieldString) = Ucase(SearchString) Then 231 StringInMultiArray() = SearchList(i,ReturnIndex) 232 Exit Function 233 End if 234 Next 235 StringInMultiArray() = "" 236End Function 237 238 239' Searches for a Value in multidimensial Array by querying all Searchindices of the passed dimension 240' and delivers the Index where it is found. 241Function GetIndexInMultiArray(SearchList(), SearchValue, SearchIndex as Integer) as Integer 242Dim i as integer 243Dim MaxIndex as Integer 244Dim CurFieldValue 245 MaxIndex = Ubound(SearchList(),1) 246 For i = Lbound(SearchList()) to MaxIndex 247 CurFieldValue = SearchList(i,SearchIndex) 248 If CurFieldValue = SearchValue Then 249 GetIndexInMultiArray() = i 250 Exit Function 251 End if 252 Next 253 GetIndexInMultiArray() = -1 254End Function 255 256 257' Searches for a Value in multidimensial Array by querying all Searchindices of the passed dimension 258' and delivers the Index where the Searchvalue is found as a part string 259Function GetIndexForPartStringinMultiArray(SearchList(), SearchValue, SearchIndex as Integer) as Integer 260Dim i as integer 261Dim MaxIndex as Integer 262Dim CurFieldValue 263 MaxIndex = Ubound(SearchList(),1) 264 For i = Lbound(SearchList()) to MaxIndex 265 CurFieldValue = SearchList(i,SearchIndex) 266 If Instr(CurFieldValue, SearchValue) > 0 Then 267 GetIndexForPartStringinMultiArray() = i 268 Exit Function 269 End if 270 Next 271 GetIndexForPartStringinMultiArray = -1 272End Function 273 274 275Function ArrayfromMultiArray(MultiArray as String, iDim as Integer) 276Dim MaxIndex as Integer 277Dim i as Integer 278 MaxIndex = Ubound(MultiArray()) 279 Dim ResultArray(MaxIndex) as String 280 For i = 0 To MaxIndex 281 ResultArray(i) = MultiArray(i,iDim) 282 Next i 283 ArrayfromMultiArray() = ResultArray() 284End Function 285 286 287' Replaces the string "OldReplace" through the String "NewReplace" in the String 288' 'BigString' 289Function ReplaceString(ByVal Bigstring, NewReplace, OldReplace as String) as String 290 ReplaceString=join(split(BigString,OldReplace),NewReplace) 291End Function 292 293 294' Retrieves the second value for a next to 'SearchString' in 295' a two-dimensional string-Array 296Function FindSecondValue(SearchString as String, TwoDimList() as String ) as String 297Dim i as Integer 298 For i = 0 To Ubound(TwoDimList,1) 299 If Ucase(SearchString) = Ucase(TwoDimList(i,0)) Then 300 FindSecondValue = TwoDimList(i,1) 301 Exit For 302 End If 303 Next 304End Function 305 306 307' raises a base to a certain power 308Function Power(Basis as Double, Exponent as Double) as Double 309 Power = Exp(Exponent*Log(Basis)) 310End Function 311 312 313' rounds a Real to a given Number of Decimals 314Function Round(BaseValue as Double, Decimals as Integer) as Double 315Dim Multiplicator as Long 316Dim DblValue#, RoundValue# 317 Multiplicator = Power(10,Decimals) 318 RoundValue = Int(BaseValue * Multiplicator) 319 Round = RoundValue/Multiplicator 320End Function 321 322 323'Retrieves the mere filename out of a whole path 324Function FileNameoutofPath(ByVal Path as String, Optional Separator as String) as String 325Dim i as Integer 326Dim SepList() as String 327 If IsMissing(Separator) Then 328 Path = ConvertFromUrl(Path) 329 Separator = GetPathSeparator() 330 End If 331 SepList() = ArrayoutofString(Path, Separator,i) 332 FileNameoutofPath = SepList(i) 333End Function 334 335 336Function GetFileNameExtension(ByVal FileName as String) 337Dim MaxIndex as Integer 338Dim SepList() as String 339 SepList() = ArrayoutofString(FileName,".", MaxIndex) 340 GetFileNameExtension = SepList(MaxIndex) 341End Function 342 343 344Function GetFileNameWithoutExtension(ByVal FileName as String, Optional Separator as String) 345Dim MaxIndex as Integer 346Dim SepList() as String 347 If not IsMissing(Separator) Then 348 FileName = FileNameoutofPath(FileName, Separator) 349 End If 350 SepList() = ArrayoutofString(FileName,".", MaxIndex) 351 GetFileNameWithoutExtension = RTrimStr(FileName, "." & SepList(MaxIndex) 352End Function 353 354 355Function DirectoryNameoutofPath(sPath as String, Separator as String) as String 356Dim LocFileName as String 357 LocFileName = FileNameoutofPath(sPath, Separator) 358 DirectoryNameoutofPath = RTrimStr(sPath, Separator & LocFileName) 359End Function 360 361 362Function CountCharsinString(BigString, LocChar as String, ByVal StartPos as Integer) as Integer 363Dim LocCount%, LocPos% 364 LocCount = 0 365 Do 366 LocPos = Instr(StartPos,BigString,LocChar) 367 If LocPos <> 0 Then 368 LocCount = LocCount + 1 369 StartPos = LocPos+1 370 End If 371 Loop until LocPos = 0 372 CountCharsInString = LocCount 373End Function 374 375 376Function BubbleSortList(ByVal SortList(),optional sort2ndValue as Boolean) 377'This function bubble sorts an array of maximum 2 dimensions. 378'The default sorting order is the first dimension 379'Only if sort2ndValue is True the second dimension is the relevant for the sorting order 380 Dim s as Integer 381 Dim t as Integer 382 Dim i as Integer 383 Dim k as Integer 384 Dim dimensions as Integer 385 Dim sortvalue as Integer 386 Dim DisplayDummy 387 dimensions = 2 388 389On Local Error Goto No2ndDim 390 k = Ubound(SortList(),2) 391 No2ndDim: 392 If Err <> 0 Then dimensions = 1 393 394 i = Ubound(SortList(),1) 395 If ismissing(sort2ndValue) then 396 sortvalue = 0 397 else 398 sortvalue = 1 399 end if 400 401 For s = 1 to i - 1 402 For t = 0 to i-s 403 Select Case dimensions 404 Case 1 405 If SortList(t) > SortList(t+1) Then 406 DisplayDummy = SortList(t) 407 SortList(t) = SortList(t+1) 408 SortList(t+1) = DisplayDummy 409 End If 410 Case 2 411 If SortList(t,sortvalue) > SortList(t+1,sortvalue) Then 412 For k = 0 to UBound(SortList(),2) 413 DisplayDummy = SortList(t,k) 414 SortList(t,k) = SortList(t+1,k) 415 SortList(t+1,k) = DisplayDummy 416 Next k 417 End If 418 End Select 419 Next t 420 Next s 421 BubbleSortList = SortList() 422End Function 423 424 425Function GetValueoutofList(SearchValue, BigList(), iDim as Integer, Optional ValueIndex) 426Dim i as Integer 427Dim MaxIndex as Integer 428 MaxIndex = Ubound(BigList(),1) 429 For i = 0 To MaxIndex 430 If BigList(i,0) = SearchValue Then 431 If Not IsMissing(ValueIndex) Then 432 ValueIndex = i 433 End If 434 GetValueOutOfList() = BigList(i,iDim) 435 End If 436 Next i 437End Function 438 439 440Function AddListtoList(ByVal FirstArray(), ByVal SecondArray(), Optional StartIndex) 441Dim n as Integer 442Dim m as Integer 443Dim MaxIndex as Integer 444 MaxIndex = Ubound(FirstArray()) + Ubound(SecondArray()) + 1 445 If MaxIndex > -1 Then 446 Dim ResultArray(MaxIndex) 447 For m = 0 To Ubound(FirstArray()) 448 ResultArray(m) = FirstArray(m) 449 Next m 450 For n = 0 To Ubound(SecondArray()) 451 ResultArray(m) = SecondArray(n) 452 m = m + 1 453 Next n 454 AddListToList() = ResultArray() 455 Else 456 Dim NullArray() 457 AddListToList() = NullArray() 458 End If 459End Function 460 461 462Function CheckDouble(DoubleString as String) 463On Local Error Goto WRONGDATATYPE 464 CheckDouble() = CDbl(DoubleString) 465WRONGDATATYPE: 466 If Err <> 0 Then 467 CheckDouble() = 0 468 Resume NoErr: 469 End If 470NOERR: 471End Function 472</script:module> 473