SPOC Utility Agents

Copy companies:

Sub Initialize
   Dim s As New NotesSession
   Dim dbTarget As NotesDatabase
   Dim dbSource As NotesDatabase
   Dim docSource As NotesDocument
   Dim docTarget As NotesDocument
   Dim viewSource As NotesView
   Dim viewTarget As NotesView
   Dim copy_count As Integer

   Set dbSource = s.CurrentDatabase
   Set dbTarget = s.GetDatabase("server", "spoc.nsf")
   Set viewTarget = dbTarget.GetView("lookupMainFirmById")
   Set viewSource = dbSource.GetView("lookupMainFirmById")
   viewTarget.AutoUpdate = False
   viewSource.AutoUpdate = False

   Set docSource = viewSource.GetFirstDocument
   While Not (docSource Is Nothing)
      Set docTarget = viewTarget.GetDocumentByKey(docSource.ID(0), True)
      If docTarget Is Nothing Then
         copy_count = copy_count + 1
         Call docSource.CopyToDatabase(dbTarget)
      End If

      Set docSource = viewSource.GetNextDocument(docSource)
   Wend

   Msgbox "Copy count=" & copy_count
End Sub

Copy contacts:

Sub Initialize
   Dim s As New NotesSession
   Dim dbTarget As NotesDatabase
   Dim dbSource As NotesDatabase
   Dim docSource As NotesDocument
   Dim docTarget As NotesDocument
   Dim viewSource As NotesView
   Dim viewTarget As NotesView
   Dim copy_count As Integer

   Set dbSource = s.CurrentDatabase
   Set dbTarget = s.GetDatabase("server", "spoc.nsf")
   Set viewTarget = dbTarget.GetView("lookupContactsByUnique")
   Set viewSource = dbSource.GetView("lookupContactsByUnique")
   viewTarget.AutoUpdate = False
   viewSource.AutoUpdate = False

   Set docSource = viewSource.GetFirstDocument
   While Not (docSource Is Nothing)
      Set docTarget = viewTarget.GetDocumentByKey(docSource.ContactUnique(0), True)
      If docTarget Is Nothing Then
         copy_count = copy_count + 1
         Call docSource.CopyToDatabase(dbTarget)
      End If

      Set docSource = viewSource.GetNextDocument(docSource)
   Wend

   Msgbox "Copy count=" & copy_count
End Sub

Copy e-mails:

Sub Initialize
   Dim s As New NotesSession
   Dim dbTarget As NotesDatabase
   Dim dbSource As NotesDatabase
   Dim docSource As NotesDocument
   Dim docTarget As NotesDocument
   Dim viewSource As NotesView
   Dim viewTarget As NotesView
   Dim copy_count As Integer
   Dim docEmailSource As NotesDocument
   Dim docEmailTarget As NotesDocument
   Dim dc As NotesDocumentCollection

   Set dbSource = s.CurrentDatabase
   Set dbTarget = s.GetDatabase("server", "spoc.nsf")
   Set viewTarget = dbTarget.GetView("lookupContactsByUnique")
   Set viewSource = dbSource.GetView("lookupContactsByUnique")
   viewTarget.AutoUpdate = False
   viewSource.AutoUpdate = False

   Set docSource = viewSource.GetFirstDocument
   While Not (docSource Is Nothing)
      'find contact in target spoc
      Set docTarget = viewTarget.GetDocumentByKey(docSource.ContactUnique(0), True)

      'get responses
      Set dc = docSource.Responses
      Set docEmailSource = dc.GetFirstDocument
      While Not (docEmailSource Is Nothing)
         'copy
         Set docEmailTarget = docEmailSource.CopyToDatabase(dbTarget)
         Call docEmailTarget.Save(True, False)

         'make response
         Call docEmailTarget.MakeResponse(docTarget)

         'increment count
         copy_count = copy_count + 1

         'get next
         Set docEmailSource = dc.GetNextDocument(docEmailSource)
      Wend

      'get next
      Set docSource = viewSource.GetNextDocument(docSource)
   Wend

   Msgbox "Copy count=" & copy_count
End Sub

Disable auto-commit in DB2 from CLI

Auto-commit is by default enabled in the command line interface (CLI) of DB2. To disable auto-commit use the UPDATE COMMAND OPTIONS command:

update command options using c off
insert into some_table values (1, 'abc123');
commit

NABPerson

Example:

Dim n As New NABPerson()
Msgbox n.Shortname
Const NAB_FILENAME$ = "names.nsf"
Const DEBUG_USERNAME$ = "DEBUG_SCANNING_USER"

Public Class NABPerson
   'declarations
   Private pSession As NotesSession
   Private pDb As NotesDatabase
   Private pDoc As NotesDocument

   '/**
   ' * Constructor.
   ' */
   Public Sub New()
      Set Me.pSession = New NotesSession
      Dim view As NotesView
      Dim server As String
      Dim debug_user As String

      'get the users home server
      server = Me.pSession.GetEnvironmentString("MailServer", True)

      'get database
      Set Me.pDb = Me.pSession.GetDatabase(server, NAB_FILENAME)

      'get view
      Set view = Me.pDb.GetView("($Users)")

      'should we use a debug name
      debug_user = Me.pSession.GetEnvironmentString(DEBUG_USERNAME)
      If debug_user  "" Then
         'use debug name
         Set Me.pDoc = view.GetDocumentByKey(debug_user, True)
      Else
         'use active usename
         Set Me.pDoc = view.GetDocumentByKey(Me.pSession.Username, True)
      End If

      'verify that we found a document
      If Me.pDoc Is Nothing Then
         If debug_user  "" Then
            Error 9999, "User (" + debug_user + ") not found in Domino Directory on " + server
         Else
            Error 9999, "User (" + Me.pSession.Username + ") not found in Domino Directory on " + server
         End If
      End If
   End Sub

   '/**
   ' * Get the shortname of the user.
   ' */
   Public Property Get Shortname As String
      Shortname = Me.pDoc.Shortname(0)
   End Property

End Class

LotusScript class: FileWriter for R5.x

Example:

Dim fw As New FileWriter(|c:lekkim.txt|, True)
Call fw.WriteText(CStr(Now))
Call fw.Close()

Code:

'constants
Const FILE_NOTOPENED% = 0
Const FILE_CLOSED% = -1

Public Class FileWriter
   'declarations
   Private pFileNum As Integer
   Private pFilename As String

   '/**
   ' * Constructor.
   ' */
   Public Sub New(filename As String, replace_existing As Integer)
      'make sure we have a filename
      If filename = "" Then
         Error 9999, "You must supply a filename."
      End If

      'store filename
      Me.pFilename = filename

      'error handling
      On Error Goto catch

      'should we replace
      If replace_existing Then
         'remove the file if it exists
         Kill filename
      End If

      'exit gracefully
      Exit Sub

catch:
      Resume finally
finally:
      Exit Sub
   End Sub

   '/**
   ' * Destructor.
   ' */
   Public Sub Delete()
      'make sure we close any file we might have open
      If Me.pFileNum > 0 Then
         'we need to close the file
         Close Me.pFileNum
      End If
   End Sub

   '/**
   ' * Write text to the file.
   ' */
   Public Sub WriteText(text As String)
      'is the file open
      If Me.pFileNum = FILE_NOTOPENED Then
         'no - open the file

         'get a new filenumber
         Me.pFileNum = Freefile()

         'open the file for writing
         Open Me.pFilename For Output As Me.pFilenum
      Elseif Me.pFileNum = FILE_CLOSED Then
         'the user is trying to write to a closed file
         Error 9999, "You cannot write to a file you have closed"
      End If

      'write to the file
      Print #Me.pFileNum, text
   End Sub

   '/**
   ' * Close the file.
   ' */
   Public Sub Close()
      'close any file we might have open
      If Me.pFileNum > 0 Then
         'we need to close the file
         Close Me.pFileNum

         'set filenum to -1 to signal that we closed the file
         Me.pFilenum = FILE_CLOSED
      End If
   End Sub

End Class

Fallback JavaScript library

The solution is a combination of the two JavaScript libraries and the calling HTML page using exception handling and dynamic HTML generation.

“Primary JavaScript library

function one() {
   return "1";
}

“Fallback” JavaScript library

function two() {
   return "2";
}

HTML file

<?xml version="1.0"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
    "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
  <head>
    <title>Test</title>
    <link rev="made" href="mailto:www-validator@w3.org" />
    <link rev="start" href="./" title="Home Page" />
    <style type="text/css" media="all">@import "./base.css";</style>
  </head>

   <!-- fail to load the primary library1.js JavaScript library -->
   http://library.js

  <body>

   <!-- holder for dynamic HTML -->
   <div id="script_holder" />

   
      try {
       // try and use the primary script library (will fail)
       alert(one());
      } catch (exception) {
         // using the primary script library failed - fallback to secondary library
         var e = document.createElement("script");
         e.type = "text/javascript";
         e.src = "library2.js";
         document.getElementById("script_holder").appendChild(e);

         // set timeout to test that the fallback library was loaded
         setTimeout("doTest()", 100);
      }

      function doTest() {
         alert(two());
      }
   

  </body>
</html>

ReplaceSubstring in LotusScript

Full code for the function is inserted below as well as an example.

Please note that the code may wrap…

Sub Initialize
   'declarations
   Dim s As New NotesSession
   Dim dc As NotesDocumentCollection
   Dim doc As NotesDocument
   Dim result As Variant

   Dim look_for(1) As String
   look_for(0) = TEST_OLD_URL_RESOURCE
   look_for(1) = TEST_OLD_URL_SCANNET

   Dim replace_with(1) As String
   replace_with(0) = TEST_NEW_URL_RESOURCE
   replace_with(1) = TEST_NEW_URL_SCANNET

   Dim process_fields(5) As String
   process_fields(0) = "txtLinksDisplayData_1"
   process_fields(1) = "txtLinksDisplayData_2"
   process_fields(2) = "txtLinksTargetData_1"
   process_fields(3) = "txtLinksTargetData_2"
   process_fields(4) = "txtLinks_1"
   process_fields(5) = "txtLinks_2"

   Set dc = s.CurrentDatabase.UnprocessedDocuments
   Set doc = dc.GetFirstDocument
   While Not (doc Is Nothing)
      'loop fields and replace
      Forall field In process_fields
         result = ReplaceSubstring(doc.GetItemValue(field), look_for, replace_with)
         Call doc.ReplaceItemValue(field, result)
      End Forall

      'save
      Call doc.Save(True, False)

      'get next
      Set doc = dc.GetNextDocument(doc)
   Wend
End Sub
Public Function ReplaceSubstring(look_in As Variant, look_for As Variant, replace_with As Variant) As Variant
   'validate parameters
   If Isarray(look_for) And Isarray(replace_with) Then
      'both are arrays - make sure they are the same size
      If Ubound(look_for)  Ubound(replace_with) Then
         'different size
         Error 9999, "The look_for and replace_with arrays must be of the same size."
      End If
   Elseif (Isarray(look_for) Xor Isarray(replace_with))  Then
      'either look_for is an array and replace_with isn't or nice versa
      Error 9999, "If look_for is an array so must replace_with or vice versa."
   End If

   If Isarray(look_in) Then
      'handle all entries in the array
      Dim result_array() As Variant
      Dim result As Variant
      Redim result_array(Ubound(look_in))
      Dim count As Integer

      'loop
      Forall v In look_in
         'make sure we do not run on objects
         If Not Isobject(v) Then
            'do replace
            result = pReplaceSubstring(v, look_for, replace_with)

            'store result in array
            result_array(count) = result
         Else
            'keep original value
            Set result_array(count) = v
         End If

         'increment count
         count = count + 1
      End Forall

      'return result
      ReplaceSubstring = result_array
   Else
      'handle single value - make sure we do not run on objects
      If Not Isobject(look_in) Then
         'do replace
         ReplaceSubstring = pReplaceSubstring(look_in, look_for, replace_with)
      Else
         'return original value
         Set ReplaceSubstring = look_in
      End If
   End If
End Function

Private Function pReplaceSubstring(Byval look_in As Variant, look_for As Variant, replace_with As Variant) As Variant
   'make sure the input is a string
   If Typename(look_in)  "STRING" Then
      'return original value
      If Isobject(look_in) Then
         Set pReplaceSubstring = look_in
      Else
         pReplaceSubstring = look_in
      End If
      Exit Function
   End If

   'is there an array of things to look for ?
   If Isarray(look_for) Then
      'yes - handle all values
      Dim i As Integer

      'loop - arrays garanteed to be the same size be calling function
      For i=0 To Ubound(look_for)
         'do replacesubstring
         look_in = pReplaceSingleValue(look_in,look_for(i), replace_with(i))
      Next

      'return
      pReplaceSubstring = look_in
   Else
      'nope - single value
      pReplaceSubstring = pReplaceSingleValue(look_in,look_for, replace_with)
   End If

End Function

Private Function pReplaceSingleValue(look_in As Variant, look_for As Variant, replace_with As Variant) As String
   'declarations
   Dim index_start As Integer
   Dim index_stop As Integer
   Dim first_part As String
   Dim last_part As String
   Dim result As String

   'look for the value
   index_start = Instr(1, look_in, look_for)
   If index_start > 0 Then
      'we found the value - get the part before what we are
      'looking for (if not at the beginning)
      If index_start > 1 Then
         first_part = Mid$(look_in, 1, index_start-1)
      End If

      'calcuate the stop index
      index_stop = index_start + Len(look_for)

      'get the last part (if not past the end of the string)
      If index_stop < Len(look_in) Then
         last_part = Mid$(look_in, index_stop)
      End If

      'concatenate the parts
      result = first_part + replace_with + last_part

      'return
      pReplaceSingleValue = result
   Else
      'substring not found - return the original value
      pReplaceSingleValue = look_in
   End If
End Function