Quick Links

Other stuff

Site owners

  • Bruce Mcpherson

Encoding client keys for Maps

If you have a business account for Google Mapping, you'll need to provide your client id and crypto key. These things are meant to be kept private, so I did not provide a mechanism for parameterization of the url to include these. However I have provided the encryption functions needed to generate them from VBA.  You'll find all this in the latest version of googlemapping.xlsm, downloadable from here.

apiKeys module

You need to modify two functions here to supply your key and your clientID. Substitute your key value and clientID. You can obtain them here from the registry or however you choose to protect them. You simply need to return them as below.

Public Function addClientId() As String
    '--------------change this to the correct thing
    addClientId = "&client=" & "yourclientID"
End Function
Public Function addSignature(url As String) As String
    Dim keyString As String
    '-----------change this to the correct thing - should be hidden
    keyString = "vNIXE0xscrmjlyV-12Nj_BvUPaw="
    addSignature = url & createSignature(keyString, url)
End Function

googleMaps module

For the moment, I've only applied this to the section that does geoCoding, since this is rate limited section. If you need the keys you specified in the apiKeys module to be used, then uncomment the code below in the googleMaps module so that it will create a signature for each query it does

            ' -- uncomment this line if you have a business account
            ' -- you will need to modify the apiKeys module to supply your credentials however you store them
                'sReq = addSignature(sReq & addClientId())
            '------------------------------


Implementation details

Google do point you at how to do this using various other languages, but there is not a VBA solution, so below is how to do it.

The url is signed by hashing your query url and your key using SHA1 encryption. VBA doesn't have the ability to do that directly, but a solution can be hacked together, mainly from clues on various stackoverflow postings (apologies for not crediting them here- i didn't keep track). These have been implemented in the apikeys module.

Private Function createSignature(keyString As String, url As String) As String
    ' should get this from some secure place
    Dim effectiveUrl As String, k As Long, h As String

    ' strip domain - just a temp solution
    k = InStr(1, url, "/maps/api/")
    effectiveUrl = Mid(url, k, Len(url) - k + 1)
    h = sha1(keyString, effectiveUrl)
    createSignature = "&signature=" & h
End Function
Private Function sha1(ByVal keyString As String, ByVal str As String) As String

    Dim encode As Object, encrypt As Object, s As String, _
        t() As Byte, b() As Byte, privateKeyBytes() As Byte
        
    Set encode = CreateObject("System.Text.asciiEncoding")
    Set encrypt = CreateObject("System.Security.Cryptography.HMACSHA1")
    s = Replace(keyString, "-", "+")
    s = Replace(s, "_", "/")
    privateKeyBytes = decodeBase64(s)

    encrypt.key = privateKeyBytes
    t = encode.Getbytes_4(str)
    b = encrypt.ComputeHash_2((t))
    
    s = tob64(b)
    s = Replace(s, "+", "-")
    sha1 = Replace(s, "/", "_")
    
    Set encode = Nothing
    Set encrypt = Nothing

End Function

Private Function tob64(ByRef arrData() As Byte) As String

    Dim objXML As MSXML2.DOMDocument
    Dim objNode As MSXML2.IXMLDOMElement

    Set objXML = New MSXML2.DOMDocument

    ' byte array to base64
    Set objNode = objXML.createElement("b64")
    objNode.DataType = "bin.base64"
    objNode.nodeTypedValue = arrData
    tob64 = objNode.Text

    Set objNode = Nothing
    Set objXML = Nothing

End Function

Private Function decodeBase64(ByVal strData As String) As Byte()
    Dim objXML As MSXML2.DOMDocument
    Dim objNode As MSXML2.IXMLDOMElement
    
    Set objXML = New MSXML2.DOMDocument
    Set objNode = objXML.createElement("b64")
    objNode.DataType = "bin.base64"
    objNode.Text = strData
    decodeBase64 = objNode.nodeTypedValue
    
    Set objNode = Nothing
    Set objXML = Nothing
End Function

For more on mapping see, Using Google Maps. For help and more information join our forum,follow the blog or follow me on twitter .



Comments