Adobe Analytics REST API 使用 VBA 调用（PHP 中的原始代码）
Adobe Analytics REST API call with VBA (Original Code in PHP)
我正在尝试对 Adobe Analytics 进行 REST API 调用，但我无法连接到我当前的代码，也无法弄清楚原因。我知道我正在连接服务器并且 header 格式正确，因为我收到以下错误：
{"error":"Bad Request","error_description":"Unable to validate authentication.","error_uri":null}
这个 API 特别需要几个不同的加密组件，我认为这就是问题所在。 （我的 SHA1 和 Base64 函数在下面看起来正确吗？）请求的 header 如下所示：
X-WSSE: UsernameToken Username="will.smith:Google", PasswordDigest="QOmCMlIR4mVPTaiqmuSzM5eKZn0=", Nonce="MTRlYjY2YTM3NmNjMTVlZDk0NDkzZWFj", Created="2016-08-24T23:51:08Z"
阅读代码前的一些注意事项：
- Adobe 推荐使用 MD5(rand()) 生成 Nonce 变量，但我找不到适合 VBA 的 MD5 库。我选择只生成我自己的随机 32 位字母数字字符串，根据我阅读的一些文档，它应该可以工作。
- 我已经多次检查我的用户名、密码和端点是否正确，所以我相当确定问题出在 SHA1 或 Base64 转换中。
他们在 PHP 中的示例代码是这样的：
include_once("SimpleRestClient.class.php");
$username = '%%YOUR-USERNAME%%';
$secret = '%%YOUR-SECRET%%';
$nonce = md5(uniqid(php_uname('n'), true));
$nonce_ts = date('c');
$digest = base64_encode(sha1($nonce.$nonce_ts.$secret));
$server = "https://api.omniture.com";
$path = "/admin/1.3/rest/";
$rc=new SimpleRestClient();
$rc->setOption(CURLOPT_HTTPHEADER, array("X-WSSE: UsernameToken Username=\"$username\", PasswordDigest=\"$digest\", Nonce=\"$nonce\", Created=\"$nonce_ts\""));
$query="?method=Company.GetTokenUsage";
$rc->getWebRequest($server.$path.$query);
if ($rc->getStatusCode()==200) {
$response=$rc->getWebResponse();
var_dump($response);
} else {
echo "something went wrong\n";
var_dump($rc->getInfo());
}
这是我对VBA的解释：
Sub GetPromoData()
Dim objHTTP As New WinHttp.WinHttpRequest
Dim Send As String
Dim Username As String
Dim Secret As String
Dim EndPoint As String
Dim Time As String
Dim nonce As String
Dim Timestamp As String
Dim digest As String
Dim Header As String
Time = DateAdd("h", 7, Now())
'Time = Now()
Username = "Redacted"
Secret = "Redacted"
'Randomize
Timestamp = generateTimestamp(Time)
nonce = generateNonce()
digest = generateDigest(nonce & Timestamp & Secret)
Debug.Print Timestamp
Debug.Print nonce
Debug.Print digest
Header = "UsernameToken Username=""" & Username & """, PasswordDigest=""" & digest & """, Nonce=""" & nonce & """, Created=""" & Timestamp & """"
Debug.Print Header
Send = Worksheets("Promo Code Data").Range("A1").Value
URL = "https://api.omniture.com/admin/1.4/rest/?method=Report.Queue"
objHTTP.Open "POST", URL, False
objHTTP.SetRequestHeader "X-WSSE", Header
objHTTP.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
objHTTP.Send (Send)
Debug.Print objHTTP.Status
Debug.Print objHTTP.ResponseText
End Sub
Public Function generateTimestamp(Timestamp As String)
'Debug.Print Application.WorksheetFunction.Text(TimeStamp, "yyyy-MM-ddTHH:mm:ssZ");
generateTimestamp = Application.WorksheetFunction.Text(Timestamp, "yyyy-MM-ddTHH:mm:ssZ")
End Function
Public Function generateNonce()
Dim nonce As String
Dim alphaNumeric As Variant
alphaNumeric = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
Randomize
For I = 1 To 32
nonce = nonce & alphaNumeric(61 * Rnd)
Next
generateNonce = nonce
End Function
Public Function generateDigest(Values As String)
'Debug.Print SHA1Base64(Values)
generateDigest = SHA1Base64(Values)
End Function
Public Function SHA1Base64(ByVal sTextToHash As String)
Dim asc As Object, enc As Object
Dim TextToHash() As Byte
Set asc = CreateObject("System.Text.UTF8Encoding")
Set enc = CreateObject("System.Security.Cryptography.SHA1CryptoServiceProvider")
TextToHash = asc.Getbytes_4(sTextToHash)
Dim bytes() As Byte
bytes = enc.ComputeHash_2((TextToHash))
SHA1Base64 = EncodeBase64(bytes)
Set asc = Nothing
Set enc = Nothing
End Function
Private Function EncodeBase64(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
EncodeBase64 = objNode.Text
Set objNode = Nothing
Set objXML = Nothing
End Function
为清楚起见添加实际的 HTTP 请求：
{
""reportDescription"":{
""reportSuiteID"":""Redacted"",
""date"":""2016-8-23"",
""metrics"":[
{
""id"":""Orders""
}
],
""sortBy"":""Orders"",
""elements"":[
{
""id"":""evar4"",
""top"":""10"",
""startingWith"":""1""
}
]
}
}
我想通了这个问题。我发现的 SHA1 和 Base64 编码器并不准确。必须使用正确的有效负载更新发送变量，并且还需要使用正确的方法更新 URL 变量。
这是工作代码的完整版本：
Sub CallAPI()
Dim objHTTP As New WinHttp.WinHttpRequest
Dim Send As String
Dim Username As String
Dim Secret As String
Dim EndPoint As String
Dim Time As String
Dim Nonce As String
Dim Timestamp As String
Dim digest As String
Dim Header As String
Time = DateAdd("h", 7, Now())
'Time = Now()
Username = "USERNAME HERE"
Secret = "SECRETHERE"
Timestamp = generateTimestamp(Time)
Nonce = generateNonce()
digest = generateDigest(Nonce, Timestamp, Secret)
Debug.Print Timestamp
Debug.Print Nonce
Debug.Print digest
Header = "UsernameToken Username=""" & Username & """, PasswordDigest=""" & digest & """, Nonce=""" & Nonce & """, Created=""" & Timestamp & """"
Debug.Print Header
Send = Worksheets("Promo Code Data").Range("A1").Value
URL = "https://api.omniture.com/admin/1.4/rest/?method=Report.Queue"
objHTTP.Open "POST", URL, False
objHTTP.SetRequestHeader "X-WSSE", Header
objHTTP.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
objHTTP.Send (Send)
Debug.Print objHTTP.Status
Debug.Print objHTTP.ResponseText
End Sub
Public Function generateTimestamp(Timestamp As String)
'Debug.Print Application.WorksheetFunction.Text(TimeStamp, "yyyy-MM-ddTHH:mm:ssZ");
generateTimestamp = Application.WorksheetFunction.Text(Timestamp, "yyyy-MM-ddTHH:mm:ssZ")
End Function
Public Function generateNonce()
Dim Nonce As String
Dim alphaNumeric As Variant
alphaNumeric = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
Randomize
For i = 1 To 32
Nonce = Nonce & alphaNumeric(61 * Rnd)
Next
generateNonce = Nonce
End Function
Public Function generateDigest(Nonce, Timestamp, Secret)
generateDigest = Base64EncodeString(SHA1HASH(Nonce & Timestamp & Secret))
End Function
' Based on: http://vb.wikia.com/wiki/SHA-1.bas
Option Explicit
Private Type FourBytes
a As Byte
b As Byte
c As Byte
d As Byte
End Type
Private Type OneLong
L As Long
End Type
Function HexDefaultSHA1(message() As Byte) As String
Dim H1 As Long, H2 As Long, H3 As Long, H4 As Long, H5 As Long
DefaultSHA1 message, H1, H2, H3, H4, H5
HexDefaultSHA1 = DecToHex5(H1, H2, H3, H4, H5)
End Function
Function HexSHA1(message() As Byte, ByVal Key1 As Long, ByVal Key2 As Long, ByVal Key3 As Long, ByVal Key4 As Long) As String
Dim H1 As Long, H2 As Long, H3 As Long, H4 As Long, H5 As Long
xSHA1 message, Key1, Key2, Key3, Key4, H1, H2, H3, H4, H5
HexSHA1 = DecToHex5(H1, H2, H3, H4, H5)
End Function
Sub DefaultSHA1(message() As Byte, H1 As Long, H2 As Long, H3 As Long, H4 As Long, H5 As Long)
xSHA1 message, &H5A827999, &H6ED9EBA1, &H8F1BBCDC, &HCA62C1D6, H1, H2, H3, H4, H5
End Sub
Sub xSHA1(message() As Byte, ByVal Key1 As Long, ByVal Key2 As Long, ByVal Key3 As Long, ByVal Key4 As Long, H1 As Long, H2 As Long, H3 As Long, H4 As Long, H5 As Long)
'CA62C1D68F1BBCDC6ED9EBA15A827999 + "abc" = "A9993E36 4706816A BA3E2571 7850C26C 9CD0D89D"
'"abc" = "A9993E36 4706816A BA3E2571 7850C26C 9CD0D89D"
Dim U As Long, P As Long
Dim FB As FourBytes, OL As OneLong
Dim i As Integer
Dim w(80) As Long
Dim a As Long, b As Long, c As Long, d As Long, e As Long
Dim t As Long
H1 = &H67452301: H2 = &HEFCDAB89: H3 = &H98BADCFE: H4 = &H10325476: H5 = &HC3D2E1F0
U = UBound(message) + 1: OL.L = U32ShiftLeft3(U): a = U \ &H20000000: LSet FB = OL 'U32ShiftRight29(U)
ReDim Preserve message(0 To (U + 8 And -64) + 63)
message(U) = 128
U = UBound(message)
message(U - 4) = a
message(U - 3) = FB.d
message(U - 2) = FB.c
message(U - 1) = FB.b
message(U) = FB.a
While P < U
For i = 0 To 15
FB.d = message(P)
FB.c = message(P + 1)
FB.b = message(P + 2)
FB.a = message(P + 3)
LSet OL = FB
w(i) = OL.L
P = P + 4
Next i
For i = 16 To 79
w(i) = U32RotateLeft1(w(i - 3) Xor w(i - 8) Xor w(i - 14) Xor w(i - 16))
Next i
a = H1: b = H2: c = H3: d = H4: e = H5
For i = 0 To 19
t = U32Add(U32Add(U32Add(U32Add(U32RotateLeft5(a), e), w(i)), Key1), ((b And c) Or ((Not b) And d)))
e = d: d = c: c = U32RotateLeft30(b): b = a: a = t
Next i
For i = 20 To 39
t = U32Add(U32Add(U32Add(U32Add(U32RotateLeft5(a), e), w(i)), Key2), (b Xor c Xor d))
e = d: d = c: c = U32RotateLeft30(b): b = a: a = t
Next i
For i = 40 To 59
t = U32Add(U32Add(U32Add(U32Add(U32RotateLeft5(a), e), w(i)), Key3), ((b And c) Or (b And d) Or (c And d)))
e = d: d = c: c = U32RotateLeft30(b): b = a: a = t
Next i
For i = 60 To 79
t = U32Add(U32Add(U32Add(U32Add(U32RotateLeft5(a), e), w(i)), Key4), (b Xor c Xor d))
e = d: d = c: c = U32RotateLeft30(b): b = a: a = t
Next i
H1 = U32Add(H1, a): H2 = U32Add(H2, b): H3 = U32Add(H3, c): H4 = U32Add(H4, d): H5 = U32Add(H5, e)
Wend
End Sub
Function U32Add(ByVal a As Long, ByVal b As Long) As Long
If (a Xor b) < 0 Then
U32Add = a + b
Else
U32Add = (a Xor &H80000000) + b Xor &H80000000
End If
End Function
Function U32ShiftLeft3(ByVal a As Long) As Long
U32ShiftLeft3 = (a And &HFFFFFFF) * 8
If a And &H10000000 Then U32ShiftLeft3 = U32ShiftLeft3 Or &H80000000
End Function
Function U32ShiftRight29(ByVal a As Long) As Long
U32ShiftRight29 = (a And &HE0000000) \ &H20000000 And 7
End Function
Function U32RotateLeft1(ByVal a As Long) As Long
U32RotateLeft1 = (a And &H3FFFFFFF) * 2
If a And &H40000000 Then U32RotateLeft1 = U32RotateLeft1 Or &H80000000
If a And &H80000000 Then U32RotateLeft1 = U32RotateLeft1 Or 1
End Function
Function U32RotateLeft5(ByVal a As Long) As Long
U32RotateLeft5 = (a And &H3FFFFFF) * 32 Or (a And &HF8000000) \ &H8000000 And 31
If a And &H4000000 Then U32RotateLeft5 = U32RotateLeft5 Or &H80000000
End Function
Function U32RotateLeft30(ByVal a As Long) As Long
U32RotateLeft30 = (a And 1) * &H40000000 Or (a And &HFFFC) \ 4 And &H3FFFFFFF
If a And 2 Then U32RotateLeft30 = U32RotateLeft30 Or &H80000000
End Function
Function DecToHex5(ByVal H1 As Long, ByVal H2 As Long, ByVal H3 As Long, ByVal H4 As Long, ByVal H5 As Long) As String
Dim H As String, L As Long
DecToHex5 = "00000000 00000000 00000000 00000000 00000000"
H = Hex(H1): L = Len(H): Mid(DecToHex5, 9 - L, L) = H
H = Hex(H2): L = Len(H): Mid(DecToHex5, 18 - L, L) = H
H = Hex(H3): L = Len(H): Mid(DecToHex5, 27 - L, L) = H
H = Hex(H4): L = Len(H): Mid(DecToHex5, 36 - L, L) = H
H = Hex(H5): L = Len(H): Mid(DecToHex5, 45 - L, L) = H
End Function
' Convert the string into bytes so we can use the above functions
' From Chris Hulbert: http://splinter.com.au/blog
Public Function SHA1HASH(str)
Dim i As Integer
Dim arr() As Byte
ReDim arr(0 To Len(str) - 1) As Byte
For i = 0 To Len(str) - 1
arr(i) = asc(Mid(str, i + 1, 1))
Next i
SHA1HASH = Replace(LCase(HexDefaultSHA1(arr)), " ", "")
End Function
' A Base64 Encoder/Decoder.
'
' This module is used to encode and decode data in Base64 format as described in RFC 1521.
'
' Home page: www.source-code.biz.
' License: GNU/LGPL (www.gnu.org/licenses/lgpl.html).
' Copyright 2007: Christian d'Heureuse, Inventec Informatik AG, Switzerland.
' This module is provided "as is" without warranty of any kind.
Option Explicit
Private InitDone As Boolean
Private Map1(0 To 63) As Byte
Private Map2(0 To 127) As Byte
' Encodes a string into Base64 format.
' No blanks or line breaks are inserted.
' Parameters:
' S a String to be encoded.
' Returns: a String with the Base64 encoded data.
Public Function Base64EncodeString(ByVal s As String) As String
Base64EncodeString = Base64Encode(ConvertStringToBytes(s))
End Function
' Encodes a byte array into Base64 format.
' No blanks or line breaks are inserted.
' Parameters:
' InData an array containing the data bytes to be encoded.
' Returns: a string with the Base64 encoded data.
Public Function Base64Encode(InData() As Byte)
Base64Encode = Base64Encode2(InData, UBound(InData) - LBound(InData) + 1)
End Function
' Encodes a byte array into Base64 format.
' No blanks or line breaks are inserted.
' Parameters:
' InData an array containing the data bytes to be encoded.
' InLen number of bytes to process in InData.
' Returns: a string with the Base64 encoded data.
Public Function Base64Encode2(InData() As Byte, ByVal InLen As Long) As String
If Not InitDone Then Init
If InLen = 0 Then Base64Encode2 = "": Exit Function
Dim ODataLen As Long: ODataLen = (InLen * 4 + 2) \ 3 ' output length without padding
Dim OLen As Long: OLen = ((InLen + 2) \ 3) * 4 ' output length including padding
Dim Out() As Byte
ReDim Out(0 To OLen - 1) As Byte
Dim ip0 As Long: ip0 = LBound(InData)
Dim ip As Long
Dim op As Long
Do While ip < InLen
Dim i0 As Byte: i0 = InData(ip0 + ip): ip = ip + 1
Dim i1 As Byte: If ip < InLen Then i1 = InData(ip0 + ip): ip = ip + 1 Else i1 = 0
Dim i2 As Byte: If ip < InLen Then i2 = InData(ip0 + ip): ip = ip + 1 Else i2 = 0
Dim o0 As Byte: o0 = i0 \ 4
Dim o1 As Byte: o1 = ((i0 And 3) * &H10) Or (i1 \ &H10)
Dim o2 As Byte: o2 = ((i1 And &HF) * 4) Or (i2 \ &H40)
Dim o3 As Byte: o3 = i2 And &H3F
Out(op) = Map1(o0): op = op + 1
Out(op) = Map1(o1): op = op + 1
Out(op) = IIf(op < ODataLen, Map1(o2), asc("=")): op = op + 1
Out(op) = IIf(op < ODataLen, Map1(o3), asc("=")): op = op + 1
Loop
Base64Encode2 = ConvertBytesToString(Out)
End Function
' Decodes a string from Base64 format.
' Parameters:
' s a Base64 String to be decoded.
' Returns a String containing the decoded data.
Public Function Base64DecodeString(ByVal s As String) As String
If s = "" Then Base64DecodeString = "": Exit Function
Base64DecodeString = ConvertBytesToString(Base64Decode(s))
End Function
' Decodes a byte array from Base64 format.
' Parameters
' s a Base64 String to be decoded.
' Returns: an array containing the decoded data bytes.
Public Function Base64Decode(ByVal s As String) As Byte()
If Not InitDone Then Init
Dim IBuf() As Byte: IBuf = ConvertStringToBytes(s)
Dim ILen As Long: ILen = UBound(IBuf) + 1
If ILen Mod 4 <> 0 Then Err.Raise vbObjectError, , "Length of Base64 encoded input string is not a multiple of 4."
Do While ILen > 0
If IBuf(ILen - 1) <> asc("=") Then Exit Do
ILen = ILen - 1
Loop
Dim OLen As Long: OLen = (ILen * 3) \ 4
Dim Out() As Byte
ReDim Out(0 To OLen - 1) As Byte
Dim ip As Long
Dim op As Long
Do While ip < ILen
Dim i0 As Byte: i0 = IBuf(ip): ip = ip + 1
Dim i1 As Byte: i1 = IBuf(ip): ip = ip + 1
Dim i2 As Byte: If ip < ILen Then i2 = IBuf(ip): ip = ip + 1 Else i2 = asc("A")
Dim i3 As Byte: If ip < ILen Then i3 = IBuf(ip): ip = ip + 1 Else i3 = asc("A")
If i0 > 127 Or i1 > 127 Or i2 > 127 Or i3 > 127 Then _
Err.Raise vbObjectError, , "Illegal character in Base64 encoded data."
Dim b0 As Byte: b0 = Map2(i0)
Dim b1 As Byte: b1 = Map2(i1)
Dim b2 As Byte: b2 = Map2(i2)
Dim b3 As Byte: b3 = Map2(i3)
If b0 > 63 Or b1 > 63 Or b2 > 63 Or b3 > 63 Then _
Err.Raise vbObjectError, , "Illegal character in Base64 encoded data."
Dim o0 As Byte: o0 = (b0 * 4) Or (b1 \ &H10)
Dim o1 As Byte: o1 = ((b1 And &HF) * &H10) Or (b2 \ 4)
Dim o2 As Byte: o2 = ((b2 And 3) * &H40) Or b3
Out(op) = o0: op = op + 1
If op < OLen Then Out(op) = o1: op = op + 1
If op < OLen Then Out(op) = o2: op = op + 1
Loop
Base64Decode = Out
End Function
Private Sub Init()
Dim c As Integer, i As Integer
' set Map1
i = 0
For c = asc("A") To asc("Z"): Map1(i) = c: i = i + 1: Next
For c = asc("a") To asc("z"): Map1(i) = c: i = i + 1: Next
For c = asc("0") To asc("9"): Map1(i) = c: i = i + 1: Next
Map1(i) = asc("+"): i = i + 1
Map1(i) = asc("/"): i = i + 1
' set Map2
For i = 0 To 127: Map2(i) = 255: Next
For i = 0 To 63: Map2(Map1(i)) = i: Next
InitDone = True
End Sub
Private Function ConvertStringToBytes(ByVal s As String) As Byte()
Dim b1() As Byte: b1 = s
Dim L As Long: L = (UBound(b1) + 1) \ 2
If L = 0 Then ConvertStringToBytes = b1: Exit Function
Dim b2() As Byte
ReDim b2(0 To L - 1) As Byte
Dim P As Long
For P = 0 To L - 1
Dim c As Long: c = b1(2 * P) + 256 * CLng(b1(2 * P + 1))
If c >= 256 Then c = asc("?")
b2(P) = c
Next
ConvertStringToBytes = b2
End Function
Private Function ConvertBytesToString(b() As Byte) As String
Dim L As Long: L = UBound(b) - LBound(b) + 1
Dim b2() As Byte
ReDim b2(0 To (2 * L) - 1) As Byte
Dim p0 As Long: p0 = LBound(b)
Dim P As Long
For P = 0 To L - 1: b2(2 * P) = b(p0 + P): Next
Dim s As String: s = b2
ConvertBytesToString = s
End Function
我正在尝试对 Adobe Analytics 进行 REST API 调用，但我无法连接到我当前的代码，也无法弄清楚原因。我知道我正在连接服务器并且 header 格式正确，因为我收到以下错误：
{"error":"Bad Request","error_description":"Unable to validate authentication.","error_uri":null}
这个 API 特别需要几个不同的加密组件，我认为这就是问题所在。 （我的 SHA1 和 Base64 函数在下面看起来正确吗？）请求的 header 如下所示：
X-WSSE: UsernameToken Username="will.smith:Google", PasswordDigest="QOmCMlIR4mVPTaiqmuSzM5eKZn0=", Nonce="MTRlYjY2YTM3NmNjMTVlZDk0NDkzZWFj", Created="2016-08-24T23:51:08Z"
阅读代码前的一些注意事项：
- Adobe 推荐使用 MD5(rand()) 生成 Nonce 变量，但我找不到适合 VBA 的 MD5 库。我选择只生成我自己的随机 32 位字母数字字符串，根据我阅读的一些文档，它应该可以工作。
- 我已经多次检查我的用户名、密码和端点是否正确，所以我相当确定问题出在 SHA1 或 Base64 转换中。
他们在 PHP 中的示例代码是这样的：
include_once("SimpleRestClient.class.php");
$username = '%%YOUR-USERNAME%%';
$secret = '%%YOUR-SECRET%%';
$nonce = md5(uniqid(php_uname('n'), true));
$nonce_ts = date('c');
$digest = base64_encode(sha1($nonce.$nonce_ts.$secret));
$server = "https://api.omniture.com";
$path = "/admin/1.3/rest/";
$rc=new SimpleRestClient();
$rc->setOption(CURLOPT_HTTPHEADER, array("X-WSSE: UsernameToken Username=\"$username\", PasswordDigest=\"$digest\", Nonce=\"$nonce\", Created=\"$nonce_ts\""));
$query="?method=Company.GetTokenUsage";
$rc->getWebRequest($server.$path.$query);
if ($rc->getStatusCode()==200) {
$response=$rc->getWebResponse();
var_dump($response);
} else {
echo "something went wrong\n";
var_dump($rc->getInfo());
}
这是我对VBA的解释：
Sub GetPromoData()
Dim objHTTP As New WinHttp.WinHttpRequest
Dim Send As String
Dim Username As String
Dim Secret As String
Dim EndPoint As String
Dim Time As String
Dim nonce As String
Dim Timestamp As String
Dim digest As String
Dim Header As String
Time = DateAdd("h", 7, Now())
'Time = Now()
Username = "Redacted"
Secret = "Redacted"
'Randomize
Timestamp = generateTimestamp(Time)
nonce = generateNonce()
digest = generateDigest(nonce & Timestamp & Secret)
Debug.Print Timestamp
Debug.Print nonce
Debug.Print digest
Header = "UsernameToken Username=""" & Username & """, PasswordDigest=""" & digest & """, Nonce=""" & nonce & """, Created=""" & Timestamp & """"
Debug.Print Header
Send = Worksheets("Promo Code Data").Range("A1").Value
URL = "https://api.omniture.com/admin/1.4/rest/?method=Report.Queue"
objHTTP.Open "POST", URL, False
objHTTP.SetRequestHeader "X-WSSE", Header
objHTTP.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
objHTTP.Send (Send)
Debug.Print objHTTP.Status
Debug.Print objHTTP.ResponseText
End Sub
Public Function generateTimestamp(Timestamp As String)
'Debug.Print Application.WorksheetFunction.Text(TimeStamp, "yyyy-MM-ddTHH:mm:ssZ");
generateTimestamp = Application.WorksheetFunction.Text(Timestamp, "yyyy-MM-ddTHH:mm:ssZ")
End Function
Public Function generateNonce()
Dim nonce As String
Dim alphaNumeric As Variant
alphaNumeric = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
Randomize
For I = 1 To 32
nonce = nonce & alphaNumeric(61 * Rnd)
Next
generateNonce = nonce
End Function
Public Function generateDigest(Values As String)
'Debug.Print SHA1Base64(Values)
generateDigest = SHA1Base64(Values)
End Function
Public Function SHA1Base64(ByVal sTextToHash As String)
Dim asc As Object, enc As Object
Dim TextToHash() As Byte
Set asc = CreateObject("System.Text.UTF8Encoding")
Set enc = CreateObject("System.Security.Cryptography.SHA1CryptoServiceProvider")
TextToHash = asc.Getbytes_4(sTextToHash)
Dim bytes() As Byte
bytes = enc.ComputeHash_2((TextToHash))
SHA1Base64 = EncodeBase64(bytes)
Set asc = Nothing
Set enc = Nothing
End Function
Private Function EncodeBase64(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
EncodeBase64 = objNode.Text
Set objNode = Nothing
Set objXML = Nothing
End Function
为清楚起见添加实际的 HTTP 请求：
{
""reportDescription"":{
""reportSuiteID"":""Redacted"",
""date"":""2016-8-23"",
""metrics"":[
{
""id"":""Orders""
}
],
""sortBy"":""Orders"",
""elements"":[
{
""id"":""evar4"",
""top"":""10"",
""startingWith"":""1""
}
]
}
}
我想通了这个问题。我发现的 SHA1 和 Base64 编码器并不准确。必须使用正确的有效负载更新发送变量，并且还需要使用正确的方法更新 URL 变量。
这是工作代码的完整版本：
Sub CallAPI()
Dim objHTTP As New WinHttp.WinHttpRequest
Dim Send As String
Dim Username As String
Dim Secret As String
Dim EndPoint As String
Dim Time As String
Dim Nonce As String
Dim Timestamp As String
Dim digest As String
Dim Header As String
Time = DateAdd("h", 7, Now())
'Time = Now()
Username = "USERNAME HERE"
Secret = "SECRETHERE"
Timestamp = generateTimestamp(Time)
Nonce = generateNonce()
digest = generateDigest(Nonce, Timestamp, Secret)
Debug.Print Timestamp
Debug.Print Nonce
Debug.Print digest
Header = "UsernameToken Username=""" & Username & """, PasswordDigest=""" & digest & """, Nonce=""" & Nonce & """, Created=""" & Timestamp & """"
Debug.Print Header
Send = Worksheets("Promo Code Data").Range("A1").Value
URL = "https://api.omniture.com/admin/1.4/rest/?method=Report.Queue"
objHTTP.Open "POST", URL, False
objHTTP.SetRequestHeader "X-WSSE", Header
objHTTP.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
objHTTP.Send (Send)
Debug.Print objHTTP.Status
Debug.Print objHTTP.ResponseText
End Sub
Public Function generateTimestamp(Timestamp As String)
'Debug.Print Application.WorksheetFunction.Text(TimeStamp, "yyyy-MM-ddTHH:mm:ssZ");
generateTimestamp = Application.WorksheetFunction.Text(Timestamp, "yyyy-MM-ddTHH:mm:ssZ")
End Function
Public Function generateNonce()
Dim Nonce As String
Dim alphaNumeric As Variant
alphaNumeric = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
Randomize
For i = 1 To 32
Nonce = Nonce & alphaNumeric(61 * Rnd)
Next
generateNonce = Nonce
End Function
Public Function generateDigest(Nonce, Timestamp, Secret)
generateDigest = Base64EncodeString(SHA1HASH(Nonce & Timestamp & Secret))
End Function
' Based on: http://vb.wikia.com/wiki/SHA-1.bas
Option Explicit
Private Type FourBytes
a As Byte
b As Byte
c As Byte
d As Byte
End Type
Private Type OneLong
L As Long
End Type
Function HexDefaultSHA1(message() As Byte) As String
Dim H1 As Long, H2 As Long, H3 As Long, H4 As Long, H5 As Long
DefaultSHA1 message, H1, H2, H3, H4, H5
HexDefaultSHA1 = DecToHex5(H1, H2, H3, H4, H5)
End Function
Function HexSHA1(message() As Byte, ByVal Key1 As Long, ByVal Key2 As Long, ByVal Key3 As Long, ByVal Key4 As Long) As String
Dim H1 As Long, H2 As Long, H3 As Long, H4 As Long, H5 As Long
xSHA1 message, Key1, Key2, Key3, Key4, H1, H2, H3, H4, H5
HexSHA1 = DecToHex5(H1, H2, H3, H4, H5)
End Function
Sub DefaultSHA1(message() As Byte, H1 As Long, H2 As Long, H3 As Long, H4 As Long, H5 As Long)
xSHA1 message, &H5A827999, &H6ED9EBA1, &H8F1BBCDC, &HCA62C1D6, H1, H2, H3, H4, H5
End Sub
Sub xSHA1(message() As Byte, ByVal Key1 As Long, ByVal Key2 As Long, ByVal Key3 As Long, ByVal Key4 As Long, H1 As Long, H2 As Long, H3 As Long, H4 As Long, H5 As Long)
'CA62C1D68F1BBCDC6ED9EBA15A827999 + "abc" = "A9993E36 4706816A BA3E2571 7850C26C 9CD0D89D"
'"abc" = "A9993E36 4706816A BA3E2571 7850C26C 9CD0D89D"
Dim U As Long, P As Long
Dim FB As FourBytes, OL As OneLong
Dim i As Integer
Dim w(80) As Long
Dim a As Long, b As Long, c As Long, d As Long, e As Long
Dim t As Long
H1 = &H67452301: H2 = &HEFCDAB89: H3 = &H98BADCFE: H4 = &H10325476: H5 = &HC3D2E1F0
U = UBound(message) + 1: OL.L = U32ShiftLeft3(U): a = U \ &H20000000: LSet FB = OL 'U32ShiftRight29(U)
ReDim Preserve message(0 To (U + 8 And -64) + 63)
message(U) = 128
U = UBound(message)
message(U - 4) = a
message(U - 3) = FB.d
message(U - 2) = FB.c
message(U - 1) = FB.b
message(U) = FB.a
While P < U
For i = 0 To 15
FB.d = message(P)
FB.c = message(P + 1)
FB.b = message(P + 2)
FB.a = message(P + 3)
LSet OL = FB
w(i) = OL.L
P = P + 4
Next i
For i = 16 To 79
w(i) = U32RotateLeft1(w(i - 3) Xor w(i - 8) Xor w(i - 14) Xor w(i - 16))
Next i
a = H1: b = H2: c = H3: d = H4: e = H5
For i = 0 To 19
t = U32Add(U32Add(U32Add(U32Add(U32RotateLeft5(a), e), w(i)), Key1), ((b And c) Or ((Not b) And d)))
e = d: d = c: c = U32RotateLeft30(b): b = a: a = t
Next i
For i = 20 To 39
t = U32Add(U32Add(U32Add(U32Add(U32RotateLeft5(a), e), w(i)), Key2), (b Xor c Xor d))
e = d: d = c: c = U32RotateLeft30(b): b = a: a = t
Next i
For i = 40 To 59
t = U32Add(U32Add(U32Add(U32Add(U32RotateLeft5(a), e), w(i)), Key3), ((b And c) Or (b And d) Or (c And d)))
e = d: d = c: c = U32RotateLeft30(b): b = a: a = t
Next i
For i = 60 To 79
t = U32Add(U32Add(U32Add(U32Add(U32RotateLeft5(a), e), w(i)), Key4), (b Xor c Xor d))
e = d: d = c: c = U32RotateLeft30(b): b = a: a = t
Next i
H1 = U32Add(H1, a): H2 = U32Add(H2, b): H3 = U32Add(H3, c): H4 = U32Add(H4, d): H5 = U32Add(H5, e)
Wend
End Sub
Function U32Add(ByVal a As Long, ByVal b As Long) As Long
If (a Xor b) < 0 Then
U32Add = a + b
Else
U32Add = (a Xor &H80000000) + b Xor &H80000000
End If
End Function
Function U32ShiftLeft3(ByVal a As Long) As Long
U32ShiftLeft3 = (a And &HFFFFFFF) * 8
If a And &H10000000 Then U32ShiftLeft3 = U32ShiftLeft3 Or &H80000000
End Function
Function U32ShiftRight29(ByVal a As Long) As Long
U32ShiftRight29 = (a And &HE0000000) \ &H20000000 And 7
End Function
Function U32RotateLeft1(ByVal a As Long) As Long
U32RotateLeft1 = (a And &H3FFFFFFF) * 2
If a And &H40000000 Then U32RotateLeft1 = U32RotateLeft1 Or &H80000000
If a And &H80000000 Then U32RotateLeft1 = U32RotateLeft1 Or 1
End Function
Function U32RotateLeft5(ByVal a As Long) As Long
U32RotateLeft5 = (a And &H3FFFFFF) * 32 Or (a And &HF8000000) \ &H8000000 And 31
If a And &H4000000 Then U32RotateLeft5 = U32RotateLeft5 Or &H80000000
End Function
Function U32RotateLeft30(ByVal a As Long) As Long
U32RotateLeft30 = (a And 1) * &H40000000 Or (a And &HFFFC) \ 4 And &H3FFFFFFF
If a And 2 Then U32RotateLeft30 = U32RotateLeft30 Or &H80000000
End Function
Function DecToHex5(ByVal H1 As Long, ByVal H2 As Long, ByVal H3 As Long, ByVal H4 As Long, ByVal H5 As Long) As String
Dim H As String, L As Long
DecToHex5 = "00000000 00000000 00000000 00000000 00000000"
H = Hex(H1): L = Len(H): Mid(DecToHex5, 9 - L, L) = H
H = Hex(H2): L = Len(H): Mid(DecToHex5, 18 - L, L) = H
H = Hex(H3): L = Len(H): Mid(DecToHex5, 27 - L, L) = H
H = Hex(H4): L = Len(H): Mid(DecToHex5, 36 - L, L) = H
H = Hex(H5): L = Len(H): Mid(DecToHex5, 45 - L, L) = H
End Function
' Convert the string into bytes so we can use the above functions
' From Chris Hulbert: http://splinter.com.au/blog
Public Function SHA1HASH(str)
Dim i As Integer
Dim arr() As Byte
ReDim arr(0 To Len(str) - 1) As Byte
For i = 0 To Len(str) - 1
arr(i) = asc(Mid(str, i + 1, 1))
Next i
SHA1HASH = Replace(LCase(HexDefaultSHA1(arr)), " ", "")
End Function
' A Base64 Encoder/Decoder.
'
' This module is used to encode and decode data in Base64 format as described in RFC 1521.
'
' Home page: www.source-code.biz.
' License: GNU/LGPL (www.gnu.org/licenses/lgpl.html).
' Copyright 2007: Christian d'Heureuse, Inventec Informatik AG, Switzerland.
' This module is provided "as is" without warranty of any kind.
Option Explicit
Private InitDone As Boolean
Private Map1(0 To 63) As Byte
Private Map2(0 To 127) As Byte
' Encodes a string into Base64 format.
' No blanks or line breaks are inserted.
' Parameters:
' S a String to be encoded.
' Returns: a String with the Base64 encoded data.
Public Function Base64EncodeString(ByVal s As String) As String
Base64EncodeString = Base64Encode(ConvertStringToBytes(s))
End Function
' Encodes a byte array into Base64 format.
' No blanks or line breaks are inserted.
' Parameters:
' InData an array containing the data bytes to be encoded.
' Returns: a string with the Base64 encoded data.
Public Function Base64Encode(InData() As Byte)
Base64Encode = Base64Encode2(InData, UBound(InData) - LBound(InData) + 1)
End Function
' Encodes a byte array into Base64 format.
' No blanks or line breaks are inserted.
' Parameters:
' InData an array containing the data bytes to be encoded.
' InLen number of bytes to process in InData.
' Returns: a string with the Base64 encoded data.
Public Function Base64Encode2(InData() As Byte, ByVal InLen As Long) As String
If Not InitDone Then Init
If InLen = 0 Then Base64Encode2 = "": Exit Function
Dim ODataLen As Long: ODataLen = (InLen * 4 + 2) \ 3 ' output length without padding
Dim OLen As Long: OLen = ((InLen + 2) \ 3) * 4 ' output length including padding
Dim Out() As Byte
ReDim Out(0 To OLen - 1) As Byte
Dim ip0 As Long: ip0 = LBound(InData)
Dim ip As Long
Dim op As Long
Do While ip < InLen
Dim i0 As Byte: i0 = InData(ip0 + ip): ip = ip + 1
Dim i1 As Byte: If ip < InLen Then i1 = InData(ip0 + ip): ip = ip + 1 Else i1 = 0
Dim i2 As Byte: If ip < InLen Then i2 = InData(ip0 + ip): ip = ip + 1 Else i2 = 0
Dim o0 As Byte: o0 = i0 \ 4
Dim o1 As Byte: o1 = ((i0 And 3) * &H10) Or (i1 \ &H10)
Dim o2 As Byte: o2 = ((i1 And &HF) * 4) Or (i2 \ &H40)
Dim o3 As Byte: o3 = i2 And &H3F
Out(op) = Map1(o0): op = op + 1
Out(op) = Map1(o1): op = op + 1
Out(op) = IIf(op < ODataLen, Map1(o2), asc("=")): op = op + 1
Out(op) = IIf(op < ODataLen, Map1(o3), asc("=")): op = op + 1
Loop
Base64Encode2 = ConvertBytesToString(Out)
End Function
' Decodes a string from Base64 format.
' Parameters:
' s a Base64 String to be decoded.
' Returns a String containing the decoded data.
Public Function Base64DecodeString(ByVal s As String) As String
If s = "" Then Base64DecodeString = "": Exit Function
Base64DecodeString = ConvertBytesToString(Base64Decode(s))
End Function
' Decodes a byte array from Base64 format.
' Parameters
' s a Base64 String to be decoded.
' Returns: an array containing the decoded data bytes.
Public Function Base64Decode(ByVal s As String) As Byte()
If Not InitDone Then Init
Dim IBuf() As Byte: IBuf = ConvertStringToBytes(s)
Dim ILen As Long: ILen = UBound(IBuf) + 1
If ILen Mod 4 <> 0 Then Err.Raise vbObjectError, , "Length of Base64 encoded input string is not a multiple of 4."
Do While ILen > 0
If IBuf(ILen - 1) <> asc("=") Then Exit Do
ILen = ILen - 1
Loop
Dim OLen As Long: OLen = (ILen * 3) \ 4
Dim Out() As Byte
ReDim Out(0 To OLen - 1) As Byte
Dim ip As Long
Dim op As Long
Do While ip < ILen
Dim i0 As Byte: i0 = IBuf(ip): ip = ip + 1
Dim i1 As Byte: i1 = IBuf(ip): ip = ip + 1
Dim i2 As Byte: If ip < ILen Then i2 = IBuf(ip): ip = ip + 1 Else i2 = asc("A")
Dim i3 As Byte: If ip < ILen Then i3 = IBuf(ip): ip = ip + 1 Else i3 = asc("A")
If i0 > 127 Or i1 > 127 Or i2 > 127 Or i3 > 127 Then _
Err.Raise vbObjectError, , "Illegal character in Base64 encoded data."
Dim b0 As Byte: b0 = Map2(i0)
Dim b1 As Byte: b1 = Map2(i1)
Dim b2 As Byte: b2 = Map2(i2)
Dim b3 As Byte: b3 = Map2(i3)
If b0 > 63 Or b1 > 63 Or b2 > 63 Or b3 > 63 Then _
Err.Raise vbObjectError, , "Illegal character in Base64 encoded data."
Dim o0 As Byte: o0 = (b0 * 4) Or (b1 \ &H10)
Dim o1 As Byte: o1 = ((b1 And &HF) * &H10) Or (b2 \ 4)
Dim o2 As Byte: o2 = ((b2 And 3) * &H40) Or b3
Out(op) = o0: op = op + 1
If op < OLen Then Out(op) = o1: op = op + 1
If op < OLen Then Out(op) = o2: op = op + 1
Loop
Base64Decode = Out
End Function
Private Sub Init()
Dim c As Integer, i As Integer
' set Map1
i = 0
For c = asc("A") To asc("Z"): Map1(i) = c: i = i + 1: Next
For c = asc("a") To asc("z"): Map1(i) = c: i = i + 1: Next
For c = asc("0") To asc("9"): Map1(i) = c: i = i + 1: Next
Map1(i) = asc("+"): i = i + 1
Map1(i) = asc("/"): i = i + 1
' set Map2
For i = 0 To 127: Map2(i) = 255: Next
For i = 0 To 63: Map2(Map1(i)) = i: Next
InitDone = True
End Sub
Private Function ConvertStringToBytes(ByVal s As String) As Byte()
Dim b1() As Byte: b1 = s
Dim L As Long: L = (UBound(b1) + 1) \ 2
If L = 0 Then ConvertStringToBytes = b1: Exit Function
Dim b2() As Byte
ReDim b2(0 To L - 1) As Byte
Dim P As Long
For P = 0 To L - 1
Dim c As Long: c = b1(2 * P) + 256 * CLng(b1(2 * P + 1))
If c >= 256 Then c = asc("?")
b2(P) = c
Next
ConvertStringToBytes = b2
End Function
Private Function ConvertBytesToString(b() As Byte) As String
Dim L As Long: L = UBound(b) - LBound(b) + 1
Dim b2() As Byte
ReDim b2(0 To (2 * L) - 1) As Byte
Dim p0 As Long: p0 = LBound(b)
Dim P As Long
For P = 0 To L - 1: b2(2 * P) = b(p0 + P): Next
Dim s As String: s = b2
ConvertBytesToString = s
End Function