Не могу пройти Аутентификацию на бирже OKEX
Всем добрый день. Целый день помучался - патаюсь пройти аутентификацию на бирже OKEX через API. Сделано все как описано https://www.okex.com/docs/en/#summary-yan-zheng. Прошу тыкните пальцем что не так я делаю.
Option Compare Database
Option Explicit
Const linkServer = "https://www.okex.com"
Const sApiKey1 = "3d7f03c3-...7"
Const sSign = "59...E7"
Const sPass = "kZ...cgj"
Const sText = "VBA_ACCESS_002"
Function getServerInfo(strZapros As String) As String
Dim objRequest As Object
Dim strUrl As String
Dim blnAsync As Boolean
Dim strResponse As String
Set objRequest = CreateObject("MSXML2.XMLHTTP")
strUrl = linkServer & strZapros
Debug.Print strUrl
blnAsync = True
With objRequest
.Open "GET", strUrl, blnAsync
.SetRequestHeader "Content-Type", "application/json"
.Send
While objRequest.ReadyState <> 4
DoEvents
Wend
strResponse = .ResponseText
End With
Set objRequest = Nothing
Debug.Print strResponse
getServerInfo = strResponse
End Function
Function getParametr(sPrm As String, sData As String) As Variant
Dim dStartPrm As Integer
Dim dStartData, dEndData As Integer
Dim dOut As String
dStartPrm = InStr(1, sData, sPrm)
dStartData = InStr(dStartPrm, sData, ":""")
dEndData = InStr(dStartData + 2, sData, """")
dOut = Mid(sData, dStartData + 2, dEndData - dStartData - 2)
getParametr = dOut
End Function
Function getServerTimeNano() As String
Dim sData As String
Dim sOut As String
sData = getServerInfo("/api/general/v3/time")
sOut = getParametr("iso", sData)
getServerTimeNano = sOut
End Function
Sub verifacationAccaunt()
Dim sData1 As String
Dim sIso As String, sEpoch As String
Dim sVerZapros As String
Dim sData As String
Dim sOut As String
sData = getServerInfo("/api/general/v3/time")
sIso = getParametr("iso", sData)
sEpoch = getParametr("epoch", sData)
sData1 = getServerVerif("/api/spot/v5/accounts", sIso, sEpoch)
End Sub
Function getServerVerif(strZapros As String, sIso As String, sEpoch As String) As String
Dim objRequest As Object
Dim strUrl As String
Dim blnAsync As Boolean
Dim strResponse As String
Dim sMes As String
Set objRequest = CreateObject("MSXML2.XMLHTTP")
strUrl = linkServer & strZapros
Debug.Print strUrl
blnAsync = True
sMes = getSecretMes(sIso, "GET", strZapros, "")
With objRequest
.Open "GET", strUrl, blnAsync
.SetRequestHeader "Content-Type", "application/json"
.SetRequestHeader "OK-ACCESS-KEY", sApiKey1
.SetRequestHeader "OK-ACCESS-PASSPHRASE", sPass
.SetRequestHeader "OK-ACCESS-TIMESTAMP", sIso
.SetRequestHeader "OK-ACCESS-SIGN", sMes
'.SetRequestHeader "x-simulated-trading", "0"
Debug.Print "sApiKey1 ", sApiKey1
Debug.Print "sPass ", sPass
Debug.Print "sIso ", sIso
Debug.Print "sMes ", sMes
.Send
While objRequest.ReadyState <> 4
DoEvents
Wend
strResponse = .ResponseText
End With
Set objRequest = Nothing
Debug.Print strResponse
getServerVerif = strResponse
End Function
Function getSecretMes(sTime As String, sMode As String, sUrl As String, sBody As String) As String
getSecretMes = Base64_HMACSHA256(sTime & sMode & sUrl, sSign)
End Function
Sub asdf()
getSecret getServerTimeNano
End Sub
Public Function Base64_HMACSHA256(ByVal sTextToHash As String, ByVal sSharedSecretKey As String)
Dim asc As Object, enc As Object
Dim TextToHash() As Byte
Dim SharedSecretKey() As Byte
Set asc = CreateObject("System.Text.UTF8Encoding")
Set enc = CreateObject("System.Security.Cryptography.HMACSHA256")
TextToHash = asc.GetBytes_4(sTextToHash) '"59CD46C1244645E4BAA79C2C5354E4E7"
SharedSecretKey = asc.GetBytes_4(sSharedSecretKey) '"2021-06-16T16:04:37.916ZGET/api/spot/v5/accounts"
enc.Key = SharedSecretKey 'H1Nq0n1nSlrMyW5ZqCsGp0XSjwQQYTrqYy3UZtBwNj0=
Dim bytes() As Byte
bytes = enc.ComputeHash_2((TextToHash))
Base64_HMACSHA256 = EncodeBase64(bytes)
Set asc = Nothing
Set enc = Nothing
End Function
Private Function EncodeBase64(ByRef arrData() As Byte) As String
'Inside the VBE, Go to Tools -> References, then Select Microsoft XML, v6.0
'(or whatever your latest is. This will give you access to the XML Object Library.)
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