Script to retrieve textual, geodetic information from www.geonames.org

Recently, when searching for an alternative to enter placenames into my digital asset management catalogs running with the aid of Expression Media2 by Microsoft, I came across a reveiling and interesting discussion in the forum for Expression Media2.
Felix Andrews, has written a script in Visual Basic that retrieves textual, geodetic information (aka reverse geocoding) from www.geonames.org.

Following that discussion and working with that VB-script, I soon found this script to be the base for the alternative I seeked for.
People like John Beardsworth and Tom Bartl added helpful changes and improvements. However the thread of this discussion ended in November 2008.
Meanwhile Expression Media 2 has been released with a very helpful improvement by providing an interface to 'Virtual Earth' from Bing allowing to add GPS-Coordinates to images. To all who already have carefully added GPS-Data to their images this new functinality was not so much of an improvement. Nevertheless, I still regard the geotagging function as very helpful as once in while some GPS-Data is simply not there.

However, since Expression Media2 allows to geocode images but not the reverse processs, I decided to adapt the script so that it also reads that newly entered, annotated GPS-Data from images. This GPS-Data is kept inside the IPTC-fields for Longitude and Latidude only and not within the EXIF section that may contain more valuable geodetic information.
For the script to recognize and differentiate reading GPS-Data from the EXIF section or from the IPTC section, I had change the structure of that script. In addition, I also adapted the output according to my needs. So for images taken in the US, the County name is placed after the City name. Of course, one may change the outputs according to their needs.
An experienced coder for Visual Basic may certainly improve the script to be more efficient, but for now I am quite happy the way it works.
For images taken in the US the quality of geodetic information provided by www.geonames.org is very detailed and thus useful.
Unfortunately for other countries, like Switzerland and Italy (as Mantra Siva stated in the discussion thread) the geodetic information could and should be improved dramatically. So in addition to my effort of rewriting the script, I also contacted people in charge at SwissTopo (http://www.swisstopo.ch/) and the ETH University in Zurich (http://www.geo.uzh.ch/), requesting the release of a public dataset of good quality geodetic information for Switzerland. My personal gusto of good quality geodetic information is data that is younger than a maximum of 10 - 5 years as placenames for describing images does not change very often.

'Script to retrieve geodetic information from geonames.org
'Script derived from:
'- (dead url) social.expression.microsoft.com/forums/en/media/thread/1728cf60-c8c8-4d4a-b805-19ab5451fded
'- original by Felix Andrew / download the code at: (dead url) go.microsoft.com/fwlink/?LinkId=116859
'- modification1 by John Beardsworth, GB / view the code at: http://www.beardsworth.co.uk/pics/blog/Country_State_City_Location_from_GPS.vbs.txt
'- modification2 by Tom Bartl / http://social.expression.microsoft.com/Profile/en-US/?user=TomBartl
'- modification3 by Hans Loepfe, Switzerland / https://www.halo-photographs.comscripts/GPS-to-textual-geodectic-information.html
'  corrected GPS Data conversion from DDD.MM.SS.SS to DD.ddddddd in original script
'- source: written by http://www.fcc.gov/mb/audio/bickel/DDDMMSS-decimal.html
'------------------------
'current functionalities:
'------------------------
'checks for availability of GPS-Data in EXIF- and in IPTC-fields
'if found, select using GPS-Data from EXIF or IPTC
'function validation for degrees > 0 and < 360
'copies GPS-Data from EXIF into IPTC
'processed images are labeled by means of a defineable keyword
'non-processed images are labeled with - Label# 8, light-blue (adjustable, optional)
'reverse geocoding is adjusted to 1st use findNearby (fN) and then findNearbyPlaceName(fNPN) because fN holds a more specific placename than fNPN, which holds a placename of a broader scope.
'Timezone values are written into custom_field 'TimeZoneGMT' as offset value to GMT and also the placename, both referring to GMT (DST optional).
'Country specific adjustments for City and Region (for now US and CH only)
'option to display full results (XML) of actual querry in browser

Option Explicit
const BoxTitle = "Microsoft Expression Media"
const BoxTitle1 = "Reverse geocode images online via geonames.org"
'Images that have no GPS-Data and thus cannot be reverse geocoded will be labeled
'you can choose a Labelnumber (0-9) according to your needs
const Labelnumber = 8	'light-blue

'Images that were successfully reverse-geocoded receive the keyword assigned here
const kw_success = "reverse_geocoded_by_script"		'optional, adjustable

Dim app, mediaItems, mediaItem, x, y, EXIF, IPTC, switch, longitude, latitude, debug
debug = "no"	'to display the full results of the actual querry, set this to "yes"  and copy the contents in the box into the browser URL
'debug = "yes"
Dim strLong, strLat 		'variables for function to convert DD.MM.SS.SS (Degrees) to DD.dddddd (Degrees.decimal)

'display description and EXIF or IPTC question boxes
if ( MsgBox("Regular Execution (YES) / Debug mode (NO) ?", 4, BoxTitle1) = vbYes ) then
	debug = "no"
	Main()
else
	debug = "yes"
	Main()
end if

'Main()
sub Main()
	set app = CreateObject("ExpressionMedia.Application")
	set mediaItems = app.ActiveCatalog.MediaItems
	'reset result counters to 0
	x = 0000
	y = 0000
	for each mediaItem in mediaItems
        if( mediaItem.Selected ) then
			'check for value in EXIF
			if( mediaItem.DeviceInfo.Longitude  = "" ) then
				'check for value IPTC in degrees: 000, empty, 
				if( mid(mediaItem.Annotations.Longitude,3,3) = "000" ) then	'check if the image has been processed before using the the alternative option below
					'do not attempt to reverse geocode this image, as there is no GPS Data in it
					mediaItem.LabelIndex = Labelnumber			'item gets labeled
					x = x + 1						'number of images without GPS-Data
					switch = "nogps"
				elseif mediaItem.Annotations.Longitude ="" then
						'do not attempt to reverse geocode this image, as there is no GPS Data in it
						mediaItem.LabelIndex = Labelnumber
						x = x + 1
						switch = "nogps"
						'alternatively write 0 values into Long & Lat for items without GPS-Data (aka Gulf of New Guinea)
						'mediaItem.Annotations.Latitude = 0		'option
						'mediaItem.Annotations.Longitude = 0		'option
				else 'run subroutine for images with GPS-Data held in IPTC-fields
					switch = "iptc"
					GPSIPTC
				end If
			elseif ( MsgBox("Use Lat/Long from IPTC- instead of EXIF-Data ? (IPTC = YES) / EXIF = NO ", 4, BoxTitle1) = vbYes ) then
					switch = "iptc"
					GPSIPTC
			else	'run subroutine for images with GPS-Data held in EXIF-fields
				'( mediaItem.DeviceInfo.Longitude <> "" ) then		
				switch = "exif"	'GPS-Data in EXIF has priority over GPS-Data in IPTC
				GPSEXIF
			end if
			'msgbox switch,,"switch2"
			y = y + 1	'total number of images processed
		end if  
	next	
MsgBox y-x & " - reverse geocoded" & vbCrLf & x & "  - NOT reverse geocoded" & vbCrLf & y & " - processed", vbOKOnly, "Result"
end sub

'Function to convert GPS-Data into decimals
'This function is accurate as rounding errors are taken into account.
'0.2 is not the same as 0.2000284

'Function adapted by Hans Loepfe, Switzerland in July 2008
'source: written by http://www.fcc.gov/mb/audio/bickel/DDDMMSS-decimal.html

'calculating the LATITUDE
Function DegLat(value)
	dim latsign, dLat, dLat1, dLat2, dLat3, dLat4
	dim absdlat, absmlat, absslat, alat

	dlat = split(strLat, " ")
	dLat1 = Left(dLat(1), 3)
	dLat2 = CSng(Left(dLat(2), 2))
	dLat3 = CSng(Left(dLat(3), 5))

	'NORTH or SOUTH
	if (dLat(0)) = "S" then 'checking for northern (+) or southern (-) Hemisphere
		latsign = -1
		else
		latsign = 1
	end if
	
	'DEGREES		
	absdlat = abs(round(dLat1 * 1000000.)) '	'round' is used to eliminate the small error caused by rounding in the computer. e.g. 0.2 is not the same as 0.20000000000284
	'Error check
	if (absdlat > (90 * 1000000)) then 
		msgbox ("Degrees Latitude must be in the range of -90 to 90.")
	end if

	'MINUTES	
	dLat2 = abs(round(dLat2 * 1000000.)/1000000)
	absmlat = abs(round(dLat2 * 1000000.))
	'Error check
	if (absmlat >= (60 * 1000000)) then 
		msgbox ("Minutes Latitude must be in the range of 0 to 59.")
	end if

	'SECONDS
	dLat4 = round(dlat3 * 1000000.)/1000000
	absslat = abs(round(dLat4 * 1000000.))  'Note: kept as big integer for now, even if submitted as decimal
	'Error check
	if (absslat > (59.99999999 * 1000000)) then 
		msgbox ("Minutes Latitude must be 0 or greater and less than 60.")
	end if

	'CONVERT Latidude Degrees to decimals
	DegLat = round(absdlat + (absmlat/60.) + (absslat/3600.) ) * latsign/1000000
end function

'calculating the LONGITUDE
function DegLong(value)
	dim lonsign, dlon, dlon1, dlon2, dlon3, dlon4
	dim absdlon, absmlon, absslon, alon

	dlon = split(strLong, " ")
	dlon1 = Left(dlon(1), 3)
	dlon2 = CSng(Left(dlon(2), 2))
	dlon3 = CSng(Left(dlon(3), 5))

	'EAST or WEST
	if (dLon(0)) = "W" then 'checking for eastern (+) or western (-) Hemisphere
		lonsign = -1
		else
		lonsign = 1
	end if
	
	'DEGREES		
	absdlon = abs(round(dlon1 * 1000000.)) '	'round' is used to eliminate the small error caused by rounding in the computer. e.g. 0.2 is not the same as 0.20000000000284
	'Error check
	if (absdlon > (180 * 1000000)) then 
		msgbox ("Degrees Longitude must be in the range of -180 to 180.")
	end if
	
	'MINUTES	
	dlon2 = abs(round(dlon2 * 1000000.)/1000000)
	absmlon = abs(round(dlon2 * 1000000.))
	'Error check
	if (absmlon >= (60 * 1000000)) then 
		msgbox ("Minutes Longitude must be in the range of 0 to 59.")
	end if
	
	'SECONDS
	dlon4 = round(dlon3 * 1000000.)/1000000
	absslon = abs(round(dlon4 * 1000000.))  'Note: kept as big integer for now, even if submitted as decimal
	'Error check
	if (absslon > (59.99999999 * 1000000)) then 
		msgbox ("Minutes Longitude must be 0 or greater and less than 60.")
	end if
	
	'CONVERT longitude Degrees to decimals
	DegLong = round(absdlon + (absmlon/60.) + (absslon/3600.) ) * lonsign/1000000
end function


'Process images with GPS-Data in EXIF
sub GPSEXIF()
if (switch = "exif") then
	strLong = mediaItem.DeviceInfo.Longitude
	strLat  = mediaItem.DeviceInfo.Latitude
	msgbox strLong
	longitude = DegLong( strLong )
	latitude = DegLat( strLat )

	'copy the GPS-Data from EXIF into IPTC, this ensures that all processed images have GPS-Data in the IPTC section
	'GPS-Data in EXIF has priority over GPS-Data in IPTC
	'Disable the following 2 lines only, if the above is not your preference and enable the 2 disabled lines below.
	mediaItem.Annotations.Longitude = mediaItem.DeviceInfo.Longitude		'enable / disable
	mediaItem.Annotations.Latitude = mediaItem.DeviceInfo.Latitude			'enable / disable
	'copying the values calculated by the function above clearly reveal rounding errors as a fraction of seconds (0.0x)
	'this equivalent to about 0.88m or 3 feet only (at LAT 38°)
	'see also http://commons.wikimedia.org/wiki/Commons:Geocoding#Precision
	'mediaItem.Annotations.Longitude = Longitude							'enable / disable
	'mediaItem.Annotations.Latitude = Latitude								'enable / disable
	Image	'retrieve geodetic properties from www.Geonames.org
end if
end sub

'Process images with GPS-Data in IPTC
sub GPSIPTC()
if ( switch = "iptc" ) then
	strLong = mediaItem.Annotations.Longitude
	strLat  = mediaItem.Annotations.Latitude
	longitude = DegLong( strLong )
	latitude = DegLat( strLat )
	Image	'retrieve geodetic properties from www.Geonames.org
end if
end sub

'Retrieve geodetic information from http://www.geonames.org for images with GPS-Data in EXIF or IPTC
sub Image()
if (switch <> "nogps") then
	dim xmlhttp, xmldom,  nbySuffix, querry
	dim geoIdNode, locationNode, isoCodeNode, countryNode, cityNode, regionNode, city_region, stateNode
	dim TZ1, TZGMT, TZDST, TZID, timezoneNode
	dim fNPN_location1, fN_location2, geoId0, fNPN_geoId1, fN_geoId2
	dim timezoneNodeGMT, timezoneNodeDST, timezoneNodeID
	dim fNPN_isoCode
	nbySuffix = "&style=full"
	'querry = ""
	set xmlhttp = CreateObject("Microsoft.XMLHTTP")

'findNearby (fN)
	'first run a narrower search of data for the selected item
	'uncomment following line for adjustments - copy the contents into the browser URL
	if ( debug = "yes" ) then 
		inputbox "findNearby", , "http://ws.geonames.org/findNearby?lat="+CStr(latitude)+"&lng="+CStr(longitude) & nbySuffix
		inputbox "findNearbyWikipedia", , "http://ws.geonames.org/findNearbyWikipedia?lat="+CStr(latitude)+"&lng="+CStr(longitude) & nbySuffix
	end if

	xmlhttp.open "GET", "http://ws.geonames.org/findNearby?lat="+CStr(latitude)+"&lng="+CStr(longitude) & nbySuffix , False
	set xmldom = CreateObject("Microsoft.XMLDOM")
	xmlhttp.send xmldom
	xmldom.loadXML(xmlhttp.responseText)

	set locationNode = xmldom.selectSingleNode("geonames/geoname/name")
	'store location node for comparison below
	fN_location2 = locationNode.text
	
	set geoIDNode = xmldom.selectSingleNode("geonames/geoname/geonameId")
	'store geoID node for comparison below
	fN_geoId2 = geoIdNode.text
	
'	set isoCodeNode = xmldom.selectSingleNode("geonames/geoname/countryCode")		'not needed here
'	set countryNode = xmldom.selectSingleNode("geonames/geoname/countryName")		'not needed here
	set cityNode = xmldom.selectSingleNode("geonames/geoname/adminName1")
	set regionNode = xmldom.selectSingleNode("geonames/geoname/adminName2")
	set stateNode = xmldom.selectSingleNode("geonames/geoname/adminName3")

	
'findNearbyPlaceName (fNPN)
	'a broader search of data as a 2nd step for the selected item
	'this querry will overwrite data already retrieved with 'findNearby (fN)
	'but that's ok becuase the PlaceName found is stored in the variable fN-Location2
	'uncomment following line for adjustments - copy the contents into the browser URL
	if ( debug = "yes" ) then 
		inputbox "findNearbyPlaceName", , "http://ws.geonames.org/findNearbyPlaceName?lat="+CStr(latitude)+"&lng="+CStr(longitude) & nbySuffix
		inputbox "extendedFindNearby", , "http://ws.geonames.org/extendedFindNearby?lat="+CStr(latitude)+"&lng="+CStr(longitude)
	end if
	
	xmlhttp.open "GET", "http://ws.geonames.org/findNearbyPlaceName?lat="+CStr(latitude)+"&lng="+CStr(longitude) & nbySuffix, False
	set xmldom = CreateObject("Microsoft.XMLDOM")
	xmlhttp.send xmldom
	xmldom.loadXML(xmlhttp.responseText)

	set locationNode = xmldom.selectSingleNode("geonames/geoname/name")
	'store location node for comparison below
	fNPN_location1 = locationNode.text
	
	set geoIDNode = xmldom.selectSingleNode("geonames/geoname/geonameId")
	'store geoID node for comparison below
	fNPN_geoId1 = geoIdNode.text
	'msgbox fNPN_geoID1
		
	set isoCodeNode = xmldom.selectSingleNode("geonames/geoname/countryCode")
	'store isoCode node for comparison below
	fNPN_isoCode = isoCodeNode.text
	
	set countryNode = xmldom.selectSingleNode("geonames/geoname/countryName")
	set cityNode = xmldom.selectSingleNode("geonames/geoname/name")
	if ( fNPN_isoCode = "US" ) then
		set regionNode = xmldom.selectSingleNode("geonames/geoname/adminName2")
	elseif (fNPN_isoCode = "CH" ) then
		set regionNode = xmldom.selectSingleNode("geonames/geoname/adminName3")
	end if
	
	set stateNode = xmldom.selectSingleNode("geonames/geoname/adminName1")
	set timezoneNode = xmldom.selectSingleNode("geonames/geoname/timezone")
	'store timezone value for verification below
	TZ1 = timezoneNode.text

'timezone (TZ) - get timezone information from another request to geonames.org
	'uncomment following line for adjustments - copy the contents into the browser URL
	'inputbox "timezone", , "http://ws.geonames.org/timezone?lat="+CStr(latitude)+"&lng="+CStr(longitude)

	xmlhttp.open "GET", "http://ws.geonames.org/timezone?lat="+CStr(latitude)+"&lng="+CStr(longitude), False
	set xmldom = CreateObject("Microsoft.XMLDOM")
	xmlhttp.send xmldom
	xmldom.loadXML(xmlhttp.responseText)

	set timezoneNodeGMT = xmldom.selectSingleNode("geonames/timezone/gmtOffset")
	set timezoneNodeDST = xmldom.selectSingleNode("geonames/timezone/dstOffset")
	set timezoneNodeID = xmldom.selectSingleNode("geonames/timezone/timezoneId")
	
	TZGMT = timezoneNodeGMT.text
	TZDST = timezoneNodeDST.text
	TZID = timezoneNodeID.text
	'verifying timezone querries
	if ( TZ1 <> TZID ) then
		msgbox "For some reason Timezone values do NOT correspond",,BoxTitle
	end if
	'else
		'do nothing as both querries retrieved the same data
	'end if

'findNearbyWikipedia (fNW)
	'first run a narrower search of data for the selected item
	'uncomment following line for adjustments - copy the contents into the browser URL
	if ( debug = "yes" ) then 
		inputbox "findNearbyWikipedia", , "http://ws.geonames.org/findNearbyWikipedia?lat="+CStr(latitude)+"&lng="+CStr(longitude) & nbySuffix
	end if
	
	dim summaryNode, wikiUrlNode, fNW_summary, fNW_wikiURL, exist_description, fNW_description
	
	xmlhttp.open "GET", "http://ws.geonames.org/findNearbyWikipedia?lat="+CStr(latitude)+"&lng="+CStr(longitude) & nbySuffix , False
	set xmldom = CreateObject("Microsoft.XMLDOM")
	xmlhttp.send xmldom
	xmldom.loadXML(xmlhttp.responseText)

	set summaryNode = xmldom.selectSingleNode("geonames/entry/summary")
	'store location node for comparison below
	fNW_summary = summaryNode.text
	
	set wikiUrlNode = xmldom.selectSingleNode("geonames/entry/wikipediaUrl")
	'store geoID node for comparison below
	fNW_wikiUrl = wikiUrlNode.text
	fNW_description = fNW_summary & "(source: " & fNW_wikiUrl &")"
	

'writing retrieved data into the EM2 catalog
	'1st: compare values for location and geoId
	if (fNPN_location1 <> fN_location2) then 
		mediaItem.Annotations.Location=fN_location2
	end if
	'else
		'do nothing as we want to further specify the location manually and also to avoid double entries
		'mediaItem.Annotations.Location=fNPN_location1
	'end if
	
	if (fNPN_geoId1 <> fN_geoId2) then 
		geoId0 = fN_geoId2
	else
		geoId0 = fNPN_geoId1
	end if
	
	'2nd: concatenate (gmtOffset/timezoneId/genameId) into one custom field named TimeZoneGMT
	'mediaItem.customFields.item("TimeZoneGMT").value = timezoneNode.text
	'mediaItem.customFields.item("TimeZoneGMT").value = TZDST & "/" & TZID & "/" & geoId0	'optional
	mediaItem.customFields.item("TimeZoneGMT").value = TZGMT & "/" & TZID & "/" & geoId0
	
	'3rd: differentiate 'cityNode' between isoCode= US and CH
	if ( fNPN_isoCode = "US" ) then
		city_region = fNPN_location1 & ", " & regionNode.text	'combine City, Region for US only
		mediaItem.Annotations.city = city_region
	elseif (fNPN_isoCode = "CH" ) then
		mediaItem.Annotations.City=cityNode.text
	end if
	'mediaItem.Annotations.Region=regionNode.text
	
	'4th: descision about description entry
	exist_description = mediaItem.Annotations.Caption						'store exisiting description
	if ( exist_description <> "" ) then
		dim result
		result = msgbox("Exisiting:" & vbCrLf & exist_description & vbCrLf & vbCrLf & "Wiki:" &vbCrLf & fNW_description & vbCrLf & vbCrLF & "Add Wiki to exisiting description (YES) "& vbCrLf & "Wiki only, overwrite existing description (NO)" & vbCrLf & "Keep exisiting description (CANCEL) ?", 3, "Descriptions")
		'msgbox result										'check button push
		select case result
			case VbYes	'result = 6
			mediaItem.Annotations.Caption = exist_description & " - " & fNW_description	'add Wiki-Description to existing Description
			case VbNo	'result = 7
			mediaItem.Annotations.Caption = fNW_description					'overwrite exisiting and write Wiki-Description
			case VbCancel	'result = 2							'do nothing = keep exisitng
		end select
	else
		'fNW_description = inputbox( "findNearbyWikipedia", , fNW_description)			'option to edit the Wiki-Description
		mediaItem.Annotations.Caption =  fNW_description
	end if

	'5th: write the rest into the EM2 catalog
	mediaItem.Annotations.State=stateNode.text
	mediaItem.Annotations.Country=countryNode.text
	mediaItem.Annotations.CountryCode=isoCodeNode.text
	'optional keyword assignment
	mediaItem.Annotations.Keywords = kw_success							'enable / disable
	
	
	'Stuff to be added or completed
'1- Altidude in meters could be requested equally using the service astergdem at www.geonames.org
'	uncomment following line for adjustments - copy the contents into the browser URL
	'inputbox "altitude", , "http://ws.geonames.org/astergdem?lat="+CStr(latitude)+"&lng="+CStr(longitude)
'2- put url into WEB-Page code to verify location on WEB published images
	'inputbox "display1", , "http://www.geonames.org/maps/google_"+CStr(latitude)+"_"+CStr(longitude)+".html"
	mediaItem.Annotations.Url = "http://www.geonames.org/maps/google_"+CStr(latitude)+"_"+CStr(longitude)+".html"
'   better to use
	'inputbox "display1", , "http://www.geonames.org/"+CStr(geoId0)
	'mediaItem.Annotations.Url = "http://www.geonames.org/"+CStr(geoId0)
'3- genaue CH Placenames und Flurnamen auf map.geo.admin.ch finden
'	umrechnen von CH-X/Y-Koordinaten(UTM) into GPS-Lat/Long-Koordinaten

end if
end sub

resources:

(URL no longer available) discussion in the forum for Expression Media2
- original script by Felix Andrew / download the code at: (URL no longer available) "go.microsoft.com/fwlink/?LinkId=116859"
- 1st. modification by John Beardsworth, GB / view the code at: http://www.beardsworth.co.uk/pics/blog/Country_State_City_Location_from_GPS.vbs.txt
- 2nd. modification by Tom Bartl / (URL no longer available) discussion entry 'Thursday, November 27, 2008 4:49 PM' in the forum for Expression Media2