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:
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:
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
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
@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:
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:
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
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:
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
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
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
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
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
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
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]...)
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
Ich hau jetzt erstmal alle Functions rein die ich so finde als Diskussionsbasis :-)
Könnte auch was doppelt werden .......
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
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
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
Function min(a,b)
If a < b Then
min = a
Else
min = b
End If
End Function
Function max(a,b)
If a < b Then
max = b
Else
max = a
End If
End Function
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
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
Function atTrim(src, Byval options As Integer)
' src is either a string, or an array of strings.
' options is a set of bit flags corresponding to the constants defined above. If the ATTRIM_TAB flag is set,
' we will treat tabs as whitespace, replacing them with spaces. If ATTRIM_NEWLINE is set, newlines will
' be treated as whitespace. And if ATTRIM_KEEP_NULL is set, null elements will not be removed from the
' array.
Dim cc$, result$, i&, pos&
If Isarray(src) Then
' recursively process each array element.
Dim lim%
lim = Lbound(src)
Redim retval(lim To Ubound(src)) As String
pos = lim
For i = Lbound(src) To Ubound(src)
result = atTrim(src(i), options)
If result <> "" Or (options And ATTRIM_KEEP_NULL) Then
retval(pos) = result
pos = pos + 1
End If
Next
Redim Preserve retval(lim To max(lim, pos-1))
atTrim = retval
Else
Dim state%, whitespace%
For i = 1 To Len(src)
cc = Mid(src, i, 1)
' The string is scanned with a state machine.
' State 0 means we have not yet encountered a non-whitespace character.
' State 1 means the last character was non-whitespace.
' State 2 means the last character was whitespace but there have been some non-whitespace.
If (cc = " ") Then
whitespace = True
Elseif cc = Chr$(9) Then
whitespace = (options And ATTRIM_TAB)
Elseif cc = Chr$(10) Or cc = Chr$(13) Then
whitespace = (options And ATTRIM_NEWLINE)
Else
whitespace = False
End If
Select Case state
Case 0:
If whitespace Then
Else
result = cc
state = 1
End If
Case 1:
If whitespace Then
state = 2
Else
result = result + cc
End If
Case Else:
If whitespace Then
Else
result = result + " " + cc
state = 1
End If
End Select
Next
atTrim = result
End If ' src is an array.
End Function
Function atBegins(Byval a$, b)
If Isarray(b) Then
Dim i%
For i = Lbound(b) To Ubound(b)
If atBegins(a, b(i)) Then
atBegins = True
Exit Function
End If
Next
Else
atBegins = (Left(a, Len(b)) = b)
End If
End Function
Function Word(Byval source$, Byval delims$, Byval wordnum%) As String
' source: a string from which a word is to be extracted.
' delims: a string containing one or more characters used as word divisions. Unlike EasyWord,
' this may contain multiple single-character delimiters.
' wordnum: which word out of 'source' you want. positive counts frol left to right; negative from right to left (e.g. -1 returns last word). 0 is illegal.
Dim pos&, tmppos&, lastpos&, i&
If wordnum > 0 Then
pos = 1
Do Until wordnum = 0 Or pos = 0
lastpos = pos
pos = 1
For i = 1 To Len(delims)
tmppos = Instr(pos, source, Mid$(delims, i, 1))
If tmppos > 0 And tmppos < pos Then pos = tmppos+1
Next
wordnum = wordnum - 1
Loop
If pos = 1 Then
word = Mid$(source, lastpos)
Else
word = Mid$(source, lastpos, pos-lastpos-1)
End If
Elseif wordnum < 0 Then
Dim tmpstr$, remst$, laststr$
remst = source
Do Until wordnum = 0
laststr = remst
remst = ""
For i = 1 To Len(delims)
tmpstr = Strleftback(laststr, Mid$(delims, i, 1))
If Len(tmpstr) > Len(remst) Then remst = tmpstr
Next
wordnum = wordnum + 1
Loop
pos = Len(laststr) - Len(remst)
If pos > 0 Then Word = Strright(laststr, pos)
End If
End Function
nur coole Codes aufnehmen, keine 0815 Einzeiler
OK, cool ist ja bekanntlich relativ.
Ich meine:
Ein
Function min(a,b)
If a < b Then
min = a
Else
min = b
End If
End Function
Dafür schaut keiner in einer Code-Plattform etc. nach.
Coole Codes wären z.B.
- eine Liste bereinigen (Leere Zeilen rausschmeißen, doppelte Werte raus,
alphabetisch sortieren);
sowas verwende ich bsp. in Setup-Docs wo man Kategorien vorgibt, wäre auch
praktisch in Addressbooks wo in den Gruppen Namen eingetragen werden
- Listen / Feldinhalte etc. in Windows-Zwischenablage kopieren; dabei noch
der Funktion übergebbar, wie die einzelnen Werte getrennt werden sollen
(@Newline, Semikolon, etc.)
u.v.m.
TMC
OK, lasst uns doch mal starten.
Funktion: PurgingLists
Kurzbeschreibung: Sortiert ein Array alphabetisch und entfernt Leerzeilen
Verwendung: Für Felder mit Mehrfachwerten, Dokument ist im Bearbeitungsmodus
Aufruf-Beispiel:
Sub Click(Source As Button)
Dim workspace As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim doc As NotesDocument
Dim Purging As Variant
Dim MyUnique As Variant
Set uidoc = workspace.CurrentDocument
Set doc = uidoc.Document
Purging = PurgingList(doc.IchBinDasFeld)
Call doc.ReplaceItemValue("IchBinDasFeld", Purging)
Call uidoc.Reload
End Sub
Die Funktion:
Function PurgingList( feldwert As Variant ) As Variant
Dim k As Integer
Dim i As Integer
Dim j As Integer
Dim h As Integer
Dim r As Integer
Dim memberArray() As String
Dim temp As String
'Build an array of values to sort
For k = 0 To Ubound(feldwert)
Redim Preserve memberArray(1 To k+1)
memberArray(k+1) = Cstr(feldwert(k))
Next
'Set up for Shell sort algorithm
h = 1
Do While h < k
h = (h*3)+1
Loop
h = (h-1)/3
If h > 3 Then
h = (h-1)/3
End If
'Shell sort algorithm
Do While h > 0
For i = 1+h To k
temp = memberArray(i)
j = i-h
Do While j >0
If memberArray(j)>temp Then
memberArray(j+h) = memberArray(j)
memberArray(j) = temp
Else
Exit Do
End If
j = j-h
Loop
Next i
h = (h-1)/3
Loop
PurgingList = memberArray
End Function
Hier stelle ich gleich mal die Frage:
Sollte man gleich noch ein @Unique einbinden? Oder lieber separat behandeln?
Ich tendiere zu 'separat behandeln', damit es übersichtlicher bleibt.
Der Code sollte jetzt noch angepasst werden:
- Errorhandling
- unsere festgelegten Standards (wie benenne ich Variablen etc.)
- evtl. noch weiter fassen damit auch in anderen Situationen verwendbar
TMC
Hi,
ein Versuch war es mal, Scripts offline zu disktutieren, nur leider verliert man da im PM leicht den Überblick und Zusammenhang.
Daher tendiere ich doch dazu, die Diskussion online weiterzuführen.
Wir haben in Summe jetzt 5 Scripts zur Diskussion.
Mit dem ersten starte ich mal, es ist von Bernhard (koehlerbv) und ein ReplaceSubstring-Derivat:
ACHTUNG ENTWURF - NUR ZUM TESTEN VERWENDEN
Function ReplaceSubstring (vSource As Variant, vFrom As Variant, vTo As Variant) As Variant
'===========================================================================================
' Purpose: Replaces a specific substring in a string or array of strings with a new substring
' The parameters MUST be strings or array of strings !
'--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' Arguments Type Description
' vOriginal | I/- | the source string or string array
' vForm | I/- | the substring (or string array) to replace
' szTo | I/- | the substring (or string array) to insert
'--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' Returns: String array with replaced values
' NOTE: There is a difference between @ReplaceSubstring and this function !
' If vFrom has more elements as vTo, we replace only the amount of elements in vTo !!!
'--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' Created by: Bernhard Koehler on 08.07.2003 Modified by: on
'===========================================================================================
Dim aSource As Variant
Dim aFrom As Variant
Dim aTo As Variant
Dim szSource As String
Dim vResult As Variant
Dim iLoop As Integer
Dim iElementsToChange As Integer
Dim iFirstStringPos As Integer
Dim szTo As String
On Error Goto ErrorRoutine
'The default value: Source = Result
ReplaceSubstring = vSource
'Make sure that all parameters becomes arrays (We have to decide two cases: vSource is String, or any kind of a variant)
If Datatype (vSource) = V_STRING Then
Redim aSource (0) As String
aSource (0) = vSource
Else
aSource = vSource
End If
If Datatype (vFrom) = V_STRING Then
'No calculations with an empty FromList:
If vFrom = "" Then Exit Function
Redim aFrom (0) As String
aFrom (0) = vFrom
Else
aFrom = vFrom
End If
If Datatype (vTo) = V_STRING Then
Redim aTo (0) As String
aTo (0) = vTo
Else
aTo = vTo
End If
'Make the replaces:
szSource = Implode (aSource, Chr$ (255)) 'make a string from the source parameter
'Determine the limit of changes:
If Ubound (aFrom) > Ubound (aTo) Then
iElementsToChange = Ubound (aTo)
Else
iElementsToChange = Ubound (aFrom)
End If
For iLoop = 0 To iElementsToChange
While Instr (szSource, aFrom (iLoop)) > 0
iFirstStringPos = Instr (szSource, aFrom (iLoop))
If iFirstStringPos = 1 Then
szSource = aTo (iLoop) & Mid$ (szSource, iFirstStringPos + Len (aFrom (iLoop)) - 0, 255)
Else
'szSource = Mid$ (szSource, 1, iFirstStringPos - 1) & aTo (iLoop) & Mid$ (szSource, 1 + iFirstStringPos + Len (aFrom (iLoop)))
szSource = Mid$ (szSource, 1, iFirstStringPos - 1) & aTo (iLoop) & Mid$ (szSource, iFirstStringPos + Len (aFrom (iLoop)), 255)
End If
Wend
Next
ReplaceSubstring = Explode (szSource, Chr$ (255))
Exit Function
ErrorRoutine:
Call DisplayErrMsg ("ReplaceSubstring")
End Function
Ich poste mal direkt ohne Rücksicht auf Höflichkeitsfloskeln (bla bla leider könnte da u.U. vielleicht evtl. ein Fehler sein bla bla...)
- Code-Header: Code-Header "Arguments" stimmt nicht überein mit tatsächlichen Bezeichnungen (vOriginal / vSource , etc.)
- Wenn ich Option Declare setze, bringt der Designer eine Fehlermeldung, dass " V_STRING" nicht deklariert ist.
Testszenario:
R5011 Client, Maske in Bearbeitung, die Textfelder
- Inhalt (dieses Feld soll durchsucht werden)
- Vorgabe_Ist (Wert nach dem gesucht werden soll - also der replaced werden soll)
- Vorgabe_Soll (Wert, der eingefügt werden soll)
Aufruf des Scripts: über Button
Script:
Sub Click(Source As Button)
Dim uiws As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim session As New NotesSession
Dim db As NotesDatabase
Dim doc As NotesDocument
'die 3 Felder
Dim szInhalt As String
Dim szIst As String
Dim szSoll As String
Set db = session.CurrentDatabase
Set uidoc = uiws.CurrentDocument
Set doc = uidoc.Document
'Feldinhalte holen...
szInhalt = doc.Inhalt(0)
szIst = doc.Vorgabe_Ist(0)
szSoll = doc.Vorgabe_Soll(0)
'Function ausführen
doc.Inhalt = ReplaceSubstring(szInhalt, szIst, szSoll)
'Speichere Doc
Call doc.save(False, False)
End Sub
Im Textfeld "Inhalt" steht der Text "Rainer askhfdkjad hkjahdkjas dk"
Im Textfeld "Vorgabe_Ist" steht "Rainer"
Im Textfeld "Vorgabe_Soll" steht "Hans"
Dokument wurde bereits gespeichert und neu im Bearbeitungsmodus geöffnet.
Aufruf
Beim Klick auf den Codebutton
- durchläuft der Debugger sauber die Sub, geht dann normal in die Function, durchläuft die Function
- An der Stelle "If Ubound (aFrom) > Ubound (aTo) Then" springt er danach zum Errorhandler, dann Fehlermeldung "No RESUME"
TMC