wizards/source/tools/Strings.xba

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