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 ' 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 ' 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 = "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 Function GetValueoutofList(SearchValue, BigList(), iDim as Integer) Dim i as Integer Dim MaxIndex as Integer MaxIndex = Ubound(BigList(),1) For i = 0 To MaxIndex If BigList(i,0) = SearchValue Then GetValueOutOfList() = BigList(i,iDim) End If Next i End Function