@Formula-Befehle in Lotus Script abbilden

[TMC]

Hi,

immer mal wieder stoße ich auf die Frage, wie ich denn z.B. ein @Unique in Lotus Script abbilden kann.

Daher mache ich mal ein neues Projekt hier auf, in der Hoffnung, dass sich das ganze nach und nach füllt.

Ich fange mal an:

@ReplaceSubstring:

Code

Function strReplace(Byval target As String, Byval rfrom As String, Byval rto As String) As String
   Dim pos As Long, lastpos As Long
   pos = Instr(target, rfrom)
   lastpos = 1
   Do Until pos = 0
      strReplace = strReplace & Mid$(target, lastpos, pos-lastpos) & rto
      lastpos = pos + Len(rfrom)
      pos = Instr(lastpos, target, rfrom)
   Loop
   strReplace = strReplace & Mid$(target, lastpos)
End Function

@Unique:

Infos von der Quelle (Sandbox Tipp DB):

Suppose you have built an array that may have duplicate items, and now you want to "clean up" the array by eliminating the duplicates.  The obvious way to do this is to loop through the array and build another array without the duplicates.  
An alternative method is to build a list array where each listtag is the value for the desired array.  (Remember, since we only need the listtag from the list array the value that the elements of the array are set to is irrelevant - in the function we set them to 1.)  After building the list array, loop through the list and pull the listtag values out and write them to the final array.  This prevents dupes from getting into the array, and eliminates the need for any REDIMs.
Here is button demonstrating this concept.  This button uses a LotusScript function called "Unique" to perform the same operation that @Unique(list) performs, using the technique described above.

Button-Code:

Code

Sub Click(Source As Button)
     Dim newitem$, reslist$, ulist As Variant
     newitem = "Notes is kewl"
     x = 0
     
     REM prompt the user for items for the array till they quit
     Do While newitem <> ""
          If newitem <> "" Then
               Redim Preserve slist(x) As String
               REM InputBox[$] ( prompt [ , [ title ] [ , [ default ] [ , xpos , ypos ] ] ] )
                 newitem = Inputbox$("Enter another item to add to the list." & Chr$(10) & "Click Cancel when you are done.", "Enter Item", newitem)
               slist(x) = newitem
               x = x + 1
          End If
     Loop
     
     REM run the array through the unique function
     ulist = Unique(slist)
     
     REM Now set up the result so it can be displayed to the user
     Forall u In ulist
          reslist = reslist & Chr$(10) & u
     End Forall
     Msgbox "The unique list is:" & reslist,, "Unique Result"
End Sub

Function Code

Code

Function Unique(a) 
     Dim data List As Integer
     Dim i%, n%
     
     REM test to see if a is an array; if not, return it
     If Not(IsArray(a)) Then
           Unique = a
           Exit Function
     End If

     For i=Lbound(a) To Ubound(a) 
          data( Cstr(a(i)) ) = i 
     Next
     
     REM This takes the new list and puts it back into an array
     n = 0
     Redim newarray(0 To Ubound(a)-Lbound(a)) 
     Forall z In data
          newarray(n) = a(z) 
          n = n + 1
     End Forall
     Redim Preserve newarray(0 To n-1) 
     
     REM This returns the new array
     Unique = newarray
End Function

TMC

P.S.: Sollte es schon eine Auflistung im World Wide Web geben, bitte um Info, dann schließe ich das wieder

[TMC]

Damit nicht gleich die Frage aufkommt, "wie Formel in Script verwenden":

Syntax

variant = notesSession.Evaluate( formula$, doc )

variant: Das Rückgabewert. Ist ein "Skalar"-Wert.
formula$: String. Eben die Formel
doc: NotesDocument. Der Formelkontext. Darf nicht null sein.


TMC

[TMC]

@RightBack

Text der Quelle:

Similar to the @RightBack function, RightBackArr takes a string scalar or array and a search string or numeric position, and returns everything to the right of the last occurrence of the search string. RightBack function is similar but only works on scalars. In R5, you can use StrRightBack instead of RightBack if your position argument is a string.

Für R5 und höher:

Code

Function RightBackArr(src, pos, Byval flags As Integer)
   If Isarray(src) Then
      Dim i As Integer
      Redim result(Lbound(src) To Ubound(src))
      For i = Lbound(src) To Ubound(src)
         result(i) = RightBackArr(src(i), pos)
      Next
      RightBackArr = result
   Elseif Datatype(pos) = 8 Then
      RightBackArr = StrRightBack(src, pos, flags)
   Else
      RightBackArr = Mid$(src, pos)
   End If
End Function

Für R4 und höher:

Code

Function RightBack(Byval src As String, pos) As String
   If Datatype(pos) = 8 Then
      ' position is a string.
      If pos = "" Then Exit Function
      Dim epos&, lpos&
      epos = Instr(src, pos)
      Do Until epos = 0
         lpos = epos
         epos = Instr(epos + Len(pos), src, pos)
      Loop
      If lpos > 0 Then
         RightBack = Mid$(src, lpos+Len(pos))
      End If
   Else
      RightBack = Mid$(src, pos)
   End If
End Function

Function RightBackArr(src, pos)
   If Isarray(src) Then
      Dim i As Integer
      Redim result(Lbound(src) To Ubound(src))
      For i = Lbound(src) To Ubound(src)
         result(i) = RightBack(src(i), pos)
      Next
      RightBackArr = result
   Else
      RightBackArr = RightBack(src, pos)
   End If
End Function

[TMC]

@LeftBack

Text der Quelle:

Equivalent to @LeftBack except that it doesn't handle lists. Intended for use in R4 apps that can't use StrLeftBack.
Note: StrLeftBack can only search for strings. This function can take a string or a numeric position, like @LeftBack.

Script:

Code

Function LeftBack(Byval src As String, pos) As String
   If Datatype(pos) = 8 Then
      If pos = "" Then Exit Function
      Dim epos&, lpos&
      epos = Instr(src, pos)
      Do Until epos = 0
         lpos = epos
         epos = Instr(epos + Len(pos), src, pos)
      Loop
      If lpos > 0 Then
         LeftBack = Mid$(src,1, lpos-1)
      End If
   Else
      LeftBack = Mid$(src, pos)
   End If
End Function

[TMC]

@Replace

Code

Function atReplace(src As Variant, from_list As Variant, to_list As Variant) As Variant
' Replace in src all occurrences of an item in from_list with the corresponding element of to_list.
   ' Resembles the macro language @Replace function.
   Dim i%
   If Isarray(src) Then
      Redim result(Lbound(src) To Ubound(src))
      For i = Lbound(result) To Ubound(result)
         result(i) = atReplace(src(i), from_list, to_list)
' Note: we expect the elements of Replace to be simple strings, but this will also work with an array of arrays.
      Next
      atReplace = result
   Elseif Isarray(from_list) Then
' The "from" argument is an array; compare each element of the array against the scalar value src.
      For i = Lbound(from_list) To Ubound(from_list)
         If src = from_list(i) Then
' If a match is found, get the corresponding element of the "to" list (null string if no corresponding element).
            If Isarray(to_list) Then
               If Ubound(to_list) < i Then
                  atReplace = ""
               Else
                  atReplace = to_list(i)
               End If
            Elseif i = 0 Then
               atReplace = to_list
            Else
               atReplace = ""
            End If
            Exit Function
         End If
      Next
      atReplace = src
   Elseif from_list = src Then
      If Isarray(to_list) Then
         atReplace = to_list(Lbound(to_list))
      Else
         atReplace = to_list
      End If
   Else
      atReplace = src
   End If
End Function

[TMC]

@Count

Code

Function atCount(s$, k$) As Long
   Dim p&, r&
   p = 1
   atCount = 0
   While p>0
      r = Instr(p, s$, k$)
      If r>0 Then
         atCount = atCount + 1
         p  =  r + Len(k$)
      Else
         p = 0
      End If
   Wend
End Function

[TMC]

@Explode

Code

Function atExplode(Byval s$, Byval div$) As Variant
   Redim result(0 To 0) As String
   Dim i%, pos&, oldpos&, skip&
   oldpos = 1
   skip = Len(div)
   pos = Instr(s, div)
   Do Until pos = 0
      Redim Preserve result(0 To i+1)
      result(i) = Mid$(s, oldpos, pos-oldpos)
      i = i + 1
      oldpos = pos + skip
      pos = Instr(oldpos, s, div)
   Loop
   result(i) = Mid$(s, oldpos)
   atExplode = result
End Function

[TMC]

@Implode

Code

Function atImplode(s, div As String) As String
   If Isarray(s) Then
      Dim i%
      atImplode = s(Lbound(s))
      For i = Lbound(s)+1 To Ubound(s)
         atImplode = atImplode & div & s(i)
      Next
   Else
      atImplode = Cstr(s)
   End If
End Function

@ReplaceSubstring

Code

Function atReplaceSubstring(source As Variant, repl As Variant, replacewith As Variant) As Variant
' Written 24 Sept 1996 by Andre Guirard.
   Dim tTo As Variant, tFrom As Variant
   Dim i&, j&
   
' If the search string and replacement are not arrays, make them one element arrays; this makes the
' subsequent code simpler.
   If Isarray(repl) Then
      tFrom = repl
   Else
      tFrom = SingleElementArray(repl)
   End If
   If Isarray(replacewith) Then
      tTo = replacewith
   Else
      tTo = SingleElementArray(replacewith)
   End If
   
' If the main input is an array, recursively process each element and return the results as an array.
   If Isarray(source) Then
      Redim result(Lbound(source) To Ubound(source)) As Variant
      For i = Lbound(source) To Ubound(source)
         result(i) = atReplaceSubstring(source(i), tFrom, tTo)
      Next
      atReplaceSubstring = result
   Else
      Dim res$, src$
      src$ = source
      For i = 1 To Len(src$)
' Scan the list of search strings to see whether any of them is present at position i in the source string.
         For j = Lbound(tFrom) To Ubound(tFrom)
            If tFrom(j) = Mid$(src$, i, Len(tFrom(j))) Then
               Exit For
            End If
         Next
' If a match was found, replace it in the output with the corresponding "replacewith" entry.
         If j <= Ubound(tFrom) Then
            res$ = res$ + tTo(min(Ubound(tTo), j))
            i = i + max(0, Len(tFrom(j)) - 1)
  ' shift the input pointer past the end of the matching string so we don't match another string in the middle of it.
         Else
' Otherwise, copy over the one character at position i.
            res$ = res$ + Mid$(src$, i, 1)
         End If
      Next
      atReplaceSubstring = res$
   End If
End Function

[Semeaphoros]

Well, in R5 und nochmal in ND6 sind eine ganze Reihe solcher Sachen in Script aufgetaucht, zum Bleistift:

Removes duplicate elements from an Array.
Syntax
ArrayUnique(sourceArray [,compMethod ])



Replaces specific words or phrases in a string with new words or phrases that you specify.
Syntax
Replace(sourceArray as Variant, findArray as Variant, replacementArray as Variant[, start as Integer[, count as Integer[, compMethod as Integer]]]) as Variant



Die ND6-Designer-Hilfe hat häufig (leider nicht immer) eine Cross-Language-Section, so dass man diese Aequivalente findet.

[koehlerbv]

TMC, der Rückgabewert ist genau nicht skalar, sondern ein Array (ein- oder mehrdimensional).

Dim v As Variant
v = Evaluate ({@Left ("Das ist ein Test"; 16)})

Msgbox v ergibt nun einen Fehler, es muss ja
Msgbox v (0) heissen.

@TMC:
ReplaceSubstring wie von Dir angegeben ist sicher die im Web häufigst verbreitete Variante, entspricht aber keineswegs dem @ReplaceSubstring - denn dieses verarbeitet auch Arrays und nicht nur Strings. Hier im Forum gibt es m.E. schon eine "richtige Umsetzung".

Die Idee einer wirklich sicheren (!) Umsetzung cooler @functions in einer Art wie Deine "Schlaufen"-Doku von AtNotes hat aber was !
Dies sollte aber unter keinen Umständen auf Nachbildungen von @functions begrenzt sein, sondern um immer wieder benötigte Funktionen wie "IsValueEmpty" oder "CompareValues" oder oder ergänzt werden !

Ich wäre auf jeden Fall mit dabei ;-)

Bernhard

[TMC]

@Name([abbreviate]...)

Code

Function UIDAbbr(ids As Variant)
' This function performs roughly the same task as @Name([abbreviate]...);
' i.e., given an argument which is a string or array of strings, it returns
' the same string or array with the CN=, OU=, etc. stripped off of every
' hierarchical level of what is assumed to be a Notes username.
'
' Example: UIDAbbr("CN=Andre P. Guirard/OU=Nav/O=Hoptoad/C=US")
'   returns "Andre P. Guirard/Nav/Hoptoad/US"
   If Isarray(ids) Then
      Dim i%
      Redim r(Lbound(ids) To Ubound(ids)) As String
      For i = Lbound(ids) To Ubound(ids)
         r(i) = UIDAbbr(ids(i))
      Next
      UIDAbbr = r
   Else
      UIDAbbr = Fulltrim(atReplaceSubstring(atImplode(atWord(atExplode(atWord(Cstr(ids), "<@", 1), "/"), "=", -1), "/"), """", ""))
   End If
End Function

@Name([CN]...)

Code

Function UIDCn(ids)
' This function performs roughly the same task as @Name([CN]...);
'
' Example: UIDCn("CN=Andre P. Guirard/OU=HiRollers/O=Gossamer/C=US")
'   returns "Andre P. Guirard"
'
' If passed an array, it will process each element separately and return an
' array as a result.
   If Isarray(ids) Then
      Dim i%
      Redim r$(Lbound(ids) To Ubound(ids))
      For i = Lbound(ids) To Ubound(ids)
         r$(i) = UIDCn(ids(i))
      Next
      UIDCn = r$
   Else
      UIDCn = Trim(atReplaceSubstring(atWord(atWord(Cstr(ids), "/<@", 1), "=", -1), """", ""))
   End If
End Function

[TMC]

Weiterer Code zu @Unique

Ich hau jetzt erstmal alle Functions rein die ich so finde als Diskussionsbasis :-)

Könnte auch was doppelt werden .......

Code

Function atUnique(a, Byval caseflag%) As Variant
' a is an array. The return value is the same array with duplicate elements removed.
' Note: this is a case sensitive comparison. A non-case sensitive version of this
' function is available in the @NCFunctions script library. Non-text elements are
' considered to be duplicates if their text representations match another element,
' e.g. the number 5 is considered a duplicate of the string "5".
' The caseflag argument is True for a case-sensitive comparison, False for case sensitive
   Dim data List As Integer
   Dim i%, n%
   
   For i=Lbound(a) To Ubound(a) ' don't assume that the array starts at index 0.
      If caseflag Then data( Cstr(a(i)) ) = i Else data( Lcase(Cstr(a(i))) ) = i
       ' remember array index of original element.
   Next
   
' Take the new list and put it into a new array
   Redim newarray(0 To Ubound(a)-Lbound(a)) ' initially dimension array to maximum size we might need.
   Forall z In data
      newarray(n) = a(z) ' copying from the original array instead of the list tags lets us preserve the original datatype of the elements.
      n = n + 1
   End Forall
   Redim Preserve newarray(0 To n-1) ' redimension the array only once, after we know how large it should be.
   
   atUnique = newarray
End Function

[TMC]

@Left

Code

Function atLeft(str_or_list, position, Byval flags%)
 ' This reproduces the @Left function of the Notes macro language.
 'Syntax: atLeft(str_or_list, position)
' where:
'   str_or_list is a string or string array.
'   position is either a number or a string.
'  
'  If  'position' is a number and str_or_list is a string, the first 'position' characters
'  of the str_or_list are returned, or if str_or_list contains fewer than 'position'
'  characters, the entire string.
'
'  If  'position' is a string and str_or_list is a string, the result is the portion of
'  str_or_list that precedes the first occurence of the string 'position' (case sensitive
'  search).  If 'position' is not found, the empty string is returned.
'
'  If str_or_list is an array, the return value is an array where each element contains
'  the result of the Left function on that element.
   
   ' arguments: str_or_list: string or array of strings to search in.
   ' position: integer or string: position in str_or_list if numeric, else string to search for in str_or_list
   ' flags option added for R5 - case/pitch sensitivity (see Strright function in developer help).
   ' return value: same type as str_or_list, containing the portion (of each element, if an array) to the left of 'position'
   Dim seekval, c%
   If Isarray(position) Then
      seekval = position(Lbound(position))
   Else
      seekval = position
   End If
   
   If Isarray(str_or_list) Then
      Redim result(Lbound(str_or_list) To Ubound(str_or_list))
      If Vartype(seekval) <> 8 Then
         For c = Lbound(result) To Ubound(result)
            result(c) = Left(str_or_list(c), seekval)
         Next
      Else
         For c = Lbound(result) To Ubound(result)
            result(c) = Strleft(str_or_list(c), seekval, flags)
         Next
      End If
      atLeft = result
   Elseif Vartype(seekval) <> 8 Then
      atLeft = Left(str_or_list, seekval)
   Else
      ' change for R5: use Strleft instead of Instr and Right
      atLeft = Strleft(str_or_list, seekval, flags)
   End If
End Function

[TMC]

@Repeat

Code

Function atRepeat(s, Byval count As Integer)
' Given a string and a count, Repeat returns a string which is
' the argument value repeated "count" times.  Passed an array,
' it returns an array where each element is the corresponding
' source element repeated "count" times.
   Dim i%
   If Isarray(s) Then
      Redim hark(Lbound(s) To Ubound(s)) As String
      For i = Lbound(s) To Ubound(s)
         hark(i) = atRepeat(s(i), count)
      Next
      atRepeat = hark
   Elseif Vartype(s) = 8 Then
      Select Case Len(s)
      Case 0:
         atRepeat = "" ' empty string repeated any number of times is still empty.
      Case 1:
         atRepeat = String(s, count) ' This is much faster than using a loop.
      Case Else
         atRepeat = ""
         For i = 1 To count
            atRepeat = atRepeat & s
         Next
      End Select
   Else
      atRepeat = atRepeat(Cstr(s), count)
   End If
End Function

[Semeaphoros]

Bernhard: Ist schon klar, wollte nur drauf hinweisen, dass es diese Funktionen gibt, viele Leute haben das eben übersehen, und wenn die eingebaute Funktion die geforderte Leistung erbringt (was nicht bei allen der Fall ist), ist sie zu bevorzugen, weil meilenweit schneller als irgendwas nachgebautes. Aber Du hast schon recht, es sind nicht immer Gleichsetzungen, sondern nur Teiläquivalente, aber dafür gibt es ja die Hilfe ......

[koehlerbv]

Wenn wir 'ne Sammlung aufbauen, dann sollten die Sources aber ordentlich geschrieben werden und nicht so grauslig wie in den von Dir gefundenen Beispielen. Und ordentlich dokumentiert. Nach einem ersten Blick auf die zweite @ReplaceSubstring-Variante: Was passiert, wenn die Arrays unterschiedlich viele Elemente enthalten ?
Was demzufolge noch gemacht werden sollte: Ordentliche Testszenarien und -dokumentationen !

Was meint Ihr ?

Bernhard

[TMC]

@Min

Code

Function min(a,b)
   If a < b Then
      min = a
   Else
      min = b
   End If
End Function

[TMC]

@Max

Code

Function max(a,b)
   If a < b Then
      max = b
   Else
      max = a
   End If
End Function

[TMC]

@Right

Code

Function atRight(str_or_list, position, Byval flags%)
   ' arguments: str_or_list: string or array of strings to search in.
   ' position: integer or string: position in str_or_list if numeric, else string to search for in str_or_list
   ' flags option added for R5 - case/pitch sensitivity (see Strright function in developer help).
   ' return value: same type as str_or_list, containing the portion (of each element, if an array) to the right of 'position'
   Dim seekval, c%
   If Isarray(position) Then
      seekval = position(Lbound(position))
   Else
      seekval = position
   End If
   
   If Isarray(str_or_list) Then
      Redim result(Lbound(str_or_list) To Ubound(str_or_list))
      For c = Lbound(result) To Ubound(result)
         If Vartype(seekval) <> 8 Then
            result(c) = Right(str_or_list(c), seekval)
         Else
            result(c) = Strright(str_or_list(c), seekval, flags)
         End If
      Next
      atRight = result
   Elseif Vartype(seekval) <> 8 Then
      atRight = Right(str_or_list, seekval)
   Else
      ' change for R5: use Strright instead of Instr and Right
      atRight = Strright(str_or_list, seekval, flags)
   End If
End Function

@Word

Code

Function atWord(s, d$, i%)
   If Isarray(s) Then
      Dim j
      Redim r(0 To Ubound(s)-Lbound(s)) As String
      For j = 0 To Ubound(r)
         r(j) = atWord(s(j), d, i)
      Next
      atWord = r
   Elseif Len(d$) = 1 Then
      atWord = EasyWord(Cstr(s), d, i)
   Else
      atWord = Word(Cstr(s), d, i)
   End If
End Function

[Semeaphoros]

Ja, eine wirklich saubere Sammlung von unterstützenden Funktionen, gut dokumentiert, gut getestet, das ist eine gute Sache, mache ich auch mit.