OAuth Signaturen mit VBA für Excel, Access oder Word

Heute ein kurzes Beispiel, wie man mit VBA eine OAuth-Signatur erstellt, um z. B. via Mircosoft Word, Excel oder Access auf Facebook, Twitter oder Google-Dienste zugreifen zu können (Details siehe auch meine Tutorials zu VBA und Social Networks). Folgendes Beispiel ist auch auf älteren Office-Versionen (getestet ab 2007) lauffähig.

Zum Test verwende ich die Daten eines Beispiels der offiziellen OAuth-Seite – dieses Beispiel ist in der Doku zu OAuth 1.0A zu finden, aber in diesem Punkt hat sich zu OAuth 2.0 nichts geändert.

Die Methode EncodeBase64() habe ich größtenteils von diesem Artikel bei Stackoverflow übernommen. Die Methode UrlEncode() ist nur eine kleine Lösung, für diverse komplexere Methoden empfehle ich diesen Aritkel (ebenfalls bei Stackoverflow).

Private Sub Befehl_Click()

    ' Daten aus folgenden OAuth-Example:
    ' http://oauth.net/core/1.0a/#sig_base_example
    
    Dim oauthSecret As String
    oauthSecret = "kd94hf93k423kf44"
    
    Dim oauthTokenSecret As String
    oauthTokenSecret = "pfkkdhi9sl3r4s00"
    
    Dim requestMethod As String
    requestMethod = "GET"
    
    Dim uri As String
    uri = "http://photos.example.net/photos"
    
    Dim params As String
    params = "file=vacation.jpg"
    params = params & "&oauth_consumer_key=dpf43f3p2l4k3l03"
    params = params & "&oauth_nonce=kllo9940pd9333jh"
    
    'Tipp - so könnte man eine 15-stellige Nonce erstellen:
    'nonce = Int((999999999999999# - 100000000000000# + 1) _ 
    '   * Rnd + 100000000000000#)
    
    params = params & "&oauth_signature_method=HMAC-SHA1"
    params = params & "&oauth_timestamp=1191242096"
    
    'Tipp - eine Timestamp lässt sich in VBA so generien:
    'zeitstempel = DateDiff("S", "1/1/1970", Now())
    'zeitstempel = Replace(Zeitstempel, " ", "")
        
    params = params & "&oauth_token=nnch734d00sl2jdk"
    params = params & "&oauth_version=1.0"
    params = params & "&size=original"
    
    'Base URL bauen - die muss signiert werden
    
    Dim uriEnc As String
    uriEnc = UrlEncode(uri)
        
    Dim paramsEnc As String
    paramsEnc = UrlEncode(params)

    Dim baseUrl As String
    baseUrl = requestMethod & "&" & uriEnc & "&" & paramsEnc
    
    Debug.Print ("BASE URL : " & baseUrl)
            
    ' Signatur erstellen
    Dim asc As Object, enc As Object
    Dim tmpTextToHash() As Byte
    Dim tmpSharedSecretKey() As Byte
    
    Set asc = CreateObject("System.Text.UTF8Encoding")
    Set enc = CreateObject("System.Security.Cryptography.HMACSHA1")
    
    tmpTextToHash = asc.Getbytes_4(baseUrl)
    tmpSharedSecretKey = asc.Getbytes_4(oauthSecret & _
      "&" & oauthTokenSecret)
    enc.Key = tmpSharedSecretKey

    Dim byteSignature() As Byte
    byteSignature = enc.ComputeHash_2(tmpTextToHash)
    signatur = EncodeBase64(byteSignature)
    
    Debug.Print ("SIGNATUR : " & signatur)
    
    If signatur = "tR3+Ty81lMeYAr/Fid0kMTYa/WM=" Then
        Debug.Print ("Signatur korrekt.")
    Else
        Debug.Print ("Signatur NICHT korrekt!")
    End If
    
End Sub

Function EncodeBase64(arrData() As Byte) As String
    ' Diese Methode ist inspiriert von einem Artikel
    ' in Stackoverflow - Link siehe oben!
    
    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.nodeTypedValue = arrData
    EncodeBase64 = objNode.Text

    Set objNode = Nothing
    Set objXML = Nothing

End Function

Function UrlEncode(strToEncode As String) As String
    ' eine built-in Funktion gibt es erst ab Excel 2013
    ' hier eine Mini-Lösung, die nicht alle Sonderzeichen
    ' und Umlaute abdeckt - koplexere Lösungen siehe
    ' Link oben im Text!
    
    strToEncode = Replace(strToEncode, "/", "%2F")
    strToEncode = Replace(strToEncode, "=", "%3D")
    strToEncode = Replace(strToEncode, ":", "%3A")
    strToEncode = Replace(strToEncode, "&", "%26")
    
    UrlEncode = strToEncode

End Function

Nícht vergessen: Verweis zu „Microsoft XML“ hinzufügen (Im Menu „Extras“, dann „Verweise..“, mind. Version 2).

P.S.

Probleme? Fragen? Anregungen? Ich helfe jederzeit und gerne  – einfach einen Kommentar oder Mail schreiben, die Antwort kommt schnellstmöglich. Unternehmen, die Unterstützung, Beratung oder Schulung bei der API- oder Webprogrammierung, der Social-Media-Entwicklung oder dem Social-Media-Management benötigen finden zudem entsprechende Angebote meiner Firma auf der Website www.Frank-IT-Beratung.de