TexasSwede

Brian Moore wrote about the problem with users thinking Notes applications are slow, due to no visible feedback:
"People seem to be totally happy at letting something take bleeding ages just so long as there is a little moving object to distract them from the clock."

This is very true, and I addressed this in one of my applications a while back by implementing a progress bar.
Suddenly, when the users got feedback on what was happening, all complaints about it being slow stopped, despite it taking the same amount of time...

I built a progress bar class. Here it is, as well as a small code sample showing how to call it. Note that this is a Win32 only solution.

' ***** Declarations for (undocumented) progress bar in Notes *****
Private Const NPB_TWOLINE% = 1
Private Const NPB_STATUSBAR% = 32
Declare Private Function NEMProgressBegin Lib "nnotesws.dll" ( Byval wFlags As Integer ) As Long
Declare Private Sub NEMProgressDeltaPos Lib "nnotesws.dll" ( Byval hwnd As Long, Byval dwIncrement As Long )
Declare Private Sub NEMProgressEnd Lib "nnotesws.dll" ( Byval hwnd As Long )
Declare Private Sub NEMProgressSetBarPos Lib "nnotesws.dll" ( Byval hwnd As Long, Byval dwPos As Long)
Declare Private Sub NEMProgressSetBarRange Lib "nnotesws.dll" ( Byval hwnd As Long, Byval dwMax As Long )
Declare Private Sub NEMProgressSetText Lib "nnotesws.dll" ( Byval hwnd As Long, Byval pcszLine1 As String, Byval pcszLine2 As String )

Class ProgressBar
	Private hidden As Integer
	Private hwnd As Long
	Private value As Long
	Private title As String
	Private textline1 As String
	Private textline2 As String
	Private maxvalue As Long
	
	Public Sub New(range As Long, initialtitle As String)
		Dim session As New NotesSession
		maxvalue = Clng(range)
		title = initialtitle 
		textline1 = ""
		textline2 = ""
		' Check if code is running on server (scheduled agent)
		Íf session.IsOnServer Then										
			hidden=True
		Else
			hidden=False
		End If
		If hidden = True Then
			Exit Sub
		End If		
		hwnd = NEMProgressBegin(NPB_TWOLINE)
		Call SetRange(maxvalue)
		NemProgressSetText hwnd, title, textline1 & Chr$(13) & textline2
	End Sub
	
	Sub Increase()
		If hidden = True Then
			Exit Sub
		End If
		If hwnd <> 0 Then
			If value < maxvalue Then
				value = value + 1
				NEMProgressSetBarPos hwnd, value
			End If
		End If
	End Sub
	
	Sub Decrease()
		If hidden = True Then
			Exit Sub
		End If
		If hwnd <> 0 Then
			If value > 0 Then
				value = value - 1
				NEMProgressSetBarPos hwnd, value
			End If
		End If
	End Sub
	
	Sub Close
		If hidden = True Then
			Exit Sub
		End If
		If hwnd <> 0 Then
			NEMProgressEnd hwnd	
			hwnd = 0
			title = ""
			value = 0
		End If
	End Sub
	
	Sub SetRange(value As Long)
		If hidden = True Then
			Exit Sub
		End If
		If hwnd <> 0 Then
			maxvalue = value
			NEMProgressSetBarRange hwnd, maxvalue
		End If
	End Sub
	
	Sub SetValue(value As Long)
		If hidden = True Then
			Exit Sub
		End If
		If hwnd <> 0 Then
			NEMProgressSetBarPos hwnd, value
		End If
	End Sub
	
	Sub SetText(message As String)
		If textline2="" Then
			Call PrintText()		
		End If
		If hidden = True Then
			Exit Sub
		End If
		If hwnd <> 0 Then
			textline1 = message
			NEMProgressSetText hwnd, title, textline1 & Chr$(13) & textline2
		End If
	End Sub
	
	Sub SetText2(message As String)
		Call PrintText()
		If hidden = True Then
			Exit Sub
		End If
		If hwnd <> 0 Then
			textline2 = message
			NEMProgressSetText hwnd, title, textline1 & Chr$(13) & textline2
		End If
	End Sub
	
	Function GetText() As String
		GetText = textline1
	End Function
	
	Function GetText2() As String
		GetText2 = textline2
	End Function
	
	Sub PrintText()
		Dim text As String
		If hidden = True Then
			text = textline1
			If textline2<>"" Then
				text = text & "  -  " & textline2
			End If
			Print text
		End If
	End Sub
	
	Function Show() As String
		hidden = False
		hwnd = NEMProgressBegin(NPB_TWOLINE)
		Call SetRange(maxvalue)
		NemProgressSetText hwnd, title, textline1 & Chr$(13) & textline2
	End Function
	
	Function Hide() As String
		hidden = True
		If hwnd <> 0 Then
			NEMProgressEnd hwnd	
			hwnd = 0
		End If
	End Function
	
End Class

Here is some sample code:

units = GetNumberOfUnits()
Set pbar = New ProgressBar(Clng(units+1),"Loading data from backend server...")
Call pbar.Show()

For i = 1 to units
	Call pbar.Increase()
	Call pbar.SetText("Loading coverage for unit " & i & "...")
	set vehicle = New CoverageData(i)	' Get vehicle coverage
	Call pbar.SetText2(vehicle.year & " " & Fulltrim(vehicle.name) & " - Coverage " & vehicle.cvgcode)
Next

Call pbar.Increase()
Call pbar.SetText("Finishing processing.")
Call pbar.SetText2("Please wait...")
' Do some more stuff here
Call pbar.Close()

After Kathy Brown wrote about lists earlier today, I thought I would share another example of how they can be used. Back in April I shared some code showing how to get latitude and longitude for an address, by calling Google's GeoCode REST service.
Today I will show how easy it is to use that class together with a list...

First, let's revisit the GeoCode class. I made some minor modifications, so I will post the latest version here:

Class GeoData
    Private GeoString As String
    Public street As String
    Public city As String
    Public zip As String
    Public state As String
    Public latitude As String
    Public longitude As String
    
    Public Sub New(streetStr As String, cityStr As String, stateStr As String, zipStr As String)
        Dim httpObject As Variant
        Dim mapsKey As String
        Dim mapsURL As String
        Dim address As String    
        Dim retries As Integer
        Dim httpURL As String
        Dim returncode As String
        Dim coordinates As String
        Dim ret As Integer
        Dim xmladdress As String
        Dim addarray As Variant
        
        retries = 0        
        Set httpObject = CreateObject("MSXML2.ServerXMLHTTP")
        mapsKey = "your_googleAPI_key"
        mapsUrl = "http://maps.google.com/maps/geo?q="
        address = streetStr & ", " & cityStr & ", " & stateStr & " " & zipStr
        httpURL = mapsURL & address & "&output=xml&key=" & mapsKey     ' Use output=CSV for CVS file
        Do
            If retries>1 Then
                Sleep 1        ' After the two first calls, introduce a 1 second delay betwen each additional call
            End If
            retries = retries + 1    
            Call httpObject.open("GET", httpURL, False)
            Call httpObject.send()
            GeoString = Left$(httpObject.responseText,16000)
            returncode = GetGeoValue("code")
            If retries >= 10 Then
                returncode = "500"    ' Fake other failure after 10 attempts
            End If
        Loop Until returncode <> "620"
        If returncode = "200" Then
            coordinates = GetGeoValue("coordinates")
            latitude = Left$(coordinates, Instr(coordinates,",")-1)
            longitude = Mid$(coordinates, Len(latitude)+2, Instr(Len(latitude)+2,coordinates,",")-Len(latitude)-2)
            street =GetGeoValue("ThoroughfareName")    
            zip = GetGeoValue("PostalCodeNumber")
            city = GetGeoValue("LocalityName")
            state = GetGeoValue("AdministrativeAreaName")
            xmladdress = GetGeoValue("address")
            If city = "" Then
                If state <> "" Then
                    addarray = R5split(xmladdress,", ")
                    city = addarray(1)
                    zip = Right$(addarray(2),5)
                End If
            End If
            If Ucase(state)<>Ucase(stateStr) Then    ' Different state?
                ret = Msgbox("The address returned seems to be very different" & Chr$(13) & _
                "from the one submitted." & Chr$(13) & _
                "The address returned is:" & Chr$(13)  & Chr$(13) & _
                street & Chr$(13) & city & ", " & state & " " & zip  & Chr$(13)  & Chr$(13) & _
                "Do you want to use this address?",4+32,"WARNING")
                If ret = 7 Then
                    street = streetStr
                    zip = zipStr
                    city = cityStr
                    state = stateStr
                End If
            End If
            If street = "" Then
                Msgbox "The street address could not be verified." & Chr$(13) & _
                "Existing value will be saved." & Chr$(13) & _
                "Please verify that address is correct.",,"Street Not Verified"
                street = streetStr
            End If
            If city = "" Then
                Msgbox "The city could not be verified." & Chr$(13) & _
                "Existing value will be saved." & Chr$(13) & _
                "Please verify that address is correct.",,"City Not Verified"
                city = cityStr
            End If
        Else
            If returncode = "602" Then
                Msgbox "No corresponding geographic location found"_
                ,,"Google GeoCode Error 602"
            Elseif returncode = "603" Then
                Msgbox "The geocode cannot be returned due to legal or contractual reasons." _
                ,,"Google GeoCode Error 602"
            End If
            ' Return original value to avoid overwriting...
            street = streetStr
            zip = zipStr
            city = cityStr
            state = stateStr
        End If
    End Sub
    
    Public Function Accuracy() As Integer
        Dim startpos As Long
        Dim endpos As Long
        If IsValid = False Then
            Accuracy = 0
            Exit Function
        End If
        startpos = Instr(Lcase(GeoString),|accuracy="|) + 10 
        endpos = Instr(startpos, Lcase(GeoString), |"|) 
        If endpos < startpos Then
            Accuracy = 0
        Else
            Accuracy = Cint(Fulltrim(Mid$(GeoString,startpos, endpos - startpos)))
        End If
    End Function
    
    Public Function HasAddInfo(address As String) As Integer
        If Instr(Lcase(address),"apt")>0 Then
            HasAddInfo = True
        Elseif Instr(Lcase(address),"apartment ")>0 Then            
            HasAddInfo = True            
        Elseif Instr(Lcase(address),"suite ")>0 Then            
            HasAddInfo = True
        Elseif Instr(Lcase(address),"ste ")>0 Then            
            HasAddInfo = True
        Elseif Instr(Lcase(address)," #")>0 Then            
            HasAddInfo = True
        Elseif Instr(Lcase(address),", ")>0 Then            
            HasAddInfo = True
        Else
            HasAddInfo = False
        End If
    End Function
    
    Public Function Compare(str1 As String, str2 As String) As Integer
        
    End Function
    
    Public Function IsValid() As Integer
        If GeoString = "" Then
            IsValid = False
        Else
            IsValid = True
        End If
    End Function
    
    Public Function GetGeoValue(tag As String) As String
        Dim startpos As Long
        Dim endpos As Long
        Dim tempstring As String
        If GeoString = "" Then
            GetGeoValue = ""
            Exit Function
        End If
        startpos = Instr(Lcase(GeoString),"<" & Lcase(tag) & ">") + Len(tag) 
        endpos = Instr(startpos, Lcase(GeoString), "</"+Lcase(tag) & ">") 
        If endpos < startpos Then
            GetGeoValue = ""
        Else
            tempstring = Fulltrim(Mid$(GeoString,startpos+2, endpos - startpos - 2))
            GetGeoValue = Fulltrim(R5strReplace(tempstring,"&amp;","&"))
        End If
    End Function
    
    Private Function R5strReplace(mystring As String, search As String, replacewith As String) As String
        Dim source As String
        source = mystring
        While Instr(source, search) > 0
            source = Left$(source, Instr(source, search) - 1) + replacewith + _
            Right$(source, Len(source) - Instr(source, search) - Len(search) + 1)
        Wend
        R5strReplace = source
    End Function 
    
    Private Function R5split(strSource As String, strItemDelim As String) As Variant
        Dim astrReturn() As String             ' The array to return
        Dim intElement As Integer             ' The array element currently being set
        Dim z_intItemCount As Integer         ' The total number of elements for the array
        Dim z_intStartOfItem As Integer     ' The start position of the item in the source string.
        Dim z_intEndOfItem As Integer         ' The end position of the item in the source string.
        
        Dim z_strCurItem As String             ' The currently parsed item
        Dim z_strRemaining As String         ' The remaining string to cycle through
        Dim z_strStartOfItemBack As String     ' The rest of the string, from the start of the item on back.
        
        z_strRemaining = strSource
        ' Cycle through the source string and get a count of elements:
        While (Not z_strRemaining = "")
            z_intStartOfItem = Instr(1, z_strRemaining, strItemDelim)
            
            If (z_intStartOfItem <> 0) Then
                z_intItemCount = z_intItemCount + 1
                z_strRemaining = Mid(z_strRemaining, z_intStartOfItem + Len(strItemDelim), Len(z_strRemaining))
            Else
                z_intItemCount = z_intItemCount + 1
                z_strRemaining = ""
            End If
        Wend
        ' Size the return array so that it can hold all of the elements:
        Redim astrReturn(z_intItemCount - 1)
        ' Reset the holder to the value of the source string:
        z_strRemaining = strSource
        ' Cycle through the source list, parsing the string into individual array elements:
        While (Not z_strRemaining = "")
            For intElement = 0 To Ubound(astrReturn)
            ' Find the end of the current element:
                z_intEndOfItem = Instr(1, z_strRemaining, strItemDelim)
                ' If there is still an item delimiter in the string, parse
                ' out the item, otherwise assume the remaining text is the
                ' last item:
                If (z_intEndOfItem <> 0) Then
                    z_strCurItem = Mid(z_strRemaining, 1, z_intEndOfItem - 1)
                    astrReturn(intElement) = z_strCurItem
                    z_strRemaining = Mid(z_strRemaining, z_intEndOfItem + Len(strItemDelim), _
                    Len(z_strRemaining))
                Else
                    astrReturn(intElement) = z_strRemaining
                    z_strRemaining = ""
                End If 
            Next
        Wend
        ' Return the split array to the caller:
        R5split = astrReturn
    End Function 
    
End Class

Below is a simple code sample that will read all person documents from the NAB, get address information for each person, create a list of GeoData objects, then loop through the list and retrieve data out of it.
Of course it could have been done all in the first loop, but I am splitting it up for demonstration purposes.

Sub ProcessDocs
    Dim db As New NotesDatabase("dsCorp/Deep-South","names.nsf")
    Dim view As NotesView
    Dim doc As NotesDocument 
    Dim geodata As GeoData
    Dim street As String
    Dim city As String 
    Dim state As String 
    Dim zip As String
    Dim uind As strring
    
    ' Loop though all person documents
    Set view = db.GetView("People")
    Set doc = view.GetFirstDocument()
    Do While doc Is Not Nothing
        ' Read address from person documents
        street = doc.OfficeStreetAddress(0)
        city = doc.OfficeCity(0)
        state = doc.OfficeState(0)
        zip = doc.OfficeZIP(0)
        If street<>"" Then     ' Make sure we have an address
            unid = doc.UniversalID     ' Person document unid, used as list tag
            ' Create a new list item, with unid as list tag and a GeoData object stored
            Set geodata(unid) = New GeoData(street, city, state, zip)
        End If
        Set doc = view.GetNextDocument(doc)        
    Loop
    ' Now we will look through the list and get docs again
    Forall g In geodata
        ' Get the person document again based on list tag
        Set doc = db.GetDocumentByUNID( Listtag(g) )
        ' Write latitude and longitude to person document
        doc.OfficeLatitude = g.Latitude
        doc.OfficeLongitude = g.Longitude
        Call doc.Save(True,True)
    End Forall
    
End Sub

Class MailNotification
    Public maildoc As NotesDocument 
    Public body As NotesRichTextItem
    Public subject As String
    Public sendto As String
    Public copyto As String
    Public bccto As String
    Public principal As String

    Public Sub New()
        Dim session As New NotesSession
        Set maildoc = New NotesDocument(session.CurrentDatabase)
        Call  maildoc.ReplaceItemValue("Form","Memo")
        Set body = New NotesRichTextItem(maildoc,"Body")
        subject = ""
        sendto = ""
        copyto = ""
        bccto = ""
        principal = ""
    End Sub
	
    Public Sub Send()
        If subject<>"" Then
            maildoc.Subject = subject
        End If
        If sendto<>"" Then
            maildoc.SendTo = sendto
        End If
        If copyto<>"" Then
            maildoc.CopyTo = copyto
        End If
        If bccto<>"" Then
            maildoc.BlindCopyTo= bccto
        End If
        If principal<>"" Then
            maildoc.Principal = principal
        End If
        Call maildoc.Send(True)
    End Sub
	
End Class

Recently my boss asked me to come up with a way to show certain information on a map of some kind, and after doing some research I decided to simply create a KML file and use Google Earth. In order to create the KML file, I needed latitude and longitude of each address I was going to display. I found a couple of different free services, and I decided to use the one from Google.

The Google Geocode service is using a REST API, so it was easy to write some code to send address and retrieve XML with (among other things) latitude and longitude. An additional benefit is that the address get check and modified, so if the ZIP is off, or the name of the street is not "Street" but "Drive", the correct values get returned.

You need to sign up to get your own key from Google, but it is free. 

Today I decided to write a small class to do this lookup, so now I can add this to any program I write. Below is the code for the script library, as well as a small code sample how to call it. Enjoy!

Dim geodata As GeoData
Set geodata = New GeoData("6363 North State Highway 161", "Irving", "tx", "")
If geodata.IsValid Then
	Msgbox geodata.Street & Chr$(13) & geodata.City & ", " & geodata.State & " " & geodata.ZIP,, _ 	
	"Accuracy = " & geodata.Accuracy
Msgbox "Lat: " & geodata.Latitude & "  Longitude: " & geodata.Longitude
End If

Class GeoData
	Private GeoString As String
	Public street As String
	Public city As String
	Public zip As String
	Public state As String
	Public latitude As String
	Public longitude As String
	
	Public Sub New(streetStr As String, cityStr As String, stateStr As String, zipStr As String)
		Dim httpObject As Variant
		Dim mapsKey As String
		Dim mapsURL As String
		Dim address As String	
		Dim retries As Integer
		Dim httpURL As String
		Dim returncode As String
		Dim coordinates As String
		
		Set httpObject = CreateObject("MSXML2.ServerXMLHTTP")
		mapsKey = "your key goes here"
		mapsUrl = "http://maps.google.com/maps/geo?q="
		address = streetStr & ", " & cityStr & ", " & stateStr & " " & zipStr
		httpURL = mapsURL & address & "&output=xml&key=" & mapsKey ' Use output=CSV for CSV file
		Do
			retries = retries + 1	
			Call httpObject.open("GET", httpURL, False)
			Call httpObject.send()
			GeoString = Left$(httpObject.responseText,16000)
			returncode = GetGeoValue("code")
			If retries >= 10 Then
				returncode = "500"	' Fake other failure after 10 attempts
			End If
		Loop Until returncode <> "620"
		If returncode = "200" Then
			coordinates = GetGeoValue("coordinates")
			latitude = Left$(coordinates, Instr(coordinates,",")-1)
			longitude = Mid$(coordinates, Len(latitude)+2, Instr(Len(latitude)+2, _
			coordinates,",")-Len(latitude)-2)
			street =GetGeoValue("ThoroughfareName")	
			zip = GetGeoValue("PostalCodeNumber")
			city = GetGeoValue("LocalityName")
			state = GetGeoValue("AdministrativeAreaName")
			Msgbox GeoString
		Else 
			GeoString = ""
		End If
	End Sub
	
	Public Function Accuracy() As Integer
		Dim startpos As Long
		Dim endpos As Long
		If IsValid = False Then
			Accuracy = 0
			Exit Function
		End If
		startpos = Instr(Lcase(GeoString),|accuracy="|) + 10 
		endpos = Instr(startpos, Lcase(GeoString), |"|) 
		If endpos < startpos Then
			Accuracy = 0
		Else
			Accuracy = Cint(Fulltrim(Mid$(GeoString,startpos, endpos - startpos)))
		End If
	End Function
	
	Public Function IsValid() As Integer
		If GeoString = "" Then
			IsValid = False
		Else
			IsValid = True
		End If
	End Function
	
	Public Function GetGeoValue(tag As String) As String
		Dim startpos As Long
		Dim endpos As Long
		Dim tempstring As String
		If GeoString = "" Then
			GetGeoValue = ""
			Exit Function
		End If
		startpos = Instr(Lcase(GeoString),"<" & Lcase(tag) & ">") + Len(tag) 
		endpos = Instr(startpos, Lcase(GeoString), "</"+Lcase(tag) & ">") 
		If endpos < startpos Then
			GetGeoValue = ""
		Else
			tempstring = Fulltrim(Mid$(GeoString,startpos+2, endpos - startpos - 2))
			GetGeoValue = Fulltrim(R5strReplace(tempstring,"&amp;","&"))
		End If
	End Function
	
	Private Function R5strReplace(mystring As String, search As String, replace As String) As String
		Dim source As String
		source = mystring
		While Instr(source, search) > 0
			source = Left$(source, Instr(source, search) - 1) + replace + _ 
			Right$(source, Len(source) - Instr(source, search) - Len(search) + 1)
		Wend
		R5strReplace = source
	End Function 
	
End Class

Dim dlmgrfile As String
Dim dirname As String
Dim filename As String
Dim filecode As String
Dim filedescription As String
Dim temp As String
Dim newitem As Integer
Dim fromfile As String
Dim tofile As String

dlmgrfile = "c:\dlmgr.pro"
	
Open dlmgrfile For Input As #1
Do While Not Eof(1)
    Line Input #1, temp
    If Left$(temp,6)=".file=" Then
        filecode = Right$(temp,Len(temp)-6)
        newitem = True
    Elseif Left$(temp,2) = ".." Then
        newitem = False
    End If
    If Left$(temp,7) = "..path=" Then
        dirname = Right$(temp,Len(temp)-7)
    End If
    If Left$(temp,8)="..title=" Then
        filedescription = Right$(temp,Len(temp)-8)
    End If
    If Left$(temp,7)="..name=" Then
        filename = Right$(temp,Len(temp)-7)
    End If
    If newitem = False Then
        If filename<>"" Then
            If dirname<>"" Then
                If filedescription<>"" Then
                    fromfile = dirname & "\" & filename
                    tofile = dirname & "\" & filedescription & Right$(filename,4)
                    Print "Copying " & fromfile & " to " & tofile
                    Filecopy fromfile, tofile
                    ' Kill fromfile
                    dirname = ""
                    filename = ""
                    filedescription = ""
                    filecode = ""
                End If
            End If
        End If
    End If
Loop
Close #1