Trying to create a JWT token in VBA but the output is different from the CryptoJS library used for javascript

This page summarizes the projects mentioned and recommended in the original post on /r/vba

Our great sponsors
  • WorkOS - The modern identity platform for B2B SaaS
  • InfluxDB - Power Real-Time Data Analytics at Scale
  • SaaSHub - Software Alternatives and Reviews
  • vba-aws-sqs

    VBA example code to request messages from Amazon Web Services SQS queue, using version 4 signing for the request

  • No experience with a JWT token, but you could try this supporting function from code to pull from Amazon services: https://github.com/FeatherFire/vba-aws-sqs

  • frank_jwt

    JSON Web Token implementation in Rust.

  • Option Explicit Option Base 0 Sub GenerateJWT() ' test against debugger at: https://jwt.io/ Dim header As String, data As String, secret As String Dim encodedHeader As String, encodedData As String Dim jwt_signing_string As String Dim signature() As Byte, sigText As String secret = "your-256-bit-secret" header = "{""alg"":""HS256"",""typ"":""JWT""}" data = "{""sub"":""1234567890"",""name"":""John Doe"",""iat"":1516239022}" encodedHeader = CleanEncoding(EncodeBase64(header)) encodedData = CleanEncoding(EncodeBase64(data)) ' Debug.Print encodedHeader ' OK = eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9 ' Debug.Print encodedData ' OK = eyJzdWIiOiIxMjM0NTY3ODkwIiwibmFtZSI6IkpvaG4gRG9lIiwiaWF0IjoxNTE2MjM5MDIyfQ ' sigText should be: SflKxwRJSMeKKF2QT4fwpMeJf36POk6yJV_adQssw5c Debug.Print ' this works jwt_signing_string = "eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJzdWIiOiIxMjM0NTY3ODkwIiwibmFtZSI6IkpvaG4gRG9lIiwiaWF0IjoxNTE2MjM5MDIyfQ" signature = ComputeHMACSHA256(jwt_signing_string, secret) ' secret not base64 encoded sigText = CleanEncoding(BytesEncodeBase64(signature)) Debug.Print "Works --------------------------" Debug.Print jwt_signing_string Debug.Print LenB(jwt_signing_string) Debug.Print sigText ' OK ' this fails jwt_signing_string = encodedHeader & "." & encodedData signature = ComputeHMACSHA256(jwt_signing_string, secret) ' secret not base64 encoded sigText = CleanEncoding(BytesEncodeBase64(signature)) Debug.Print "Fails --------------------------" Debug.Print jwt_signing_string Debug.Print LenB(jwt_signing_string) Debug.Print sigText ' this works jwt_signing_string = encodedHeader & "." & encodedData jwt_signing_string = Replace(jwt_signing_string, Chr(10), "") signature = ComputeHMACSHA256(jwt_signing_string, secret) ' secret not base64 encoded sigText = CleanEncoding(BytesEncodeBase64(signature)) Debug.Print "Works --------------------------" Debug.Print jwt_signing_string Debug.Print LenB(jwt_signing_string) Debug.Print sigText End Sub Function ComputeHMACSHA256(ByVal text As String, ByVal key As String) As Byte() Dim crypto As Object Dim hash() As Byte, bText() As Byte, bKey() As Byte ' encode strings bText = StrConv(text, vbFromUnicode) bKey = StrConv(key, vbFromUnicode) ' compute HMACSHA256 Set crypto = CreateObject("System.Security.Cryptography.HMACSHA256") crypto.key = bKey hash = crypto.ComputeHash_2(bText) ComputeHMACSHA256 = hash Set crypto = Nothing End Function Function CleanEncoding(ByVal str As String) As String Dim cleaned As String cleaned = str cleaned = Replace(cleaned, "+", "-") cleaned = Replace(cleaned, "/", "_") cleaned = Replace(cleaned, "=", "") CleanEncoding = cleaned End Function Function EncodeBase64(ByVal str As String) As String Dim arr() As Byte arr = StrConv(str, vbFromUnicode) Dim objXML As Object Set objXML = CreateObject("MSXML2.DOMDocument") ' Microsoft XML, v3.0 Dim objNode As MSXML2.IXMLDOMElement Set objNode = objXML.createElement("b64") objNode.DataType = "bin.base64" objNode.nodeTypedValue = arr EncodeBase64 = objNode.text Set objNode = Nothing Set objXML = Nothing End Function Private Function BytesEncodeBase64(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 BytesEncodeBase64 = objNode.text Set objNode = Nothing Set objXML = Nothing End Function

  • WorkOS

    The modern identity platform for B2B SaaS. The APIs are flexible and easy-to-use, supporting authentication, user identity, and complex enterprise features like SSO and SCIM provisioning.

    WorkOS logo
NOTE: The number of mentions on this list indicates mentions on common posts plus user suggested alternatives. Hence, a higher number means a more popular project.

Suggest a related project

Related posts