Domino Code Fragment

Code Name*
Low-level, self-contained, LotusScript
functions,		Date*
04/29/2024		Source (or email address if you prefer)*
Rlatulippe@romac.com
IP address:.3.144.161.116
Description*
This file contains somewhat low-level, self-contained, LotusScript
functions, as well as some global constants used by these Functions. To use
these Functions, add the following line to the Declarations section of your
script module:		Type*
LotusScript		Categories*
(Misc)
Implementation:
Required Client:
Server:
Limitations:
Comments:
Files/Graphics attachments (if applicable): Code:

%REM
---------HTTP/1.1 200 OK
Date: Wed, 27 Aug 1997 17:42:30 GMT
Server: Apache/1.2.1
Last-Modified: Fri, 23 May 1997 00:35:01 GMT
ETag: "454e6-4caa-3384e635"
Content-Length: 19626
Accept-Ranges: bytes
Connection: close
Content-Type: text/html


     


%REM
----------------------------------------------------------------------------
FILE:    EKLIB.LSS
UPDATED: May 1997
AUTHOR:  Eric Koeler
        mailto:ekoeler@panix.com
        http://www.panix.com/~ekoeler
NOTE:    Copyright (C) 1997 by Eric Koeler, this file is protected by the
        GNU General Public License
----------------------------------------------------------------------------
This file contains somewhat low-level, self-contained, LotusScript
functions, as well as some global constants used by these Functions.  To use
these Functions, add the following line to the Declarations section of your
script module:

    %INCLUDE "FILEPATH\EKLIB.LSS"

where FILEPATH refers to a fully qualified file path.  The contents of this
file will be inserted at compile time (when the script is saved), so if
you make changes to it, you're going to have to re-compile the modules
that use this file for the changes to be reflected.  Alternatively, this
file can be imported into a Script Library (in Notes R4.5 or higher), in
which case changes will be felt as soon as they are made...  
----------------------------------------------------------------------------
%ENDREM

' Constant used for date formatting
Const dateFormat = "MM/DD/YYYY"

'----------------------------------------------------------------------------
' ForwardFunction declarations

Declare Function CreateSharedFolder(db           As NotesDatabase,     _
                                   folder       As String)            As Integer
Declare Function ReplaceSubString  (phrase       As String,            _
                                   oldStr       As String,            _
                                   newStr       As String)            As String  
Declare Function ProperCase        (inString     As String)            As String
Declare Function SendMailMemo      (sendTo       As String,            _
                                   cc           As String,            _
                                   bcc          As String,            _
                                   subject      As String,            _
                                   body         As String,            _
                                   linkTo       As NotesDocument)     As Integer
Declare Function LogMessage        (logItem      As NotesRichTextItem, _
                                   message      As String)            As Integer
Declare Function ContainerNumVals  (containerVar As Variant)           As Long
Declare Function ContainerIndex    (theItem      As Variant,           _
                                   theVal       As String)            As Long
Declare Function StringNotNull     (stringOne    As String,            _
                                   stringTwo    As String)            As String
Declare Function DateValidOrToday  (temp         As String)            As String
Declare Function DateValidOrNone   (temp         As String)            As String
Declare Function ItemTextExists    (doc          As NotesDocument,     _
                                   itemName     As String)            As Integer
Declare Function DocGetNextByKey   (thisVw       As NotesView,         _
                                   thisDoc      As NotesDocument,     _
                                   keyVal       As String)            As NotesDocument
Declare Function DumpViewToFile    (srvr         As String,            _
                                   dbPath       As String,            _
                                    vwName       As String,            _
                                   filePath     As String)            As Long

'---------------------------------------------------------------------------

Function CreateSharedFolder(db As NotesDatabase, folder As String) As Integer
     
     ' ThisFunction creates a shared folder with the specified
     ' name in the specified database.  ThisFunction does not
     ' refresh the design cache, so if the database is already
     ' open, the new folder will not be visible until the
     ' database is closed and opened again (but it will still
     ' be available to put documents into).
   
     On Error Goto ErrorHandler
     Dim doc As NotesDocument
   
     Set doc = db.CreateDocument
     If doc.Save(True, True) then
          Call doc.PutInFolder(folder)
          CreateSharedFolder = doc.Remove(True)
     End If

TheEnd:
     Exit Function
   
ErrorHandler:
     CreateSharedFolder = False
     Print "CreateSharedFolder: " & Trim$(Str$(Err)) & ": " & Error$
     Resume TheEnd

End Function

'---------------------------------------------------------------------------

Function ReplaceSubString(phrase As String, _
                         oldStr As String, _
                         newStr As String) As String    
   
     ' ThisFunction searches the string passed in phrase for all
     ' occurences of the string passed in oldStr.  It then replaces
     ' the oldStr with the specified newStr.  If an error occurs,
     ' a NULL value is returned ("").
   
     On Error Goto ErrorHandler
   
     Dim begin     As Integer
     Dim found     As Integer
     Dim newPhrase As String
     begin = 1
   
     If StrCompare(oldStr, "") = 0 Or StrCompare(phrase, "") = 0 Then Goto TheEnd
   
     found = Instr(begin,  phrase, oldStr, 1)    
     While (found > 0)                
          begin = found + Len(oldStr)
          newPhrase = Left$(phrase, (found - 1)) & newStr & _
          Right$(phrase, Len(phrase) - (found + (Len(oldStr) - 1)))
          phrase = newPhrase
          found = Instr(begin, phrase, oldStr, 1)
     Wend
   
     ReplaceSubString = phrase
      Exit Function
   
ErrorHandler:
     Print "ReplaceSubString: " & Trim$(Str$(Err)) & ": " & Error$
     Resume TheEnd
   
TheEnd:
     ReplaceSubString = ""
   
End Function

'---------------------------------------------------------------------------

Function ProperCase(inString As String) As String
   
    ' ThisFunction first converts inString to lowercase, then it
    ' iterates through each character and capitalizes only those characters
    ' which come after a non-alphabetic character (except for the
    ' apostrophe, which is treated as an alphabetic character).  This
    ' results in a proper-cased string, which is what is returned.

     On Error Goto ErrorHandler
    ProperCase = ""
   
    Dim outString As String
    Dim char      As String
    Dim code      As Integer
    Dim last      As Integer
    Dim L         As Integer
   
    '----- Make sure we have a string
    If StrComp(inString, "") = 0 Then Goto TheEnd
   
    '----- First make everything lowercase  
    inString = Lcase$(inString)
   
    '----- Process the first char, if it's alpha then upper it
    char = Mid$(inString, 1, 1)
    code = Asc(char)
    If Isnumeric(code) Then
         If (code >= 97 And code <= 122) Then
              outString = Ucase$(char)
         Else
              outString = char
         End If
    End If
   
    For L = 2 To Len(inString)    
         last = Asc(Right$(outString, 1))          
         char = Mid$(inString, L, 1)    
         code = Asc(char)
         
         If Isnumeric(code) Then
              If (96 <= code And code <= 122) And _     ' char is lower case and
              (last <> 39) And _                        ' the last char is not an apostrophe
               Not((65 <= last And last <= 90) Or _      ' and is not a member of
              (97 <= last And last <= 122)) Then        ' of the alphabet
                   outString = outString & Ucase$(char)
              Else
                   outString = outString & char
              End If
         End If
    Next L
    ProperCase = outString
   
TheEnd:
    Exit Function
   
ErrorHandler:
    ProperCase = inString
    Print "ProperCase: " & Trim$(Str$(Err)) & ": " & Error$
    Resume TheEnd
   
End Function

'---------------------------------------------------------------------------

Function SendMailMemo(sendTo  As String,        _
                     cc      As String,        _
                     bcc     As String,        _
                     subject As String,        _
                     body    As String,        _
                     linkTo  As NotesDocument) As Integer
   
     ' ThisFunction duplicates theFunctionality of the @MailSEnd Function.
     ' If you pass a valid NotesDocument in as the last parameter, the
     ' mail memo is sent with a doclink to it.  If you don't want to send
     ' a doclink, just pass the Nothing constant as the last parameter.  
     ' If theFunction encountered problems, it returns False, otherwise
     ' it returns True.
   
     On Error Goto ErrorHandler    
   
     Dim mailDb  As New NotesDatabase("", "")
     Dim mailDoc As     NotesDocument
     Dim rtItem  As     NotesRichTextItem
   
     Call mailDb.OpenMail
     If (mailDb.IsOpen = False) Then Call mailDb.Open("", "")
   
     Set mailDoc     = mailDb.CreateDocument
      mailDoc.Form    = "Memo"
     mailDoc.SendTo  = sendTo
     mailDoc.CC      = cc
     mailDoc.BCC     = bcc
     mailDoc.Subject = subject
   
     Set rtItem = mailDoc.CreateRichTextItem("Body")
     Call rtItem.AppendText(body)
     If Not(linkTo Is Nothing) Then
          Call rtItem.AddNewLine(2)
          Call rtItem.AppendDocLink(linkTo, "Double-click to open document")
     End If
   
     Call mailDoc.Send(False)
     SendMailMemo = True

TheEnd:
     Exit Function
   
ErrorHandler:
     SendMailMemo = False
     Print "SendMailMemo: " & Str$(Err) & ": " & Error$
     Resume TheEnd

End Function

'---------------------------------------------------------------------------

Function LogMessage(logItem As NotesRichTextItem, message As String) As Integer
   
    ' ThisFunction copies the string passed in message to the item passed
    ' in logItem and prints it to the standard output device (status bar,
    ' debug output, or Notes Log).  If logItem is Nothing, it prints it
    ' only.  It prefixes the message with the date and time.  ThisFunction
    ' is efficient as the NotesLog class, so it shouldn't be primarily for
    ' logging errors and such...
   
    On Error Goto ErrorHandler
    Dim prefix As String
   
    LogMessage = False
    prefix = Format$(Now, "mm/dd/yyyy hh:nn:ss ")
   
    If Not(logItem Is Nothing) Then
         If Not(logItem.Type = RICHTEXT) Then
              Print "Error: The log item must be of type rich-text."
              Goto TheEnd
         End If
         Call logItem.AddNewLine(1)
         If StrComp(Left$(message, 3), "***") = 0 _
         Or StrComp(Left$(message, 3), "   ") = 0 _
         Or StrComp(Left$(message, 3), "---") = 0 Then
               Call logItem.AppendText(message)
         Else
              Call logItem.AppendText(prefix & message)
         End If
    End If
   
    Print message
    LogMessage = True

TheEnd:
    Exit Function
   
ErrorHandler:
    LogMessage = False
    Print "LogMessage: " & Trim$(Str$(Err)) & ": " & Error$
    Resume TheEnd
   
End Function

'---------------------------------------------------------------------------

Function ContainerNumVals(containerVar As Variant) As Long
   
    ' Counts the number of elements in the container passed
    ' to it as containerVar
   
    On Error Goto ErrorHandler
    ContainerNumVals = 0
    If IsEmpty(containerVar) Then Goto TheEnd
    Forall X In containerVar
         ContainerNumVals = ContainerNumVals + 1
    End Forall
   
TheEnd:
    Exit Function
   
ErrorHandler:
    ContainerNumVals = -1
    Resume TheEnd
   
End Function

'---------------------------------------------------------------------------

Function ContainerIndex(theItem As Variant, theVal as String) As Long
   
    ' Returns the zero-based index of the value in the container
   
    On Error Goto ErrorHandler
    ContainerIndex = -1
    If IsEmpty(theItem) Then Goto TheEnd
    Forall X In theItem
         ContainerIndex = ContainerIndex + 1
         If StrComp(X, theVal, 1) = 0 Then Goto TheEnd
    End Forall
    ContainerIndex = -1
   
TheEnd:
    Exit Function
   
ErrorHandler:
     ContainerIndex = -1
     Resume TheEnd
   
End Function

'---------------------------------------------------------------------------

Function StringNotNull(stringOne As String, stringTwo As String) As String

      ' ThisFunction returns stringOne if it is not null, otherwise it
     ' returns stringTwo
   
     On Error Goto ErrorHandler
   
     If Strcomp(Trim$(stringOne), "", 1) Then
          StringNotNull = stringOne
     Else
          StringNotNull = stringTwo
     End If
   
TheEnd:
     Exit Function
   
ErrorHandler:
     StringNotNull = ""
     Print "StringNotNull: " & Trim$(Str$(Err)) & ": " & Error$
     Resume TheEnd
   
End Function

'---------------------------------------------------------------------------

Function DateValidOrToday(temp As String) As String

      ' ThisFunction returns the string passed to it converted to a date
     ' format (but returned as a string), or if the conversion failed,
     ' today's date is returned.

      On Error Goto ErrorHandler
     DateValidOrToday = Format$(CDat(temp), dateFormat)

TheEnd:
     Exit Function
   
ErrorHandler:
     DateValidOrToday = Format$(Today, dateFormat)
     Resume TheEnd

End Function

'---------------------------------------------------------------------------

Function DateValidOrNone(temp As String) As String

      ' ThisFunction returns the string passed to it converted to a date
     ' format (but returned as a string), or if the conversion failed,
     ' the string "" is returned.

      On Error Goto ErrorHandler
     DateValidOrNone = Format$(CDat(temp), dateFormat)

TheEnd:
     Exit Function
   
ErrorHandler:
     DateValidOrNone = ""
     Resume TheEnd

End Function

'---------------------------------------------------------------------------

Function ItemTextExists(doc As NotesDocument, itemName As String) As Integer
     
     ' Check whether the specified document has the specified item
     ' and whether there is an actual value...  Returns false if the
     ' item does not exist, or if it does exist and it's text value is
     ' null ("").  Accessing the text property of an item is a quick and
     ' dirty way to get an item's value as a string.

      On Error Goto ErrorHandler

      ItemTextExists = False
     Dim tempString As String
   
     If (doc Is Nothing Or StrComp(itemName, "") = 0) Then Goto TheEnd
   
     If doc.HasItem(itemName) Then
          tempString = Trim$(doc.GetFirstItem(itemName).Text)
          If StrComp(tempString, "") then ItemTextExists = True
     End If
   
TheEnd:
     Exit Function
   
ErrorHandler:
     ItemTextExists = False
     Print "ItemTextExists: " & Trim$(Str$(Err)) & ": " & Error$
     Resume TheEnd
     
End Function

'---------------------------------------------------------------------------

Function ItemTextReturn(doc As NotesDocument, itemName As String) As String
   
     ' Check whether the specified document has the specified item
     ' and whether there is an actual value...  Returns "" if the
     ' item does not exist, or if it does exist and it's text value is
     ' null ("").  Returns the value if it does exist.  Accessing the
     ' text property of an item is a quick and dirty way to get an
     ' item's value as a string.

      On Error Goto ErrorHandler

      ItemTextReturn = ""
     Dim tempString As String
     
     If (doc Is Nothing Or StrComp(itemName, "") = 0) Then Goto TheEnd
     
     If doc.HasItem(itemName) Then
          ItemTextReturn = Trim$(doc.GetFirstItem(itemName).Text)
     End If
     
TheEnd:
     Exit Function
     
ErrorHandler:
     ItemTextReturn = ""
     Resume TheEnd
     
End Function

'----------------------------------------------------------------------------

Function DocGetNextByKey(thisVw  As NotesView,     _
                        thisDoc As NotesDocument, _
                        keyVal  As String)        As NotesDocument
   
    ' ThisFunction gets the next document after thisDoc in the
    ' specified view, tests whether the first column value (assuming
    ' this is the key) for this new document is the same as the key
    ' value passed in keyVal.  If it is, the new doc is returned,
    ' otherwise Nothing is returned.
   
    On  Error    Goto   ErrorHandler
    Dim nextDoc  As     NotesDocument
   
    '----- Initialize variables
    Set DocGetNextByKey = Nothing
    Set nextDoc         = Nothing
     
    '----- Get the next document
    Set nextDoc = thisVw.GetNextDocument(thisDoc)
    If nextDoc Is Nothing Then Goto TheEnd
   
    '----- Compare column value with the key value
    If Strcomp(keyVal, nextDoc.ColumnValues(0)) = 0 Then
         Set DocGetNextByKey = nextDoc
    End If
   
TheEnd:
    Exit Function
   
ErrorHandler:
    Set DocGetNextByKey = Nothing
    Resume TheEnd
   
End Function

'----------------------------------------------------------------------------

Function DumpViewToFile(srvr     As String, _
                       dbPath   As String, _
                       vwName   As String, _
                       filePath As String) As Long

     ' This function exports the view to the specified file
    ' as tab-delineated text.  It returns the number of records
    ' processed.

     DumpViewToFile = 0
    On Error Goto ErrorHandler
    Dim doc As NotesDocument
    Dim itm As NotesItem
    Dim txt As String
    Dim idx As Long
    Dim fil As Long
     
    '----- Make sure we have valid strings
    If Strcomp(dbPath, "") = 0 Or Strcomp(vwName, "") = 0 Then Goto TheEnd
     
    '----- Open the database and view
    Dim db As New NotesDatabase(srvr, dbPath)
    If Not(db.IsOpen) Then Call db.Open("","")
    Dim vw As NotesView
    Set vw = db.GetView(vwName)
     
    '----- Open the specified file
    fil = Freefile()
    Open filePath For Output As fil
     
    '----- Iterate through the docs in the view
    idx = 0
    While True
         idx = idx + 1
         Set doc = vw.GetNthDocument(idx)
         If doc Is Nothing Then Goto TheEnd
         Print "Exporting record #" & Trim$(Str(idx))
           
         '----- Iterate through view columns and export
         txt = ""
         Forall COL In vw.Columns
              If Strcomp(txt, "") Then txt = txt & Chr(9)
               txt = txt & ItemTextReturn(doc, COL.ItemName)
         End Forall
         Print #fil, txt
    Wend
     
TheEnd:
    If fil > 0 Then Close #fil
    DumpViewToFile = idx
    Exit Function
     
ErrorHandler:
    Print "DumpViewToFile: " & Error$
    Resume TheEnd
     
End Function