Top 10 custom JavaScript/LotusScript functions of all time

Just a quickie:

Top 10 lists are always nice (and handy) so I read with great interest Dustin Diaz’s posting on his Top 10 of custom JavaScript functions of all time.

After reading I googled after the Top 10 custom LotusScript functions of all time. I guess there is room for such a posting (hint).

Since I mostly do more Web-development than Notes-development the number of custom LS functions for me is limited, but nevertheless I use them in agents.

So here you find 10 custom functions than I (have) use(d) on a regular base (not ranked in importance). Please feel free to add your supertrooper LS functions:

===1===

Function DBColumn (strClass As String, strNoCache As String, strServer As String, strDatabase As String, strView As String, strKey As String) As Variant
 Dim strFormula As String,quotes As String
 quotes = Chr(34)
 strFormula = “@DbColumn(” & quotes & strClass & quotes & “:” & quotes & strNoCache & quotes & “;” & quotes & strServer & quotes & “:” & quotes & strDatabase & quotes & “;” & quotes & strView & quotes & “;” & strKey & “)”
 DbColumn = Evaluate( strFormula )
End Function

===2===

Function DBLookup (strClass As String, strNoCache As String, strServer As String, strDatabase As String, strView As String, strKey As String, strReturn As String) As Variant
 Dim strFormula As String,quotes As String
 quotes = Chr(34)
 strFormula = “@DbLookup(” & quotes & strClass & quotes & “:” & quotes & strNoCache & quotes & “;” & quotes & strServer & quotes & “:” & quotes & strDatabase & quotes & “;” & quotes & strView & quotes & “;” & quotes & strKey & quotes & “;” & strReturn & “)”
 DbLookup = Evaluate( strFormula )
End Function

===3===

Function LeftStr(OrigStr, LeftOf ) As String
 Dim Pos As Integer
 Dim OrigStrLen As Integer
 Pos = Instr( Lcase(OrigStr), Lcase(LeftOf) )
 OrigStrLen = Len(OrigStr)
 If pos>0 Then
  LeftStr = Left( OrigStr, (Pos-1))
 Else
  LeftStr = OrigStr
 End If
End Function

===4===

Function RightStr(OrigStr, RightOf ) As String
 Dim Pos As Integer
 Dim OrigStrLen As Integer
 Dim RightOfLen As Integer
 Pos = Instr( Lcase(OrigStr), Lcase(RightOf) )
 OrigStrLen = Len(OrigStr)
 RightOfLen = Len(RightOf)
 If Pos>0 Then
  RightStr = Right( OrigStr, OrigStrLen -(RightOfLen+Pos-1))
 Else
  RightStr = OrigStr
 End If
End Function

===5===

Function ReplaceSubString(SourceS As String, SearchS As String, ReplaceS As String) As String
 While Instr(SourceS, SearchS) > 0
  SourceS = Left$(SourceS, Instr(SourceS, SearchS) – 1) + ReplaceS + Right$(SourceS, Len(SourceS) – Instr(SourceS, SearchS) – Len(SearchS) + 1)
 Wend
 ReplaceSubstring = SourceS
End Function

===6===

Function Unique(vIn As Variant) As Variant
 Dim lsTemp List As String     ‘Create the list
 Dim astemp() As String        ‘A place to store the compacted array
 Dim iCount As Integer         ‘Count how many uniques we find
 
  ‘Make sure they sent us an array of strings
 If Not Isarray(vIn) Then
  Msgbox “Unique requires an array as input”
  UniqueA = vIn
  Exit Function
 Elseif Typename( vIn(0) ) <> “STRING” Then
  Msgbox “Unique requires an array of strings as input. vIn(0) is a ” _
  + Typename( vIn(0) )
  UniqueA = vIn
  Exit Function
 End If
 
 Forall s In vIn
     ‘If the entry isn’t in the list…
  If Not Iselement( lsTemp(s) ) Then
       ‘Add it to the list
   lsTemp(s) = “”
   iCount = iCount + 1
  End If
 End Forall
 
 ‘Note that there’s no “preserve” keyword here so this is relatively quick
 Redim asTemp(iCount-1)
 
 iCount = 0
  ‘Copy all the unique elements into the temp array
 Forall v In lsTemp
  asTemp(iCount) = Listtag(v)
  iCount = iCount + 1
 End Forall
 
  ‘Return the temp array
 UniqueA = asTemp
End Function

===7===

Function SortCollection(coll As NotesDocumentCollection, fieldnames() As String) As NotesDocumentCollection
 
‘ ————————————————
‘ — You may use and/or change this code freely
‘ — provided you keep this message
‘ —
‘ — Description:
‘ — Sorts and returns a NotesDocumentCollection
‘ — Fieldnames parameter is an array of strings
‘ — with the field names to be sorted on
‘ —
‘ — By Max Flodén 2005 – http://www.tjitjing.com
‘ ————————————————
 
 Dim session As New NotesSession
 Dim db As NotesDatabase
 Dim collSorted As NotesDocumentCollection
 Dim doc As NotesDocument
 Dim i As Integer, n As Integer
 Dim arrFieldValueLength() As Long
 Dim arrSort, strSort As String
 Dim viewname As String, fakesearchstring As String
 
 viewname = “$All” ‘This could be any existing view in database with first column sorted
 fakesearchstring = “zzzzzzz” ‘This search string must NOT match anything in view
 Set db = session.CurrentDatabase
 
‘ —
‘ — 1) Build array to be sorted
‘ —
 
‘Fill array with fieldvalues and docid and get max field length
 Redim arrSort(0 To coll.Count -1, 0 To Ubound(fieldnames) + 1)
 Redim arrFieldValueLength(0 To Ubound(fieldnames) + 1)
 For i = 0 To coll.Count – 1
  Set doc = coll.GetNthDocument(i + 1)
  For n = 0 To Ubound(fieldnames) + 1
   
   If n = Ubound(fieldnames) + 1 Then
    arrSort(i,n) = doc.UniversalID
    arrFieldValueLength(n) = 32
   Else
    arrSort(i,n) = “” & doc.GetItemValue(fieldnames(n))(0)
‘ Check length of field value
    If Len(arrSort(i,n)) > arrFieldValueLength(n) Then
     arrFieldValueLength(n) = Len(arrSort(i,n))
    End If
   End If
   
  Next n
 Next i
 
‘Merge fields into list that can be used for sorting using @Sort function
 For i = 0 To coll.Count – 1
  If Not strSort = “” Then strSort = strSort & “:”
  strSort = strSort & “”””
  For n = Lbound(fieldnames) To Ubound(fieldnames) + 1
   strSort = strSort & Left(arrSort(i,n) & Space(arrFieldValueLength(n)), arrFieldValueLength(n))
  Next n
  strSort = strSort & “”””
 Next i
 
‘ —
‘ — 2) Sort array
‘ —
 arrSort = Evaluate(“@Sort(” & strSort & “)”)
 
‘ —
‘ — 3) Use sorted array to sort collection
‘ —
 Set collSorted = coll.Parent.GetView(viewname).GetAllDocumentsByKey(fakesearchstring)
 
 For i = 0 To Ubound(arrSort)
  Set doc = db.GetDocumentByUNID(Right(arrSort(i), 32))
  Call collSorted.AddDocument(doc)
 Next i
 
‘ —
‘ — 4) Return collection
‘ —
 Set SortCollection = collSorted
 
End Function

===8===

Function AddToList (Value As Variant, ValueList As Variant)
 Dim tmpValueList As Variant
 ‘ Load the array element by element so that the datatypeis preserved
 Redim tmpValueList(Ubound(ValueList))
 For i = 0 To Ubound(ValueList)
  tmpValueList(i) = ValueList(i)
 Next
 ‘ Determine if we are dealing with a new list, if absolutely no values in the first entry, then add new value to 0
 If Ubound(tmpValueList) = 0 And Cstr(tmpValueList(0)) = “” Then
  x = 0
 Else
  x = Ubound(tmpValueList) + 1
 End If
 Redim Preserve tmpValueList(x)
 tmpValueList(x) = Value
 AddToList = tmpValueList
End Function

===9===

Function createTable(FldTitles As Variant ,FldNames As Variant, doccoll  As notesdocumentcollection ,rtitem As NotesRichTextItem,msgTitle As String,msgBody As String ) As NotesRichTextItem
 ‘Takes Documentcollection & creates tabular information on to the passed  rtitem (rich text item)
 
 Dim TempNitem As NotesItem
 Dim TempNm As NotesName
 
 Set ritem=rtitem
 Set rtnav = ritem.CreateNavigator
 Set rstyle=session.CreateRichTextStyle
 
 ‘===================================================
 ‘heading in the body section of the mail
 rstyle.Bold=True
 rstyle.NotesColor=COLOR_RED
 rstyle.Underline=True
 rstyle.NotesFont=FONT_COURIER
 rstyle.FontSize=12
 Call  ritem.AppendStyle(rstyle)
 ritem.AppendText(msgTitle) 
 rstyle.Underline=False
 rstyle.NotesColor=COLOR_BLACK
 ritem.AddNewline(2) 
 rstyle.FontSize=10
 rstyle.Bold=False
 rstyle.NotesColor=COLOR_BLACK
 Call  ritem.AppendStyle(rstyle)
 ritem.AppendText(msgBody)
 ritem.AddNewline(1)
 
 ‘===================================================
 rows=doccoll.Count +1
 cols=Cint(Ubound(FldTitles)+1)
 Call ritem.AppendTable(rows,cols)
 Call rtnav.FindFirstElement(RTELEM_TYPE_TABLECELL)
 ‘=================================================
 ‘heading of the table
 rstyle.Bold=True
 rstyle.NotesColor=COLOR_BLUE
 rstyle.FontSize=10
 Call  ritem.AppendStyle(rstyle)
 For i=0 To Ubound(FldTitles)
  Call ritem.BeginInsert(rtnav)
  Call ritem.AppendText(FldTitles(i))
  Call ritem.EndInsert
  Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL)
 Next
 ‘=================================================
 rstyle.FontSize=10
 rstyle.Bold=False
 rstyle.NotesColor=COLOR_BLACK
 Call  ritem.AppendStyle(rstyle)
 Set  doc=doccoll.GetFirstDocument
 While Not (doc Is Nothing)
  For i=0 To Ubound(FldNames)
  ‘check for date/ names document link
   Call ritem.BeginInsert(rtnav)
   If FldNames(i)=”Doc_Link” Then
    Call ritem.AppendDocLink(doc,doc.Created)
   Else
    Set TempNitem=doc.GetFirstItem(FldNames(i))   
    If TempNitem.IsNames Then
     Set TempNm=Nothing
     Set TempNm=New NotesName(TempNitem.Values(0))
     Call ritem.AppendText(TempNm.Common)
    Elseif Isdate(TempNitem.Values(0)) Then
     Call ritem.AppendText(Format(TempNitem.Values(0),”DD-MMM-YYYY”))  
    Else
     Call ritem.AppendText(TempNitem.Values(0))    
    End If
   End If
   Call ritem.EndInsert
   Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL)  
  Next
  Set doc=doccoll.GetNextDocument(doc)
 Wend
 Set CreateTable=ritem
End Function

===10===

Function GetProfile(ProfName As String) As notesdocument
     ‘Get Database Profile and return to variable
 On Error Resume Next
 Print “Opening Database Profile”
 Set getProfile=Db.GetProfileDocument( profName)
 If Not getProfile Is Nothing Then
  var=getProfile.IsProfile
  If Not var Then Set getProfile=Nothing
 End If
End Function

Advertisements

4 thoughts on “Top 10 custom JavaScript/LotusScript functions of all time

  1. Theo Heselmans 2008-November-5 / 11:39 am

    Hi Patrick, nice list.
    I especially like the CreaTable.
    One major comment though: 3, 4, 5, 6 and 8 have standard LS equivalents as of Notes 5 or 6:
    strleft, strright, replace, arrayunique, arrayappend

  2. Dmytro 2008-November-5 / 12:17 pm

    3, 4 from R6:
    strleft/strright already in lotus
    5 from R6:
    Replace(sourceArray, findArray, replacementArray [, start [, count [, compMethod]]])
    6: i think @evaluate(|@unique(@explode(implode(arr, “^”); “^”)) (need to be corrected, but idea works)

  3. Jan Schulz 2008-November-5 / 3:36 pm

    Your replacesubstring will get into an endless loop if source is a substring of search. I’ve replaced my version with a split->join version…

  4. Tim Tripcony 2008-November-5 / 4:22 pm

    You can also omit the Is Nothing conditional from 10; if a profile document is requested but doesn’t exist, it creates one automatically.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s