Savvy DIAdem Solutions

Home Navigator View Analysis Report DAC Script Dialog Data Apps Blog

 

Data

Data sets related to measurement data ingestion, attribution, analysis, and visualization using NI DIAdem.  

 

Shuttle Radar Topography Mission (SRTM) Data

Shuttle Radar Topography Mission (SRTM) data is high-resolution digital topographic data covering nearly all of the earth at a resolution of 30 m (along the equator).   DIAdem has commands that allow you to quickly find out what SRTM data is available, download the data, and extract elevation information from it based on an area specified by four GPS coordinates. 

' ChnSRTMAltitude - elevation from SRTM data for the area specified by four GPS coordinates.
' SRTMDownloadTilesArea() - download SRTM data for the area specified by four GPS coordinates. 
' SRTMDownloadGetStatistics - get information about the availability of SRTM data for the area specified by four GPS coordinates.
'
' Shuttle Radar Topography Mission (SRTM) data is high-resolution digital topographic 
' data covering nearly all of the earth at a resolution of 30 m (along the equator).


'ChnSRTMAltitude - elevation from lat/long.
'Call SUDDlgShow("Main", ResourceDrv & "AnaChnSRTMAltitude")

'Call SRTMDownloadTilesArea(SRTMLowerLatitudeBound, SRTMUpperLatitudeBound, SRTMLowerLongitudeBound, SRTMUpperLongitudeBound) 
'Call SUDDlgShow("Main", ResourceDrv & "DlgSRTMDownLoad")

'Call SRTMDownloadGetStatistics(SRTMLowerLatitudeBound, SRTMUpperLatitudeBound, SRTMLowerLongitudeBound, SRTMUpperLongitudeBound, SRTMTilesAvailable, SRTMTilesToDownload, SRTMTilesMissing, SRTMMegaBytesOnDisk, SRTMMegaBytesToDownload, SRTMAreaNotSupported) 


''Acquire elevation information for the four corners of an area located at
''CNH Industrial New Holland PA USA facility.  https://goo.gl/maps/toAy11bYuMR2
''Demonstrates the use of the commands SRTMDownloadTilesArea(), SRTMDownloadGetStatistics(), and ChnSRTMAltitude().
''Shuttle Radar Topography Mission (SRTM) data is high-resolution digital topographic 
''data covering nearly all of the earth at a resolution of 30 m (along the equator).
'Call Data.Root.Clear()
'Dim oGrp, oChnDateTime, oChnLat, oChnLon, oChnAltitude, dLatLowerBound, dLatUpperBound, dLonLowerBound, dLonUpperBound
'Call bCreateGpsSampleDataForSRTM(oGrp, oChnDateTime, oChnLat, oChnLon, oChnAltitude)
'dLatLowerBound = oChnLat.Minimum
'dLatUpperBound = oChnLat.Maximum
'dLonLowerBound = oChnLon.Minimum
'dLonUpperBound = oChnLon.Maximum
'Call LogFileWrite("Area defined by:")
'Call LogFileWrite(vbTab & "Latitude from " & dLatLowerBound & " to " & dLatUpperBound)
'Call LogFileWrite(vbTab & "Longitude from " & dLonLowerBound & " to " & dLonUpperBound)
''Get statistics about the SRTM information required for the altitude calculation.
'Dim dFilesAvail, dFilesToDl, dFilesMissing, dMbOnMyDisk, dMbToDl, bAreaNotSupported
'Call SRTMDownloadGetStatistics(dLatLowerBound,dLatUpperBound,dLonLowerBound,dLonUpperBound,dFilesAvail,dFilesToDl,dFilesMissing, dMbOnMyDisk, dMbToDl, bAreaNotSupported)
'Call LogFileWrite("# files not available online = " & dFilesMissing)
'If bAreaNotSupported Then
'  Call LogFileWrite("SRTM data is NOT available for the area of " & dLatLowerBound & " to " & dLatUpperBound & ", " & dLonLowerBound & " to " & dLonUpperBound)
'Else
'  Call LogFileWrite("SRTM data is available for the area of " & dLatLowerBound & " to " & dLatUpperBound & ", " & dLonLowerBound & " to " & dLonUpperBound)
'End If
''Download the Shuttle Radar Topography Mission (SRTM) data that is required 
''for the command ChnSRTMAltitude().
'Call SRTMDownloadTilesArea(dLatLowerBound,dLatUpperBound,dLonLowerBound,dLonUpperBound)
'Call LogFileWrite("The SRTM files are in the folder " & SRTMTilesCacheFolder)
'''Calculate the elevation from the SRTM data.
'Call ChnSRTMAltitude(oChnLat, oChnLon, oChnAltitude)


Function bCreateGpsSampleDataForSRTM(oGrp, oChnDateTime, oChnLat, oChnLon, oChnAltitude)
  'Creates channel groups and channels for GPS data and then populates them
  'with the following sample data:
  '40.095343, -76.099005   CNH Industrial - New Holland PA campus - NE
  '40.093166, -76.112725   CNH Industrial - New Holland PA campus - NW
  '40.085021, -76.111771   CNH Industrial - New Holland PA campus - SW
  '40.083196, -76.099374   CNH Industrial - New Holland PA campus - SE
  '
  bCreateGpsSampleDataForSRTM = False
  Dim iRow
  Const sGrp = "GPS", sChnLat = "Lat", sChnLon = "Lon", sChnAltitude = "Altitude"
  If Data.Root.ChannelGroups.Exists(sGrp) Then Call Data.Root.ChannelGroups.Remove(sGrp)
  Set oGrp = Data.Root.ChannelGroups.Add(sGrp)
  Set oChnDateTime = oGrp.Channels.Add("DateTime",DataTypeChnDate)
  Set oChnLat = oGrp.Channels.Add(sChnLat,DataTypeChnFloat64)
  oChnLat.UnitSymbol = "°"
  Set oChnLon = oGrp.Channels.Add(sChnLon,DataTypeChnFloat64)
  oChnLon.UnitSymbol = "°"
  Set oChnAltitude = oGrp.Channels.Add(sChnAltitude,DataTypeChnFloat64)
  
  '40.095343, -76.099005   CNH Industrial - New Holland PA campus - NE
  iRow = 1
  oChnDateTime.Values(iRow) = Now()
  oChnLat.Values(iRow) = 40.095343
  oChnLon.Values(iRow) = -76.099005
  
  '40.093166, -76.112725   CNH Industrial - New Holland PA campus - NW
  iRow = 2
  oChnDateTime.Values(iRow) = Now()
  oChnLat.Values(iRow) = 40.093166
  oChnLon.Values(iRow) = -76.112725
  
  '40.085021, -76.111771   CNH Industrial - New Holland PA campus - SW
  iRow = 3  
  oChnDateTime.Values(iRow) = Now()
  oChnLat.Values(iRow) = 40.085021
  oChnLon.Values(iRow) = -76.111771
  
  '40.083196, -76.099374   CNH Industrial - New Holland PA campus - SE
  iRow = 4
  oChnDateTime.Values(iRow) = Now()
  oChnLat.Values(iRow) = 40.083196
  oChnLon.Values(iRow) = -76.099374
  
  Call ChnCharacterAll()
  bCreateGpsSampleDataForSRTM = True
End Function  'bCreateGpsSampleDataForSRTM()

 

Reverse Geocode GPS

Get a ISO 3166 2 charaacter country code for the supplied latitude and longitude (decimal degrees format).   

'40.670700,-75.632211  National Instruments headquarters
Dim dLat, dLng, sAlpha3CountryCode, sAlpha2CountryCode
dLat = 40.670700: dLng = -75.632211
sAlpha2CountryCode = sGetCountryCodeForLatLong(dLat, dLng)
If Len(sAlpha2CountryCode) = 0 Then
  Call LogFileWrite("ERROR - sAlpha2CountryCode of '" & sAlpha2CountryCode & "' is invalid")
Else
  sAlpha3CountryCode = sGetAlpha3CharCountryCodeFromAlpha2CharCode(sAlpha2CountryCode)
  If Len(sAlpha3CountryCode) = 0 Then
    Call LogFileWrite("ERROR - unable to find Alpha 3 country code for '" & sAlpha2CountryCode & "'")
  Else
    Call LogFileWrite(Str(dLat,"d.dddddd") & "," & Str(dLng,"d.dddddd") & " -> " & sAlpha2CountryCode & " -> " & sAlpha3CountryCode)
  End If
End If

Function sGetCountryCodeForLatLong(ByVal dLat, ByVal dLng)
  'Returns ISO 3166 2 character country code for the passed latitude & longitude
  'Returns a zero length string if an error occurs.
  '
  'Requires:
  ' bLatitudeLongitudeIsValid()
  ' bStrIsNothing()
  ' sStrReplaceAll()
  ' sStrReplaceNonPrintChars()
  '
  'Ref:  http://www.geonames.org/export/web-services.html#countrycode
  '      http://www.geonames.org/
  sGetCountryCodeForLatLong = ""
  If Not bLatitudeLongitudeIsValid(dLat, dLng) Then
    Call LogFileWrite("ERROR - invalid values of " & Str(dLat,"d.dddddd") & "," & Str(dLng,"d.dddddd") & " passed to Fn sGetCountryCodeForLatLong()")
    Exit Function
  End If
  const geonamesUsername = "get your own api key at http://www.geonames.org/"
  Dim sErr, lErr
  sErr = ""
  lErr = cLng(0)
  Dim oREST, sURL, sResponse
  Set oREST = CreateObject ("Microsoft.XMLHTTP") 
  'Create the headers that we will need to make the request 
  sURL = "http://api.geonames.org/countryCode?lat=" & Str(dLat,"d.dddddd") & "&lng=" & Str(dLng,"d.dddddd") & "&username=" & geonamesUsername & "&type=xml" 
  Call MsgLineDisp("Getting country code for " & Str(dLat,"d.dddddd") & "," & Str(dLng,"d.dddddd"))
  'Open the URL
  On Error Resume Next
  oREST.open "GET", sURL, False 
  If Err.number <> 0 Then 
    Call LogFileWrite(vbTab & "Fn sGetCountryCodeForLatLong() experienced a .Open error.  Err #" & Err.number & vbTab & Err.Description)
    On Error Goto 0
    Set oRest = Nothing
    Exit Function
  End If
  On Error Goto 0
  'Catch an error caused by lack of an internet connection.
  On Error Resume Next
  oREST.send("")
  lErr = Err.number: sErr = Err.Description
  On Error Goto 0
  If lErr = 0 Then
    'ok
  ElseIf lErr = -2147024891 Then
    Call LogFileWrite("Error - unable to access the internet.  Err # " & lErr & "  " & sErr)
    Exit Function
  Else
    Call LogFileWrite("Unexpected error # " & lErr & "  " & sErr)
    Exit Function
  End If
  'Get the REST response
  On Error Resume Next
  sResponse = oREST.responseText
  If Err.number <> 0 Then 
    Call LogFileWrite(vbTab & "Fn sGetCountryCodeForLatLong() experienced a oREST.responseText.  Err #" & Err.number & vbTab & Err.Description)
    On Error Goto 0
    Set oRest = Nothing
    Exit Function
  End If
  On Error Goto 0
  'LogFileWrite(sResponse)
  
  '
  '
  ' 
  '   AT
  '   Austria
  '   de-AT,hr,hu,sl
  '   0
  ' 
  '
  
  '
  '
  ' 
  '   US
  '   United States
  '   en-US,es-US,haw,fr
  '   0
  ' 
  ''
  
  Dim xmlDoc, oNode, sXpath, oChild
  'Load the xml within sResponse
  Set xmlDoc = CreateObject("Microsoft.XMLDOM")
  xmlDoc.Async = "false"
  If Not xmlDoc.loadXML(sResponse) Then
    'Sometimes the REST response is just the country code, no XML.  
    If len(sResponse) > 0 Then
      'ok 
      'When this happens, a CrLf is added to the string, so strip it out.
      'Call LogFileWrite("sGetCountryCodeForLatLong; if not xmlDoc.loadXML(sResponse); sResponse = '" & sResponse & "'")
      sGetCountryCodeForLatLong = GetAlpha3CharCountryCodeFromAlpha2CharCode(sStrReplaceNonPrintChars(cStr(sResponse),""))
    Else
      Call LogFileWrite("ERROR - Fn sGetCountryCodeForLatLong() response  = '" & sResponse & "'")
      sGetCountryCodeForLatLong = ""
      Exit Function
    End If
  Else
    sXpath = "/geonames/country"
    'Call LogFileWrite("The number of nodes is " & xmlDoc.selectNodes(sXpath).length & " for '" & sXpath & "'")
    For Each oNode in xmlDoc.selectNodes(sXpath)
        'Find a specific child and get the value..
        'Get the country code..
        For Each oChild in oNode.SelectNodes("countryCode")
          sGetCountryCodeForLatLong = oChild.Text
        Next
    Next
    Set oRest = Nothing
    Set xmlDoc = Nothing
  End If
  Call MsgLineDisp(vbTab)
End Function  'sGetCountryCodeForLatLong()

'Call LogFileWrite("bLatitudeLongitudeIsValid(40.670700,-75.632211) = " & bLatitudeLongitudeIsValid(40.670700,-75.632211))
'Call LogFileWrite("bLatitudeLongitudeIsValid(181,-75.632211) = " & bLatitudeLongitudeIsValid(181.0,-75.632211))

Function bLatitudeLongitudeIsValid(ByVal dLat, ByVal dLng)
  bLatitudeLongitudeIsValid = False
  If bLatitudeIsValid(dLat) AND bLongitudeIsValid(dLng) Then bLatitudeLongitudeIsValid = True
End Function  'bLatitudeIsValid()

Function bLatitudeIsValid(ByVal dLat)
  'Lat values vary from 90° N to 90° S.  (+90 to -90)
  'Long values vary from 180° W to 180° E.  (-180 to +180)
  'N & E are positive, S & W are negative
  bLatitudeIsValid = True
  If dLat < -90.0 OR dLat > 90.0 Then
    bLatitudeIsValid = False
  End If
End Function  'bLatitudeIsValid()

Function bLongitudeIsValid(ByVal dLng)
  'Lat values vary from 90° N to 90° S.  (+90 to -90)
  'Long values vary from 180° W to 180° E.  (-180 to +180)
  'N & E are positive, S & W are negative
  bLongitudeIsValid = True
  If dLng < -180.0 OR dLng > 180.0 Then
    bLongitudeIsValid = False
  End If
End Function  'bLongitudeIsValid()

'-------------------------------------------------------------------------------
' helper functions

Function sStrReplaceNonPrintChars(ByVal sHaystack, ByVal sNewNeedle)
    Dim i
    'replace non printable characters, ASCII 0-31 and 127-255 (decimal).
    If bStrIsNothing(sHaystack) Then
        sStrReplaceNonPrintChars = sHaystack
    Else
        For i = 0 To 31
          sHaystack = sStrReplaceAll(sHaystack, String(1, Chr(i)), sNewNeedle)
        Next
        For i = 127 To 255
          sHaystack = sStrReplaceAll(sHaystack, String(1, Chr(i)), sNewNeedle)
        Next
        sStrReplaceNonPrintChars = sHaystack
    End If
End Function  'sStrReplaceNonPrintChars()

Function sStrReplaceAll(ByVal sHaystack, ByVal sNeedle, ByVal sNewNeedle)
    'replace all occurrences of sNeedle in sHaystack with sNewNeedle, even those created during replacing
    'if sNeedle is empty or not found, sHaystack is returned
    'if sNeedle is equal to sNewNeedle, sHaystack is returned
    'if sNeedle is equal to sHaystack, sNewNeedle is returned
    'if sNeedle is a subset of sNewNeedle, the function would loop;
    'to avoid this, sStrReplaceAllOnce is executed instead
    'sStrReplaceAll("   This is   my string   ","i","ee") returns "   Thees ees   my streeng   "
    If InStr(1, sNewNeedle, sNeedle, vbBinaryCompare) > 0 Then
        sHaystack = sStrReplaceAllOnce(sHaystack, sNeedle, sNewNeedle)
    Else
        Do While InStr(1, sHaystack, sNeedle, vbBinaryCompare) > 0
            sHaystack = sStrReplaceAllOnce(sHaystack, sNeedle, sNewNeedle)
        Loop
    End If
    sStrReplaceAll = sHaystack
End Function  'sStrReplaceAll()

Function bStrIsNothing(ByVal sHaystack)
    'check if there is anything in a string (to avoid testing for
    'isnull, isempty, and zero-length strings)
    'bStrIsNothing("   This is   my string   ") returns False
    If sHaystack & "" = "" Then
        bStrIsNothing = True
    Else
        bStrIsNothing = False
    End If
End Function  'bStrIsNothing()

'Dim sAlpha3CountryCode, sAlpha2CountryCode
'sAlpha3CountryCode = "USA"
'sAlpha2CountryCode = sGetAlpha2CharCountryCodeFromAlpha3CharCode(sAlpha3CountryCode)
'If Len(sAlpha2CountryCode) = 0 Then
'  Call LogFileWrite("ERROR - invalid input of '" & sAlpha3CountryCode & "' to Fn sGetAlpha2CharCountryCodeFromAlpha3CharCode()")
'Else
'  Call LogFileWrite(sAlpha3CountryCode & " -> " & sAlpha2CountryCode)
'End If

Private Function sGetAlpha2CharCountryCodeFromAlpha3CharCode(ByVal sAlpha3CountryCode)
  sGetAlpha2CharCountryCodeFromAlpha3CharCode = ""
  Dim xmlDoc, oRootNodes, oNodes, oNode
  If VarType(sAlpha3CountryCode) = vbEmpty OR len(sAlpha3CountryCode) < 3 OR len(sAlpha3CountryCode) > 3 Then
    Call LogFileWrite("ERROR - A zero length string for sAlpha3CountryCode was passed to function sGetAlpha2CharCountryCodeFromAlpha3CharCode()")
    Exit Function
  End If
  '
  ' 
  '   United States
  '   US
  '   USA
  ' 
  '
  Const sXmlFilePath = "http://www.savvydiademsolutions.com/data/country_lookup_ISO3166.xml"
  'Load the xml file
  Set xmlDoc = CreateObject("Microsoft.XMLDOM")
  xmlDoc.Async = "false"
  if not xmlDoc.Load(sXmlFilePath) then
    Call LogFileWrite("ERROR - Unable to load " & sXmlFilePath)
    Exit Function
  end if
  For Each oRootNodes in xmlDoc.selectNodes("/countries/country")
    'Iterate through the root nodes, looking for sAlpha3CountryCode
    'Call LogFileWrite(oRootNodes.ChildNodes(2).text)
    If oRootNodes.ChildNodes(2).text = sAlpha3CountryCode Then
      sGetAlpha2CharCountryCodeFromAlpha3CharCode = oRootNodes.ChildNodes(1).text
      Exit For
    End If
  Next
  set xmlDoc = Nothing
End Function  'sGetAlpha2CharCountryCodeFromAlpha3CharCode()

'Call LogFileDel()
'Dim sAlpha3CountryCode, sAlpha2CountryCode
'sAlpha2CountryCode = "US"
'sAlpha3CountryCode = sGetAlpha3CharCountryCodeFromAlpha2CharCode(sAlpha2CountryCode)
'If Len(sAlpha3CountryCode) = 0 Then
'  Call LogFileWrite("ERROR - invalid input of '" & sAlpha2CountryCode & "' to Fn sGetAlpha3CharCountryCodeFromAlpha2CharCode()")
'Else
'  Call LogFileWrite(sAlpha2CountryCode & " -> " & sAlpha3CountryCode)
'End If

Private Function sGetAlpha3CharCountryCodeFromAlpha2CharCode(ByVal sAlpha2CountryCode)
  sGetAlpha3CharCountryCodeFromAlpha2CharCode = ""
  Dim xmlDoc, oRootNodes, oNodes, oNode
  If VarType(sAlpha2CountryCode) = vbEmpty OR len(sAlpha2CountryCode) = 0 OR len(sAlpha2CountryCode) > 2 Then
    Call LogFileWrite("ERROR - A zero length string for sAlpha3CountryCode was passed to function sGetAlpha3CharCountryCodeFromAlpha2CharCode()")
    Exit Function
  End If
  '
  ' 
  '   United States
  '   US
  '   USA
  ' 
  '
  Const sXmlFilePath = "http://www.savvydiademsolutions.com/data/country_lookup_ISO3166.xml"
  'Load the xml file
  Set xmlDoc = CreateObject("Microsoft.XMLDOM")
  xmlDoc.Async = "false"
  if not xmlDoc.Load(sXmlFilePath) then
    Call LogFileWrite("ERROR - Unable to load " & sXmlFilePath)
    Exit Function
  end if
  For Each oRootNodes in xmlDoc.selectNodes("/countries/country")
    'Iterate through the root nodes, looking for sAlpha3CountryCode
    'Call LogFileWrite(oRootNodes.ChildNodes(1).text)
    If oRootNodes.ChildNodes(1).text = sAlpha2CountryCode Then
      sGetAlpha3CharCountryCodeFromAlpha2CharCode = oRootNodes.ChildNodes(1).text
      Exit For
    End If
  Next
  set xmlDoc = Nothing
End Function  'sGetAlpha3CharCountryCodeFromAlpha2CharCode()

 

ISO 3166 Country Codes

Download the file:   country_lookup_ISO3166.xml 

'Dim sAlpha3CountryCode, sAlpha2CountryCode
'sAlpha3CountryCode = "USA"
'sAlpha2CountryCode = sGetAlpha2CharCountryCodeFromAlpha3CharCode(sAlpha3CountryCode)
'If Len(sAlpha2CountryCode) = 0 Then
'  Call LogFileWrite("ERROR - invalid input of '" & sAlpha3CountryCode & "' to Fn sGetAlpha2CharCountryCodeFromAlpha3CharCode()")
'Else
'  Call LogFileWrite(sAlpha3CountryCode & " -> " & sAlpha2CountryCode)
'End If

Function sGetAlpha2CharCountryCodeFromAlpha3CharCode(ByVal sAlpha3CountryCode)
  'Get a ISO 3166 2 character country code code from a 3 character code.
  sGetAlpha2CharCountryCodeFromAlpha3CharCode = ""
  Dim xmlDoc, oRootNodes, oNodes, oNode
  If VarType(sAlpha3CountryCode) = vbEmpty OR len(sAlpha3CountryCode) < 3 OR len(sAlpha3CountryCode) > 3 Then
    Call LogFileWrite("ERROR - A zero length string for sAlpha3CountryCode was passed to function sGetAlpha2CharCountryCodeFromAlpha3CharCode()")
    Exit Function
  End If
  '
  ' 
  '   United States
  '   US
  '   USA
  ' 
  '
  Const sXmlFilePath = "http://www.savvydiademsolutions.com/data/country_lookup_ISO3166.xml"
  'Load the xml file
  Set xmlDoc = CreateObject("Microsoft.XMLDOM")
  xmlDoc.Async = "false"
  if not xmlDoc.Load(sXmlFilePath) then
    Call LogFileWrite("ERROR - Unable to load " & sXmlFilePath)
    Exit Function
  end if
  For Each oRootNodes in xmlDoc.selectNodes("/countries/country")
    'Iterate through the root nodes, looking for sAlpha3CountryCode
    'Call LogFileWrite(oRootNodes.ChildNodes(2).text)
    If oRootNodes.ChildNodes(2).text = sAlpha3CountryCode Then
      sGetAlpha2CharCountryCodeFromAlpha3CharCode = oRootNodes.ChildNodes(1).text
      Exit For
    End If
  Next
  set xmlDoc = Nothing
End Function  'sGetAlpha2CharCountryCodeFromAlpha3CharCode()

'Call LogFileDel()
'Dim sAlpha3CountryCode, sAlpha2CountryCode
'sAlpha2CountryCode = "US"
'sAlpha3CountryCode = sGetAlpha3CharCountryCodeFromAlpha2CharCode(sAlpha2CountryCode)
'If Len(sAlpha3CountryCode) = 0 Then
'  Call LogFileWrite("ERROR - invalid input of '" & sAlpha2CountryCode & "' to Fn sGetAlpha3CharCountryCodeFromAlpha2CharCode()")
'Else
'  Call LogFileWrite(sAlpha2CountryCode & " -> " & sAlpha3CountryCode)
'End If

Function sGetAlpha3CharCountryCodeFromAlpha2CharCode(ByVal sAlpha2CountryCode)
  'Get a ISO 3166 3 character country code code from a 2 character code.
  sGetAlpha3CharCountryCodeFromAlpha2CharCode = ""
  Dim xmlDoc, oRootNodes, oNodes, oNode
  If VarType(sAlpha2CountryCode) = vbEmpty OR len(sAlpha2CountryCode) = 0 OR len(sAlpha2CountryCode) > 2 Then
    Call LogFileWrite("ERROR - A zero length string for sAlpha3CountryCode was passed to function sGetAlpha3CharCountryCodeFromAlpha2CharCode()")
    Exit Function
  End If
  '
  ' 
  '   United States
  '   US
  '   USA
  ' 
  '
  Const sXmlFilePath = "http://www.savvydiademsolutions.com/data/country_lookup_ISO3166.xml"
  'Load the xml file
  Set xmlDoc = CreateObject("Microsoft.XMLDOM")
  xmlDoc.Async = "false"
  if not xmlDoc.Load(sXmlFilePath) then
    Call LogFileWrite("ERROR - Unable to load " & sXmlFilePath)
    Exit Function
  end if
  For Each oRootNodes in xmlDoc.selectNodes("/countries/country")
    'Iterate through the root nodes, looking for sAlpha3CountryCode
    'Call LogFileWrite(oRootNodes.ChildNodes(1).text)
    If oRootNodes.ChildNodes(1).text = sAlpha2CountryCode Then
      sGetAlpha3CharCountryCodeFromAlpha2CharCode = oRootNodes.ChildNodes(1).text
      Exit For
    End If
  Next
  set xmlDoc = Nothing
End Function  'sGetAlpha3CharCountryCodeFromAlpha2CharCode()

 

Timezone & Country from Latitude & Longitude

'40.670700,-75.632211  National Instruments headquarters
Dim dLat, dLng, oTimezoneDic, sNodeName
dLat = 40.670700: dLng = -75.632211
Set oTimezoneDic = oTimezoneByLatitudeLongitudeAsDic(dLat, dLng)
For Each sNodeName In oTimezoneDic
  Call LogFileWrite(sNodeName & " = " & oTimezoneDic(sNodeName))
Next

'status = OK
'message = 
'countryCode = US
'countryName = United States
'zoneName = America/New_York
'abbreviation = EST
'gmtOffset = -18000
'dst = 0
'zoneStart = 1541311200
'zoneEnd = 1552201200
'nextAbbreviation = EDT
'timestamp = 1543379542
'formatted = 2018-11-28 04:32:22


Function oTimezoneByLatitudeLongitudeAsDic(ByVal dLat, ByVal dLng)
  'Returns a dictionary object with timezone and location information
  'for dLat and dLng.  Sample key = value:
  '    status = OK
  '    message = 
  '    countryCode = US
  '    countryName = United States
  '    zoneName = America/New_York
  '    abbreviation = EST
  '    gmtOffset = -18000
  '    dst = 0
  '    zoneStart = 1541311200
  '    zoneEnd = 1552201200
  '    nextAbbreviation = EDT
  '    timestamp = 1543379542
  '    formatted = 2018-11-28 04:32:22
  '
  'Get free sApiKey at: https://timezonedb.com/register
  '
  'Requires:
  ' bLatitudeLongitudeIsValid()
  Set oTimezoneByLatitudeLongitudeAsDic = CreateObject("Scripting.Dictionary")
  If Not bLatitudeLongitudeIsValid(dLat, dLng) Then
    Call LogFileWrite("ERROR - invalid values of " & Str(dLat,"d.dddddd") & "," & Str(dLng,"d.dddddd") & " passed to Fn oTimezoneByLatitudeLongitudeAsDic()")
    Exit Function
  End If
  const sApiKey = "get your own free api key at https://timezonedb.com/register"
  Dim sErr, lErr
  sErr = ""
  lErr = cLng(0)
  Dim oREST, sURL, sResponse
  Set oREST = CreateObject ("Microsoft.XMLHTTP") 
  'Create the headers that we will need to make the request 
  sURL = "http://api.timezonedb.com/v2.1/get-time-zone?key=" & sApiKey & "&format=xml&by=position&lat=" & Str(dLat,"d.dddddd") & "&lng=" & Str(dLng,"d.dddddd")
  'Call LogFileWrite("sURL = '" & sURL & "'")
  Call MsgLineDisp("Getting country code for " & Str(dLat,"d.dddddd") & "," & Str(dLng,"d.dddddd"))
  'Open the URL
  On Error Resume Next
  oREST.open "GET", sURL, False 
  If Err.number <> 0 Then 
    Call LogFileWrite(vbTab & "Fn oTimezoneByLatitudeLongitudeAsDic() experienced a .Open error.  Err #" & Err.number & vbTab & Err.Description)
    On Error Goto 0
    Set oRest = Nothing
    Exit Function
  End If
  On Error Goto 0
  'Catch an error caused by lack of an internet connection.
  On Error Resume Next
  oREST.send("")
  lErr = Err.number: sErr = Err.Description
  On Error Goto 0
  If lErr = 0 Then
    'ok
  ElseIf lErr = -2147024891 Then
    Call LogFileWrite("Error - unable to access the internet.  Err # " & lErr & "  " & sErr)
    Exit Function
  Else
    Call LogFileWrite("Unexpected error # " & lErr & "  " & sErr)
    Exit Function
  End If
  'Get the REST response
  On Error Resume Next
  sResponse = oREST.responseText
  If Err.number <> 0 Then 
    Call LogFileWrite(vbTab & "Fn oTimezoneByLatitudeLongitudeAsDic() experienced a oREST.responseText.  Err #" & Err.number & vbTab & Err.Description)
    On Error Goto 0
    Set oRest = Nothing
    Exit Function
  End If
  On Error Goto 0
  'LogFileWrite(sResponse)
  
  '  
  '    OK
  '    
  '    US
  '    United States
  '    America/New_York
  '    EST
  '    -18000
  '    0
  '    1541311200
  '    1552201200
  '    EDT
  '    1543379614
  '    2018-11-28 04:33:34
  '  

  Dim xmlDoc, oNode, sXpath, oChild
  'Load the xml within sResponse
  Set xmlDoc = CreateObject("Microsoft.XMLDOM")
  xmlDoc.Async = "false"
  If Not xmlDoc.loadXML(sResponse) Then
    Call LogFileWrite("ERROR - Fn oTimezoneByLatitudeLongitudeAsDic() response  = '" & sResponse & "'")
    oTimezoneByLatitudeLongitudeAsDic = ""
    Exit Function
  Else
    sXpath = "/result"
    'Call LogFileWrite("The number of nodes is " & xmlDoc.selectNodes(sXpath).length & " for '" & sXpath & "'")
    For Each oNode in xmlDoc.selectNodes(sXpath)
      If oNode.hasChildNodes() Then 
        For Each oChild in oNode.SelectNodes("*")
          'Call LogFileWrite(oChild.NodeName & vbTab & oChild.Text)
          If Not oTimezoneByLatitudeLongitudeAsDic.Exists(oChild.NodeName) Then
            Call oTimezoneByLatitudeLongitudeAsDic.Add(oChild.NodeName, oChild.Text)
          End If
        Next
      End If
    Next
    Set oRest = Nothing
    Set xmlDoc = Nothing
  End If
  Call MsgLineDisp(vbTab)
End Function  'oTimezoneByLatitudeLongitudeAsDic()

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

Function bLatitudeLongitudeIsValid(ByVal dLat, ByVal dLng)
  bLatitudeLongitudeIsValid = False
  If bLatitudeIsValid(dLat) AND bLongitudeIsValid(dLng) Then bLatitudeLongitudeIsValid = True
End Function  'bLatitudeIsValid()

Function bLatitudeIsValid(ByVal dLat)
  'Lat values vary from 90° N to 90° S.  (+90 to -90)
  'Long values vary from 180° W to 180° E.  (-180 to +180)
  'N & E are positive, S & W are negative
  bLatitudeIsValid = True
  If dLat < -90.0 OR dLat > 90.0 Then
    bLatitudeIsValid = False
  End If
End Function  'bLatitudeIsValid()

Function bLongitudeIsValid(ByVal dLng)
  'Lat values vary from 90° N to 90° S.  (+90 to -90)
  'Long values vary from 180° W to 180° E.  (-180 to +180)
  'N & E are positive, S & W are negative
  bLongitudeIsValid = True
  If dLng < -180.0 OR dLng > 180.0 Then
    bLongitudeIsValid = False
  End If
End Function  'bLongitudeIsValid()

 

Windows Date/Time Stamps

It is frequently critical to know the date/time when a measurement data file was created.   Unfortunately, the best you can determine from a file that has touched a Windows operating system (OS) storage device is the last date/time that data has been written to the file provided the file has never been copied for moved from the original storage/folder location.   The modified date will be the file attribute to reference in this case.

Three dates are stored as properties for a file saved on a Windwos storage device, creation data, accessed date, and the modified date.   All three terms are misleading.   The creation date is updated every time a file is copied or moved from one storage media to another, so it is completely unreliable in the scenario of measurement data moved from a data logger to a data storage and analysis system.   The accessed date is unreliable, because anytime an application reads the file (including a virus scanner, the OS, etc), the date is modified.   The modified date is the last time that new data was saved to the file, but it is updated if the file is copied or moved to a new folder or drive.  

 

Write, read, edit, append XML files

XML files provide you with a flexible data structure that is human readable and easy to create.   Although not suitable for storage of lists in the 100,00 or more range, you can use it as a simple database to store metadata, settings, etc.   

'-------------------------------------------------------------------------------
'-- VBS script file
'-- Author:   Mark W Kiehl
'             www.SavvyDiademSolutions.com
'             http://www.savvysolutions.info/savvycodesolutions/
'-- Comment:  XML file reading and writing
'
' Note that you cannot easily search an XML document for a particular 
' node VALUE using xPath.  This makes editing existing data difficult.  
' You can however easily append new data to an existing XML file. 
'-------------------------------------------------------------------------------
Option Explicit  
Call LogFileDel()
'-------------------------------------------------------------------------------

''  
''    
''      DJI Innovations
''      Shenzhen, China
''    
''      Yuneec
''      Kunshan Jiangsu, China
''    
''      Parrot SA
''      Paris
''    
'
'Dim sFilePathXml, oCustomersDic, arrTestSites, arrNodeNames
'Set oCustomersDic = CreateObject("Scripting.Dictionary")
'
'arrTestSites = Array("Shenzhen, China")
'Call oCustomersDic.Add("DJI Innovations",arrTestSites)
'
'arrTestSites = Array("Kunshan Jiangsu, China")
'Call oCustomersDic.Add("Yuneec",arrTestSites)
'
'arrTestSites = Array("Paris")
'Call oCustomersDic.Add("Parrot SA",arrTestSites)
'
'arrNodeNames = Array("customers","customer","customer_name","test_site")
'If IsArray(arrTestSites) Then Call Erase(arrTestSites)
'sFilePathXml = OsTmpDrv & "Customer-TestSites.xml"
'If FileExist(sFilePathXml) Then Call FileDelete(sFilePathXml)
'Call bWriteXmlFile_CustomerTestSites(sFilePathXml, oCustomersDic, arrNodeNames)
'If IsArray(arrTestSites) Then Call Erase(arrTestSites)
'Call oCustomersDic.RemoveAll: Set oCustomersDic = Nothing


''  
''    
''      DJI Innovations
''      
''        Shenzhen, China
''        South Korea
''      
''    
''      Yuneec
''      
''        Kunshan Jiangsu, China
''        Corona, CA USA
''        Hong Kong
''        Hamburg, Germany
''      
''    
''      Parrot SA
''      
''        Paris
''      
''    
'
'Dim sFilePathXml, oCustomersDic, arrTestSites, arrNodeNames
'Set oCustomersDic = CreateObject("Scripting.Dictionary")
'
'arrTestSites = Array("Shenzhen, China","South Korea") 
'Call oCustomersDic.Add("DJI Innovations",arrTestSites)
'
'arrTestSites = Array("Kunshan Jiangsu, China","Corona, CA USA","Hong Kong","Hamburg, Germany")
'Call oCustomersDic.Add("Yuneec",arrTestSites)
'
'arrTestSites = Array("Paris")
'Call oCustomersDic.Add("Parrot SA",arrTestSites)
'
'arrNodeNames = Array("customers","customer","customer_name","test_sites","test_site")
'If IsArray(arrTestSites) Then Call Erase(arrTestSites)
'sFilePathXml = OsTmpDrv & "Customer-TestSites.xml"
'If FileExist(sFilePathXml) Then Call FileDelete(sFilePathXml)
'Call bWriteXmlFile_CustomerTestSites(sFilePathXml, oCustomersDic, arrNodeNames)
'If IsArray(arrTestSites) Then Call Erase(arrTestSites)
'Call oCustomersDic.RemoveAll: Set oCustomersDic = Nothing

Function bWriteXmlFile_CustomerTestSites(ByVal sFilePathXml, ByVal oXmlDic, ByVal arrNodeNames)
  bWriteXmlFile_CustomerTestSites = False
  '  
  '    
  '      DJI Innovations
  '      
  '        Shenzhen, China
  '        South Korea
  '      
  '    
  '      Yuneec
  '      
  '        Kunshan Jiangsu, China
  '        Corona, CA USA
  '        Hong Kong
  '        Hamburg, Germany
  '      
  '    
  '      Parrot SA
  '      
  '        Paris
  '      
  '    
  If Not IsObject(oXmlDic) Then
    Call LogFileWrite("ERROR - oXmlDic passed to bWriteXmlFile_CustomerTestSites() is not a dictionary object")
    Exit Function
  End If
  If Not IsArray(arrNodeNames) Then
    Call LogFileWrite("ERROR - arrNodeNames passed to bWriteXmlFile_CustomerTestSites() is not an array")
    Exit Function
  End If
  Dim oXml, oRootElement, oElement, oChild, oSibling, oIntro
  Dim sKey, arrTestSites, arrVal
  Set oXml = CreateObject("Microsoft.XMLDOM")
  oXml.Async = "false"
  
  Set oRootElement = oXml.createElement(arrNodeNames(0))  'customers
  oXml.appendChild oRootElement
 
    
  For Each sKey In oXmlDic
    Set oElement = oXml.createElement(arrNodeNames(1))  'customer
    oElement.Text = ""
    oRootElement.appendChild oElement
    
      Set oChild = oXml.CreateElement(arrNodeNames(2))  'customer_name
      oChild.Text = sKey
      oElement.appendChild(oChild)
          
      arrTestSites = oXmlDic(sKey)
      If uBound(arrNodeNames) = 3 Then
        Set oChild = oXml.CreateElement(arrNodeNames(3)) 'test_site
        oChild.Text = arrTestSites(0)
        oElement.appendChild(oChild)
      Else
        Set oChild = oXml.CreateElement(arrNodeNames(3)) 'test_sites
        oChild.Text = ""
        oElement.appendChild(oChild)
        For Each arrVal In arrTestSites
          Set oSibling = oXml.CreateElement(arrNodeNames(4))  'test_site
          oSibling.Text = arrVal
          oChild.appendChild(oSibling)
        Next  'arrVal
      End If
  Next  'sKey
  Set oIntro = oXml.createProcessingInstruction("xml","version='1.0'") 
  oXml.insertBefore oIntro,oXml.childNodes(0)
  oXml.Save sFilePathXml
  Set oIntro = Nothing: Set oElement = Nothing: Set oRootElement = Nothing: Set oXml = Nothing
  If FileExist(sFilePathXml) Then bWriteXmlFile_CustomerTestSites = True
End Function  'bWriteXmlFile_CustomerTestSites()


'Dim sFilePathXml, oCustomersDic, arrNodeNames, sKey, vArrVal, arrTestSites
'Set oCustomersDic = CreateObject("Scripting.Dictionary")
'sFilePathXml = OsTmpDrv & "Customer-TestSites.xml"
'arrNodeNames = Array("customers","customer","customer_name","test_sites","test_site")
'Set oCustomersDic = oReadXmlFile_CustomerTestSites(sFilePathXml, arrNodeNames)
'For Each sKey In oCustomersDic
'  Call LogFileWrite("Customer '" & sKey & "'  " & Str(uBound(oCustomersDic(sKey))+1) & " test sites")
'  arrTestSites = oCustomersDic(sKey)
'  For Each vArrVal In arrTestSites
'    Call LogFileWrite(vbTab & "Test site: '" & vArrVal & "'")
'  Next
'Next
'If IsArray(arrTestSites) Then Call Erase(arrTestSites)
'If IsArray(arrNodeNames) Then Call Erase(arrNodeNames)
'Call oCustomersDic.RemoveAll: Set oCustomersDic = Nothing


Function oReadXmlFile_CustomerTestSites(ByVal sFilePathXml, ByVal arrNodeNames)
  Set oReadXmlFile_CustomerTestSites = CreateObject("Scripting.Dictionary")
  If Not FileExist(sFilePathXml) Then
    Call LogFileWrite("ERROR - file not found " & sFilePathXml & " oReadXmlFile_CustomerTestSites()")
    Exit Function
  End If
  If Not IsArray(arrNodeNames) Then
    Call LogFileWrite("ERROR - the parameter arrNodeNames passed to oReadXmlFile_CustomerTestSites() is NOT an array")
    Exit Function
  End If
  '  
  '  
  '    
  '      Black Frog
  '      
  '        ABC
  '        
  '        GHI
  '      
  '    
  '    
  '      Red Frog
  '      
  '      
  '    
  '    
  '      Orange Frog
  '      
  '        
  '      
  '    
  '    
  '      Green Frog
  '      
  '        JKL
  '      
  '    
  '  
  Dim oXml, sXpath, oNode, oChild, oSibling, arrChildren, i, lErr
  Const bVerbose = False
  Set oXml = CreateObject("Microsoft.XMLDOM")
  oXml.Async = "false"
  If Not oXml.Load(sFilePathXml) Then
    Call LogFileWrite("  ERROR - xml format error with '" & sFilePathXml & "'.  Unable to load")
    Exit Function
  End If
  'sXpath = "/" & arrNodeNames(0) & "/" & arrNodeNames(1) & "/*"   '"/customers/customer/*"
  sXpath = "/customers/*"
  If oXml.selectNodes(sXpath).Length = 0 Then 
    Call LogFileWrite("ERROR - no items found for xPath = '" & sXPath & "' XML file " & sFilePathXml & " oReadXmlFile_CustomerTestSites()")
    Exit Function
  End If
  'Call LogFileWrite(oXml.selectNodes(sXpath).Length & " nodes for '" & sXpath & "'")
  If oXml.HasChildNodes() Then
    For Each oNode In oXml.selectNodes(sXpath)
      'Call LogFileWrite(oNode.selectNodes("*").Length & " nodes for " & oNode.NodeName)
      Set oChild = oNode.SelectSingleNode("customer_name")
      If bVerbose Then Call LogFileWrite(vbTab & oChild.NodeName & " = " & oChild.firstChild.text)
      Set oChild = oNode.SelectSingleNode("test_sites")
      'Call LogFileWrite(vbTab & oChild.selectNodes("*").Length & " " & oChild.NodeName)
      'ReDim arrChildren(oChild.SelectNodes("*").Length-1)
      ReDim arrChildren(-1)
      i = 0
      If oChild.HasChildNodes() Then
        For Each oSibling In oChild.SelectNodes("*")
          'If the node name exists, but the value is empty, an error will occur.  
          On Error Resume Next
          lErr = Len(oSibling.firstChild.text)
          lErr = Err.number: On Error Goto 0
          If lErr = 0 Then
            If bVerbose Then Call LogFileWrite(vbTab & vbTab & oSibling.NodeName & " = " & oSibling.firstChild.text)
            ReDim Preserve arrChildren(i)
            arrChildren(i) = oSibling.firstChild.text
            i = i + 1
          Else
            'ignore the empty value
          End If  'lErr
        Next
      End If  'oChild.HasChildNodes()
      If bVerbose Then Call LogFileWrite(vbTab & vbTab & "uBound(arrChildren) = " & uBound(arrChildren))
      If Not oReadXmlFile_CustomerTestSites.Exists(oNode.firstChild.text) Then Call oReadXmlFile_CustomerTestSites.Add(oNode.firstChild.text, arrChildren)      
      If IsArray(arrChildren) Then Call Erase(arrChildren)
    Next
  End If
  Set oXml = Nothing
End Function  'oReadXmlFile_CustomerTestSites()

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

'Dim sFilePathXml, oSettingsDic
'Set oSettingsDic = CreateObject("Scripting.Dictionary")
'Call oSettingsDic.Add("localTempPath","C:\Users\Mark\AppData\Local\Temp\")
'Call oSettingsDic.Add("netSharedPath","\\MK_LAPTOP\net_share_folder_(simulated)\")
'Call oSettingsDic.Add("DataSource","My DataFinder")
'Call oSettingsDic.Add("DataSourceType","eDataFinder")
'sFilePathXml = OsTmpDrv & "Settings.xml"
'If FileExist(sFilePathXml) Then Call FileDelete(sFilePathXml)
'Call bWriteXmlFile_Settings(sFilePathXml, oSettingsDic)
'Call oSettingsDic.RemoveAll(): Set oSettingsDic = Nothing

Function bWriteXmlFile_Settings(ByVal sFilePathXml, ByVal oSettingsDic)
  'Create a new XML file
  bWriteXmlFile_Settings = False
  If Not IsObject(oSettingsDic) Then
    Call LogFileWrite("ERROR - parameter oSettingsDic passed to bWriteXmlFile_Settings() is not a dictionary object")
    Exit Function
  End If
  '  
  '  
  '    C:\Users\Mark\AppData\Local\Temp\
  '    \\MK_LAPTOP\net_share_folder_(simulated)\
  '    My DataFinder
  '    eDataFinder
  '    
  Dim oXml, oRootElement, oElement, oIntro, sKey
  Set oXml = CreateObject("Microsoft.XMLDOM")
  oXml.Async = "false"
  Set oRootElement = oXml.createElement("settings")
  oXml.appendChild oRootElement
  
  For Each sKey In oSettingsDic
  
    Set oElement = oXml.createElement(sKey)
    oElement.Text = oSettingsDic(sKey)
    oRootElement.appendChild oElement
  Next
    
  Set oIntro = oXml.createProcessingInstruction("xml","version='1.0'") 
  oXml.insertBefore oIntro,oXml.childNodes(0)
  oXml.Save sFilePathXml
  Set oIntro = Nothing: Set oElement = Nothing: Set oRootElement = Nothing: Set oXml = Nothing
  If FileExist(sFilePathXml) Then bWriteXmlFile_Settings = True
End Function  'bWriteXmlFile_Settings()



'Dim sFilePathXml, oXmlFileSnsDic, sKey, sVal, sNodeName
'sNodeName = "settings"
'sFilePathXml = OsTmpDrv & "Settings.xml"
'Set oXmlFileSnsDic = oReadXmlFileAsDic_Settings(sFilePathXml, sNodeName)
'Call LogFileWrite(oXmlFileSnsDic.Count & " items found in oXmlFileSnsDic")
'For Each sKey In oXmlFileSnsDic
'  Call LogFileWrite(vbTab & sKey & " = " & oXmlFileSnsDic(sKey))
'Next

Function oReadXmlFileAsDic_Settings(ByVal sFilePathXml, ByVal sNodeName)
  'Read a simple XML file and return the first level elements
  'as a dictionary object where key = node name, value = node value. 
  Set oReadXmlFileAsDic_Settings = CreateObject("Scripting.Dictionary")
  If Not FileExist(sFilePathXml) Then
    Call LogFileWrite("ERROR - file not found " & sFilePathXml & "   oReadXmlFileAsDic_Settings()")
    Exit Function
  End If
  '  
  '  
  '    C:\Users\Mark\AppData\Local\Temp\
  '    \\MK_LAPTOP\net_share_folder_(simulated)\
  '    My DataFinder
  '    eDataFinder
  '    
  Dim oXml, sXpath, oNode, sNodeNameRoot, oChild
  Set oXml = CreateObject("Microsoft.XMLDOM")
  oXml.Async = "false"
  If Not oXml.Load(sFilePathXml) Then
    Call LogFileWrite("  ERROR - xml format error with '" & sFilePathXml & "'.  Unable to load")
    Exit Function
  End If
  sXpath = "/settings/*"
  Set oNode = oXml.SelectNodes(sXpath)
  If Not oNode Is Nothing Then 
    'Call LogFileWrite(oNode.Length & " items for '" & sXpath & "'")
    For Each oChild In oNode
      'Call LogFileWrite(vbTab & oChild.NodeName & " = " & oChild.firstChild.text)
      If Not oReadXmlFileAsDic_Settings.Exists(oChild.NodeName) Then Call oReadXmlFileAsDic_Settings.Add(oChild.NodeName,oChild.firstChild.text)
    Next
  End If
  Set oXml = Nothing: Set oNode = Nothing
End Function  'oReadXmlFileAsDic_Settings()


''Read settings in sFilePathXml, edit one setting, reading settings, set one setting back to original. 
'Dim sFilePathXml, oXmlFileSnsDic, sKey, sVal
'sFilePathXml = OsTmpDrv & "Settings.xml"
'
'Set oXmlFileSnsDic = oReadXmlFileAsDic_Settings(sFilePathXml, "settings")
'Call LogFileWrite(oXmlFileSnsDic.Count & " items in " & NameSplit(sFilePathXml,"N") & "." & NameSplit(sFilePathXml,"E"))
'For Each sKey In oXmlFileSnsDic
'  Call LogFileWrite(vbTab & sKey & " = " & oXmlFileSnsDic(sKey))
'Next
'Call oXmlFileSnsDic.RemoveAll: Set oXmlFileSnsDic = Nothing
'Call LogFileWrite(vbTab)
'
'Call LogFileWrite("bXmlFileEdit(" & NameSplit(sFilePathXml,"N") & "." & NameSplit(sFilePathXml,"E") & ",DataSourceType, eDataStore") 
'Call bXmlFileEdit(sFilePathXml, "DataSourceType", "eDataStore")
'Call LogFileWrite(vbTab)
'
'Set oXmlFileSnsDic = oReadXmlFileAsDic_Settings(sFilePathXml, "settings")
'Call LogFileWrite(oXmlFileSnsDic.Count & " items in " & NameSplit(sFilePathXml,"N") & "." & NameSplit(sFilePathXml,"E"))
'For Each sKey In oXmlFileSnsDic
'  Call LogFileWrite(vbTab & sKey & " = " & oXmlFileSnsDic(sKey))
'Next
'Call oXmlFileSnsDic.RemoveAll: Set oXmlFileSnsDic = Nothing
'Call LogFileWrite(vbTab)
'
'Call LogFileWrite("bXmlFileEdit(" & NameSplit(sFilePathXml,"N") & "." & NameSplit(sFilePathXml,"E") & ",DataSourceType, eDataStore") 
'Call bXmlFileEdit(sFilePathXml, "DataSourceType", "eDataFinder")
'Call LogFileWrite(vbTab)

Function bXmlFileEdit(ByVal sFilePathXml, ByVal sNodeName, ByVal sNodeValue)
  'Edit a node value identified by the node name.
  '(NOTE: the node name must be unique to the elements in the XML file).
  bXmlFileEdit = False
  If Not FileExist(sFilePathXml) Then
    Call LogFileWrite("ERROR - file not found " & sFilePathXml & " bXmlFileEdit()")
    Exit Function
  End If
  '  
  '  
  '    C:\Users\Mark\AppData\Local\Temp\
  '    \\MK_LAPTOP\net_share_folder_(simulated)\
  '    My DataFinder
  '    eDataFinder
  '    
  Dim oXml, sXpath, oNode, sNodeNameRoot, oChild
  Set oXml = CreateObject("Microsoft.XMLDOM")
  oXml.Async = "false"
  If Not oXml.Load(sFilePathXml) Then
    Call LogFileWrite("  ERROR - xml format error with '" & sFilePathXml & "'.  Unable to load")
    Exit Function
  End If
  Set oNode = oXml.SelectSingleNode("//" & sNodeName)
  Call LogFileWrite(oNode.NodeName & " = " & oNode.firstChild.Text & " = " & oNode.Text)
  oNode.Text = sNodeValue
  oXml.Save sFilePathXml
  Set oXml = Nothing: Set oNode = Nothing
End Function  'bXmlFileEdit()

''Read settings in sFilePathXml, append one setting, reading settings again. 
'Dim sFilePathXml, oXmlFileSnsDic, sNodeName, sNodeValue, sKey
'sFilePathXml = OsTmpDrv & "Settings.xml"
'
'Set oXmlFileSnsDic = oReadXmlFileAsDic_Settings(sFilePathXml, "settings")
'Call LogFileWrite(oXmlFileSnsDic.Count & " items in " & NameSplit(sFilePathXml,"N") & "." & NameSplit(sFilePathXml,"E"))
'For Each sKey In oXmlFileSnsDic
'  Call LogFileWrite(vbTab & sKey & " = " & oXmlFileSnsDic(sKey))
'Next
'Call oXmlFileSnsDic.RemoveAll: Set oXmlFileSnsDic = Nothing
'Call LogFileWrite(vbTab)
'
'sNodeName = "SqlDbConnectStr"
'sNodeValue = "Driver={SQL Server Native Client 11.0},Server=(localdb)\MSSQLLocalDB,Database=NVH,Trusted_Connection=yes,MultipleActiveResultSets=true"
'Call LogFileWrite("Appending to " & NameSplit(sFilePathXml,"N") & "." & NameSplit(sFilePathXml,"E") & ":")
'Call LogFileWrite(vbTab & "sNodeName = " & sNodeName)
'Call LogFileWrite(vbTab & "sNodeValue = " & sNodeValue)
'Call bXmlFileAppend(sFilePathXml, sNodeName, sNodeValue)
'Call LogFileWrite(vbTab)
'
'Set oXmlFileSnsDic = oReadXmlFileAsDic_Settings(sFilePathXml, "settings")
'Call LogFileWrite(oXmlFileSnsDic.Count & " items in " & NameSplit(sFilePathXml,"N") & "." & NameSplit(sFilePathXml,"E"))
'For Each sKey In oXmlFileSnsDic
'  Call LogFileWrite(vbTab & sKey & " = " & oXmlFileSnsDic(sKey))
'Next
'Call oXmlFileSnsDic.RemoveAll: Set oXmlFileSnsDic = Nothing
'Call LogFileWrite(vbTab)


Function bXmlFileAppend(ByVal sFilePathXml, ByVal sNodeName, ByVal sNodeValue)
  'Read a simple XML file and return the first level elements
  'as a dictionary object where key = node name, value = node value. 
  bXmlFileAppend = False
  If Not FileExist(sFilePathXml) Then
    Call LogFileWrite("ERROR - file not found " & sFilePathXml & " bXmlFileAppend()")
    Exit Function
  End If
  '  
  '  
  '    C:\Users\Mark\AppData\Local\Temp\
  '    \\MK_LAPTOP\net_share_folder_(simulated)\
  '    My DataFinder
  '    eDataFinder
  '    
  Dim oXml, oRootElement, oElement
  Set oXml = CreateObject("Microsoft.XMLDOM")
  oXml.Async = "false"
  If Not oXml.Load(sFilePathXml) Then
    Call LogFileWrite("  ERROR - xml format error with '" & sFilePathXml & "'.  Unable to load")
    Exit Function
  End If
  
  Set oRootElement = oXml.SelectSingleNode("/settings")
  
    Set oElement = oXml.createElement(sNodeName)
    oElement.Text = sNodeValue
    oRootElement.appendChild oElement
  
  oXml.Save sFilePathXml
  Set oXml = Nothing: Set oRootElement = Nothing: Set oElement = Nothing
End Function  'bXmlFileAppend()

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

'Dim sFilePathXml
'Call StopWatchReset(21)
'sFilePathXml = OsTmpDrv & "SimpleList_RepeatingNode.xml"
'If FileExist(sFilePathXml) Then Call FileDelete(sFilePathXml)
'Call bWriteXmlFile_RepeatingNodeList(sFilePathXml)
'Call StopWatchPause(21)
'Call LogFileWrite(Str(StopWatch(21),"d.d") & " sec")

Function bWriteXmlFile_RepeatingNodeList(ByVal sFilePathXml)
  'Create a new XML file populated with initial serial # data. 
  'Writing 100000 items takes 0.8 sec
  'Writing 1000000 items takes 20 sec
  bWriteXmlFile_RepeatingNodeList = False
  '  
  '  
  '    300
  '    301
  '    302
  '    
  Dim oXml, oRootElement, oElement, oIntro, iUnit
  Set oXml = CreateObject("Microsoft.XMLDOM")
  oXml.Async = "false"
  Set oRootElement = oXml.createElement("unit_serial_numbers")
  oXml.appendChild oRootElement
  For iUnit = 1 To 5
    Set oElement = oXml.createElement("unit_serial_number")
    oElement.Text = sStrRandomAlphaChars(8)
    oRootElement.appendChild oElement
  Next  'iUnit
  Set oIntro = oXml.createProcessingInstruction("xml","version='1.0'") 
  oXml.insertBefore oIntro,oXml.childNodes(0)
  oXml.Save sFilePathXml
  Set oIntro = Nothing: Set oElement = Nothing: Set oRootElement = Nothing: Set oXml = Nothing
  If FileExist(sFilePathXml) Then bWriteXmlFile_RepeatingNodeList = True
End Function  'bWriteXmlFile_RepeatingNodeList()

'Dim sFilePathXml, oXmlFileSnsDic, sKey, sVal, sNodeName
'sNodeName = "unit_serial_number"
'sFilePathXml = OsTmpDrv & "SimpleList_RepeatingNode.xml"
'Set oXmlFileSnsDic = oReadXmlFileAsDic_RepeatingNodeList(sFilePathXml, sNodeName)
'Call LogFileWrite(oXmlFileSnsDic.Count & " items found in oXmlFileSnsDic")
'For Each sKey In oXmlFileSnsDic
'  Call LogFileWrite(vbTab & sKey & " = " & oXmlFileSnsDic(sKey))
'Next


Function oReadXmlFileAsDic_RepeatingNodeList(ByVal sFilePathXml, ByVal sNodeName)
  'Read a simple XML file and return the first level elements
  'as a dictionary object where key = node value, value = node name. 
  'The root node name will be derived from sNodeName by adding a "s" to 
  'the end of sNodeName. 
  Set oReadXmlFileAsDic_RepeatingNodeList = CreateObject("Scripting.Dictionary")
  If Not FileExist(sFilePathXml) Then
    Call LogFileWrite("ERROR - file not found " & sFilePathXml & " oReadXmlFileAsDic_RepeatingNodeList()")
    Exit Function
  End If
  '  
  '  
  '    300
  '    301
  '    302
  '    
  Dim oXml, sXpath, oNode, sNodeNameRoot
  Set oXml = CreateObject("Microsoft.XMLDOM")
  oXml.Async = "false"
  If Not oXml.Load(sFilePathXml) Then
    Call LogFileWrite("  ERROR - xml format error with '" & sFilePathXml & "'.  Unable to load")
    Exit Function
  End If
  sNodeNameRoot = sNodeName & "s"
  sXpath = "/" & sNodeNameRoot & "/*"
  If oXml.selectNodes(sXpath).Length = 0 Then 
    Call LogFileWrite("ERROR - no items found for xPath = '" & sXPath & "' XML file " & sFilePathXml & " oReadXmlFileAsDic_RepeatingNodeList()")
    Exit Function
  End If
  For Each oNode In oXml.selectNodes(sXpath)
    'Call LogFileWrite(oNode.NodeName & " = " & oNode.firstChild.text)
    If Not oReadXmlFileAsDic_RepeatingNodeList.Exists(oNode.firstChild.text) Then Call oReadXmlFileAsDic_RepeatingNodeList.Add(oNode.firstChild.text,oNode.NodeName)
  Next
  Set oXml = Nothing
End Function  'oReadXmlFileAsDic_RepeatingNodeList()


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

'Call LogFileDel()
'Call LogFileWrite("sStrRandomAlphaChars(5) = " & sStrRandomAlphaChars(5))

Function sStrRandomAlphaChars(iLength)
  ' This function creates a string of random characters, both numbers
  ' and alpha, with a length of iLength.  It uses Timer to seed the Rnd
  ' function.
  sStrRandomAlphaChars = ""
  Dim i, strCharBase, iPos
  strCharBase = "01234ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz56789"
  Randomize (Timer)
  For i = 1 To iLength
    iPos = Int((Len(strCharBase) - 1 + 1) * Rnd + 1)
    'Call LogFileWrite(iPos & vbTab & "'" & Mid(strCharBase,iPos,1) & "'" & vbTab & "'" & sStrRandomAlphaChars & "'")
    sStrRandomAlphaChars = sStrRandomAlphaChars & Mid(strCharBase,iPos,1)
  Next
End Function  'sStrRandomAlphaChars()

'	===========================================================================
'
'	MIT License
'	
'	Copyright (c) 2018 Mechatronic Solutions LLC  (http://mechatronicsolutionsllc.com/)
'	
'	Permission is hereby granted, free of charge, to any person obtaining a copy
'	of this software and associated documentation files (the "Software"), to deal
'	in the Software without restriction, including without limitation the rights
'	to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
'	copies of the Software, and to permit persons to whom the Software is
'	furnished to do so, subject to the following conditions:
'	
'	The above copyright notice and this permission notice shall be included in all
'	copies or substantial portions of the Software.
'
'	THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
'	IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
'	FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
'	AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
'	LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
'	OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
'	THE SOFTWARE.		
'	===========================================================================

 

SOAP API

This is a complete working example of how to communicate with a SOAP API.   SOAP ( Simple Object Access Protocol) is a message protocol that is commonly implemented by non-public websites for their application programming interface (API).   An API receives requests and sends back responses through internet protocols such as HTTP, SMTP, and others.   SOAP relies heavily on XML.   REST – REpresentational State Transfer – is the lightweight and more popular design model for public APIs.   

'-------------------------------------------------------------------------------
'-- VBS script file API_SOAP.VBS
'-- Author:   Mechatronic Solutions LLC
'             Mark W Kiehl
'             www.SavvyDiademSolutions.com
'             www.MechatronicSolutionsLLC.com
'-- License:  http://www.savvydiademsolutions.com/license.php
'-- Comment:  Not a working example
'
' References:
'   http://kbase.icbconsulting.com/vbscripting/querying-a-web-service-with-vbscript-soap
'   https://gallery.technet.microsoft.com/scriptcenter/deed3efb-1e11-4e7e-8bfd-96a981de5c35
'-------------------------------------------------------------------------------
Option Explicit  
Call LogFileDel()

'-------------------------------------------------------------------------------
' Texas A&M Geoservices
' 
' https://geoservices.tamu.edu/Services/ReverseGeocoding/WebService/v04_01/SOAP/api.asmx?op=GetReverseGeocode
' https://geoservices.tamu.edu/Services/ReverseGeocoding/WebService/v04_01/SOAP.aspx

Dim dLat, dLon, sState2Char, sApiKey, oDic
dLat = 30.408140: dLon = -97.726827: sState2Char = "TX"
'Get a free API Key here:  https://geoservices.tamu.edu/Login/Default.aspx?ret=https://geoservices.tamu.edu/UserServices/Profile/Default.aspx
sApiKey = "getyourownapiandinsertithere"
Set oDic = oRevGeocodeTxAnMAsDic(dLat, dLon, sState2Char, sApiKey)


Function oRevGeocodeTxAnMAsDic(ByVal dLat, ByVal dLon, ByVal sState2Char, ByVal sApiKey)
  'Returns the street, city, and ZIP code for the input arguments of latitude, longitude, state (& API Key)
  'as a dictionary object
  Set oRevGeocodeTxAnMAsDic = CreateObject("Scripting.Dictionary")
  Dim sSoapXml, sURL, oXmlHttp, oXmlDoc, oRoot, oNode
  
  'Create XML to POST:
  '<?xml version="1.0" encoding="utf-8"?>
  '<soap:Envelope xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/">
  '  <soap:Body>
  '    <GetReverseGeocode xmlns="http://geoservices.tamu.edu/">
  '      <longitude>double</longitude>
  '      <latitude>double</latitude>
  '      <state>string</state>
  '      <apiKey>string</apiKey>
  '      <version>double</version>
  '      <shouldNotStore>boolean</shouldNotStore>
  '    </GetReverseGeocode>
  '  </soap:Body>
  '</soap:Envelope>
  sSoapXml=""
  sSoapXml = sSoapXml & "<?xml version=" & chr(34) & "1.0" & chr(34) & " encoding=" & chr(34) & "utf-8" & chr(34) & "?>"
  sSoapXml=sSoapXml & "<soap:Envelope xmlns:xsi=" & chr(34) & "http://www.w3.org/2001/XMLSchema-instance" & chr(34) & " xmlns:xsd=" & chr(34) & "http://www.w3.org/2001/XMLSchema" & chr(34) & " xmlns:soap=" & chr(34) & "http://schemas.xmlsoap.org/soap/envelope/" & chr(34) & ">"
  sSoapXml=sSoapXml &   "<soap:Body>"
  sSoapXml=sSoapXml &     "<GetReverseGeocode xmlns=" & chr(34) & "http://geoservices.tamu.edu/" & chr(34) & ">"
  sSoapXml=sSoapXml &       "<longitude>" & dLon & "</longitude>"
  sSoapXml=sSoapXml &       "<latitude>" & dLat & "</latitude>"
  sSoapXml=sSoapXml &       "<state>TX</state>"
  sSoapXml=sSoapXml &       "<apiKey>" & sApiKey & "</apiKey>"
  sSoapXml=sSoapXml &       "<version>4.10</version>"
  sSoapXml=sSoapXml &       "<shouldNotStore>true</shouldNotStore>"
  sSoapXml=sSoapXml &     "</GetReverseGeocode>"
  sSoapXml=sSoapXml &   "</soap:Body>"
  sSoapXml=sSoapXml & "</soap:Envelope>"
  'Call LogFileWrite("sSoapXml:"): Call LogFileWrite(sSoapXml): Call LogFileWrite(vbTab)
  
  'sURL="https://graphical.weather.gov/xml/SOAP_server/ndfdXMLclient.php?whichClient=NDFDgen&lat=38.99&lon=-77.01&listLatLon=&lat1=&lon1=&lat2=&lon2=&resolutionSub=&listLat1=&listLon1=&listLat2=&listLon2=&resolutionList=&endPoint1Lat=&endPoint1Lon=&endPoint2Lat=&endPoint2Lon=&listEndPoint1Lat=&listEndPoint1Lon=&listEndPoint2Lat=&listEndPoint2Lon=&zipCodeList=&listZipCodeList=¢erPointLat=¢erPointLon=&distanceLat=&distanceLon=&resolutionSquare=&listCenterPointLat=&listCenterPointLon=&listDistanceLat=&listDistanceLon=&listResolutionSquare=&citiesLevel=&listCitiesLevel=§or=&gmlListLatLon=&featureType=&requestedTime=&startTime=&endTime=&compType=&propertyName=&product=time-series&begin=2019-09-13T00%3A00%3A00&end=2023-09-13T00%3A00%3A00&Unit=e&maxt=maxt"
  'NOTE:  The sURL is very important, yet what the service expects can sometimes be elusive.  Try various if you get HTTP errors. 
  sURL = "https://geoservices.tamu.edu/Services/ReverseGeocoding/WebService/v04_01/SOAP/api.asmx"
  
  set oXmlHttp = CreateObject("MSXML2.ServerXMLHTTP")
  Call MsgLineDisp("oXmlHttp.open " & sURL)
  oXmlHttp.open "POST", sURL, FALSE
  oXmlHttp.setRequestHeader "Man","POST /Services/ReverseGeocoding/WebService/v04_01/SOAP/api.asmx HTTP/1.1"
  oXmlHttp.setRequestHeader "Host", "geoservices.tamu.edu" 
  oXmlHttp.setRequestHeader "SOAPAction", "http://geoservices.tamu.edu/GetReverseGeocode"
  oXmlHttp.setRequestHeader "Content-type", "text/xml; charset=utf-8"
  oXmlHttp.setRequestHeader "Content-Length", len(sSoapXml)
  'Note for "POST" that Send method passes parameters in key-value pairs format like: key1=value1&key2=value2&so=on... or any other data like XML, JSON, etc.)
  oXmlHttp.send sSoapXml
  'oXmlHttp.setRequestHeader "Content-Length", len(oXML.xml)
  'oXmlHttp.send oXML.xml
  
  Call LogFileWrite("oXmlHttp.status = " & oXmlHttp.status)
  Select Case oXmlHttp.status
    Case 200
      'OK'
      'Call LogFileWrite("oXmlHttp.responseXml.xml: '" & oXmlHttp.responseXml.xml & "'")
      'Call LogFileWrite(vbTab)
      'Get the information from the XML returned.
      Set oXmlDoc = CreateObject("Microsoft.XMLDOM") 
      oXmlDoc.async = False 
      oXmlDoc.loadXML(oXmlHttp.responseXml.xml) 
      Set oRoot = oXmlDoc.documentElement 
      'Call LogFileWrite(oRoot.xml)
      'Set oNode = oRoot.SelectSingleNode("//WebServiceReverseGeocodingQueryResult")
      'For Each oChild In oNode.SelectNodes("*")
      '  If Not oChild.firstChild Is Nothing Then Call LogFileWrite(oChild.nodeName & ": " & oChild.text)
      'Next
      'Get only the address information from the XML returned.     
      Call LogFileWrite(vbTab)
      Set oNode = oRoot.SelectSingleNode("//WebServiceReverseGeocodingQueryResult/StreetAddress")
      Call LogFileWrite(oNode.nodeName & ": " & oNode.text)
      Set oNode = oRoot.SelectSingleNode("//WebServiceReverseGeocodingQueryResult/City")
      Call LogFileWrite(oNode.nodeName & ": " & oNode.text)
      Call LogFileWrite("State: " & sState2Char)
      Set oNode = oRoot.SelectSingleNode("//WebServiceReverseGeocodingQueryResult/Zip")
      Call LogFileWrite(oNode.nodeName & ": " & oNode.text)
    Case 503
      Call LogFileWrite("Service unavailable")
    Case 500
      Call LogFileWrite("Internal Server Error")
    Case 401, 403
      Call LogFileWrite("Unauthorized. You do not have permission to access this resource")
    Case 400
      Call LogFileWrite("Bad request")
    Case 404
      Call LogFileWrite("Page not found")
    Case 415
      Call LogFileWrite("Unsupported media type")
      'indicates that the server refuses to accept the request because the payload format is in an unsupported format.
      'The format problem might be due to the request's indicated Content-Type or Content-Encoding, or as a result of inspecting the data directly.
    Case Else
      Call LogFileWrite("HTTP status: " & oXmlHttp.status)
      Call LogFileWrite("oXmlHttp.responseXml.xml:" & oXmlHttp.responseXml.xml)
      Call LogFileWrite(vbTab)
      Call LogFileWrite("oXmlHttp.responseText:")
      Call LogFileWrite(oXmlHttp.responseText)
  End Select
End Function  'oRevGeocodeTxAnMAsDic()

 

Time Series Measurement Data

Measurement data is information recorded from one or more sensors by a data logger or recorder.   It is typically time series and a linear time and/or date/time stamp is associated with every measurement value.   Metadata such as the engineering units (°F, millimeters, ft/sec, etc.), location (GPS latitude & longitude), operating conditions, environment, etc. provide important context.  

Example of Measurement Data

Time [sec] Date/Time [UTC] Latitude Longitude Temperature [°F] Humidity [%]
0.0 20210530T14:43:02.5678 40.440488 -76.122757 74.2 29.5
0.001 20210530T14:43:03.2358 40.440498 -76.122761 74.3 29.4
0.0015 20210530T14:43:04.1353 40.440489 -76.122759 74.3 30.0

The above was recorded by a custom data logger S/N APC23467 outside at Bernville, PA USA from a Cub Cadet Ultima ZT1 lawn mower at an elevation of 362 ft.  

 

 

Do you need help with your project?   Send me an email requesting a free phone / web share consultation.  

Savvy DIAdem Solutions
National Instruments (NI)
NI DIAdem Related Links

 

Copyright © 2021,2022,2023 Mechatronic Solutions LLC, All Rights Reserved