Attribute VB_Name = "Bittrex_connect"
Option Compare Database
Option Explicit

Public Const BITTREX_API_KEY As String = "0e2f0e5d6b1f4993ba6b4c208affd4fb"
Public Const BITTREX_API_SECRET As String = "a865d2eebe944b398f0cd3d4b6d2240a"
Public Const BITTREX_API_PREFIX As String = "https://bittrex.com/api/v1.1/"

Sub test()
    
    Dim j As String
    j = sendCommand("account/getbalance?currency=USDT")
    
    Debug.Print j
    Debug.Print getSuccess(j)
    Debug.Print getResult(j, "Available")
    
End Sub

Public Function getResult(jsonString As String, key As String) As String
    
    Dim json As Object
    Dim result As Object
    
    Set json = jsonParse(jsonString)
    Set result = CallByName(json, "result", VbGet)
    getResult = CallByName(result, key, VbGet)
    
End Function

Public Function getSuccess(jsonString As String) As Boolean
    
    Dim json As Object
    
    Set json = jsonParse(jsonString)
    getSuccess = CBool(CallByName(json, "success", VbGet))
    
End Function

Public Function jsonParse(strJSON As String) As Object
    
    On Error Resume Next
    
    Dim objSC      As Object
    Dim strFunc As String
     
    Set objSC = CreateObject("ScriptControl")
     
    objSC.Language = "JScript"
    strFunc = "function jsonParse(s) { return eval('(' + s + ')'); }"
    objSC.AddCode strFunc
    
    Set jsonParse = objSC.CodeObject.jsonParse(strJSON)
    
End Function

Public Function sendCommand(command As String) As String
    
    On Error GoTo Err_sendCommand
    
    Dim uri As String
    Dim con As String
    
    con = IIf(InStr(command, "?") > 0, "&", "?")
    
    uri = BITTREX_API_PREFIX & command & con & "apikey=" & BITTREX_API_KEY & "&nonce=" & CDbl(Now())
    
    Dim oXmlHttp As Object
    Set oXmlHttp = CreateObject("MSXML2.XMLHTTP")
    
    oXmlHttp.Open "POST", uri, False
    oXmlHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    oXmlHttp.setRequestHeader "apisign", hashHmacSHA512(uri, BITTREX_API_SECRET)
    oXmlHttp.send (uri)
    
    sendCommand = oXmlHttp.responseText
    
    Exit Function
    
Err_sendCommand:
    
    sendCommand = "False"
    
End Function

Private Function hashHmacSHA512(uri As String, apikey As String)
    
    Dim keyArray(64) As Byte
    Dim i As Long
    Dim text As Object
    Dim SHA512 As Object
    Dim xml As Object
    
    On Error Resume Next
    For i = 0 To 63
        keyArray(i) = Asc(Mid(apikey, i + 1, 1))
    Next
    On Error GoTo 0
    
    Set text = CreateObject("System.Text.UTF8Encoding")
    Set SHA512 = CreateObject("System.Security.Cryptography.HMACSHA512")
    Set xml = CreateObject("MSXML2.DOMDocument")
    
    SHA512.key = keyArray()
    xml.loadXML "<root />"
    xml.DocumentElement.DataType = "bin.Hex"
    xml.DocumentElement.nodeTypedValue = SHA512.ComputeHash_2((text.GetBytes_4(uri)))
    hashHmacSHA512 = Replace(xml.DocumentElement.text, vbLf, "")
    
End Function