' *** Class to provide GeoCoding in LotusScript
' *** Written 2008-2009 by Karl-Henry Martinsson (texasswede@gmail.com)
' *** http://www.bleedyellow.com/blogs/TexasSwede
' *** This code is licensed as Creative Commons Attribution-Share Alike 3.0 (CC-BY-SA)
' *** Commercial use allowed, you may modify the code assuming you share your code using
' *** the same license, and you must attribute the code to the original creator.
' *** Attribution: keep this text in your source code, and display the text 
' *** "Some code by Karl-Henry Martinsson" on any about screens.
' *** See http://creativecommons.org/licenses/by-sa/3.0/us/

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 = "<enter your personal Google API key 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 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 could be found for the specified address, possibly because the address is relatively new, or because it may be incorrect.",,"Google GeoCode Error 602"
			Elseif returncode = "603" Then
				Msgbox "The geocode for the given address or the route for the given directions query 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, 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 
	
	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