Авторизация на CRYPTSY и BTC-E (Private API) с использованием EXCEL VBA

Нашел решение для авторизации на CRYPTSY, которое с небольшой модификацией подходит и для BTC-E. Всё просто и без «левых» библиотек.

Пример применения:

Sub jGetCurMarketTrades(MTId) '//"markettrades"
Dim dPar As New Dictionary: dPar.Add "marketid", MTId
Dim o As New jCRYPTSYRequest: o.MakeReaquest "markettrades", dPar
Dim R As String: R = o.Rezult
'PARSE JSON STRING R
Set dPar = Nothing: Set o = Nothing
End Sub

Модуль класса (пусть называется jCRYPTSYRequest):

Sub MakeReaquest(ApiMethod As String, Optional dPar As Dictionary)
Dim meth: meth = ApiMethod 'method
Dim key: key = ApiKey ' your API-key
Dim secret: secret = SecretApiKey 'your Secret-key
Dim BaseURL: BaseURL = "https://api.cryptsy.com/api" 'API URL

Dim objXMLRequest As Object: Set objXMLRequest = CreateObject("MSXML2.XMLHTTP.3.0")
Call objXMLRequest.Open("POST", BaseURL, False)
Call objXMLRequest.setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
objXMLRequest.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 6.1; Windows NT 6.0)"
objXMLRequest.setRequestHeader "Key", key

Dim post_data, mt: mt = "" & DateDiff("s", "1/1/1970", Now) 'nonce
If dPar Is Nothing Then
post_data = "method=" & meth & "&" & "nonce=" & mt
Else
Dim ks, ms, k, i: ks = dPar.keys: ms = dPar.Items: k = dPar.Count - 1
post_data = "method=" & meth
For i = 0 To k
post_data = post_data & "&" & ks(i) & "=" & ms(i)
Next
mt = "" & DateDiff("s", "1/1/1970", Now)
post_data = post_data & "&" & "nonce=" & mt
End If
Dim sign: sign = HexHash512(post_data, secret)
objXMLRequest.setRequestHeader "Sign", sign
Call objXMLRequest.send(post_data)
RT = objXMLRequest.responseText
Set objXMLRequest = Nothing
End Sub

Public Property Get Rezult()
Rezult = RT
End Property

Private Function HexHash512(postData, secret)
Dim cBytes, CBS As Integer, i As Integer: cBytes = cHash512(postData, secret)
HexHash512 = "": CBS = LenB(cBytes)
For i = 1 To CBS
HexHash512 = HexHash512 & LCase(Right("0" & Hex(AscB(MidB(cBytes, i, 1))), 2))
Next
End Function
Private Function cHash512(postData, secret) As Byte()
Dim SHA As Object, BKey() As Byte, BTxt() As Byte
BKey = StrConv(secret, vbFromUnicode): BTxt = StrConv(postData, vbFromUnicode)
Set SHA = CreateObject("System.Security.Cryptography.HMACSHA512")
If secret <> "" Then
SHA.key = BKey
Else
End If
cHash512 = SHA.computeHash_2(BTxt)
Set SHA = Nothing
End Function