Showing preview only (305K chars total). Download the full file or copy to clipboard to get everything.
Repository: krijnsent/crypto_vba
Branch: master
Commit: e74ccd9b95ab
Files: 34
Total size: 293.1 KB
Directory structure:
gitextract__zi_j_oj/
├── .gitignore
├── ImmediateReporter.cls
├── JsonConverter.bas
├── LICENSE
├── ModExchBinance.bas
├── ModExchBitVavo.bas
├── ModExchBitfinex.bas
├── ModExchBitmex.bas
├── ModExchBitstamp.bas
├── ModExchBittrex.bas
├── ModExchBybit.bas
├── ModExchCoinbase.bas
├── ModExchCoinbasePro.bas
├── ModExchCoinone.bas
├── ModExchCoinspot.bas
├── ModExchHitBTC.bas
├── ModExchHuobi.bas
├── ModExchIDEX.bas
├── ModExchKraken.bas
├── ModExchKucoin.bas
├── ModExchOKEx.bas
├── ModExchPoloniex.bas
├── ModFunctions.bas
├── ModHash.bas
├── ModJSON.bas
├── ModSrcCoinGecko.bas
├── ModSrcCryptocompare.bas
├── ModWeb.bas
├── TestCase.cls
├── TestSuite.cls
├── WorkbookReporter.cls
├── _config.yml
├── crypto_vba_example.xlsm
└── readme.md
================================================
FILE CONTENTS
================================================
================================================
FILE: .gitignore
================================================
~$crypto_vba_example.xlsm
crypto_vba_example_dev.xlsm
================================================
FILE: ImmediateReporter.cls
================================================
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "ImmediateReporter"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
''
' ImmediateReporter v2.0.0-beta.3
' (c) Tim Hall - https://github.com/VBA-tools/VBA-TDD
'
' Report results to Immediate Window
'
' @class ImmediateReporter
' @author tim.hall.engr@gmail.com
' @license MIT (https://opensource.org/licenses/MIT)
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
Option Explicit
' --------------------------------------------- '
' Constants and Private Variables
' --------------------------------------------- '
Private WithEvents pSuite As TestSuite
Attribute pSuite.VB_VarHelpID = -1
Private Finished As Boolean
' ============================================= '
' Public Methods
' ============================================= '
''
' Listen to given TestSuite
'
' @method ListenTo
' @param {TestSuite} Suite
''
Public Sub ListenTo(Suite As TestSuite)
If Not pSuite Is Nothing Then
Done
End If
Debug.Print "===" & IIf(Suite.Description <> "", " " & Suite.Description & " ===", "")
Set pSuite = Suite
Finished = False
End Sub
''
' Finish report for SpecSuite
'
' @method Done
''
Public Function Done()
Finished = True
Debug.Print "= " & Summary & " = " & Now & " =" & vbNewLine
End Function
' ============================================= '
' Private Functions
' ============================================= '
Private Function ResultTypeToString(ResultType As TestResultType) As String
Select Case ResultType
Case TestResultType.Pass
ResultTypeToString = "+"
Case TestResultType.Fail
ResultTypeToString = "X"
Case TestResultType.Pending
ResultTypeToString = "."
End Select
End Function
Private Function Summary() As String
Dim total As Long
Dim Passed As Long
Dim Failed As Long
Dim Pending As Long
Dim Skipped As Long
total = pSuite.Tests.Count
Passed = pSuite.PassedTests.Count
Failed = pSuite.FailedTests.Count
Pending = pSuite.PendingTests.Count
Skipped = pSuite.SkippedTests.Count
Dim SummaryMessage As String
If Failed > 0 Then
SummaryMessage = "FAIL (" & Failed & " of " & total & " failed"
Else
SummaryMessage = "PASS (" & Passed & " of " & total & " passed"
End If
If Pending > 0 Then
SummaryMessage = SummaryMessage & ", " & Pending & " pending"
End If
If Skipped > 0 Then
SummaryMessage = SummaryMessage & ", " & Skipped & " skipped)"
Else
SummaryMessage = SummaryMessage & ")"
End If
Summary = SummaryMessage
End Function
Private Sub pSuite_Result(Test As TestCase)
If Test.Result = TestResultType.Skipped Then
Exit Sub
End If
Debug.Print ResultTypeToString(Test.Result) & " " & Test.Name
If Test.Result = TestResultType.Fail Then
Dim Failure As Variant
For Each Failure In Test.Failures
Debug.Print " " & Failure
Next Failure
End If
End Sub
Private Sub Class_Terminate()
If Not Finished Then
Done
End If
End Sub
================================================
FILE: JsonConverter.bas
================================================
Attribute VB_Name = "JsonConverter"
'Attribute VB_Name = "JsonConverter"
''
' VBA-JSON v2.3.1
' (c) Tim Hall - https://github.com/VBA-tools/VBA-JSON
'
' JSON Converter for VBA
'
' Errors:
' 10001 - JSON parse error
'
' @class JsonConverter
' @author tim.hall.engr@gmail.com
' @license MIT (http://www.opensource.org/licenses/mit-license.php)
'' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
'
' Based originally on vba-json (with extensive changes)
' BSD license included below
'
' JSONLib, http://code.google.com/p/vba-json/
'
' Copyright (c) 2013, Ryo Yokoyama
' All rights reserved.
'
' Redistribution and use in source and binary forms, with or without
' modification, are permitted provided that the following conditions are met:
' * Redistributions of source code must retain the above copyright
' notice, this list of conditions and the following disclaimer.
' * Redistributions in binary form must reproduce the above copyright
' notice, this list of conditions and the following disclaimer in the
' documentation and/or other materials provided with the distribution.
' * Neither the name of the <organization> nor the
' names of its contributors may be used to endorse or promote products
' derived from this software without specific prior written permission.
'
' THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
' ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
' WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
' DISCLAIMED. IN NO EVENT SHALL <COPYRIGHT HOLDER> BE LIABLE FOR ANY
' DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
' (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
' LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
' ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
' (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
' SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
Option Explicit
' === VBA-UTC Headers
#If Mac Then
#If VBA7 Then
' 64-bit Mac (2016)
Private Declare PtrSafe Function utc_popen Lib "/usr/lib/libc.dylib" Alias "popen" _
(ByVal utc_Command As String, ByVal utc_Mode As String) As LongPtr
Private Declare PtrSafe Function utc_pclose Lib "/usr/lib/libc.dylib" Alias "pclose" _
(ByVal utc_File As LongPtr) As LongPtr
Private Declare PtrSafe Function utc_fread Lib "/usr/lib/libc.dylib" Alias "fread" _
(ByVal utc_Buffer As String, ByVal utc_Size As LongPtr, ByVal utc_Number As LongPtr, ByVal utc_File As LongPtr) As LongPtr
Private Declare PtrSafe Function utc_feof Lib "/usr/lib/libc.dylib" Alias "feof" _
(ByVal utc_File As LongPtr) As LongPtr
#Else
' 32-bit Mac
Private Declare Function utc_popen Lib "libc.dylib" Alias "popen" _
(ByVal utc_Command As String, ByVal utc_Mode As String) As Long
Private Declare Function utc_pclose Lib "libc.dylib" Alias "pclose" _
(ByVal utc_File As Long) As Long
Private Declare Function utc_fread Lib "libc.dylib" Alias "fread" _
(ByVal utc_Buffer As String, ByVal utc_Size As Long, ByVal utc_Number As Long, ByVal utc_File As Long) As Long
Private Declare Function utc_feof Lib "libc.dylib" Alias "feof" _
(ByVal utc_File As Long) As Long
#End If
#ElseIf VBA7 Then
' http://msdn.microsoft.com/en-us/library/windows/desktop/ms724421.aspx
' http://msdn.microsoft.com/en-us/library/windows/desktop/ms724949.aspx
' http://msdn.microsoft.com/en-us/library/windows/desktop/ms725485.aspx
Private Declare PtrSafe Function utc_GetTimeZoneInformation Lib "kernel32" Alias "GetTimeZoneInformation" _
(utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION) As Long
Private Declare PtrSafe Function utc_SystemTimeToTzSpecificLocalTime Lib "kernel32" Alias "SystemTimeToTzSpecificLocalTime" _
(utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION, utc_lpUniversalTime As utc_SYSTEMTIME, utc_lpLocalTime As utc_SYSTEMTIME) As Long
Private Declare PtrSafe Function utc_TzSpecificLocalTimeToSystemTime Lib "kernel32" Alias "TzSpecificLocalTimeToSystemTime" _
(utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION, utc_lpLocalTime As utc_SYSTEMTIME, utc_lpUniversalTime As utc_SYSTEMTIME) As Long
#Else
Private Declare Function utc_GetTimeZoneInformation Lib "kernel32" Alias "GetTimeZoneInformation" _
(utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION) As Long
Private Declare Function utc_SystemTimeToTzSpecificLocalTime Lib "kernel32" Alias "SystemTimeToTzSpecificLocalTime" _
(utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION, utc_lpUniversalTime As utc_SYSTEMTIME, utc_lpLocalTime As utc_SYSTEMTIME) As Long
Private Declare Function utc_TzSpecificLocalTimeToSystemTime Lib "kernel32" Alias "TzSpecificLocalTimeToSystemTime" _
(utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION, utc_lpLocalTime As utc_SYSTEMTIME, utc_lpUniversalTime As utc_SYSTEMTIME) As Long
#End If
#If Mac Then
#If VBA7 Then
Private Type utc_ShellResult
utc_Output As String
utc_ExitCode As LongPtr
End Type
#Else
Private Type utc_ShellResult
utc_Output As String
utc_ExitCode As Long
End Type
#End If
#Else
Private Type utc_SYSTEMTIME
utc_wYear As Integer
utc_wMonth As Integer
utc_wDayOfWeek As Integer
utc_wDay As Integer
utc_wHour As Integer
utc_wMinute As Integer
utc_wSecond As Integer
utc_wMilliseconds As Integer
End Type
Private Type utc_TIME_ZONE_INFORMATION
utc_Bias As Long
utc_StandardName(0 To 31) As Integer
utc_StandardDate As utc_SYSTEMTIME
utc_StandardBias As Long
utc_DaylightName(0 To 31) As Integer
utc_DaylightDate As utc_SYSTEMTIME
utc_DaylightBias As Long
End Type
#End If
' === End VBA-UTC
Private Type json_Options
' VBA only stores 15 significant digits, so any numbers larger than that are truncated
' This can lead to issues when BIGINT's are used (e.g. for Ids or Credit Cards), as they will be invalid above 15 digits
' See: http://support.microsoft.com/kb/269370
'
' By default, VBA-JSON will use String for numbers longer than 15 characters that contain only digits
' to override set `JsonConverter.JsonOptions.UseDoubleForLargeNumbers = True`
UseDoubleForLargeNumbers As Boolean
' The JSON standard requires object keys to be quoted (" or '), use this option to allow unquoted keys
AllowUnquotedKeys As Boolean
' The solidus (/) is not required to be escaped, use this option to escape them as \/ in ConvertToJson
EscapeSolidus As Boolean
End Type
Public JsonOptions As json_Options
' ============================================= '
' Public Methods
' ============================================= '
''
' Convert JSON string to object (Dictionary/Collection)
'
' @method ParseJson
' @param {String} json_String
' @return {Object} (Dictionary or Collection)
' @throws 10001 - JSON parse error
''
Public Function ParseJson(ByVal JsonString As String) As Object
Dim json_Index As Long
json_Index = 1
' Remove vbCr, vbLf, and vbTab from json_String
JsonString = VBA.Replace(VBA.Replace(VBA.Replace(JsonString, VBA.vbCr, ""), VBA.vbLf, ""), VBA.vbTab, "")
json_SkipSpaces JsonString, json_Index
Select Case VBA.Mid$(JsonString, json_Index, 1)
Case "{"
Set ParseJson = json_ParseObject(JsonString, json_Index)
Case "["
Set ParseJson = json_ParseArray(JsonString, json_Index)
Case Else
' Error: Invalid JSON string
Err.Raise 10001, "JSONConverter", json_ParseErrorMessage(JsonString, json_Index, "Expecting '{' or '['")
End Select
End Function
''
' Convert object (Dictionary/Collection/Array) to JSON
'
' @method ConvertToJson
' @param {Variant} JsonValue (Dictionary, Collection, or Array)
' @param {Integer|String} Whitespace "Pretty" print json with given number of spaces per indentation (Integer) or given string
' @return {String}
''
Public Function ConvertToJson(ByVal JsonValue As Variant, Optional ByVal Whitespace As Variant, Optional ByVal json_CurrentIndentation As Long = 0) As String
Dim json_Buffer As String
Dim json_BufferPosition As Long
Dim json_BufferLength As Long
Dim json_Index As Long
Dim json_LBound As Long
Dim json_UBound As Long
Dim json_IsFirstItem As Boolean
Dim json_Index2D As Long
Dim json_LBound2D As Long
Dim json_UBound2D As Long
Dim json_IsFirstItem2D As Boolean
Dim json_Key As Variant
Dim json_Value As Variant
Dim json_DateStr As String
Dim json_Converted As String
Dim json_SkipItem As Boolean
Dim json_PrettyPrint As Boolean
Dim json_Indentation As String
Dim json_InnerIndentation As String
json_LBound = -1
json_UBound = -1
json_IsFirstItem = True
json_LBound2D = -1
json_UBound2D = -1
json_IsFirstItem2D = True
json_PrettyPrint = Not IsMissing(Whitespace)
Select Case VBA.VarType(JsonValue)
Case VBA.vbNull
ConvertToJson = "null"
Case VBA.vbDate
' Date
json_DateStr = ConvertToIso(VBA.CDate(JsonValue))
ConvertToJson = """" & json_DateStr & """"
Case VBA.vbString
' String (or large number encoded as string)
If Not JsonOptions.UseDoubleForLargeNumbers And json_StringIsLargeNumber(JsonValue) Then
ConvertToJson = JsonValue
Else
ConvertToJson = """" & json_Encode(JsonValue) & """"
End If
Case VBA.vbBoolean
If JsonValue Then
ConvertToJson = "true"
Else
ConvertToJson = "false"
End If
Case VBA.vbArray To VBA.vbArray + VBA.vbByte
If json_PrettyPrint Then
If VBA.VarType(Whitespace) = VBA.vbString Then
json_Indentation = VBA.String$(json_CurrentIndentation + 1, Whitespace)
json_InnerIndentation = VBA.String$(json_CurrentIndentation + 2, Whitespace)
Else
json_Indentation = VBA.Space$((json_CurrentIndentation + 1) * Whitespace)
json_InnerIndentation = VBA.Space$((json_CurrentIndentation + 2) * Whitespace)
End If
End If
' Array
json_BufferAppend json_Buffer, "[", json_BufferPosition, json_BufferLength
On Error Resume Next
json_LBound = LBound(JsonValue, 1)
json_UBound = UBound(JsonValue, 1)
json_LBound2D = LBound(JsonValue, 2)
json_UBound2D = UBound(JsonValue, 2)
If json_LBound >= 0 And json_UBound >= 0 Then
For json_Index = json_LBound To json_UBound
If json_IsFirstItem Then
json_IsFirstItem = False
Else
' Append comma to previous line
json_BufferAppend json_Buffer, ",", json_BufferPosition, json_BufferLength
End If
If json_LBound2D >= 0 And json_UBound2D >= 0 Then
' 2D Array
If json_PrettyPrint Then
json_BufferAppend json_Buffer, vbNewLine, json_BufferPosition, json_BufferLength
End If
json_BufferAppend json_Buffer, json_Indentation & "[", json_BufferPosition, json_BufferLength
For json_Index2D = json_LBound2D To json_UBound2D
If json_IsFirstItem2D Then
json_IsFirstItem2D = False
Else
json_BufferAppend json_Buffer, ",", json_BufferPosition, json_BufferLength
End If
json_Converted = ConvertToJson(JsonValue(json_Index, json_Index2D), Whitespace, json_CurrentIndentation + 2)
' For Arrays/Collections, undefined (Empty/Nothing) is treated as null
If json_Converted = "" Then
' (nest to only check if converted = "")
If json_IsUndefined(JsonValue(json_Index, json_Index2D)) Then
json_Converted = "null"
End If
End If
If json_PrettyPrint Then
json_Converted = vbNewLine & json_InnerIndentation & json_Converted
End If
json_BufferAppend json_Buffer, json_Converted, json_BufferPosition, json_BufferLength
Next json_Index2D
If json_PrettyPrint Then
json_BufferAppend json_Buffer, vbNewLine, json_BufferPosition, json_BufferLength
End If
json_BufferAppend json_Buffer, json_Indentation & "]", json_BufferPosition, json_BufferLength
json_IsFirstItem2D = True
Else
' 1D Array
json_Converted = ConvertToJson(JsonValue(json_Index), Whitespace, json_CurrentIndentation + 1)
' For Arrays/Collections, undefined (Empty/Nothing) is treated as null
If json_Converted = "" Then
' (nest to only check if converted = "")
If json_IsUndefined(JsonValue(json_Index)) Then
json_Converted = "null"
End If
End If
If json_PrettyPrint Then
json_Converted = vbNewLine & json_Indentation & json_Converted
End If
json_BufferAppend json_Buffer, json_Converted, json_BufferPosition, json_BufferLength
End If
Next json_Index
End If
On Error GoTo 0
If json_PrettyPrint Then
json_BufferAppend json_Buffer, vbNewLine, json_BufferPosition, json_BufferLength
If VBA.VarType(Whitespace) = VBA.vbString Then
json_Indentation = VBA.String$(json_CurrentIndentation, Whitespace)
Else
json_Indentation = VBA.Space$(json_CurrentIndentation * Whitespace)
End If
End If
json_BufferAppend json_Buffer, json_Indentation & "]", json_BufferPosition, json_BufferLength
ConvertToJson = json_BufferToString(json_Buffer, json_BufferPosition)
' Dictionary or Collection
Case VBA.vbObject
If json_PrettyPrint Then
If VBA.VarType(Whitespace) = VBA.vbString Then
json_Indentation = VBA.String$(json_CurrentIndentation + 1, Whitespace)
Else
json_Indentation = VBA.Space$((json_CurrentIndentation + 1) * Whitespace)
End If
End If
' Dictionary
If VBA.TypeName(JsonValue) = "Dictionary" Then
json_BufferAppend json_Buffer, "{", json_BufferPosition, json_BufferLength
For Each json_Key In JsonValue.Keys
' For Objects, undefined (Empty/Nothing) is not added to object
json_Converted = ConvertToJson(JsonValue(json_Key), Whitespace, json_CurrentIndentation + 1)
If json_Converted = "" Then
json_SkipItem = json_IsUndefined(JsonValue(json_Key))
Else
json_SkipItem = False
End If
If Not json_SkipItem Then
If json_IsFirstItem Then
json_IsFirstItem = False
Else
json_BufferAppend json_Buffer, ",", json_BufferPosition, json_BufferLength
End If
If json_PrettyPrint Then
json_Converted = vbNewLine & json_Indentation & """" & json_Key & """: " & json_Converted
Else
json_Converted = """" & json_Key & """:" & json_Converted
End If
json_BufferAppend json_Buffer, json_Converted, json_BufferPosition, json_BufferLength
End If
Next json_Key
If json_PrettyPrint Then
json_BufferAppend json_Buffer, vbNewLine, json_BufferPosition, json_BufferLength
If VBA.VarType(Whitespace) = VBA.vbString Then
json_Indentation = VBA.String$(json_CurrentIndentation, Whitespace)
Else
json_Indentation = VBA.Space$(json_CurrentIndentation * Whitespace)
End If
End If
json_BufferAppend json_Buffer, json_Indentation & "}", json_BufferPosition, json_BufferLength
' Collection
ElseIf VBA.TypeName(JsonValue) = "Collection" Then
json_BufferAppend json_Buffer, "[", json_BufferPosition, json_BufferLength
For Each json_Value In JsonValue
If json_IsFirstItem Then
json_IsFirstItem = False
Else
json_BufferAppend json_Buffer, ",", json_BufferPosition, json_BufferLength
End If
json_Converted = ConvertToJson(json_Value, Whitespace, json_CurrentIndentation + 1)
' For Arrays/Collections, undefined (Empty/Nothing) is treated as null
If json_Converted = "" Then
' (nest to only check if converted = "")
If json_IsUndefined(json_Value) Then
json_Converted = "null"
End If
End If
If json_PrettyPrint Then
json_Converted = vbNewLine & json_Indentation & json_Converted
End If
json_BufferAppend json_Buffer, json_Converted, json_BufferPosition, json_BufferLength
Next json_Value
If json_PrettyPrint Then
json_BufferAppend json_Buffer, vbNewLine, json_BufferPosition, json_BufferLength
If VBA.VarType(Whitespace) = VBA.vbString Then
json_Indentation = VBA.String$(json_CurrentIndentation, Whitespace)
Else
json_Indentation = VBA.Space$(json_CurrentIndentation * Whitespace)
End If
End If
json_BufferAppend json_Buffer, json_Indentation & "]", json_BufferPosition, json_BufferLength
End If
ConvertToJson = json_BufferToString(json_Buffer, json_BufferPosition)
Case VBA.vbInteger, VBA.vbLong, VBA.vbSingle, VBA.vbDouble, VBA.vbCurrency, VBA.vbDecimal
' Number (use decimals for numbers)
ConvertToJson = VBA.Replace(JsonValue, ",", ".")
Case Else
' vbEmpty, vbError, vbDataObject, vbByte, vbUserDefinedType
' Use VBA's built-in to-string
On Error Resume Next
ConvertToJson = JsonValue
On Error GoTo 0
End Select
End Function
' ============================================= '
' Private Functions
' ============================================= '
Private Function json_ParseObject(json_String As String, ByRef json_Index As Long) As Dictionary
Dim json_Key As String
Dim json_NextChar As String
Set json_ParseObject = New Dictionary
json_SkipSpaces json_String, json_Index
If VBA.Mid$(json_String, json_Index, 1) <> "{" Then
Err.Raise 10001, "JSONConverter", json_ParseErrorMessage(json_String, json_Index, "Expecting '{'")
Else
json_Index = json_Index + 1
Do
json_SkipSpaces json_String, json_Index
If VBA.Mid$(json_String, json_Index, 1) = "}" Then
json_Index = json_Index + 1
Exit Function
ElseIf VBA.Mid$(json_String, json_Index, 1) = "," Then
json_Index = json_Index + 1
json_SkipSpaces json_String, json_Index
End If
json_Key = json_ParseKey(json_String, json_Index)
json_NextChar = json_Peek(json_String, json_Index)
If json_NextChar = "[" Or json_NextChar = "{" Then
Set json_ParseObject.Item(json_Key) = json_ParseValue(json_String, json_Index)
Else
json_ParseObject.Item(json_Key) = json_ParseValue(json_String, json_Index)
End If
Loop
End If
End Function
Private Function json_ParseArray(json_String As String, ByRef json_Index As Long) As Collection
Set json_ParseArray = New Collection
json_SkipSpaces json_String, json_Index
If VBA.Mid$(json_String, json_Index, 1) <> "[" Then
Err.Raise 10001, "JSONConverter", json_ParseErrorMessage(json_String, json_Index, "Expecting '['")
Else
json_Index = json_Index + 1
Do
json_SkipSpaces json_String, json_Index
If VBA.Mid$(json_String, json_Index, 1) = "]" Then
json_Index = json_Index + 1
Exit Function
ElseIf VBA.Mid$(json_String, json_Index, 1) = "," Then
json_Index = json_Index + 1
json_SkipSpaces json_String, json_Index
End If
json_ParseArray.Add json_ParseValue(json_String, json_Index)
Loop
End If
End Function
Private Function json_ParseValue(json_String As String, ByRef json_Index As Long) As Variant
json_SkipSpaces json_String, json_Index
Select Case VBA.Mid$(json_String, json_Index, 1)
Case "{"
Set json_ParseValue = json_ParseObject(json_String, json_Index)
Case "["
Set json_ParseValue = json_ParseArray(json_String, json_Index)
Case """", "'"
json_ParseValue = json_ParseString(json_String, json_Index)
Case Else
If VBA.Mid$(json_String, json_Index, 4) = "true" Then
json_ParseValue = True
json_Index = json_Index + 4
ElseIf VBA.Mid$(json_String, json_Index, 5) = "false" Then
json_ParseValue = False
json_Index = json_Index + 5
ElseIf VBA.Mid$(json_String, json_Index, 4) = "null" Then
json_ParseValue = Null
json_Index = json_Index + 4
ElseIf VBA.InStr("+-0123456789", VBA.Mid$(json_String, json_Index, 1)) Then
json_ParseValue = json_ParseNumber(json_String, json_Index)
Else
Err.Raise 10001, "JSONConverter", json_ParseErrorMessage(json_String, json_Index, "Expecting 'STRING', 'NUMBER', null, true, false, '{', or '['")
End If
End Select
End Function
Private Function json_ParseString(json_String As String, ByRef json_Index As Long) As String
Dim json_Quote As String
Dim json_Char As String
Dim json_Code As String
Dim json_Buffer As String
Dim json_BufferPosition As Long
Dim json_BufferLength As Long
json_SkipSpaces json_String, json_Index
' Store opening quote to look for matching closing quote
json_Quote = VBA.Mid$(json_String, json_Index, 1)
json_Index = json_Index + 1
Do While json_Index > 0 And json_Index <= Len(json_String)
json_Char = VBA.Mid$(json_String, json_Index, 1)
Select Case json_Char
Case "\"
' Escaped string, \\, or \/
json_Index = json_Index + 1
json_Char = VBA.Mid$(json_String, json_Index, 1)
Select Case json_Char
Case """", "\", "/", "'"
json_BufferAppend json_Buffer, json_Char, json_BufferPosition, json_BufferLength
json_Index = json_Index + 1
Case "b"
json_BufferAppend json_Buffer, vbBack, json_BufferPosition, json_BufferLength
json_Index = json_Index + 1
Case "f"
json_BufferAppend json_Buffer, vbFormFeed, json_BufferPosition, json_BufferLength
json_Index = json_Index + 1
Case "n"
json_BufferAppend json_Buffer, vbCrLf, json_BufferPosition, json_BufferLength
json_Index = json_Index + 1
Case "r"
json_BufferAppend json_Buffer, vbCr, json_BufferPosition, json_BufferLength
json_Index = json_Index + 1
Case "t"
json_BufferAppend json_Buffer, vbTab, json_BufferPosition, json_BufferLength
json_Index = json_Index + 1
Case "u"
' Unicode character escape (e.g. \u00a9 = Copyright)
json_Index = json_Index + 1
json_Code = VBA.Mid$(json_String, json_Index, 4)
json_BufferAppend json_Buffer, VBA.ChrW(VBA.Val("&h" + json_Code)), json_BufferPosition, json_BufferLength
json_Index = json_Index + 4
End Select
Case json_Quote
json_ParseString = json_BufferToString(json_Buffer, json_BufferPosition)
json_Index = json_Index + 1
Exit Function
Case Else
json_BufferAppend json_Buffer, json_Char, json_BufferPosition, json_BufferLength
json_Index = json_Index + 1
End Select
Loop
End Function
Private Function json_ParseNumber(json_String As String, ByRef json_Index As Long) As Variant
Dim json_Char As String
Dim json_Value As String
Dim json_IsLargeNumber As Boolean
json_SkipSpaces json_String, json_Index
Do While json_Index > 0 And json_Index <= Len(json_String)
json_Char = VBA.Mid$(json_String, json_Index, 1)
If VBA.InStr("+-0123456789.eE", json_Char) Then
' Unlikely to have massive number, so use simple append rather than buffer here
json_Value = json_Value & json_Char
json_Index = json_Index + 1
Else
' Excel only stores 15 significant digits, so any numbers larger than that are truncated
' This can lead to issues when BIGINT's are used (e.g. for Ids or Credit Cards), as they will be invalid above 15 digits
' See: http://support.microsoft.com/kb/269370
'
' Fix: Parse -> String, Convert -> String longer than 15/16 characters containing only numbers and decimal points -> Number
' (decimal doesn't factor into significant digit count, so if present check for 15 digits + decimal = 16)
json_IsLargeNumber = IIf(InStr(json_Value, "."), Len(json_Value) >= 17, Len(json_Value) >= 16)
If Not JsonOptions.UseDoubleForLargeNumbers And json_IsLargeNumber Then
json_ParseNumber = json_Value
Else
' VBA.Val does not use regional settings, so guard for comma is not needed
json_ParseNumber = VBA.Val(json_Value)
End If
Exit Function
End If
Loop
End Function
Private Function json_ParseKey(json_String As String, ByRef json_Index As Long) As String
' Parse key with single or double quotes
If VBA.Mid$(json_String, json_Index, 1) = """" Or VBA.Mid$(json_String, json_Index, 1) = "'" Then
json_ParseKey = json_ParseString(json_String, json_Index)
ElseIf JsonOptions.AllowUnquotedKeys Then
Dim json_Char As String
Do While json_Index > 0 And json_Index <= Len(json_String)
json_Char = VBA.Mid$(json_String, json_Index, 1)
If (json_Char <> " ") And (json_Char <> ":") Then
json_ParseKey = json_ParseKey & json_Char
json_Index = json_Index + 1
Else
Exit Do
End If
Loop
Else
Err.Raise 10001, "JSONConverter", json_ParseErrorMessage(json_String, json_Index, "Expecting '""' or '''")
End If
' Check for colon and skip if present or throw if not present
json_SkipSpaces json_String, json_Index
If VBA.Mid$(json_String, json_Index, 1) <> ":" Then
Err.Raise 10001, "JSONConverter", json_ParseErrorMessage(json_String, json_Index, "Expecting ':'")
Else
json_Index = json_Index + 1
End If
End Function
Private Function json_IsUndefined(ByVal json_Value As Variant) As Boolean
' Empty / Nothing -> undefined
Select Case VBA.VarType(json_Value)
Case VBA.vbEmpty
json_IsUndefined = True
Case VBA.vbObject
Select Case VBA.TypeName(json_Value)
Case "Empty", "Nothing"
json_IsUndefined = True
End Select
End Select
End Function
Private Function json_Encode(ByVal json_Text As Variant) As String
' Reference: http://www.ietf.org/rfc/rfc4627.txt
' Escape: ", \, /, backspace, form feed, line feed, carriage return, tab
Dim json_Index As Long
Dim json_Char As String
Dim json_AscCode As Long
Dim json_Buffer As String
Dim json_BufferPosition As Long
Dim json_BufferLength As Long
For json_Index = 1 To VBA.Len(json_Text)
json_Char = VBA.Mid$(json_Text, json_Index, 1)
json_AscCode = VBA.AscW(json_Char)
' When AscW returns a negative number, it returns the twos complement form of that number.
' To convert the twos complement notation into normal binary notation, add 0xFFF to the return result.
' https://support.microsoft.com/en-us/kb/272138
If json_AscCode < 0 Then
json_AscCode = json_AscCode + 65536
End If
' From spec, ", \, and control characters must be escaped (solidus is optional)
Select Case json_AscCode
Case 34
' " -> 34 -> \"
json_Char = "\"""
Case 92
' \ -> 92 -> \\
json_Char = "\\"
Case 47
' / -> 47 -> \/ (optional)
If JsonOptions.EscapeSolidus Then
json_Char = "\/"
End If
Case 8
' backspace -> 8 -> \b
json_Char = "\b"
Case 12
' form feed -> 12 -> \f
json_Char = "\f"
Case 10
' line feed -> 10 -> \n
json_Char = "\n"
Case 13
' carriage return -> 13 -> \r
json_Char = "\r"
Case 9
' tab -> 9 -> \t
json_Char = "\t"
Case 0 To 31, 127 To 65535
' Non-ascii characters -> convert to 4-digit hex
json_Char = "\u" & VBA.Right$("0000" & VBA.Hex$(json_AscCode), 4)
End Select
json_BufferAppend json_Buffer, json_Char, json_BufferPosition, json_BufferLength
Next json_Index
json_Encode = json_BufferToString(json_Buffer, json_BufferPosition)
End Function
Private Function json_Peek(json_String As String, ByVal json_Index As Long, Optional json_NumberOfCharacters As Long = 1) As String
' "Peek" at the next number of characters without incrementing json_Index (ByVal instead of ByRef)
json_SkipSpaces json_String, json_Index
json_Peek = VBA.Mid$(json_String, json_Index, json_NumberOfCharacters)
End Function
Private Sub json_SkipSpaces(json_String As String, ByRef json_Index As Long)
' Increment index to skip over spaces
Do While json_Index > 0 And json_Index <= VBA.Len(json_String) And VBA.Mid$(json_String, json_Index, 1) = " "
json_Index = json_Index + 1
Loop
End Sub
Private Function json_StringIsLargeNumber(json_String As Variant) As Boolean
' Check if the given string is considered a "large number"
' (See json_ParseNumber)
Dim json_Length As Long
Dim json_CharIndex As Long
json_Length = VBA.Len(json_String)
' Length with be at least 16 characters and assume will be less than 100 characters
If json_Length >= 16 And json_Length <= 100 Then
Dim json_CharCode As String
json_StringIsLargeNumber = True
For json_CharIndex = 1 To json_Length
json_CharCode = VBA.Asc(VBA.Mid$(json_String, json_CharIndex, 1))
Select Case json_CharCode
' Look for .|0-9|E|e
Case 46, 48 To 57, 69, 101
' Continue through characters
Case Else
json_StringIsLargeNumber = False
Exit Function
End Select
Next json_CharIndex
End If
End Function
Private Function json_ParseErrorMessage(json_String As String, ByRef json_Index As Long, ErrorMessage As String)
' Provide detailed parse error message, including details of where and what occurred
'
' Example:
' Error parsing JSON:
' {"abcde":True}
' ^
' Expecting 'STRING', 'NUMBER', null, true, false, '{', or '['
Dim json_StartIndex As Long
Dim json_StopIndex As Long
' Include 10 characters before and after error (if possible)
json_StartIndex = json_Index - 10
json_StopIndex = json_Index + 10
If json_StartIndex <= 0 Then
json_StartIndex = 1
End If
If json_StopIndex > VBA.Len(json_String) Then
json_StopIndex = VBA.Len(json_String)
End If
json_ParseErrorMessage = "Error parsing JSON:" & VBA.vbNewLine & _
VBA.Mid$(json_String, json_StartIndex, json_StopIndex - json_StartIndex + 1) & VBA.vbNewLine & _
VBA.Space$(json_Index - json_StartIndex) & "^" & VBA.vbNewLine & _
ErrorMessage
End Function
Private Sub json_BufferAppend(ByRef json_Buffer As String, _
ByRef json_Append As Variant, _
ByRef json_BufferPosition As Long, _
ByRef json_BufferLength As Long)
' VBA can be slow to append strings due to allocating a new string for each append
' Instead of using the traditional append, allocate a large empty string and then copy string at append position
'
' Example:
' Buffer: "abc "
' Append: "def"
' Buffer Position: 3
' Buffer Length: 5
'
' Buffer position + Append length > Buffer length -> Append chunk of blank space to buffer
' Buffer: "abc "
' Buffer Length: 10
'
' Put "def" into buffer at position 3 (0-based)
' Buffer: "abcdef "
'
' Approach based on cStringBuilder from vbAccelerator
' http://www.vbaccelerator.com/home/VB/Code/Techniques/RunTime_Debug_Tracing/VB6_Tracer_Utility_zip_cStringBuilder_cls.asp
'
' and clsStringAppend from Philip Swannell
' https://github.com/VBA-tools/VBA-JSON/pull/82
Dim json_AppendLength As Long
Dim json_LengthPlusPosition As Long
json_AppendLength = VBA.Len(json_Append)
json_LengthPlusPosition = json_AppendLength + json_BufferPosition
If json_LengthPlusPosition > json_BufferLength Then
' Appending would overflow buffer, add chunk
' (double buffer length or append length, whichever is bigger)
Dim json_AddedLength As Long
json_AddedLength = IIf(json_AppendLength > json_BufferLength, json_AppendLength, json_BufferLength)
json_Buffer = json_Buffer & VBA.Space$(json_AddedLength)
json_BufferLength = json_BufferLength + json_AddedLength
End If
' Note: Namespacing with VBA.Mid$ doesn't work properly here, throwing compile error:
' Function call on left-hand side of assignment must return Variant or Object
Mid$(json_Buffer, json_BufferPosition + 1, json_AppendLength) = CStr(json_Append)
json_BufferPosition = json_BufferPosition + json_AppendLength
End Sub
Private Function json_BufferToString(ByRef json_Buffer As String, ByVal json_BufferPosition As Long) As String
If json_BufferPosition > 0 Then
json_BufferToString = VBA.Left$(json_Buffer, json_BufferPosition)
End If
End Function
''
' VBA-UTC v1.0.6
' (c) Tim Hall - https://github.com/VBA-tools/VBA-UtcConverter
'
' UTC/ISO 8601 Converter for VBA
'
' Errors:
' 10011 - UTC parsing error
' 10012 - UTC conversion error
' 10013 - ISO 8601 parsing error
' 10014 - ISO 8601 conversion error
'
' @module UtcConverter
' @author tim.hall.engr@gmail.com
' @license MIT (http://www.opensource.org/licenses/mit-license.php)
'' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
' (Declarations moved to top)
' ============================================= '
' Public Methods
' ============================================= '
''
' Parse UTC date to local date
'
' @method ParseUtc
' @param {Date} UtcDate
' @return {Date} Local date
' @throws 10011 - UTC parsing error
''
Public Function ParseUtc(utc_UtcDate As Date) As Date
On Error GoTo utc_ErrorHandling
#If Mac Then
ParseUtc = utc_ConvertDate(utc_UtcDate)
#Else
Dim utc_TimeZoneInfo As utc_TIME_ZONE_INFORMATION
Dim utc_LocalDate As utc_SYSTEMTIME
utc_GetTimeZoneInformation utc_TimeZoneInfo
utc_SystemTimeToTzSpecificLocalTime utc_TimeZoneInfo, utc_DateToSystemTime(utc_UtcDate), utc_LocalDate
ParseUtc = utc_SystemTimeToDate(utc_LocalDate)
#End If
Exit Function
utc_ErrorHandling:
Err.Raise 10011, "UtcConverter.ParseUtc", "UTC parsing error: " & Err.Number & " - " & Err.Description
End Function
''
' Convert local date to UTC date
'
' @method ConvertToUrc
' @param {Date} utc_LocalDate
' @return {Date} UTC date
' @throws 10012 - UTC conversion error
''
Public Function ConvertToUtc(utc_LocalDate As Date) As Date
On Error GoTo utc_ErrorHandling
#If Mac Then
ConvertToUtc = utc_ConvertDate(utc_LocalDate, utc_ConvertToUtc:=True)
#Else
Dim utc_TimeZoneInfo As utc_TIME_ZONE_INFORMATION
Dim utc_UtcDate As utc_SYSTEMTIME
utc_GetTimeZoneInformation utc_TimeZoneInfo
utc_TzSpecificLocalTimeToSystemTime utc_TimeZoneInfo, utc_DateToSystemTime(utc_LocalDate), utc_UtcDate
ConvertToUtc = utc_SystemTimeToDate(utc_UtcDate)
#End If
Exit Function
utc_ErrorHandling:
Err.Raise 10012, "UtcConverter.ConvertToUtc", "UTC conversion error: " & Err.Number & " - " & Err.Description
End Function
''
' Parse ISO 8601 date string to local date
'
' @method ParseIso
' @param {Date} utc_IsoString
' @return {Date} Local date
' @throws 10013 - ISO 8601 parsing error
''
Public Function ParseIso(utc_IsoString As String) As Date
On Error GoTo utc_ErrorHandling
Dim utc_Parts() As String
Dim utc_DateParts() As String
Dim utc_TimeParts() As String
Dim utc_OffsetIndex As Long
Dim utc_HasOffset As Boolean
Dim utc_NegativeOffset As Boolean
Dim utc_OffsetParts() As String
Dim utc_Offset As Date
utc_Parts = VBA.Split(utc_IsoString, "T")
utc_DateParts = VBA.Split(utc_Parts(0), "-")
ParseIso = VBA.DateSerial(VBA.CInt(utc_DateParts(0)), VBA.CInt(utc_DateParts(1)), VBA.CInt(utc_DateParts(2)))
If UBound(utc_Parts) > 0 Then
If VBA.InStr(utc_Parts(1), "Z") Then
utc_TimeParts = VBA.Split(VBA.Replace(utc_Parts(1), "Z", ""), ":")
Else
utc_OffsetIndex = VBA.InStr(1, utc_Parts(1), "+")
If utc_OffsetIndex = 0 Then
utc_NegativeOffset = True
utc_OffsetIndex = VBA.InStr(1, utc_Parts(1), "-")
End If
If utc_OffsetIndex > 0 Then
utc_HasOffset = True
utc_TimeParts = VBA.Split(VBA.Left$(utc_Parts(1), utc_OffsetIndex - 1), ":")
utc_OffsetParts = VBA.Split(VBA.Right$(utc_Parts(1), Len(utc_Parts(1)) - utc_OffsetIndex), ":")
Select Case UBound(utc_OffsetParts)
Case 0
utc_Offset = TimeSerial(VBA.CInt(utc_OffsetParts(0)), 0, 0)
Case 1
utc_Offset = TimeSerial(VBA.CInt(utc_OffsetParts(0)), VBA.CInt(utc_OffsetParts(1)), 0)
Case 2
' VBA.Val does not use regional settings, use for seconds to avoid decimal/comma issues
utc_Offset = TimeSerial(VBA.CInt(utc_OffsetParts(0)), VBA.CInt(utc_OffsetParts(1)), Int(VBA.Val(utc_OffsetParts(2))))
End Select
If utc_NegativeOffset Then: utc_Offset = -utc_Offset
Else
utc_TimeParts = VBA.Split(utc_Parts(1), ":")
End If
End If
Select Case UBound(utc_TimeParts)
Case 0
ParseIso = ParseIso + VBA.TimeSerial(VBA.CInt(utc_TimeParts(0)), 0, 0)
Case 1
ParseIso = ParseIso + VBA.TimeSerial(VBA.CInt(utc_TimeParts(0)), VBA.CInt(utc_TimeParts(1)), 0)
Case 2
' VBA.Val does not use regional settings, use for seconds to avoid decimal/comma issues
ParseIso = ParseIso + VBA.TimeSerial(VBA.CInt(utc_TimeParts(0)), VBA.CInt(utc_TimeParts(1)), Int(VBA.Val(utc_TimeParts(2))))
End Select
ParseIso = ParseUtc(ParseIso)
If utc_HasOffset Then
ParseIso = ParseIso - utc_Offset
End If
End If
Exit Function
utc_ErrorHandling:
Err.Raise 10013, "UtcConverter.ParseIso", "ISO 8601 parsing error for " & utc_IsoString & ": " & Err.Number & " - " & Err.Description
End Function
''
' Convert local date to ISO 8601 string
'
' @method ConvertToIso
' @param {Date} utc_LocalDate
' @return {Date} ISO 8601 string
' @throws 10014 - ISO 8601 conversion error
''
Public Function ConvertToIso(utc_LocalDate As Date) As String
On Error GoTo utc_ErrorHandling
ConvertToIso = VBA.Format$(ConvertToUtc(utc_LocalDate), "yyyy-mm-ddTHH:mm:ss.000Z")
Exit Function
utc_ErrorHandling:
Err.Raise 10014, "UtcConverter.ConvertToIso", "ISO 8601 conversion error: " & Err.Number & " - " & Err.Description
End Function
' ============================================= '
' Private Functions
' ============================================= '
#If Mac Then
Private Function utc_ConvertDate(utc_Value As Date, Optional utc_ConvertToUtc As Boolean = False) As Date
Dim utc_ShellCommand As String
Dim utc_Result As utc_ShellResult
Dim utc_Parts() As String
Dim utc_DateParts() As String
Dim utc_TimeParts() As String
If utc_ConvertToUtc Then
utc_ShellCommand = "date -ur `date -jf '%Y-%m-%d %H:%M:%S' " & _
"'" & VBA.Format$(utc_Value, "yyyy-mm-dd HH:mm:ss") & "' " & _
" +'%s'` +'%Y-%m-%d %H:%M:%S'"
Else
utc_ShellCommand = "date -jf '%Y-%m-%d %H:%M:%S %z' " & _
"'" & VBA.Format$(utc_Value, "yyyy-mm-dd HH:mm:ss") & " +0000' " & _
"+'%Y-%m-%d %H:%M:%S'"
End If
utc_Result = utc_ExecuteInShell(utc_ShellCommand)
If utc_Result.utc_Output = "" Then
Err.Raise 10015, "UtcConverter.utc_ConvertDate", "'date' command failed"
Else
utc_Parts = Split(utc_Result.utc_Output, " ")
utc_DateParts = Split(utc_Parts(0), "-")
utc_TimeParts = Split(utc_Parts(1), ":")
utc_ConvertDate = DateSerial(utc_DateParts(0), utc_DateParts(1), utc_DateParts(2)) + _
TimeSerial(utc_TimeParts(0), utc_TimeParts(1), utc_TimeParts(2))
End If
End Function
Private Function utc_ExecuteInShell(utc_ShellCommand As String) As utc_ShellResult
#If VBA7 Then
Dim utc_File As LongPtr
Dim utc_Read As LongPtr
#Else
Dim utc_File As Long
Dim utc_Read As Long
#End If
Dim utc_Chunk As String
On Error GoTo utc_ErrorHandling
utc_File = utc_popen(utc_ShellCommand, "r")
If utc_File = 0 Then: Exit Function
Do While utc_feof(utc_File) = 0
utc_Chunk = VBA.Space$(50)
utc_Read = CLng(utc_fread(utc_Chunk, 1, Len(utc_Chunk) - 1, utc_File))
If utc_Read > 0 Then
utc_Chunk = VBA.Left$(utc_Chunk, CLng(utc_Read))
utc_ExecuteInShell.utc_Output = utc_ExecuteInShell.utc_Output & utc_Chunk
End If
Loop
utc_ErrorHandling:
utc_ExecuteInShell.utc_ExitCode = CLng(utc_pclose(utc_File))
End Function
#Else
Private Function utc_DateToSystemTime(utc_Value As Date) As utc_SYSTEMTIME
utc_DateToSystemTime.utc_wYear = VBA.Year(utc_Value)
utc_DateToSystemTime.utc_wMonth = VBA.Month(utc_Value)
utc_DateToSystemTime.utc_wDay = VBA.Day(utc_Value)
utc_DateToSystemTime.utc_wHour = VBA.Hour(utc_Value)
utc_DateToSystemTime.utc_wMinute = VBA.Minute(utc_Value)
utc_DateToSystemTime.utc_wSecond = VBA.Second(utc_Value)
utc_DateToSystemTime.utc_wMilliseconds = 0
End Function
Private Function utc_SystemTimeToDate(utc_Value As utc_SYSTEMTIME) As Date
utc_SystemTimeToDate = DateSerial(utc_Value.utc_wYear, utc_Value.utc_wMonth, utc_Value.utc_wDay) + _
TimeSerial(utc_Value.utc_wHour, utc_Value.utc_wMinute, utc_Value.utc_wSecond)
End Function
#End If
================================================
FILE: LICENSE
================================================
MIT License
Copyright (c) 2017 Koen Rijnsent
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.
================================================
FILE: ModExchBinance.bas
================================================
Attribute VB_Name = "ModExchBinance"
Sub TestBinance()
'Source: https://github.com/krijnsent/crypto_vba
'Documentation: https://github.com/binance/binance-spot-api-docs/blob/master/rest-api.md
'Remember to create a new API key for excel/VBA
Dim Apikey As String
Dim secretKey As String
Apikey = "your api key here"
secretKey = "your secret key here"
'Remove these 2 lines, unless you define 2 constants somewhere ( Public Const secretkey_btce = "the key to use everywhere" etc )
Apikey = apikey_binance2
secretKey = secretkey_binance2
'Put the credentials in a dictionary
Dim Cred As New Dictionary
Cred.Add "apiKey", Apikey
Cred.Add "secretKey", secretKey
' Create a new test suite
Dim Suite As New TestSuite
Suite.Description = "ModExchBinance"
' Create reporter and attach it to these specs
Dim Reporter As New ImmediateReporter
Reporter.ListenTo Suite
' Create a new test
Dim Test As TestCase
Set Test = Suite.Test("TestBinancePublic")
'Error, unknown command
TestResult = PublicBinance("AnUnknownCommand", "GET")
Test.IsOk InStr(TestResult, "error") > 0, "test UnknownCommand 1a failed, result: ${1}"
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error_nr"), 404, "test UnknownCommand 1b failed, result: ${1}"
'Error, command without parameters
TestResult = PublicBinance("depth", "GET")
Test.IsOk InStr(TestResult, "error") > 0, "test MissingParams 1a failed, result: ${1}"
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error_nr"), 400, "test MissingParams 1b failed, result: ${1}"
'OK request
TestResult = PublicBinance("time", "GET")
'{"serverTime":1513605418615}
Test.IsOk InStr(TestResult, "serverTime") > 0, "test Time 1a failed, result: ${1}"
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult("serverTime") > 1510000000000#, "test Time 1b failed, result: ${1}"
'Put parameters/options in a dictionary
Dim Params As New Dictionary
Params.Add "symbol", "ETHBTC"
TestResult = PublicBinance("ticker/24hr", "GET", Params)
'{"symbol":"ETHBTC","priceChange":"-0.00022700","priceChangePercent":"-0.633","weightedAvgPrice":"0.03538261","prevClosePrice":"0.03586800","lastPrice":"0.03564100","lastQty":"0.14000000","bidPrice":"0.03564100","bidQty":"0.22300000","askPrice":"0.03564800","askQty":"0.43200000","openPrice":"0.03586800","highPrice":"0.03600300","lowPrice":"0.03410000","volume":"380396.97600000","quoteVolume":"13459.43958266","openTime":1551288592637,"closeTime":1551374992637,"firstId":109505628,"lastId":109773015,"count":267388}
Test.IsOk InStr(TestResult, "priceChange") > 0, "test Ticker 1a failed, result: ${1}"
Test.IsOk InStr(TestResult, "closeTime") > 0, "test Ticker 1b failed, result: ${1}"
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("symbol"), "ETHBTC", "test Ticker 1c failed, result: ${1}"
Test.IsOk JsonResult("lastPrice") > 0, "test Ticker 1d failed, result: ${1}"
TestResult = GetBinanceTime()
'e.g. 1516565004894
Test.IsOk TestResult > 1510000000000#, "test GetTime failed, result: ${1}"
'Unix time period:
t1 = DateToUnixTime("1/1/2014")
t2 = DateToUnixTime("1/1/2018")
Set Test = Suite.Test("TestBinancePrivate GET")
'Binance always requires a timestamp parameter, first test without
TestResult = PrivateBinance("api/v3/account", "GET", Cred)
'{"code":-1102,"msg":"Mandatory parameter 'timestamp' was not sent, was empty/null, or malformed."}
Test.IsOk InStr(TestResult, "code") > 0, "test Private GET 1a failed, result: ${1}"
Test.IsOk InStr(TestResult, "Mandatory parameter") > 0, "test Private GET 1b failed, result: ${1}"
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("response_txt")("code"), -1102, "test Private GET 1c failed, result: ${1}"
'Add timestamp to the parameters and try again
Dim Params2 As New Dictionary
Params2.Add "timestamp", GetBinanceTime()
TestResult = PrivateBinance("api/v3/account", "GET", Cred, Params2)
'{"makerCommission":10,"takerCommission":10,"buyerCommission":0,"sellerCommission":0,"canTrade":true,"canWithdraw":true,"canDeposit":true,"updateTime":1512476238993,"balances":[{"asset":"BTC","free":"0.00000000","locked":"0.00000000"},{"asset":"LTC","free":"0.00000000","locked":"0.00000000"},{"asset":"ETH","free":"0.00000000","locked":"0.00000000"},{"asset":"NEO","free":"0.00000000","locked":"0.00000000"},{"asset":"BNB","free":"0.00000000","locked":"0.00000000"},{"asset":"QTUM","free":"0.00000000","locked":"0.00000000"},{"asset":"EOS","free":"0.00000000","locked":"0.00000000"},{"asset":"SNT","free":"0.00000000","locked":"0.00000000"},{"asset":"BNT","free":"0.00000000","locked":"0.00000000"},{"asset":"GAS","free":"0.00000000","locked":"0.00000000"},{"asset":"BCC","free":"0.00000000","locked":"0.00000000"},{"asset":"USDT","free":"0.00000000","locked":"0.00000000"},{"asset":"HSR","free":"0.00000000","locked":"0.00000000"},{"asset":"OAX","free":"0.00000000","locked":"0.00000000"},{...
Test.IsOk InStr(TestResult, "takerCommission") > 0, "test Private GET 1d failed, result: ${1}"
Test.IsOk InStr(TestResult, "locked") > 0, "test Private GET 1e failed, result: ${1}"
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult("takerCommission") > 0, "test Private GET 1f failed, result: ${1}"
Test.IsOk JsonResult("balances").Count > 10, "test Private GET 1g failed, result: ${1}"
Set Test = Suite.Test("TestBinancePrivate POST/DELETE")
'Test a test order
Dim Params3 As New Dictionary
Params3.Add "symbol", "LTCBTC"
Params3.Add "side", "BUY"
Params3.Add "type", "LIMIT"
Params3.Add "price", 0.01
Params3.Add "quantity", 1
Params3.Add "timeInForce", "GTC"
Params3.Add "timestamp", GetBinanceTime()
TestResult = PrivateBinance("api/v3/order/test", "POST", Cred, Params3)
Test.IsEqual TestResult, "{}", "test Private POST order 1a failed, result: ${1}"
'Delete a non-existing order
Dim Params4 As New Dictionary
Params4.Add "symbol", "LTCBTC"
Params4.Add "orderId", 987654
Params4.Add "timestamp", GetBinanceTime()
TestResult = PrivateBinance("api/v3/order", "DELETE", Cred, Params4)
'{"error_nr":400,"error_txt":"HTTP-Bad Request","response_txt":{"code":-2011,"msg":"Unknown order sent."}}
Test.IsOk InStr(TestResult, "code") > 0, "test Private DELETE order 1a failed, result: ${1}"
Test.IsOk InStr(TestResult, "Unknown order") > 0, "test Private DELETE order 1b failed, result: ${1}"
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("response_txt")("code"), -2011, "test Private DELETE order 1c failed, result: ${1}"
'Use the Wallet end point
Dim Params5 As New Dictionary
Params5.Add "timestamp", GetBinanceTime()
TestResult = PrivateBinance("sapi/v1/system/status", "GET", Cred, Params5)
'{"status":0,"msg":"normal"}
Test.IsOk InStr(TestResult, "msg") > 0, "test Private System Status 1a failed, result: ${1}"
Test.IsOk InStr(TestResult, "status") > 0, "test Private System Status 1b failed, result: ${1}"
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("msg"), "normal", "test Private System Status 1c failed, result: ${1}"
Dim Params6 As New Dictionary
Params6.Add "timestamp", GetBinanceTime()
TestResult = PrivateBinance("sapi/v1/capital/withdraw/history", "GET", Cred, Params6)
'e.g. [] (none) or
'e.g. [{"address":"0x94df8b352de7f46f64b01d3666bf6e936e44ce60","amount":"8.91000000","applyTime":"2019-10-1211:12:02","coin":"USDT","id":"b6ae22b3aa844210a7041aee7589627c","withdrawOrderId":"WITHDRAWtest123",//willnotbereturnedifthere'snowithdrawOrderIdforthiswithdraw."network":"ETH","transferType":0,//1forinternaltransfer,0forexternaltransfer"status":6,"transactionFee":"0.004","txId":"0xb5ef8c13b968a406cc62a93a8bd80f9e9a906ef1b3fcf20a2e48573c17659268"},{"address":"1FZdVHtiBqMrWdjPyRPULCUceZPJ2WLCsB","amount":"0.00150000","applyTime":"2019-09-2412:43:45","coin":"BTC","id":"156ec387f49b41df8724fa744fa82719","network":"BTC","status":6,"transactionFee":"0.004","transferType":0,//1forinternaltransfer,0forexternaltransfer"txId":"60fd9007ebfddc753455f95fafa808c4302c836e4d1eebc5a132c36c1d8ac354"}]
If TestResult = "[]" Then
'Empty result, OK
Test.IsEqual TestResult, "[]", "test Private Withdraw History 1a failed, result: ${1}"
Else
Test.IsOk InStr(TestResult, "address") > 0, "test Private Withdraw History 1b failed, result: ${1}"
Test.IsOk InStr(TestResult, "coin") > 0, "test Private Withdraw History 1c failed, result: ${1}"
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult(1)("amount") * 1 > 0, "test Private Withdraw History 1d failed, result: ${1}"
End If
End Sub
Function PublicBinance(Method As String, ReqType As String, Optional ParamDict As Dictionary) As String
Dim url As String
PublicApiSite = "https://api.binance.com"
MethodParams = DictToString(ParamDict, "URLENC")
If MethodParams <> "" Then MethodParams = "?" & MethodParams
urlPath = "/api/v1/" & Method & MethodParams
url = PublicApiSite & urlPath
PublicBinance = WebRequestURL(url, ReqType)
End Function
Function PrivateBinance(Method As String, ReqType As String, Credentials As Dictionary, Optional ParamDict As Dictionary) As String
Dim NonceUnique As String
Dim TimeCorrection As Long
Dim url As String
TradeApiSite = "https://api.binance.com/"
MethodParams = DictToString(ParamDict, "URLENC")
If MethodParams <> "" Then MethodParams = "&" & MethodParams
APIsign = ComputeHash_C("SHA256", MethodParams, Credentials("secretKey"), "STRHEX")
url = TradeApiSite & Method & "?" & MethodParams & "&signature=" & APIsign
Dim UrlHeaders As New Dictionary
UrlHeaders.Add "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
UrlHeaders.Add "Content-Type", "application/x-www-form-urlencoded"
UrlHeaders.Add "X-MBX-APIKEY", Credentials("apiKey")
PrivateBinance = WebRequestURL(url, ReqType, UrlHeaders)
End Function
Function GetBinanceTime() As Double
Dim JsonResponse As String
Dim Json As Object
'PublicBinance time
JsonResponse = PublicBinance("time", "GET")
Set Json = JsonConverter.ParseJson(JsonResponse)
GetBinanceTime = Json("serverTime")
Set Json = Nothing
End Function
================================================
FILE: ModExchBitVavo.bas
================================================
Attribute VB_Name = "ModExchBitVavo"
Sub TestBitVavo()
'Source: https://github.com/krijnsent/crypto_vba
'Documentation: https://docs.bitvavo.com/
'Remember to create a new API key for excel/VBA
Dim Apikey As String
Dim secretKey As String
Apikey = "your api key here"
secretKey = "your secret key here"
'Remove these 2 lines, unless you define 2 constants somewhere ( Public Const secretkey_btce = "the key to use everywhere" etc )
Apikey = apikey_bitvavo
secretKey = secretkey_bitvavo
'Put the credentials in a dictionary
Dim Cred As New Dictionary
Cred.Add "apiKey", Apikey
Cred.Add "secretKey", secretKey
' Create a new test suite
Dim Suite As New TestSuite
Suite.Description = "ModExchBitVavo"
' Create reporter and attach it to these specs
Dim Reporter As New ImmediateReporter
Reporter.ListenTo Suite
' Create a new test
Dim Test As TestCase
Set Test = Suite.Test("TestBitVavoPublic")
'Error, unknown command
TestResult = PublicBitVavo("AnUnknownCommand", "GET")
'{"error_nr":404,"error_txt":"HTTP-Not Found","response_txt":{"errorCode":110,"error":"Invalid endpoint. Please check url and HTTP method."}}
Test.IsOk InStr(TestResult, "error") > 0, "test error 1a failed, result: ${1}"
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error_nr"), 404, "test error 1b failed, result: ${1}"
'Error, parameter missing
TestResult = PublicBitVavo("BTC-EUR/candles", "GET")
'{"error_nr":400,"error_txt":"HTTP-Bad Request","response_txt":{"errorCode":203,"error":"interval parameter is required."}}
Test.IsOk InStr(TestResult, "error") > 0, "test error 2a failed, result: ${1}"
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error_nr"), 400, "test error 2b failed, result: ${1}"
Test.IsEqual JsonResult("response_txt")("error"), "interval parameter is required.", "test error 2c failed, result: ${1}"
'OK simple time request
TestResult = PublicBitVavo("time", "GET")
'e.g. {"time":1617720826734}
Test.IsOk InStr(TestResult, "time") > 0, "test time 1 failed, result: ${1}"
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult("time") > 1600000000000#, "test time 2 failed, result: ${1}"
'OK request with parameter
Dim Params As New Dictionary
Params.Add "interval", "1d"
Params.Add "limit", 10
TestResult = PublicBitVavo("BTC-EUR/candles", "GET", Params)
'[[1617667200000,"49950","50300","48547","49010","455.91371112"],[1617580800000,"49590","50200","48500","49870","555.41905353"], etc.
'returns: time, OHLCV
Test.IsOk InStr(TestResult, "error") = 0, "test candles 1 failed, result: ${1}"
Set JsonResult = JsonConverter.ParseJson(TestResult)
For N = 1 To JsonResult.Count
Test.IsOk JsonResult(N)(1) > 1600000000000#, "test candles 2-" & N & " failed, result: ${1}" 'check time of record
Test.IsOk JsonResult(N)(2) > 0, "test candles 3-" & N & " failed, result: ${1}" 'check Open of record
Next N
Set Test = Suite.Test("TestBitVavoPrivate")
TestResult = PrivateBitVavo("account", "GET", Cred)
'e.g. {"fees":{"taker":"0.0025","maker":"0.0015","volume":"0.00"}}
Test.IsOk InStr(TestResult, "fees") > 0, "test private account 1 failed, result: ${1}"
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult("fees")("taker") >= 0, "test private account 2 failed, result: ${1}"
'Private GET request that requires a parameter
TestResult = PrivateBitVavo("deposit", "GET", Cred)
'{"error_nr":400,"error_txt":"HTTP-Bad Request","response_txt":{"errorCode":203,"error":"symbol parameter is required."}}
Test.IsOk InStr(TestResult, "error_txt") > 0, "test private deposit 1 failed, result: ${1}"
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("response_txt")("error"), "symbol parameter is required.", "test private deposit 2 failed, result: ${1}"
Dim Params2 As New Dictionary
Params2.Add "symbol", "ETH"
TestResult = PrivateBitVavo("deposit", "GET", Cred, Params2)
'{"errorCode":412,"error":"crypto_bank_required."} - no deposit address set
'Or {"address": "CryptoCurrencyAddress","paymentId": "10002653"} - deposit address set
AddrSet = False
If InStr(TestResult, "address") > 0 Then AddrSet = True
Set JsonResult = JsonConverter.ParseJson(TestResult)
If AddrSet Then
Test.IsOk JsonResult("address") <> "", "test private deposit 3b failed, result: ${1}"
Else
Test.IsEqual JsonResult("response_txt")("error"), "crypto_bank_required.", "test private deposit 3a failed, result: ${1}"
End If
'Sign test case from API docs
TestMsgToSign = "1548172481125POST/v2/order{""market"":""BTC-EUR"",""side"":""buy"",""price"":""5000"",""amount"":""1.23"",""orderType"":""limit""}"
TestSign = ComputeHash_C("SHA256", TestMsgToSign, "bitvavo", "STRHEX")
Test.IsEqual TestSign, "44d022723a20973a18f7ee97398b9fdd405d2d019c8d39e24b8cc0dcb39ca016", "test sign failed, result: ${1}"
'Buy order, buying 1 BTC for 100 EUR/BTC
Dim Params3 As New Dictionary
Params3.Add "market", "BTC-EUR"
Params3.Add "side", "buy"
Params3.Add "orderType", "limit"
Params3.Add "amount", 1
Params3.Add "price", 100
Params3.Add "timeInForce", "FOK"
TestResult = PrivateBitVavo("order", "POST", Cred, Params3)
'{"error_nr":400,"error_txt":"HTTP-Bad Request","response_txt":{"errorCode":216,"error":"You do not have sufficient balance to complete this operation."}}
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error_nr"), 400, "test private order 1 failed, result: ${1}"
Test.IsEqual JsonResult("response_txt")("errorCode"), 216, "test private order 2 failed, result: ${1}"
'Deleting not existing order
Dim Params4 As New Dictionary
Params4.Add "market", "ETH-EUR"
Params4.Add "orderId", "ff403e21-e270-4584-bc9e-9c4b18461465"
TestResult = PrivateBitVavo("order", "DELETE", Cred, Params4)
'{"error_nr":404,"error_txt":"HTTP-Not Found","response_txt":{"errorCode":240,"error":"No order found. Please be aware that simultaneously updating the same order may return this error."}}
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error_nr"), 404, "test private delete order 1 failed, result: ${1}"
Test.IsEqual JsonResult("response_txt")("errorCode"), 240, "test private delete order 2 failed, result: ${1}"
'Test by default switched off... Deletes all open orders...
'Dim Params5 As New Dictionary
'TestResult = PrivateBitVavo("orders", "DELETE", Cred, Params5)
'TestResult = "{""orderId"": ""2e7ce7fc-44e2-4d80-a4a7-d079c4750b61""}"
'If InStr(TestResult, "orderId") > 0 Then
' 'has some results
' 'e.g.: {"orderId": "2e7ce7fc-44e2-4d80-a4a7-d079c4750b61"}
' Test.IsOk InStr(TestResult, "orderId") > 0
' Set JsonResult = JsonConverter.ParseJson(TestResult)
' For Each k In JsonResult.Keys()
' Test.IsOk Len(JsonResult(k)) >= 10
' Next k
'Else
' 'no results
' 'Empty: []
' Test.IsEqual TestResult, "[]"
'End If
End Sub
Function PublicBitVavo(Method As String, ReqType As String, Optional ParamDict As Dictionary) As String
Dim url As String
PublicApiSite = "https://api.bitvavo.com"
MethodParams = DictToString(ParamDict, "URLENC")
If MethodParams <> "" Then MethodParams = "?" & MethodParams
urlPath = "/v2/" & Method & MethodParams
url = PublicApiSite & urlPath
PublicBitVavo = WebRequestURL(url, ReqType)
End Function
Function PrivateBitVavo(Method As String, ReqType As String, Credentials As Dictionary, Optional ParamDict As Dictionary) As String
Dim NonceUnique As String
Dim MethodParams As String
Dim postdata As String
Dim url As String
TradeApiSite = "https://api.bitvavo.com"
ApiEndPoint = "/v2/" & Method
postdata = ""
NonceUnique = GetBitVavoTime
If UCase(ReqType) = "POST" Then
'For POST request, all query parameters need to be included in the request body with JSON. (e.g. {"currency":"BTC"}).
postdata = JsonConverter.ConvertToJson(ParamDict)
If postdata = "{}" Then postdata = ""
ElseIf UCase(ReqType) = "GET" Or UCase(ReqType) = "DELETE" Or UCase(ReqType) = "PUT" Then
MethodParams = DictToString(ParamDict, "URLENC")
If MethodParams <> "" Then MethodParams = "?" & MethodParams
ApiEndPoint = ApiEndPoint & MethodParams
End If
StrToHash = NonceUnique & ReqType & ApiEndPoint & postdata
APIsign = ComputeHash_C("SHA256", StrToHash, Credentials("secretKey"), "STRHEX")
url = TradeApiSite & ApiEndPoint
Dim UrlHeaders As New Dictionary
UrlHeaders.Add "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
UrlHeaders.Add "Content-Type", "application/json"
UrlHeaders.Add "BITVAVO-ACCESS-TIMESTAMP", NonceUnique
UrlHeaders.Add "BITVAVO-ACCESS-KEY", Credentials("apiKey")
UrlHeaders.Add "BITVAVO-ACCESS-SIGNATURE", APIsign
PrivateBitVavo = WebRequestURL(url, ReqType, UrlHeaders, postdata)
End Function
Function GetBitVavoTime() As Double
Dim JsonResponse As String
Dim Json As Object
'PublicBinance time
JsonResponse = PublicBitVavo("time", "GET")
Set Json = JsonConverter.ParseJson(JsonResponse)
GetBitVavoTime = Json("time")
Set Json = Nothing
End Function
================================================
FILE: ModExchBitfinex.bas
================================================
Attribute VB_Name = "ModExchBitfinex"
Sub TestBitfinex()
'Source: https://github.com/krijnsent/crypto_vba
'Documentation: https://docs.bitfinex.com/docs/rest-auth
'Note: there are two versions, v1 and v2, v2 is in Beta and does not have all functions
'Remember to create a new API key for excel/VBA
Dim Apikey As String
Dim secretKey As String
Apikey = "your api key here"
secretKey = "your secret key here"
'Remove these 2 lines, unless you define 2 constants somewhere ( Public Const secretkey_bitfinex = "the key to use everywhere" etc )
Apikey = apikey_bitfinex
secretKey = secretkey_bitfinex
'Put the credentials in a dictionary
Dim Cred As New Dictionary
Cred.Add "apiKey", Apikey
Cred.Add "secretKey", secretKey
' Create a new test suite
Dim Suite As New TestSuite
Suite.Description = "ModExchBitfinex"
' Create reporter and attach it to these specs
Dim Reporter As New ImmediateReporter
Reporter.ListenTo Suite
' Create a new test
Dim Test As TestCase
Set Test = Suite.Test("TestBitfinexPublic v1")
'Error, unknown command
TestResult = PublicBitfinex1("AnUnknownCommand", "GET")
'{"error_nr":404,"error_txt":"HTTP-Not Found","response_txt":0}
Test.IsOk InStr(TestResult, "error") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error_nr"), 404
'Error, wrong parameter
TestResult = PublicBitfinex1("ticker/bogus_here", "GET")
'{"error_nr":400,"error_txt":"HTTP-Bad Request","response_txt":{"message":"Unknown symbol"}}
Test.IsOk InStr(TestResult, "error") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error_nr"), 400
Test.IsEqual JsonResult("response_txt")("message"), "Unknown symbol"
'OK request
TestResult = PublicBitfinex1("symbols", "GET")
'["btcusd","ltcusd","ltcbtc","ethusd","ethbtc","etcbtc",
Test.IsOk InStr(TestResult, "ethbtc") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult(1), "btcusd"
'OK request with details
TestResult = PublicBitfinex1("stats/BTCUSD", "GET")
'[{"period":1,"volume":"6815.19360556"},{"period":7,"volume":"98002.43336128"},{"period":30,"volume":"387511.06628926"}]
Test.IsOk InStr(TestResult, "volume") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult(1)("period"), 1
Test.IsOk JsonResult(1)("volume") > 0
Set Test = Suite.Test("TestBitfinexPrivate v1 Balances")
TestResult = PrivateBitfinex1("balances", "POST", Cred)
'[{"type":"exchange","currency":"btc","amount":"5.15334045","available":"5.15334045"},{"type":"exchange","currency":"eos","amount":"15.0","available":"15.0"}]
Test.IsOk InStr(TestResult, "currency") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk InStr(JsonResult(1)("type"), "exchange") + InStr(JsonResult(1)("type"), "margin") + InStr(JsonResult(1)("type"), "funding") > 0
Test.IsOk Len(JsonResult(1)("currency")) >= 3
Test.IsOk Len(JsonResult(1)("amount")) >= 0
Set Test = Suite.Test("TestBitfinexPrivate v1 Orders")
Dim Params1o As New Dictionary
Params1o.Add "symbol", "BTCUSD"
Params1o.Add "amount", "1.33"
Params1o.Add "price", "9"
Params1o.Add "side", "buy"
Params1o.Add "type", "fill-or-kill"
TestResult = PrivateBitfinex1("order/new", "POST", Cred, Params1o)
'e.g. {"error_nr":403,"error_txt":"HTTP-Forbidden","response_txt":{"message":"This API key does not have permission for this action"}}
'or: {"id":448364249,"symbol":"btcusd","exchange":"bitfinex",etc.
If InStr(TestResult, "error") > 0 Then
Test.IsOk InStr(TestResult, "message") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error_nr"), 403
Else
Test.IsOk InStr(TestResult, "symbol") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult("id") > 0
Test.IsEqual JsonResult("symbol"), "btcusd"
End If
Set Test = Suite.Test("TestBitfinexPublic v2")
'Error, unknown command
TestResult = PublicBitfinex2("AnUnknownCommand", "GET")
'{"error_nr":404,"error_txt":"HTTP-Not Found","response_txt":0}
Test.IsOk InStr(TestResult, "error") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error_nr"), 404
'Error, wrong parameter
TestResult = PublicBitfinex2("ticker/bogus_here", "GET")
'{"error_nr":500,"error_txt":"HTTP-","response_txt":["error",10020,"symbol: invalid"]}
Test.IsOk InStr(TestResult, "error") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error_nr"), 500
Test.IsEqual JsonResult("response_txt")(2), 10020
'OK request
TestResult = PublicBitfinex2("platform/status", "GET")
'[1] -> 1 = active, 0=maintenance
Test.IsOk InStr(TestResult, "]") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult(1), 1
'OK request with parameters
Dim Params As New Dictionary
Params.Add "symbols", "tBTCUSD,tNEOETH"
TestResult = PublicBitfinex2("tickers", "GET", Params)
'[["tBTCUSD",3907.1,34.68474518,3907.2,84.93216888,-24.5,-0.0062,3907.2,6790.69338403,3949,3838.89411809],["tNEOETH",0.065716,3437.62864427,0.06589,2087.26914816,0.000835,0.0129,0.065611,4944.19962337,0.068214,0.064699]]
Test.IsOk InStr(TestResult, "tNEOETH") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult(1)(1), "tBTCUSD"
Test.IsOk JsonResult(1)(2) > 100
Set Test = Suite.Test("TestBitfinexPublic v2 POST")
'OK POST request with parameters, no credentials needed
Dim Params2 As New Dictionary
Params2.Add "symbol", "tBTCUSD"
Params2.Add "amount", "-2.5"
TestResult = PublicBitfinex2("calc/trade/avg", "POST", Params2)
'[3905,-2.5]
Test.IsOk InStr(TestResult, "]") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult(1) > 100
Test.IsEqual JsonResult(2), -2.5
Set Test = Suite.Test("TestBitfinexPrivate v2 Wallets")
TestResult = PrivateBitfinex2("auth/r/wallets", "POST", Cred)
'e.g. [["exchange","BTC",5.15334045,0,null],["exchange","EOS",15,0,null]]
Test.IsOk InStr(TestResult, "]]") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
'Test first result for being one of three types exchange, margin, funding
Test.IsOk InStr(JsonResult(1)(1), "exchange") + InStr(JsonResult(1)(1), "margin") + InStr(JsonResult(1)(1), "funding") > 0
Test.IsOk Len(JsonResult(1)(2)) >= 3
Test.IsOk Len(JsonResult(1)(3)) >= 0
Set Test = Suite.Test("TestBitfinexPrivate v2 Trades")
'Unix time period (add 3 zeros for ms):
t1 = DateToUnixTime("1/1/2016") & "000"
t2 = DateToUnixTime("1/1/2018") & "000"
Dim Params3 As New Dictionary
Params3.Add "start", t1
Params3.Add "end", t2
Params3.Add "limit", 25
TestResult = PrivateBitfinex2("auth/r/ledgers/BTC/hist", "POST", Cred, Params3)
'[] for empty or [[ID,CURRENCY,null,TIMESTAMP_MILLI,null,AMOUNT,BALANCE,null,Description]]
Test.IsOk InStr(TestResult, "]") > 0
If Len(TestResult) > 2 Then
'Results, some more tests
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult(1)(1) > 0
Test.IsOk Len(JsonResult(1)(2)) >= 3
Test.IsOk JsonResult(1)(4) > 1400000000000#
End If
End Sub
'Version 2 APIs below
Function PublicBitfinex1(Method As String, ReqType As String, Optional ParamDict As Dictionary) As String
Dim url As String
PublicApiSite = "https://api.bitfinex.com"
MethodParams = DictToString(ParamDict, "URLENC")
If MethodParams <> "" Then MethodParams = "?" & MethodParams
urlPath = "/v1/" & Method & MethodParams
url = PublicApiSite & urlPath
PublicBitfinex1 = WebRequestURL(url, ReqType)
End Function
Function PrivateBitfinex1(Method As String, ReqType As String, Credentials As Dictionary, Optional ParamDict As Dictionary) As String
'Thanks to balin77!
Dim NonceUnique As String
Dim TimeCorrection As Long
Dim url As String
NonceUnique = CreateNonce(15)
TradeApiSite = "https://api.bitfinex.com"
ApiPath = "/v1/" & Method
MethodParams = DictToString(ParamDict, "URLENC")
If MethodParams <> "" Then MethodParams = "?" & MethodParams
Set PayloadDict = New Dictionary
PayloadDict("request") = ApiPath
PayloadDict("nonce") = NonceUnique
If Not ParamDict Is Nothing Then
For Each key In ParamDict.Keys
PayloadDict(key) = ParamDict(key)
Next key
End If
Json = Replace(ConvertToJson(PayloadDict), "/", "\/")
payload = Base64Encode(Json)
APIsign = ComputeHash_C("SHA384", payload, Credentials("secretKey"), "STRHEX")
url = TradeApiSite & ApiPath
Dim UrlHeaders As New Dictionary
UrlHeaders.Add "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
UrlHeaders.Add "Content-Type", "application/x-www-form-urlencoded"
UrlHeaders.Add "X-BFX-APIKEY", Credentials("apiKey")
UrlHeaders.Add "X-BFX-PAYLOAD", payload
UrlHeaders.Add "X-BFX-SIGNATURE", APIsign
PrivateBitfinex1 = WebRequestURL(url, ReqType, UrlHeaders)
End Function
Function PublicBitfinex2(Method As String, ReqType As String, Optional ParamDict As Dictionary) As String
Dim url As String
PublicApiSite = "https://api-pub.bitfinex.com"
MethodParams = DictToString(ParamDict, "URLENC")
If MethodParams <> "" Then MethodParams = "?" & MethodParams
urlPath = "/v2/" & Method & MethodParams
url = PublicApiSite & urlPath
PublicBitfinex2 = WebRequestURL(url, ReqType)
End Function
Function PrivateBitfinex2(Method As String, ReqType As String, Credentials As Dictionary, Optional ParamDict As Dictionary) As String
Dim NonceUnique As String
Dim TimeCorrection As Long
Dim url As String
NonceUnique = CreateNonce(15)
TradeApiSite = "https://api.bitfinex.com/"
ApiPath = "v2/" & Method
MethodParams = DictToString(ParamDict, "URLENC")
If MethodParams <> "" Then MethodParams = "?" & MethodParams
ToSign = "/api/" & ApiPath & NonceUnique
APIsign = ComputeHash_C("SHA384", ToSign, Credentials("secretKey"), "STRHEX")
url = TradeApiSite & ApiPath & MethodParams
Dim UrlHeaders As New Dictionary
UrlHeaders.Add "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
UrlHeaders.Add "Content-Type", "application/x-www-form-urlencoded"
UrlHeaders.Add "bfx-nonce", NonceUnique
UrlHeaders.Add "bfx-apikey", Credentials("apiKey")
UrlHeaders.Add "bfx-signature", APIsign
PrivateBitfinex2 = WebRequestURL(url, ReqType, UrlHeaders)
End Function
================================================
FILE: ModExchBitmex.bas
================================================
Attribute VB_Name = "ModExchBitmex"
Sub TestBitmex()
'Source: https://github.com/krijnsent/crypto_vba
'Documentation: https://www.bitmex.com/app/restAPI
'Commands: https://www.bitmex.com/api/explorer/
'VBA example: https://github.com/BitMEX/api-connectors/tree/master/official-http/vba
'Remember to create a new API key for excel/VBA
Dim Apikey As String
Dim secretKey As String
Apikey = "your api key here"
secretKey = "your secret key here"
'Remove these 2 lines, unless you define 2 constants somewhere ( Public Const secretkey_btce = "the key to use everywhere" etc )
Apikey = apikey_bitmex
secretKey = secretkey_bitmex
'Put the credentials in a dictionary
Dim Cred As New Dictionary
Cred.Add "apiKey", Apikey
Cred.Add "secretKey", secretKey
' Create a new test suite
Dim Suite As New TestSuite
Suite.Description = "ModExchBitmex"
' Create reporter and attach it to these specs
Dim Reporter As New ImmediateReporter
Reporter.ListenTo Suite
' Create a new test
Dim Test As TestCase
Set Test = Suite.Test("TestBitmexPublic")
'Error, unknown command
TestResult = PublicBitmex("AnUnknownCommand", "GET")
'{"error_nr":404,"error_txt":"HTTP-Not Found","response_txt":{"error":{"message":"Not Found","name":"HTTPError"}}}
Test.IsOk InStr(TestResult, "error") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error_nr"), 404
'Error, command without parameters
TestResult = PublicBitmex("orderBook/L2", "GET")
'{"error_nr":400,"error_txt":"HTTP-Bad Request","response_txt":{"error":{"message":"'symbol' is a required arg.","name":"HTTPError"}}}
Test.IsOk InStr(TestResult, "error") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error_nr"), 400
'OK request
TestResult = PublicBitmex("stats", "GET")
'[{"rootSymbol":"A50","currency":"XBt","volume24h":0,"turnover24h":0,"openInterest":0,"openValue":0},{"rootSymbol":"ADA","currency":"XBt","volume24h":28782927,"turnover24h":17393857814,"openInterest":54769214,"openValue":33902143466},{"rootSymbol":"BCH","currency":"XBt","volume24h":3642,"turnover24h":9362243000,"openInterest":24992,"openValue":64404384000},{"rootSymbol":"BFX","currency":"XBt","volume24h":0,"turnover24h":0,"openInterest":0,"openValue":0},{"rootSymbol":"BLOCKS","currency":"XBt","volume24h":0,"turnover24h":0,"openInterest":0,"openValue":0},{"rootSymbol":"BVOL","currency":"XBt","volume24h":0,"turnover24h":0,"openInterest":0,"openValue":0},{"rootSymbol":"COIN","currency":"XBt","volume24h":0,"turnover24h":0,"openInterest":0,"openValue":0},{"rootSymbol":"DAO","currency":"XBt","volume24h":0,"turnover24h":0,"openInterest":0,"openValue":0},{"rootSymbol":"DASH","currency":"XBt","volume24h":0,"turnover24h":0,"openInterest":0,"openValue":0} etc.
Test.IsOk InStr(TestResult, "ETH") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
For N = 1 To JsonResult.Count
Test.IsEqual JsonResult(N)("currency"), "XBt"
If JsonResult(N)("rootSymbol") <> "Total" Then Test.IsOk JsonResult(N)("volume24h") >= 0
Next N
'Put parameters/options in a dictionary
Dim Params As New Dictionary
Params.Add "symbol", "XBT"
Params.Add "depth", 5
TestResult = PublicBitmex("orderBook/L2", "GET", Params)
'[{"symbol":"XBTUSD","id":8799115700,"side":"Sell","size":65300,"price":8843},{"symbol":"XBTUSD","id":8799115750,"side":"Sell","size":58655,"price":8842.5},{"symbol":"XBTUSD","id":8799115800,"side":"Sell","size":88599,"price":8842},{"symbol":"XBTUSD","id":8799115850,"side":"Sell","size":5368,"price":8841.5},{"symbol":"XBTUSD","id":8799115900,"side":"Sell","size":1436605,"price":8841},{"symbol":"XBTUSD","id":8799115950,"side":"Buy","size":2230982,"price":8840.5},{"symbol":"XBTUSD","id":8799116000,"side":"Buy","size":30155,"price":8840},{"symbol":"XBTUSD","id":8799116050,"side":"Buy","size":61062,"price":8839.5},{"symbol":"XBTUSD","id":8799116100,"side":"Buy","size":78279,"price":8839},{"symbol":"XBTUSD","id":8799116150,"side":"Buy","size":81493,"price":8838.5}]
Test.IsOk InStr(TestResult, "symbol") > 0
Test.IsOk InStr(TestResult, "side") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult(1)("symbol"), "XBTUSD"
Test.IsOk JsonResult(1)("id") > 0
Test.IsOk JsonResult(1)("size") > 0
Test.IsOk JsonResult(1)("price") > 0
'GET private API
Set Test = Suite.Test("TestBitmexPrivate GET")
'Use TESTNET
'Test an invalid command
Dim Params2 As New Dictionary
Params2.Add "testnet", 1
TestResult = PrivateBitmex("not_a_command", "GET", Cred, Params2)
'{"error_nr":404,"error_txt":"HTTP-Not Found","response_txt":{"error":{"message":"Not Found","name":"HTTPError"}}}
Test.IsOk InStr(TestResult, "error") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error_nr"), 404
'Simple GET without parameters
Dim Params3 As New Dictionary
Params3.Add "testnet", 1
TestResult = PrivateBitmex("user", "GET", Cred, Params3)
'{"id":30219,"ownerId":null,"lastname":"Rijnsent","username":"rijnsent","email":"rijnsent",etc..}
Test.IsOk InStr(TestResult, "lastname") > 0
Test.IsOk InStr(TestResult, "username") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult("id") > 0
'Simple GET without parameters
Dim Params4 As New Dictionary
Params4.Add "testnet", 1
Params4.Add "currency", "XBt"
Params4.Add "count", 5
TestResult = PrivateBitmex("user/walletHistory", "GET", Cred, Params4)
'[{"transactID":"db7925ad-b54156-baff28-baf7","account":3210,"currency":"XBt","transactType":"Transfer","amount":1000000,"fee":null,"transactStatus":"Completed","address":"0","tx":"9ddad751-507a-81ca-0b55-13cd08b7063f","text":"Signup bonus","transactTime":"2020-06-01T18:14:33.791Z","walletBalance":1000000,"marginBalance":null,"timestamp":"2020-06-01T18:14:33.791Z"}]
Test.IsOk InStr(TestResult, "transactID") > 0
Test.IsOk InStr(TestResult, "currency") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult(1)("amount") > 0
Set Test = Suite.Test("TestBitmexPrivate POST/DELETE")
'Test delete all orders
Dim Params5 As New Dictionary
Params5.Add "testnet", 1
TestResult = PrivateBitmex("order/all", "DELETE", Cred, Params5)
Test.IsEqual TestResult, "[]"
'Test delete all orders
Dim Params6 As New Dictionary
Params6.Add "testnet", 1
Params6.Add "symbol", "XBTUSD"
Params6.Add "price", 2
Params6.Add "orderQty", 0.00000002
Params6.Add "clOrdID", "MyTestOrderIDHere"
TestResult = PrivateBitmex("order", "POST", Cred, Params6)
'{"error_nr":403,"error_txt":"HTTP-Forbidden","response_txt":{"error":{"message":"Access Denied","name":"HTTPError"}}}
Test.IsOk InStr(TestResult, "error_nr") > 0
Test.IsOk InStr(TestResult, "error") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error_nr"), 403
End Sub
Function PublicBitmex(Method As String, ReqType As String, Optional ParamDict As Dictionary) As String
Dim url As String
PublicApiSite = "https://www.bitmex.com"
MethodParams = DictToString(ParamDict, "URLENC")
If MethodParams <> "" Then MethodParams = "?" & MethodParams
urlPath = "/api/v1/" & Method & MethodParams
url = PublicApiSite & urlPath
PublicBitmex = WebRequestURL(url, ReqType)
End Function
Function PrivateBitmex(Method As String, ReqType As String, Credentials As Dictionary, Optional ParamDict As Dictionary) As String
Dim NonceUnique As String
Dim MethodParams As String
Dim postdata As String
Dim url As String
TradeApiSite = "https://www.bitmex.com"
If Not ParamDict Is Nothing Then
If ParamDict.Exists("testnet") Then
ParamDict.Remove "testnet"
TradeApiSite = "https://testnet.bitmex.com"
End If
End If
ApiEndPoint = "/api/v1/" & Method
postdata = ""
NonceUnique = CreateNonce(13)
If UCase(ReqType) = "POST" Then
'For POST request, all query parameters need to be included in the request body with JSON. (e.g. {"currency":"BTC"}).
postdata = JsonConverter.ConvertToJson(ParamDict)
ElseIf UCase(ReqType) = "GET" Then
MethodParams = DictToString(ParamDict, "URLENC")
If MethodParams <> "" Then MethodParams = "?" & MethodParams
ApiEndPoint = ApiEndPoint & MethodParams
End If
StrToHash = ReqType & ApiEndPoint & NonceUnique & postdata
APIsign = ComputeHash_C("SHA256", StrToHash, Credentials("secretKey"), "STRHEX")
url = TradeApiSite & ApiEndPoint
Dim UrlHeaders As New Dictionary
UrlHeaders.Add "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
UrlHeaders.Add "Content-Type", "application/x-www-form-urlencoded"
UrlHeaders.Add "api-nonce", NonceUnique 'NOT USED ANYMORE
UrlHeaders.Add "api-key", Credentials("apiKey")
UrlHeaders.Add "api-signature", APIsign
PrivateBitmex = WebRequestURL(url, ReqType, UrlHeaders, postdata)
End Function
================================================
FILE: ModExchBitstamp.bas
================================================
Attribute VB_Name = "ModExchBitstamp"
Sub TestBitstamp()
'Source: https://github.com/krijnsent/crypto_vba
'Documentation: https://Bitstamp.com/home/api
'Remember to create a new API key for excel/VBA
Dim Apikey As String
Dim secretKey As String
Apikey = "your api key here"
secretKey = "your secret key here"
customerID = "your customer id here"
'Remove these 3 lines, unless you define 3 constants somewhere ( Public Const secretkey_btce = "the key to use everywhere" etc )
Apikey = apikey_bitstamp
secretKey = secretkey_bitstamp
customerID = customer_id_bitstamp
'Put the credentials in a dictionary
Dim Cred As New Dictionary
Cred.Add "apiKey", Apikey
Cred.Add "secretKey", secretKey
Cred.Add "customerID", customerID
' Create a new test suite
Dim Suite As New TestSuite
Suite.Description = "ModExchBitstamp"
' Create reporter and attach it to these specs
Dim Reporter As New ImmediateReporter
Reporter.ListenTo Suite
' Create a new test
Dim Test As TestCase
Set Test = Suite.Test("TestBitstampPublic")
'Error, unknown command
TestResult = PublicBitstamp("AnUnknownCommand", "GET")
'{"error_nr":404,"error_txt":"HTTP-Not Found","response_txt":0}
Test.IsOk InStr(TestResult, "error") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error_nr"), 404
'Error, parameter missing
TestResult = PublicBitstamp("v2/ticker_hour/", "GET")
'{"error_nr":404,"error_txt":"HTTP-NOT FOUND","response_txt":0}
Test.IsOk InStr(TestResult, "error") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error_nr"), 404
'Request without parameters
TestResult = PublicBitstamp("ticker/", "GET")
'{"high": "3806.90000000", "last": "3707.22", "timestamp": "1551731354", "bid": "3707.14", "vwap": "3724.51", "volume": "6515.58124105", "low": "3670.00000000", "ask": "3707.22", "open": 3789.70}
Test.IsOk InStr(TestResult, "timestamp") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult("timestamp") * 1 >= 1510000000
Test.IsOk JsonResult("bid") >= 0
'Put variables in
TestResult = PublicBitstamp("v2/ticker_hour/btceur/", "GET")
'{"high": "3282.58", "last": "3277.18", "timestamp": "1551731355", "bid": "3276.00", "vwap": "3276.05", "volume": "24.42762265", "low": "3270.77", "ask": "3276.08", "open": "3275.17"}
Test.IsOk InStr(TestResult, "timestamp") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult("timestamp") * 1 >= 1510000000
Test.IsOk JsonResult("bid") >= 0
'Unix time period:
Set Test = Suite.Test("TestBitstampPrivate")
TestResult = PrivateBitstamp("balance/", "POST", Cred)
'{"xrp_available": "0.00000000", "eur_available": "0.00", "usd_reserved": "0.00", "eur_balance": "0.00", "btc_balance": "0.00000000", "usd_available": "0.00", "btc_reserved": "0.00000000", "fee": "0.2500", "btc_available": "0.00000000", "eur_reserved": "0.00", "xrp_reserved": "0.00000000", "xrp_balance": "0.00000000", "usd_balance": "0.00"}
Test.IsOk InStr(TestResult, "eur_balance") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult("eur_balance") >= 0
Test.IsOk JsonResult("usd_balance") >= 0
TestResult = PrivateBitstamp("v2/balance/", "POST", Cred)
'{"bch_available": "0.00000000", "bch_balance": "0.00000000", "bch_reserved": "0.00000000", "bchbtc_fee": "0.25", "bcheur_fee": "0.25", "bchusd_fee": "0.25", "btc_available": "0.00000000", "btc_balance": "0.00000000", "btc_reserved": "0.00000000", "btceur_fee": "0.25", "btcusd_fee": "0.25", "eth_available": "0.00000000", "eth_balance": "0.00000000", "eth_reserved": "0.00000000", "ethbtc_fee": "0.25", "etheur_fee": "0.25", "ethusd_fee": "0.25", "eur_available": "0.00", "eur_balance": "0.00", "eur_reserved": "0.00", "eurusd_fee": "0.25", "ltc_available": "0.00000000", "ltc_balance": "0.00000000", "ltc_reserved": "0.00000000", "ltcbtc_fee": "0.25", "ltceur_fee": "0.25", "ltcusd_fee": "0.25", "usd_available": "0.00", "usd_balance": "0.00", "usd_reserved": "0.00", "xrp_available": "0.00000000", "xrp_balance": "0.00000000", "xrp_reserved": "0.00000000", "xrpbtc_fee": "0.25", "xrpeur_fee": "0.25", "xrpusd_fee": "0.25"}
Test.IsOk InStr(TestResult, "btc_balance") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult("bch_balance") >= 0
Test.IsOk JsonResult("eth_balance") >= 0
TestResult = PrivateBitstamp("order_status/", "POST", Cred)
'{"error": "Missing id POST param"}
Test.IsOk InStr(TestResult, "Missing") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error"), "Missing id POST param"
'Put the parameters in a dictionary
Dim Params As New Dictionary
Params.Add "id", 12345
TestResult = PrivateBitstamp("order_status/", "POST", Cred, Params)
'{"error": "Order not found"}
Test.IsOk InStr(TestResult, "found") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error"), "Order not found"
'Set a buy order, put the parameters in a dictionary
Dim Params2 As New Dictionary
Params2.Add "amount", 1
Params2.Add "price", 3
Params2.Add "ioc_order", True
TestResult = PrivateBitstamp("v2/buy/etheur/", "POST", Cred, Params2)
'{"status": "error", "reason": {"__all__": ["Minimum order size is 5.0 EUR."]}}
Test.IsOk InStr(TestResult, "Minimum order size") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("status"), "error"
End Sub
Function PublicBitstamp(Method As String, ReqType As String, Optional ParamDict As Dictionary) As String
Dim url As String
PublicApiSite = "https://www.bitstamp.net"
MethodParams = DictToString(ParamDict, "URLENC")
If MethodParams <> "" Then MethodParams = "?" & MethodParams
urlPath = "/api/" & Method & MethodParams
url = PublicApiSite & urlPath
PublicBitstamp = WebRequestURL(url, ReqType)
End Function
Function PrivateBitstamp(Method As String, ReqType As String, Credentials As Dictionary, Optional ParamDict As Dictionary) As String
Dim NonceUnique As String
Dim message As String
Dim PostMsg As String
Dim url As String
Dim PayloadDict As Dictionary
'Get a Nonce
NonceUnique = CreateNonce()
TradeApiSite = "https://www.bitstamp.net/api/"
message = NonceUnique & Credentials("customerID") & Credentials("apiKey")
APIsign = UCase(ComputeHash_C("SHA256", message, Credentials("secretKey"), "STRHEX"))
Set PayloadDict = New Dictionary
PayloadDict("key") = Credentials("apiKey")
PayloadDict("signature") = APIsign
PayloadDict("nonce") = NonceUnique
If Not ParamDict Is Nothing Then
For Each key In ParamDict.Keys
PayloadDict(key) = ParamDict(key)
Next key
End If
PostMsg = DictToString(PayloadDict, "URLENC")
Dim headerDict As New Dictionary
headerDict.Add "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
headerDict.Add "Content-Type", "application/x-www-form-urlencoded"
url = TradeApiSite & Method
PrivateBitstamp = WebRequestURL(url, ReqType, headerDict, PostMsg)
End Function
================================================
FILE: ModExchBittrex.bas
================================================
Attribute VB_Name = "ModExchBittrex"
Sub TestBittrex()
'Source: https://github.com/krijnsent/crypto_vba
'Documentation: https://bittrex.com/home/api
'v3 - https://bittrex.github.io/api/v3
'Remember to create a new API key for excel/VBA
Dim Apikey As String
Dim secretKey As String
Apikey = "your api key here"
secretKey = "your secret key here"
'Remove these 2 lines, unless you define 2 constants somewhere ( Public Const secretkey_btce = "the key to use everywhere" etc )
Apikey = apikey_bittrex
secretKey = secretkey_bittrex
'Put the credentials in a dictionary
Dim Cred As New Dictionary
Cred.Add "apiKey", Apikey
Cred.Add "secretKey", secretKey
' Create a new test suite
Dim Suite As New TestSuite
Suite.Description = "ModExchBittrex"
' Create reporter and attach it to these specs
Dim Reporter As New ImmediateReporter
Reporter.ListenTo Suite
' Create a new test
Dim Test As TestCase
Set Test = Suite.Test("TestBittrexPublic")
'Error, unknown/wrong command
TestResult = PublicBittrex("AnUnknownCommand", "GET")
'{"error_nr":404,"error_txt":"HTTP-Not Found","response_txt":{"code":"NOT_FOUND"}}
Test.IsOk InStr(TestResult, "error") > 0, "test error 1 failed, result: ${1}"
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error_nr"), 404, "test error 2 failed, result: ${1}"
'Request without parameters
TestResult = PublicBittrex("markets", "GET")
'[{"symbol":"4ART-BTC","baseCurrencySymbol":"4ART","quoteCurrencySymbol":"BTC","minTradeSize":"10.00000000","precision":8,"status":"ONLINE","createdAt":"2020-06-10T15:05:29.833Z","notice":"","prohibitedIn":["US"],"associatedTermsOfService":[]},{"symbol":"4ART-USDT","baseCurrencySymbol":"4ART","quoteCurrencySymbol":"USDT","minTradeSize":"10.00000000","precision":5,"status":"ONLINE","createdAt":"2020-06-10T15:05:40.98Z", etc.
Test.IsOk InStr(TestResult, "quoteCurrencySymbol") > 0, "test markets 1 failed, result: ${1}"
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult(1)("quoteCurrencySymbol"), "BTC", "test markets 2 failed, result: ${1}"
Test.IsOk JsonResult(1)("precision") > 0, "test markets 3 failed, result: ${1}"
'Put parameters/options in a dictionary for a summary of one coin, wrong input
Dim Params As New Dictionary
Params.Add "market", "BTC-DOGE"
TestResult = PublicBittrex("markets", "GET", Params)
'{"error_nr":404,"error_txt":"HTTP-Not Found","response_txt":{"code":"MARKET_NAME_REVERSED","detail":"The provided market symbol appears to be reversed. Please retry with the market symbol provided in data.NewMarketSymbol.","data":{"newMarketSymbol":"DOGE-BTC"}}}
Test.IsOk InStr(TestResult, "error") > 0, "test error2 1 failed, result: ${1}"
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error_nr"), 404, "test error2 2 failed, result: ${1}"
'Parameter in a dictionary
Dim Params2 As New Dictionary
Params2.Add "market", "DOGE-BTC"
TestResult = PublicBittrex("markets", "GET", Params2)
'{"symbol":"DOGE-BTC","baseCurrencySymbol":"DOGE","quoteCurrencySymbol":"BTC","minTradeSize":"1000.00000000","precision":8,"status":"ONLINE","createdAt":"2014-02-13T00:00:00Z","prohibitedIn":[],"associatedTermsOfService":[]}
Test.IsOk InStr(TestResult, "baseCurrencySymbol") > 0, "test markets detail 1 failed, result: ${1}"
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("quoteCurrencySymbol"), "BTC", "test markets detail 2 failed, result: ${1}"
Test.IsEqual JsonResult("precision"), 8, "test markets detail 3 failed, result: ${1}"
Test.IsEqual JsonResult("baseCurrencySymbol"), "DOGE", "test markets detail 4 failed, result: ${1}"
'Parameters in a dictionary get '/markets/{marketSymbol}/candles/{candleInterval}/recent
Dim Params3 As New Dictionary
Params3.Add "market", "ETH-BTC"
Params3.Add "type1", "candles"
Params3.Add "candleInterval", "HOUR_1"
Params3.Add "type2", "recent"
TestResult = PublicBittrex("markets", "GET", Params3)
'[{"startsAt":"2020-08-13T15:00:00Z","open":"0.03405607","high":"0.03412946","low":"0.03393712","close":"0.03411082","volume":"224.62409851","quoteVolume":"7.64110651"},{"startsAt":"2020-08-13T16:00:00Z","open":"0.03411095","high":"0.03418634","low":"0.03387446","close":"0.03402789","volume":"303.55027355","quoteVolume":"10.33201616"},{"startsAt":"2020-08-13T17:00:00Z","open":"0.03403607","high":"0.03407806","low":"0.03389236","close":"0.03403147","volume":"487.61617145","quoteVolume":"16.57089220"},{"startsAt":"2020-08-13T18:00:00Z","open":"0.03403252","high":"0.03413220","low":"0.03403252","close":"0.03410964","volume":"388.13757692","quoteVolume":"13.22881730"},{"startsAt":"2020-08-13T19:00:00Z","open":"0.03408765","high":"0.03425485","low":"0.03408765","close":"0.03422712","volume":"312.75229144","quoteVolume":"10.69620756"}, etc...
Test.IsOk InStr(TestResult, "startsAt") > 0, "test candles 1 failed, result: ${1}"
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult(1)("open") > 0, "test candles 2 failed, result: ${1}"
Test.IsOk JsonResult(1)("high") > 0, "test candles 3 failed, result: ${1}"
Test.IsOk JsonResult(1)("low") > 0, "test candles 4 failed, result: ${1}"
'Get bittrex time from ping
Set Test = Suite.Test("TestBittrexTime")
TestResult = GetBittrexTime()
Test.IsOk TestResult > 0, "test time 2 failed, result: ${1}"
'Test private API
Set Test = Suite.Test("TestBittrexPrivate")
TestResult = PrivateBittrex("balances", "GET", Cred)
'[{"currencySymbol":"BCH","total":"0.00001733","available":"0.00001733","updatedAt":"2001-01-01T00:00:00Z"},{"currencySymbol":"BTC","total":"0.01500039","available":"0.01500039","updatedAt":"2001-01-01T00:00:00Z"},{"currencySymbol":"BTXCRD","total":"0.00000000","available":"0.00000000","updatedAt":"2019-10-23T04:16:31.1Z"},{"currencySymbol":"XLM","total":"0","available":"0","updatedAt":"2020-09-13T16:02:42.84307Z"}], etc...
Test.IsOk InStr(TestResult, "currencySymbol") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk Len(JsonResult(1)("currencySymbol")) >= 3
Test.IsOk JsonResult(1)("Balance") >= 0
Dim Params4 As New Dictionary
Params4.Add "marketSymbol", "XRP-BTC"
TestResult = PrivateBittrex("orders/open", "GET", Cred, Params4)
'[] (assuming no open orders DOGE-BTC, why would you have any...?
Test.IsEqual TestResult, "[]"
'Buy 1 BTC for a crazy low price of 0.1 USD :-)
Dim Params5 As New Dictionary
Params5.Add "marketSymbol", "BTC-USD"
Params5.Add "direction", "BUY"
Params5.Add "type", "LIMIT"
Params5.Add "timeInForce", "FILL_OR_KILL"
Params5.Add "quantity", 1
Params5.Add "limit", 0.1
TestResult = PrivateBittrex("orders", "POST", Cred, Params5)
Debug.Print TestResult
If InStr(TestResult, "error_nr") Then
'e.g. {"error_nr":400,"error_txt":"HTTP-Bad Request","response_txt":{"code":"SOURCE_OF_FUNDS_REQUIRED"}}
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult("error_nr") >= 400
Else
'or OK: {"id": "string (uuid)","marketSymbol": "string","direction": "string","type": "string","quantity": "number (double)","limit": "number (double)","ceiling": "number (double)","timeInForce": "string","clientOrderId": "string (uuid)","fillQuantity": "number (double)","commission": "number (double)","proceeds": "number (double)","status": "string","createdAt": "string (date-time)","updatedAt": "string (date-time)","closedAt": "string (date-time)","orderToCancel": { "type": "string", "id": "string (uuid)"}}
Test.IsOk InStr(TestResult, "marketSymbol") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("direction"), "BUY"
End If
'Cancel order with id
Dim Params6 As New Dictionary
Params6.Add "uuid", "orderid-bla"
TestResult = PrivateBittrex("orders", "DELETE", Cred, Params6)
'{"error_nr":404,"error_txt":"HTTP-Not Found","response_txt":{"code":"NOT_FOUND"}}
Test.IsOk InStr(TestResult, "error_nr") > 0
Test.IsOk InStr(TestResult, "NOT_FOUND") > 0
End Sub
Function PublicBittrex(Method As String, ReqType As String, Optional ParamDict As Dictionary) As String
Dim url As String
PublicApiSite = "https://api.bittrex.com"
MethodParams = ""
If Not ParamDict Is Nothing Then
For Each itm In ParamDict
MethodParams = MethodParams & ParamDict(itm) & "/"
Next itm
End If
urlPath = "/v3/" & Method & "/" & MethodParams
url = PublicApiSite & urlPath
PublicBittrex = WebRequestURL(url, ReqType)
End Function
Function PrivateBittrex(Method As String, ReqType As String, Credentials As Dictionary, Optional ParamDict As Dictionary) As String
Dim NonceUnique As String
Dim postdata As String
Dim url As String
Dim Uri As String
'Get a 13-digit Nonce from the server time
NonceUnique = GetBittrexTime
TradeApiSite = "https://api.bittrex.com/v3/"
url = TradeApiSite & Method
postdata = ""
If ReqType = "DELETE" Then
For Each itm In ParamDict
url = url & "/" & ParamDict(itm)
Next itm
ElseIf ReqType = "GET" And Not ParamDict Is Nothing Then
url = url & "?" & DictToString(ParamDict, "URLENC")
ElseIf ReqType = "POST" Then
postdata = JsonConverter.ConvertToJson(ParamDict)
End If
contentHash = ComputeHash_C("SHA512", postdata, "", "STRHEX")
preSign = NonceUnique & url & ReqType & contentHash
APIsign = ComputeHash_C("SHA512", preSign, Credentials("secretKey"), "STRHEX")
Dim headerDict As New Dictionary
headerDict.Add "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
headerDict.Add "Content-Type", "application/json"
headerDict.Add "Api-Key", Credentials("apiKey")
headerDict.Add "Api-Timestamp", NonceUnique
headerDict.Add "Api-Content-Hash", contentHash
headerDict.Add "Api-Signature", APIsign
'Debug.Print url, postdata
PrivateBittrex = WebRequestURL(url, ReqType, headerDict, postdata)
End Function
Function GetBittrexTime() As Double
Dim JsonResponse As String
Dim Json As Object
'GetBittrexTime time from ping
JsonResponse = PublicBittrex("ping", "GET")
Set Json = JsonConverter.ParseJson(JsonResponse)
GetBittrexTime = Json("serverTime")
NonceUnique = CreateNonce(13)
If GetBittrexTime = 0 Then
TimeCorrection = -3600
GetBittrexTime = DateDiff("s", "1/1/1970", Now)
GetBittrexTime = Trim(Str((Val(GetBittrexTime) + TimeCorrection)) & Right(Int(Timer * 100), 2) & "0")
End If
Set Json = Nothing
End Function
================================================
FILE: ModExchBybit.bas
================================================
Attribute VB_Name = "ModExchBybit"
Sub TestBybit()
'Source: https://github.com/krijnsent/crypto_vba
'https://doc.Bybit.co.kr/#section/V2-version
'Remember to create a new API key for excel/VBA
Dim Apikey As String
Dim secretKey As String
Apikey = "your api key here"
secretKey = "your secret key here"
'Remove these 2 lines, unless you define 2 constants somewhere ( Public Const secretkey_btce = "the key to use everywhere" etc )
Apikey = apikey_bybit
secretKey = secretkey_bybit
'Put the credentials in a dictionary
Dim Cred As New Dictionary
Cred.Add "apiKey", Apikey
Cred.Add "secretKey", secretKey
' Create a new test suite
Dim Suite As New TestSuite
Suite.Description = "ModExchBybit"
' Create reporter and attach it to these specs
Dim Reporter As New ImmediateReporter
Reporter.ListenTo Suite
' Create a new test
Dim Test As TestCase
Set Test = Suite.Test("TestBybitPublic")
'Error, unknown command
TestResult = PublicBybit("AnUnknownCommand", "GET")
'{"error_nr":404,"error_txt":"HTTP-Not Found","response_txt":0}
Test.IsOk InStr(TestResult, "error") > 0, "unknowncommand 1 failed, result: ${1}"
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error_txt"), "HTTP-Not Found", "unknowncommand 2 failed, result: ${1}"
Test.IsEqual JsonResult("error_nr"), 404, "unknowncommand 3 failed, result: ${1}"
'OK request
TestResult = PublicBybit("time", "GET")
'e.g. {"ret_code":0,"ret_msg":"OK","ext_code":"","ext_info":"","result":{},"time_now":"1572094930.589837"}
Test.IsOk InStr(TestResult, "time_now") > 0, "time 1 failed, result: ${1}"
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("ret_msg"), "OK", "time 1 failed, result: ${1}"
Test.IsOk Val(JsonResult("time_now")) > 1500000000#, "time 1 failed, result: ${1}"
'GET with parameter for orderBook
Dim Params1 As New Dictionary
Params1.Add "symbol", "BTCUSD"
TestResult = PublicBybit("orderBook/L2", "GET", Params1)
'e.g {"ret_code":0,"ret_msg":"OK","ext_code":"","ext_info":"","result":[{"symbol":"BTCUSD","price":"9094","size":214217,"side":"Buy"},{"symbol":"BTCUSD","price":"9093","size":208793,"side":"Buy"},{"symbol":"BTCUSD","price":"9092","size":208793,"side":"Buy"},{"symbol":"BTCUSD","price":"9086","size":1,"side":"Buy"},{"symbol":"BTCUSD","price":"9077","size":3855,"side":"Buy"},{"symbol":"BTCUSD","price":"9076","size":2500,"side":"Buy"},{"symbol":"BTCUSD","price":"9075","size":1515,"side":"Buy"},{"symbol":"BTCUSD","price":"9074","size":11419,"side":"Buy"},{"symbol":"BTCUSD","price":"9073","size":500,"side":"Buy"},{"symbol":"BTCUSD","price":"9070.5","size":727,"side":"Buy"},{"symbol":"BTCUSD","price":"9070","size":6786,"side":"Buy"},{"symbol":"BTCUSD","price":"9068","size":10057,"side":"Buy"},{"symbol":"BTCUSD","price":"9067.5","size":5200,"side":"Buy"},{"symbol":"BTCUSD","price":"9067","size":50,"side":"Buy"},{"symbol":"BTCUSD","price":"9066.5","size":433,"side":"Buy"},
Test.IsEqual JsonResult("ret_msg"), "OK", "orderbook 1 failed, result: ${1}"
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult("result").Count > 0, "orderbook 2 failed, result: ${1}"
Test.IsEqual JsonResult("result")(1)("symbol"), "BTCUSD", "orderbook 3 failed, result: ${1}"
Test.Includes Array("Buy", "Sell"), JsonResult("result")(1)("side"), "orderbook 4 failed, result: ${1}"
'GET all tickers -> add a parameter like above to only get one
TestResult = PublicBybit("tickers", "GET")
'e.g. {"ret_code":0,"ret_msg":"OK","ext_code":"","ext_info":"","result":[{"symbol":"BTCUSD","bid_price":"9176","ask_price":"9176.5","last_price":"9176.00","last_tick_direction":"MinusTick","prev_price_24h":"7624.50","price_24h_pcnt":"0.203488","high_price_24h":"10558.00","low_price_24h":"7624.00","prev_price_1h":"9250.50","price_1h_pcnt":"-0.008053","mark_price":"9174.56","index_price":"9174.02","open_interest":98256174,"open_value":"10936.65","total_turnover":"11422803.74","turnover_24h":"476498.44","total_volume":106760806255,"volume_24h":4369471987,"funding_rate":"0.000168","predicted_funding_rate":"0.000352","next_funding_time":"2019-10-26T16:00:00Z","countdown_hour":3},{"symbol":"ETHUSD","bid_price":"180.2","ask_price":"180.25","last_price":"180.20","last_tick_direction":"MinusTick","prev_price_24h":"166.60","price_24h_pcnt":"0.081632","high_price_24h":"199.85","low_price_24h":"166.50","prev_price_1h":"181.65","price_1h_pcnt":"-0.007982","mark_price":"180.49","index_price":"180.48",
Test.IsEqual JsonResult("ret_msg"), "OK", "tickers 1 failed, result: ${1}"
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult("result").Count > 0, "tickers 2 failed, result: ${1}"
Test.IsOk Val(JsonResult("result")(1)("bid_price")) > 0, "tickers 3 failed, result: ${1}"
Test.IsOk Val(JsonResult("result")(1)("prev_price_24h")) > 0, "tickers 4 failed, result: ${1}"
Dim Params1a As New Dictionary
Dim LimitTime As Double
Dim ResTime As Long
Params1a.Add "symbol", "BTCUSD"
Params1a.Add "interval", 60 'TimeFrame in minutes
Params1a.Add "limit", 2
LimitTime = Round(GetBybitTime() / 1000, 0) - 60 * 60 * 2
'GetByBitTime returns time in ms (microseconds, 13 digits), and this function takes seconds (10 digits)
'In order to get the past 2 hours, deduct that time in seconds: interval*limit*60
Params1a.Add "from", LimitTime
TestResult = PublicBybit("kline/list", "GET", Params1a)
Test.IsEqual JsonResult("ret_msg"), "OK", "kline 1 failed, result: ${1}"
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult("result").Count > 0, "kline 2 failed, result: ${1}"
Test.IsEqual JsonResult("result")(1)("symbol"), "BTCUSD", "kline 3 failed, result: ${1}"
Test.IsOk Val(JsonResult("result")(1)("high")) > 0, "kline 4 failed, result: ${1}"
'ResTime = JsonResult("result")(1)("open_time")
'Debug.Print ResTime, UnixTimeToDate(ResTime)
'ResTime = JsonResult("result")(2)("open_time")
'Debug.Print ResTime, UnixTimeToDate(ResTime)
' Create a new test
Set Test = Suite.Test("TestBybitTime")
TestResult = GetBybitTime()
Test.IsOk TestResult > 1500000000000#, "bybit time 1 failed, result: ${1}"
Test.IsOk TestResult < 1600000000000#, "bybit time 2 failed, result: ${1}"
Set Test = Suite.Test("TestBybitPrivate")
'Api key properties
TestResult = PrivateBybit("open-api/api-key", "GET", Cred)
'e.g. {"ret_code":0,"ret_msg":"ok","ext_code":"","result":[{"api_key":"Tc5aI32WaSqSD","user_id":619,"ips":["192.168.1.1"],"note":"ExcelBybit","permissions":["Order","Position"],"created_at":"2019-10-26T10:16:38.000Z","read_only":false}],"ext_info":null,"time_now":"1572103275.354790","rate_limit_status":99,"rate_limit_reset":1572103275}
Test.IsOk InStr(TestResult, "ret_msg") > 0
'Debug.Print TestResult
Set JsonResult = JsonConverter.ParseJson(TestResult)
If JsonResult("ret_msg") = "ok" Then
Test.IsOk Len(JsonResult("result")(1)("api_key")) >= 10
Test.IsOk JsonResult("result")(1)("user_id") > 0
Else
'E.g. IP-address block
Test.IsEqual Left(JsonResult("ret_msg"), 12), "unmatched IP"
Test.IsUndefined JsonResult("result")
End If
'Example set leverage
Dim Params2 As New Dictionary
Params2.Add "symbol", "ETHUSD"
Params2.Add "leverage", 1
TestResult = PrivateBybit("user/leverage/save", "POST", Cred, Params2)
'Debug.Print TestResult
'e.g. {"ret_code":0,"ret_msg":"ok","ext_code":"","result":2,"ext_info":null,"time_now":"1572104006.055933","rate_limit_status":74,"rate_limit_reset":1572104006}
'or {"ret_code":34015,"ret_msg":"cannot set leverage which is same to the old leverage","ext_code":"","result":null,"ext_info":null,"time_now":"1572103987.614015","rate_limit_status":72,"rate_limit_reset":1572103987}
Test.IsOk InStr(TestResult, "ret_msg") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
If JsonResult("ret_msg") = "ok" Then
Test.IsEqual JsonResult("ret_msg"), "ok"
Test.IsEqual JsonResult("result"), 1 'same as input leverage
Else
'Assume leverage is the same as before
Test.IsEqual JsonResult("ret_msg"), "cannot set leverage which is same to the old leverage"
Test.IsUndefined JsonResult("result")
End If
'Example set leverage
Tm = GetBybitTime()
'e.g. 1583401823000 -> milliseconds
Hrs = 24
Dim Params3 As New Dictionary
Params3.Add "symbol", "ETHUSD"
Params3.Add "limit", 1
Params3.Add "start_time", Tm - 3600000 * Hrs
TestResult = PrivateBybit("v2/private/execution/list", "GET", Cred, Params3)
'Debug.Print Tm
'Debug.Print TestResult
'{"ret_code":0,"ret_msg":"OK","ext_code":"","ext_info":"","result":{"order_id":"","trade_list":null},"time_now":"1583400361.063716","rate_limit_status":119,"rate_limit_reset_ms":1583400361061,"rate_limit":120}
'/v2/private/execution/list
End Sub
Function PublicBybit(Method As String, ReqType As String, Optional ParamDict As Dictionary) As String
Dim url As String
PublicApiSite = "https://api.bybit.com/v2/public/"
'symbols, orderBook/L2 +symbol , time, tickers (+symbol)
MethodParams = DictToString(ParamDict, "URLENC")
If MethodParams <> "" Then MethodParams = "?" & MethodParams
urlPath = Method & MethodParams
url = PublicApiSite & urlPath
PublicBybit = WebRequestURL(url, ReqType)
End Function
Function PrivateBybit(Method As String, ReqType As String, Credentials As Dictionary, Optional ParamDict As Dictionary) As String
Dim NonceUnique As String
Dim postdata As String
Dim postdataUrl As String
Dim postdataJSON As String
Dim url As String
'Get a 10-digit Nonce
NonceUnique = GetBybitTime()
TradeApiSite = "https://api.bybit.com/"
url = TradeApiSite & Method
Dim PostDict As New Dictionary
PostDict.Add "api_key", Credentials("apiKey")
PostDict.Add "timestamp", NonceUnique
If Not ParamDict Is Nothing Then
For Each key In ParamDict.Keys
PostDict(key) = ParamDict(key)
Next key
End If
'Sort alphabetically
Call SortDictByKey(PostDict)
'All parameters are in the PostDict dictionary, merge them to a string
MsgToSign = DictToString(PostDict, "URLENC")
APIsign = ComputeHash_C("SHA256", MsgToSign, Credentials("secretKey"), "STRHEX")
PostDict.Add "sign", APIsign
If UCase(ReqType) = "GET" Then
MethodParams = DictToString(PostDict, "URLENC")
If MethodParams <> "" Then MethodParams = "?" & MethodParams
contentFormat = "application/x-www-form-urlencoded"
ElseIf UCase(ReqType) = "POST" Then
postdataJSON = JsonConverter.ConvertToJson(ParamDict)
contentFormat = "application/json"
MethodParams = ""
Else
'Wrong Method, error out
Exit Function
End If
Dim headerDict As New Dictionary
headerDict.Add "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
headerDict.Add "Content-Type", contentFormat
url = TradeApiSite & Method & MethodParams
PrivateBybit = WebRequestURL(url, ReqType, headerDict, postdataJSON)
End Function
Function GetBybitTime() As Double
Dim BybitTime As String
Dim ValBybitTime As Double
Dim JsonResponse As String
Dim Json As Object
'PublicBybit time, 13 digit (ms)
JsonResponse = PublicBybit("time", "GET")
Set Json = JsonConverter.ParseJson(JsonResponse)
BybitTime = Left(Json("time_now"), InStr(Json("time_now"), ".") - 1) & "000"
If Len(BybitTime) = 0 Then
TimeCorrection = -3600
ValBybitTime = DateDiff("s", "1/1/1970", Now) + TimeCorrection
BybitTime = Trim(Str(ValBybitTime) & Right(Int(Timer * 100), 2) & "0")
End If
'Debug.Print BybitTime
GetBybitTime = Val(BybitTime)
Set Json = Nothing
End Function
================================================
FILE: ModExchCoinbase.bas
================================================
Attribute VB_Name = "ModExchCoinbase"
Sub TestCoinbase()
'Standard Coinbase, for CoinbasePro (formerly known as GDAX), see that Module
'https://developers.coinbase.com/api/v2#introduction
'Source: https://github.com/krijnsent/crypto_vba
'Remember to create a new API key for excel/VBA
Dim Apikey As String
Dim secretKey As String
Apikey = "your api key here"
secretKey = "your secret key here"
'Remove these 3 lines, unless you define 3 constants somewhere ( Public Const secretkey_gdax = "the key to use everywhere" etc )
Apikey = apikey_coinbase
secretKey = secretkey_coinbase
'Put the credentials in a dictionary
Dim Cred As New Dictionary
Cred.Add "apiKey", Apikey
Cred.Add "secretKey", secretKey
' Create a new test suite
Dim Suite As New TestSuite
Suite.Description = "ModExchCoinbase"
' Create reporter and attach it to these specs
Dim Reporter As New ImmediateReporter
Reporter.ListenTo Suite
' Create a new test
Dim Test As TestCase
Set Test = Suite.Test("TestCoinbasePublic")
'Error, unknown command
TestResult = PublicCoinbase("AnUnknownCommand", "GET")
'{"error_nr":404,"error_txt":"HTTP-Not Found","response_txt":{"errors":[{"id":"not_found","message":"Not found"}]}}
Test.IsOk InStr(TestResult, "error") > 0, "test UnknownCommand 1a failed, result: ${1}"
Test.IsOk InStr(TestResult, "not_found") > 0, "test UnknownCommand 1b failed, result: ${1}"
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error_nr"), 404, "test UnknownCommand 1c failed, result: ${1}"
'Request wrong parameter
Dim Params As New Dictionary
Params.Add "currency", "XY"
TestResult = PublicCoinbase("exchange-rates", "GET", Params)
'{"error_nr":400,"error_txt":"HTTP-Bad Request","response_txt":{"errors":[{"id":"invalid_request","message":"Invalid currency (X)"}]}}
Test.IsOk InStr(TestResult, "error") > 0, "test Rates 1a failed, result: ${1}"
Test.IsOk InStr(TestResult, "invalid_request") > 0, "test Rates 1b failed, result: ${1}"
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error_nr"), 400, "test Rates 1c failed, result: ${1}"
'Simpel request without parameters
TestResult = PublicCoinbase("currencies", "GET")
'{"data":[{"id":"AED","name":"United Arab Emirates Dirham","min_size":"0.01000000"},{"id":"AFN","name":"Afghan Afghani","min_size":"0.01000000"},{"id":"ALL","name":"Albanian Lek","min_size":"0.01000000"},
Test.IsOk InStr(TestResult, "min_size") > 0, "test Currencies 1a failed, result: ${1}"
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult("data").Count >= 20, "test Currencies 1b failed, result: ${1}"
Test.IsEqual JsonResult("data")(1)("id"), "AED", "test Currencies 1c failed, result: ${1}"
Test.IsEqual JsonResult("data")(1)("name"), "United Arab Emirates Dirham", "test Currencies 1d failed, result: ${1}"
Test.IsEqual Val(JsonResult("data")(1)("min_size")), 0.01, "test Currencies 1e failed, result: ${1}"
'Request with parameter
Dim Params2 As New Dictionary
Params2.Add "currency", "ETH"
TestResult = PublicCoinbase("exchange-rates", "GET", Params2)
'{"data":{"currency":"ETH","rates":{"AED":"503.843775","AFN":"10260.72100155","ALL":"15205.84875","AMD":"66996.080561325","ANG":"250.3323036", etc
Test.IsOk InStr(TestResult, "EUR") > 0, "test Rates 2a failed, result: ${1}"
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("data")("currency"), "ETH", "test Rates 2b failed, result: ${1}"
Test.IsEqual Val(JsonResult("data")("rates")("ETH")), 1, "test Rates 2c failed, result: ${1}"
Test.IsOk Val(JsonResult("data")("rates")("USD")) > 0, "test Rates 2d failed, result: ${1}"
'Coinbase time
TestResult = GetCoinbaseTime
Test.IsOk TestResult > 1550000000, "test Time failed, result: ${1}"
Set Test = Suite.Test("TestCoinbasePrivate")
TestResult = PrivateCoinbase("accounts", "GET", Cred)
'Debug.Print TestResult
'{"pagination":{"ending_before":null,"starting_after":null,"limit":25,"order":"desc","previous_uri":null,"next_uri":null},"data":[{"id":"0cdbaac7-da83-5b85-0fe555be0b48","name":"EUR-wallet","primary":false,"type":"fiat","currency":{"code":"EUR","name":"Euro","color":"#0066cf","sort_index":0,"exponent":2,"type":"fiat"},"balance":{"amount":"0.00","currency":"EUR"},"created_at":"2017-12-27T16:57:41Z","updated_at":"2017-12-27T16:57:41Z","resource":"account","resource_path":"/v2/accounts/0cdbaac7-da83-5b85-b647-0fe402be0b48","allow_deposits":true,"allow_withdrawals":true},{"id":"0a3c2dfc-1c62-190b-abef-fbba3102c89b","name":"LTC-wallet","primary":true,"type":"wallet", etc...
Test.IsOk InStr(TestResult, "currency") > 0
Test.IsOk InStr(TestResult, "warnings") > 0
Test.IsOk InStr(TestResult, "balance") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("pagination")("limit"), 74
Test.IsOk JsonResult("data").Count >= 1
Test.IsEqual JsonResult("warnings")(1)("id"), "missing_version"
'user with CB-VERSION (API client version you can add to your requests to make sure you have the same version as you checked online, but no response is given
'Request with CB-VERSION
Dim Params3 As New Dictionary
Params3.Add "CB-VERSION", "2005-05-05"
TestResult = PrivateCoinbase("user", "GET", Cred, Params3)
'{"data":{"id":"3c7-12505bcbf174","name":"Koen Rijnsent","username":null,"profile_location":null,"profile_bio":null,"profile_url":null,"avatar_url":"https://res.cloudinary.com/coinbase/image/upload/c_fill,h_128,w_128/heg.png","resource":"user","resource_path":"/v2/user","email":"donotmailthis@here.com","time_zone":"Pacific Time (US \u0026 Canada)","native_currency":"EUR","bitcoin_unit":"BTC","state":null,"country":{"code":"NL","name":"Netherlands","is_in_europe":true},"region_supports_fiat_transfers":true,"region_supports_crypto_to_crypto_transfers":true,"created_at":"2008-01-01T16:51:09Z","tiers":{"completed_description":"Level 1","upgrade_button_text":null,"header":null,"body":null},"referral_money":{"amount":"8.90","currency":"EUR","currency_symbol":""}}}
Test.IsEqual InStr(TestResult, "warnings"), 0
Test.IsOk InStr(TestResult, "profile_location") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk Len(JsonResult("data")("id")) > 10
Test.IsOk Len(JsonResult("data")("native_currency")) >= 3
'Update the default currency to EUR
Dim Params4 As New Dictionary
Params4.Add "CB-VERSION", "2005-05-05"
Params4.Add "native_currency", "EUR"
TestResult = PrivateCoinbase("user", "PUT", Cred, Params4)
'{"data":{"id":"3c7-12505bcbf174","name":"Koen Rijnsent","username":null,"profile_location":null,"profile_bio":null,"profile_url":null,"avatar_url":"https://res.cloudinary.com/coinbase/image/upload/c_fill,h_128,w_128/heg.png","resource":"user","resource_path":"/v2/user","email":"donotmailthis@here.com","time_zone":"Pacific Time (US \u0026 Canada)","native_currency":"EUR","bitcoin_unit":"BTC","state":null,"country":{"code":"NL","name":"Netherlands","is_in_europe":true},"region_supports_fiat_transfers":true,"region_supports_crypto_to_crypto_transfers":true,"created_at":"2008-01-01T16:51:09Z","tiers":{"completed_description":"Level 1","upgrade_button_text":null,"header":null,"body":null},"referral_money":{"amount":"8.90","currency":"EUR","currency_symbol":""}}}
Test.IsEqual InStr(TestResult, "warnings"), 0
Test.IsOk InStr(TestResult, "profile_location") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk Len(JsonResult("data")("id")) > 10
Test.IsEqual JsonResult("data")("referral_money")("currency"), "EUR"
'Buy order that errors out
Dim Params5 As New Dictionary
Params5.Add "CB-VERSION", "2005-05-05"
Params5.Add "amount", 3
Params5.Add "currency", "BTC"
Params5.Add "quote", "true"
TestResult = PrivateCoinbase("accounts/the_right_account_here/buys", "POST", Cred, Params5)
'error with account: {"error_nr":400,"error_txt":"HTTP-Bad Request","response_txt":{"errors":[{"id":"invalid_request","message":"Can't buy with this account"}]}}
'unknown account id: {"error_nr":404,"error_txt":"HTTP-Not Found","response_txt":{"errors":[{"id":"not_found","message":"Not found"}]}}
Test.IsOk InStr(TestResult, "errors") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult("response_txt")("errors").Count >= 1
End Sub
Function PublicCoinbase(Method As String, ReqType As String, Optional ParamDict As Dictionary) As String
Dim url As String
PublicApiSite = "https://api.coinbase.com"
MethodParams = DictToString(ParamDict, "URLENC")
If MethodParams <> "" Then MethodParams = "?" & MethodParams
urlPath = "/v2/" & Method & MethodParams
url = PublicApiSite & urlPath
PublicCoinbase = WebRequestURL(url, ReqType)
End Function
Function PrivateCoinbase(Method As String, ReqType As String, Credentials As Dictionary, Optional ParamDict As Dictionary) As String
Dim NonceUnique As String
Dim url As String
Dim CBVersion As String
Dim MethodParams As String
'Get a 10-digit Nonce
NonceUnique = GetCoinbaseTime
TradeApiSite = "https://api.coinbase.com/v2/"
'If a CB-VERSION is present, put it in a variable and remove it from the Parameter dictionary
CBVersion = ""
MethodParams = ""
If Not ParamDict Is Nothing Then
If ParamDict.Exists("CB-VERSION") Then
CBVersion = ParamDict("CB-VERSION")
ParamDict.Remove "CB-VERSION"
End If
'Change the rest of the parameters to JSON
MethodParams = JsonConverter.ConvertToJson(ParamDict)
If MethodParams = "{}" Then MethodParams = ""
End If
SignMsg = NonceUnique & UCase(ReqType) & "/v2/" & Method & MethodParams
APIsign = ComputeHash_C("SHA256", SignMsg, Credentials("secretKey"), "STRHEX")
Dim headerDict As New Dictionary
headerDict.Add "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
headerDict.Add "Content-Type", "application/json"
headerDict.Add "CB-ACCESS-KEY", Credentials("apiKey")
headerDict.Add "CB-ACCESS-SIGN", APIsign
headerDict.Add "CB-ACCESS-TIMESTAMP", NonceUnique
If CBVersion <> "" Then
headerDict.Add "CB-VERSION", CBVersion
End If
url = TradeApiSite & Method
PrivateCoinbase = WebRequestURL(url, ReqType, headerDict, MethodParams)
End Function
Function GetCoinbaseTime() As Double
Dim JsonResponse As String
Dim Json As Object
JsonResponse = PublicCoinbase("time", "GET")
Set Json = JsonConverter.ParseJson(JsonResponse)
GetCoinbaseTime = Int(Json("data")("epoch"))
If GetCoinbaseTime = 0 Then
TimeCorrection = -3600
GetCoinbaseTime = CreateNonce(10)
GetCoinbaseTime = Trim(Str((Val(GetCoinbaseTime) + TimeCorrection)) & Right(Int(Timer * 100), 2) & "0")
End If
Set Json = Nothing
End Function
================================================
FILE: ModExchCoinbasePro.bas
================================================
Attribute VB_Name = "ModExchCoinbasePro"
Sub TestCoinbasePro()
'CoinbasePro, formerly known as GDAX
'For normal Coinbase, see the Coinbase API
'API docs: https://docs.pro.coinbase.com/
'Source: https://github.com/krijnsent/crypto_vba
'Remember to create a new API key for excel/VBA
Dim Apikey As String
Dim secretKey As String
Dim passphrase As String
Apikey = "your api key here"
secretKey = "your secret key here"
passphrase = "your passphrase here"
'Remove these 3 lines, unless you define 3 constants somewhere ( Public Const secretkey_gdax = "the key to use everywhere" etc )
Apikey = apikey_coinbase_pro
secretKey = secretkey_coinbase_pro
passphrase = passphrase_coinbase_pro
'Put the credentials in a dictionary
Dim Cred As New Dictionary
Cred.Add "apiKey", Apikey
Cred.Add "secretKey", secretKey
Cred.Add "Passphrase", passphrase
' Create a new test suite
Dim Suite As New TestSuite
Suite.Description = "ModExchCoinbasePro"
' Create reporter and attach it to these specs
Dim Reporter As New ImmediateReporter
Reporter.ListenTo Suite
' Create a new test
Dim Test As TestCase
Set Test = Suite.Test("TestCoinbaseProPublic")
'Error, unknown command
TestResult = PublicCoinbasePro("AnUnknownCommand", "GET")
'{"error_nr":401,"error_txt":"HTTP-Unauthorized","response_txt":{"message":"CB-ACCESS-KEY header is required"}}
Test.IsOk InStr(TestResult, "message") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error_nr"), 401
Test.IsEqual JsonResult("response_txt")("message"), "Unauthorized."
'Request wrong parameters
Dim Params As New Dictionary
Params.Add "level", 5
TestResult = PublicCoinbasePro("products/BTC-USD/book", "GET", Params)
'{"error_nr":400,"error_txt":"HTTP-Bad Request","response_txt":{"message":"Bad Request"}}
Test.IsOk InStr(TestResult, "message") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error_nr"), 400
Test.IsEqual JsonResult("response_txt")("message"), "unexpected level: _"
'Request with parameter
Dim Params2 As New Dictionary
Params2.Add "level", 1
TestResult = PublicCoinbasePro("products/ETH-EUR/book", "GET", Params2)
'{"sequence":2052119022,"bids":[["118.04","200.16128756",5]],"asks":[["118.05","30.06104554",4]]}
Test.IsOk InStr(TestResult, "asks") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult("sequence") > 1
Test.IsEqual JsonResult("bids").Count, 1
Test.IsEqual JsonResult("asks").Count, 1
'Coinbase time
TestResult = GetCoinbaseProTime
Test.IsOk TestResult > 1550000000
Set Test = Suite.Test("TestCoinbaseProPrivate")
TestResult = PrivateCoinbasePro("accounts", "GET", Cred)
'[{"id":"8a06fcff-f233-4b2a-b333-ec2ccd727956","currency":"BTC","balance":"0.0000000000000000","available":"0","hold":"0.0000000000000000","profile_id":"2c-015-61806709e17"},{"id":"b9d028fa-748a-9fa3-9df9b877457d","currency":"LTC","balance":"0.0000000000000000","available":"0","hold":" etc...
Test.IsOk InStr(TestResult, "profile_id") > 0
Test.IsOk InStr(TestResult, "balance") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult.Count > 1
Test.IsEqual JsonResult(1)("currency"), "BAT"
Test.IsOk JsonResult(1)("balance") >= 0
Dim Params8 As New Dictionary
Params8.Add "size", 0.01
Params8.Add "price", 100.1
Params8.Add "side", "buy"
Params8.Add "product_id", "BTC-EUR"
TestResult = PrivateCoinbasePro("orders", "POST", Cred, Params8)
If InStr(TestResult, "error_txt") > 0 Then
'Error result, assume insufficient funds, but could also be Product not found
'{"error_nr":400,"error_txt":"HTTP-Bad Request","response_txt":{"message":"Insufficient funds"}}
Test.IsOk InStr(TestResult, "response_txt") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("response_txt")("message"), "Insufficient funds"
Else
'Normal result
'{"id": "d0c5340b-6d6c-49d9-b567-48c4bfca13d2","price": "100.10000000","size": "0.01000000","product_id": "BTC-EUR","side": "buy","stp": "dc","type": "limit","time_in_force": "GTC","post_only": false,"created_at": "2016-12-08T20:02:28.53864Z","fill_fees": "0.0000000000000000","filled_size": "0.00000000","executed_value": "0.0000000000000000","status": "pending","settled": false}
Test.IsOk InStr(TestResult, "created_at") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk Len(JsonResult("id")) > 10
Test.IsEqual JsonResult("product_id"), "BTC-EUR"
End If
'Delete all BTC-EUR orders
Dim Params3 As New Dictionary
Params3.Add "product_id", "BTC-EUR"
TestResult = PrivateCoinbasePro("orders", "DELETE", Cred, Params3)
'No orders to delete: []
Test.IsEqual TestResult, "[]"
'Withdraw one BAT to an invalid account
Dim Params4 As New Dictionary
Params4.Add "amount", 1
Params4.Add "currency", "BAT"
Params4.Add "crypto_address", "0x0"
TestResult = PrivateCoinbasePro("withdrawals/crypto", "POST", Cred, Params4)
'E.g. {"error_nr":403,"error_txt":"HTTP-Forbidden","response_txt":{"message":"Forbidden"}}
Test.IsOk InStr(TestResult, "Forbidden") > 0
Dim Params5 As New Dictionary
Params5.Add "product_id", "ETH-USD"
TestResult = PrivateCoinbasePro("fills", "GET", Cred, Params5)
Test.IsEqual TestResult, "[]"
'{"error_nr":401,"error_txt":"HTTP-Unauthorized","response_txt":{"message":"invalid signature"}}
End Sub
Function PublicCoinbasePro(Method As String, ReqType As String, Optional ParamDict As Dictionary) As String
Dim url As String
PublicApiSite = "https://api.pro.coinbase.com"
MethodParams = DictToString(ParamDict, "URLENC")
If MethodParams <> "" Then MethodParams = "?" & MethodParams
urlPath = "/" & Method & MethodParams
url = PublicApiSite & urlPath
PublicCoinbasePro = WebRequestURL(url, ReqType)
End Function
Function PrivateCoinbasePro(Method As String, ReqType As String, Credentials As Dictionary, Optional ParamDict As Dictionary) As String
Dim NonceUnique As String
Dim url As String
Dim MethodParams As String
'Get a 10-digit Nonce
NonceUnique = GetCoinbaseProTime
TradeApiSite = "https://api.pro.coinbase.com"
'Change the parameters to JSON HEREHERE
If ReqType = "GET" Then
MethodParams = DictToString(ParamDict, "URLENC")
If MethodParams <> "" Then MethodParams = "?" & MethodParams
Else
'e.g. POST
MethodParams = JsonConverter.ConvertToJson(ParamDict)
If MethodParams = "{}" Then MethodParams = ""
End If
SignMsg = NonceUnique & UCase(ReqType) & "/" & Method & "" & MethodParams
APIsign = Base64Encode(ComputeHash_C("SHA256", SignMsg, Base64Decode(Credentials("secretKey")), "RAW"))
Dim headerDict As New Dictionary
headerDict.Add "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
headerDict.Add "Content-Type", "application/json"
headerDict.Add "CB-ACCESS-KEY", Credentials("apiKey")
headerDict.Add "CB-ACCESS-SIGN", APIsign
headerDict.Add "CB-ACCESS-TIMESTAMP", NonceUnique
headerDict.Add "CB-ACCESS-PASSPHRASE", Credentials("Passphrase")
url = TradeApiSite & "/" & Method
If ReqType = "GET" Then url = url & MethodParams
PrivateCoinbasePro = WebRequestURL(url, ReqType, headerDict, MethodParams)
End Function
Function GetCoinbaseProTime() As Double
Dim JsonResponse As String
Dim Json As Object
'PublicCoinbasePro time
JsonResponse = PublicCoinbasePro("time", "GET")
Set Json = JsonConverter.ParseJson(JsonResponse)
GetCoinbaseProTime = Int(Json("epoch"))
If GetCoinbaseProTime = 0 Then
TimeCorrection = -3600
GetCoinbaseProTime = CreateNonce(10)
GetCoinbaseProTime = Trim(Str((Val(GetGDAXTime) + TimeCorrection)) & Right(Int(Timer * 100), 2) & "0")
End If
Set Json = Nothing
End Function
================================================
FILE: ModExchCoinone.bas
================================================
Attribute VB_Name = "ModExchCoinone"
Sub TestCoinone()
'Source: https://github.com/krijnsent/crypto_vba
'https://doc.coinone.co.kr/#section/V2-version
'Remember to create a new API key for excel/VBA
Dim Apikey As String
Dim secretKey As String
Apikey = "your api key here"
secretKey = "your secret key here"
'Remove these 2 lines, unless you define 2 constants somewhere ( Public Const secretkey_btce = "the key to use everywhere" etc )
Apikey = apikey_coinone
secretKey = secretkey_coinone
'Put the credentials in a dictionary
Dim Cred As New Dictionary
Cred.Add "apiKey", Apikey
Cred.Add "secretKey", secretKey
' Create a new test suite
Dim Suite As New TestSuite
Suite.Description = "ModExchCoinone"
' Create reporter and attach it to these specs
Dim Reporter As New ImmediateReporter
Reporter.ListenTo Suite
' Create a new test
Dim Test As TestCase
Set Test = Suite.Test("TestCoinonePublic")
'Error, unknown command
TestResult = PublicCoinone("AnUnknownCommand", "GET")
'{"error_nr":200,"error_txt":"NO JSON BUT HTML RETURNED","response_txt":0}
Test.IsOk InStr(TestResult, "error") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error_txt"), "HTTP-Found"
Test.IsEqual JsonResult("error_nr"), 302
'OK request
TestResult = PublicCoinone("ticker", "GET")
'e.g. {"currency":"btc","volume":"633.1048","last":"4684000.0","yesterday_last":"4636000.0","timestamp":"1554107620","yesterday_low":"4592000.0","errorCode":"0","yesterday_volume":"395.8966","high":"4720000.0","result":"success","yesterday_first":"4615000.0","first":"4636000.0","yesterday_high":"4651000.0","low":"4630000.0"}
Test.IsOk InStr(TestResult, "yesterday_last") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk Val(JsonResult("last")) > 0
Test.IsEqual JsonResult("currency"), "btc"
Test.IsOk Val(JsonResult("timestamp")) > 1500000000#
'Put parameters/options in a dictionary
'If no parameters are provided, the defaults are used
'If WRONG PARAMETERS are provided, the defaults will be used: the API fails "silently" and gives no error but default BTC data
Dim Params As New Dictionary
Params.Add "currency", "eth"
Params.Add "period", "hour"
TestResult = PublicCoinone("trades", "GET", Params)
'e.g. {"errorCode":"0","timestamp":"1554107995","completeOrders":[{"is_ask":"0","timestamp":"1554107949","price":"161600.0","id":"395377","qty":"1.6044"},
Test.IsOk InStr(TestResult, "completeOrders") > 0
Test.IsOk InStr(TestResult, "timestamp") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk Val(JsonResult("timestamp")) > 1500000000#
Test.IsEqual JsonResult("errorCode"), "0"
Test.IsEqual JsonResult("completeOrders").Count, 200
Test.IsOk Val(JsonResult("completeOrders")(1)("id")) > 0
Test.IsOk Val(JsonResult("completeOrders")(1)("qty")) > 0
Set Test = Suite.Test("TestCoinonePrivate")
TestResult = PrivateCoinone2("account/balance", "POST", Cred)
'{"btt": {"avail": "0.0", "balance": "0.0"}, "edna": {"avail": "0.0", "balance": "0.0"}, etc.
Test.IsOk InStr(TestResult, "avail") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("result"), "success"
Test.IsEqual JsonResult("errorCode"), "0"
Test.IsOk JsonResult("eos")("avail") >= 0
Test.IsOk JsonResult("btc")("balance") >= 0
Dim Params2 As New Dictionary
Params2.Add "price", 100
Params2.Add "qty", 3
Params2.Add "currency", "EOS"
TestResult = PrivateCoinone2("order/limit_buy", "POST", Cred, Params2)
'{"errorCode":"103","errorMsg":"Lack of Balance","result":"error"}
'{"errorCode":"113","errorMsg":"Quantity is too low","result":"error"}
'{"result": "success","errorCode": "0","orderId": "8a82c561-40b4-4cb3-9bc0-9ac9ffc1d63b"}
Test.IsOk InStr(TestResult, "errorCode") > 0
Test.IsOk InStr(TestResult, "result") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
If Val(JsonResult("errorCode")) = 0 Then
'No error
Test.IsEqual JsonResult("result"), "success"
Test.IsEqual JsonResult("errorCode"), "0"
Test.IsOk Len(JsonResult("orderId")) > 10
Else
'Error
Test.IsEqual JsonResult("result"), "error"
Test.IsOk Len(JsonResult("errorMsg")) > 0
End If
Dim Params3 As New Dictionary
Params3.Add "currency", "ETH"
TestResult = PrivateCoinone2("order/complete_orders", "POST", Cred, Params3)
'{"errorCode": "0", "completeOrders": [], "result": "success"}
'{"result": "success","errorCode": "0","completeOrders": [{"timestamp": "1416561032","price": "419000.0","type": "bid","qty": "0.001","feeRate": "-0.0015","fee": "-0.0000015","orderId": "E84A1AC2-8088-4FA0-B093-A3BCDB9B3C85"}]}
Test.IsOk InStr(TestResult, "completeOrders") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("result"), "success"
Test.IsEqual JsonResult("errorCode"), "0"
Test.IsOk JsonResult("completeOrders").Count >= 0
End Sub
Function PublicCoinone(Method As String, ReqType As String, Optional ParamDict As Dictionary) As String
Dim url As String
PublicApiSite = "https://api.coinone.co.kr/"
MethodParams = DictToString(ParamDict, "URLENC")
If MethodParams <> "" Then MethodParams = "?" & MethodParams
urlPath = Method & MethodParams
url = PublicApiSite & urlPath
PublicCoinone = WebRequestURL(url, ReqType)
End Function
Function PrivateCoinone2(Method As String, ReqType As String, Credentials As Dictionary, Optional ParamDict As Dictionary) As String
Dim NonceUnique As String
Dim postdata As String
Dim postdataUrl As String
Dim postdataJSON As String
Dim url As String
'Get a 14-digit Nonce
NonceUnique = CreateNonce(14)
TradeApiSite = "https://api.coinone.co.kr/v2/"
url = TradeApiSite & Method
Dim PostDict As New Dictionary
PostDict.Add "access_token", Credentials("apiKey")
PostDict.Add "nonce", NonceUnique
If Not ParamDict Is Nothing Then
For Each key In ParamDict.Keys
PostDict(key) = ParamDict(key)
Next key
End If
postdataUrl = DictToString(PostDict, "URLENC")
postdataJSON = JsonConverter.ConvertToJson(PostDict)
postdata64 = Base64Encode(postdataJSON)
APIsign = ComputeHash_C("SHA512", postdata64, Credentials("secretKey"), "STRHEX")
Dim headerDict As New Dictionary
headerDict.Add "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
headerDict.Add "Content-Type", "application/json"
headerDict.Add "X-COINONE-PAYLOAD", postdata64
headerDict.Add "X-COINONE-SIGNATURE", APIsign
url = TradeApiSite & Method
PrivateCoinone2 = WebRequestURL(url, ReqType, headerDict, postdataUrl)
End Function
================================================
FILE: ModExchCoinspot.bas
================================================
Attribute VB_Name = "ModExchCoinspot"
Sub TestCoinspot()
'Source: https://github.com/krijnsent/crypto_vba
'Documentation: https://www.coinspot.com.au/api
'Remember to create a new API key for excel/VBA
Dim Apikey As String
Dim secretKey As String
Apikey = "your api key here"
secretKey = "your secret key here"
'Remove these 2 lines, unless you define 2 constants somewhere ( Public Const secretkey_btce = "the key to use everywhere" etc )
Apikey = apikey_coinspot
secretKey = secretkey_coinspot
'Put the credentials in a dictionary
Dim Cred As New Dictionary
Cred.Add "apiKey", Apikey
Cred.Add "secretKey", secretKey
' Create a new test suite
Dim Suite As New TestSuite
Suite.Description = "ModExchCoinspot"
' Create reporter and attach it to these specs
Dim Reporter As New ImmediateReporter
Reporter.ListenTo Suite
' Create a new test
Dim Test As TestCase
Set Test = Suite.Test("TestCoinspotPublic")
'Error, unknown command
TestResult = PublicCoinspot("AnUnknownCommand", "GET")
'{"error_nr":404,"error_txt":"HTTP-Not Found","response_txt":0}
Test.IsOk InStr(TestResult, "error") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error_nr"), 404
'Request without parameters (for Coinspot only public request)
TestResult = PublicCoinspot("latest", "GET")
'{"status":"ok","prices":{"btc":{"bid":"5330.10000001","ask":"5394","last":"5367"},"ltc":{"bid":"67.1","ask":"68.7","last":"68"},"doge":{"bid":"0.0027","ask":"0.0028","last":"0.0028"},"eth":{"bid":"186.11","ask":"191.99","last":"187"},"powr":{"bid":"0.133","ask":"0.1425","last":"0.14"},"ans":{"bid":"12.5","ask":"13","last":"12.5"},"xrp":{"bid":"0.44","ask":"0.449","last":"0.442"},"trx":{"bid":"0.0325","ask":"0.033999","last":"0.0327"}}}
Test.IsOk InStr(TestResult, "btc") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("status"), "ok"
Test.IsOk JsonResult("prices").Count >= 3
Test.IsOk JsonResult("prices")("btc")("last") > 0
Set Test = Suite.Test("TestCoinspotPrivate")
TestResult = PrivateCoinspot("my/balances", "POST", Cred)
'e.g. {"status":"ok","balance":{"btc":0,"ltc":3,"doge":1000,"ppc":0,"wdc":0,"xpm":0,"max":0,"lot":0,"qrk":0,"moon":0,"ftc":0,"drk":0}}
Test.IsOk InStr(TestResult, "balance") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("status"), "ok"
Test.IsOk JsonResult("balance")("btc") >= 0
Test.IsOk JsonResult("balance")("doge") >= 0
'Put the parameters in a dictionary
Dim Params As New Dictionary
Params.Add "cointype", "DOGE"
Params.Add "amount", 10000
TestResult = PrivateCoinspot("quote/buy", "POST", Cred, Params)
'e.g. {"status":"ok","quote":0.001619,"timeframe":0}
Test.IsOk InStr(TestResult, "quote") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("status"), "ok"
Test.IsOk JsonResult("quote") >= 0
Test.IsOk JsonResult("timeframe") >= 0
End Sub
Function PublicCoinspot(Method As String, ReqType As String, Optional ParamDict As Dictionary) As String
Dim url As String
PublicApiSite = "https://www.coinspot.com.au"
MethodParams = DictToString(ParamDict, "URLENC")
If MethodParams <> "" Then MethodParams = "&" & MethodParams
urlPath = "/pubapi/" & Method & MethodOptions
url = PublicApiSite & urlPath
PublicCoinspot = WebRequestURL(url, ReqType)
End Function
Function PrivateCoinspot(Method As String, ReqType As String, Credentials As Dictionary, Optional ParamDict As Dictionary) As String
Dim NonceUnique As String
Dim postdata As String
Dim url As String
Dim PayloadDict As Dictionary
Dim MethodParams As String
'Get a Nonce
NonceUnique = CreateNonce()
TradeApiSite = "https://www.coinspot.com.au"
Set PayloadDict = New Dictionary
PayloadDict("nonce") = Val(NonceUnique)
If Not ParamDict Is Nothing Then
For Each key In ParamDict.Keys
PayloadDict(key) = ParamDict(key)
Next key
End If
MethodParams = JsonConverter.ConvertToJson(PayloadDict)
PostPath = "/api/" & Method
APIsign = ComputeHash_C("SHA512", MethodParams, Credentials("secretKey"), "STRHEX")
Dim headerDict As New Dictionary
headerDict.Add "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
headerDict.Add "Content-Type", "application/json"
headerDict.Add "sign", APIsign
headerDict.Add "key", Credentials("apiKey")
url = TradeApiSite & PostPath
PrivateCoinspot = WebRequestURL(url, "POST", headerDict, MethodParams)
End Function
================================================
FILE: ModExchHitBTC.bas
================================================
Attribute VB_Name = "ModExchHitBTC"
Sub TestHitBTC()
'Source: https://github.com/krijnsent/crypto_vba
'Remember to create a new API key for excel/VBA
'https://api.hitbtc.com/api/2/explore/
'https://github.com/hitbtc-com/hitbtc-api#rest-api-reference
'HitBTC will require ever increasing values/nonces for the private API and the nonces created in VBA might mismatch that of other sources
Dim Apikey As String
Dim secretKey As String
Apikey = "your api key here"
secretKey = "your secret key here"
'Remove these 2 lines, unless you define 2 constants somewhere ( Public Const secretkey_HitBTC = "the key to use everywhere" etc )
Apikey = apikey_hitbtc
secretKey = secretkey_hitbtc
'Put the credentials in a dictionary
Dim Cred As New Dictionary
Cred.Add "apiKey", Apikey
Cred.Add "secretKey", secretKey
' Create a new test suite
Dim Suite As New TestSuite
Suite.Description = "ModExchHitBTC"
' Create reporter and attach it to these specs
Dim Reporter As New ImmediateReporter
Reporter.ListenTo Suite
' Create a new test
Dim Test As TestCase
Set Test = Suite.Test("TestHitBTCPublic v2")
'Error, unknown command
TestResult = PublicHitBTCv2("AnUnknownCommand", "GET")
'{"error_nr":404,"error_txt":"HTTP-Not Found","response_txt":0}
Test.IsOk InStr(TestResult, "error") > 0, "unknowncommand 1 failed, result: ${1}"
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error_nr"), 503, "unknowncommand 2 failed, result: ${1}"
'Error, wrong parameter
Dim Params As New Dictionary
Params.Add "symbol", "BLABLA"
TestResult = PublicHitBTCv2("trades", "GET", Params)
'{"error_nr":400,"error_txt":"HTTP-Bad Request","response_txt":{"timestamp":"2021-02-09T17:30:24.738+00:00","path":"/api/2/public/trades/BLABLA","status":400,"error":{"code":2001,"description":"Try get /public/symbol, to get list of all available symbols.","message":"No such symbol: BLABLA"},"requestId":"eecd7978-102065517"}}
Test.IsOk InStr(TestResult, "error") > 0, "trades params 1 failed, result: ${1}"
Test.IsOk InStr(TestResult, "No such symbol") > 0, "trades params 2 failed, result: ${1}"
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error_nr"), 400, "trades params 3 failed, result: ${1}"
Test.IsEqual JsonResult("response_txt")("error")("code"), 2001, "trades params 4 failed, result: ${1}"
'Simple request without parameters
TestResult = PublicHitBTCv2("currency", "GET")
'Example: [{"id":"DDF","fullName":"DDF","crypto":true,"payinEnabled":false,"payinPaymentId":false,"payinConfirmations":2,"payoutEnabled":true,"payoutIsPaymentId":false,"transferEnabled":true,"delisted":false,"payoutFee":"646"},{"id":"ZRX","fullName":"0x Protocol","crypto":true,"payinEnabled":true,"payinPaymentId":false,"payinConfirmations":2,"payoutEnabled":true,"payoutIsPaymentId":false,"transferEnabled":true,"delisted":false,"payoutFee":"26.45"},{"id":"ACO","fullName":"A!Coin","crypto":true etc...
Test.IsOk InStr(TestResult, "payoutFee") > 0, "currency 1 failed, result: ${1}"
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult.Count >= 100, "currency 2 failed, result: ${1}"
Test.IsOk Len(JsonResult(1)("id")) >= 3, "currency 3 failed, result: ${1}"
'Request with parameter
Dim Params2 As New Dictionary
Params2.Add "currency", "ETH"
TestResult = PublicHitBTCv2("currency", "GET", Params2)
'{"id":"ETH","fullName":"Ethereum","crypto":true,"payinEnabled":true,"payinPaymentId":false,"payinConfirmations":2,"payoutEnabled":true,"payoutIsPaymentId":false,"transferEnabled":true,"delisted":false,"payoutFee":"0.0428"}
Test.IsOk InStr(TestResult, "Ethereum") > 0, "currency params 1 failed, result: ${1}"
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("id"), "ETH", "currency params 2 failed, result: ${1}"
Test.IsEqual JsonResult("crypto"), True, "currency params 3 failed, result: ${1}"
Test.IsEqual JsonResult("delisted"), False, "currency params 4 failed, result: ${1}"
'Request with parameters
Dim Params3 As New Dictionary
Params3.Add "symbol", "ETHBTC"
Params3.Add "sort", "ASC"
Params3.Add "limit", 10
TestResult = PublicHitBTCv2("trades", "GET", Params3)
'[{"id":3462311,"price":"0.006000","quantity":"0.001","side":"buy","timestamp":"2015-08-20T19:01:23.764Z"},{"id":3462314,"price":"0.006000","quantity":"0.001","side":"buy","timestamp":"2018-07-10T16:11:35.511Z"},etc...
Test.IsOk InStr(TestResult, "timestamp") > 0, "trades2 params 1 failed, result: ${1}"
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult(1)("id") > 0, "trades2 params 2 failed, result: ${1}"
Test.IsOk Val(JsonResult(1)("quantity")) > 0, "trades2 params 3 failed, result: ${1}"
Test.IsEqual JsonResult(1)("side"), "buy", "trades2 params 4 failed, result: ${1}"
Set Test = Suite.Test("TestHitBTCPrivate v2")
TestResult = PrivateHitBTCv2("trading/balance", "GET", Cred)
'[{"currency":"1ST","available":"0","reserved":"0"},{"currency":"8BT","available":"0","reserved":"0"},{"currency":"ABA","available":"0","reserved":"0"},{"currency":"ABTC","available":"0","reserved":"0"},{"currency":"ABYSS","available":"0","reserved":"0"} etc...
Test.IsOk InStr(TestResult, "available") > 0
Test.IsOk InStr(TestResult, "reserved") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
'Loop through all coins
For Each Coin In JsonResult
If Coin("available") + Coin("reserved") > 0 Then
'Debug.Print Coin("currency"), Coin("available") + Coin("reserved")
Test.IsOk Len(Coin("currency")) >= 3
End If
Next Coin
Test.IsOk Len(JsonResult(1)("currency")) > 0
Test.IsOk Val(JsonResult(2)("available")) >= 0
Dim Params4 As New Dictionary
Params4.Add "symbol", "DOGEETH"
TestResult = PrivateHitBTCv2("history/trades", "GET", Cred, Params4)
'e.g. [{"id":215639995,"clientOrderId":"4ab37988ea9545aeb325fc60931fbaa3","orderId":19837911730,"symbol":"DOGEETH","side":"sell","quantity": etc.
If TestResult = "[]" Then
Test.IsEqual TestResult, "[]"
Else
Test.IsOk InStr(TestResult, "clientOrderId") > 0
Test.IsOk InStr(TestResult, "symbol") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk Len(JsonResult(1)("symbol")) >= 6
Test.IsOk JsonResult(2)("orderId") > 0
End If
'Delete all orders DOGE-ETH
Dim Params5 As New Dictionary
Params5.Add "symbol", "DOGEETH"
TestResult = PrivateHitBTCv2("order", "DELETE", Cred, Params5)
'e.g. [{"id": 0,"clientOrderId": "d8574207d9e3b16a4a5511753eeef175","symbol": "DOGEETH","side": "sell","status": "canceled","type": "limit", etc...
If InStr(TestResult, "NO VALID JSON RETURNED") > 0 Then
Test.IsOk InStr(TestResult, ":200") > 0
Else
If TestResult <> "[]" Then
Test.IsOk InStr(TestResult, "clientOrderId") > 0
Test.IsOk InStr(TestResult, "symbol") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult(1)("symbol"), "DOGEETH"
Test.IsOk Len(JsonResult(1)("side")) >= 3
End If
End If
'Create an order, but trigger an error
Dim Params6 As New Dictionary
Params6.Add "symbol", "ETHBTC"
Params6.Add "side", "sell"
Params6.Add "quantity", "0.000005"
Params6.Add "price", "1"
TestResult = PrivateHitBTCv2("order", "POST", Cred, Params6)
'e.g. {"error_nr":400,"error_txt":"HTTP-Bad Request","response_txt":{"error":{"code":20001,"message":"Insufficient funds","description":"Check that the funds are sufficient, given commissions"}}}
'{"error_nr":400,"error_txt":"HTTP-Bad Request","response_txt":{"error":{"code":2011,"message":"Quantity too low","description":"Minimum quantity 0.0001"}}}
'if OK, e.g. {"id": 0,"clientOrderId": "d8574207d9e3b16a4a5511753eeef175","symbol": "ETHBTC","side": "sell","status": "new","type": "limit","timeInForce": "GTC","quantity": "0.063","price": "0.046016","cumQuantity": "0.000","postOnly": false,"createdAt": "2017-05-15T17:01:05.092Z","updatedAt": "2017-05-15T17:01:05.092Z"}
If InStr(TestResult, "clientOrderId") > 0 Then
'Shouldn't happen with current test, for successfull orders
Test.IsOk InStr(TestResult, "symbol") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult(1)("symbol"), "ETHBTC"
Test.IsOk Len(JsonResult(1)("side")) >= 3
Else
Test.IsOk InStr(TestResult, "message") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("response_txt")("error")("code"), 2011
Test.IsEqual JsonResult("response_txt")("error")("message"), "Quantity too low"
End If
End Sub
Function PublicHitBTCv2(Method As String, ReqType As String, Optional ParamDict As Dictionary) As String
Dim url As String
Dim PayloadDict As New Dictionary
PublicApiSite = "https://api.hitbtc.com"
'Get special parameters currency and symbol and add them to the URL
If Not ParamDict Is Nothing Then
For Each key In ParamDict.Keys
If LCase(key) = "currency" Or LCase(key) = "symbol" Then
Method = Method & "/" & ParamDict(key)
Else
PayloadDict(key) = ParamDict(key)
End If
Next key
End If
MethodParams = DictToString(PayloadDict, "URLENC")
If MethodParams <> "" Then MethodParams = "?" & MethodParams
urlPath = "/api/2/public/" & Method & MethodParams
url = PublicApiSite & urlPath
PublicHitBTCv2 = WebRequestURL(url, ReqType)
End Function
Function PrivateHitBTCv2(Method As String, ReqType As String, Credentials As Dictionary, Optional ParamDict As Dictionary) As String
Dim NonceUnique As String
Dim postdata As String
Dim url As String
Dim MethodParams As String
NonceUnique = CreateNonce(10)
TradeApiSite = "https://api.hitbtc.com"
urlPath = "/api/2/" & Method
MethodParams = DictToString(ParamDict, "URLENC")
postdata = JsonConverter.ConvertToJson(ParamDict)
If MethodParams <> "" Then MethodParams = "?" & MethodParams
url = TradeApiSite & urlPath
Dim headerDict As New Dictionary
headerDict.Add "Content-Type", "application/json"
'Credentials in a special format
headerDict.Add "Authorization", "Basic " & Base64Encode(Credentials("apiKey") & ":" & Credentials("secretKey"))
url = TradeApiSite & urlPath & MethodParams
PrivateHitBTCv2 = WebRequestURL(url, ReqType, headerDict, postdata)
End Function
================================================
FILE: ModExchHuobi.bas
================================================
Attribute VB_Name = "ModExchHuobi"
Sub TestHuobi()
'Source: https://github.com/krijnsent/crypto_vba
'https://alphaex-api.github.io/openapi/spot/v1/en/#introduction
'Remember to create a new API key for excel/VBA
Dim Apikey As String
Dim secretKey As String
Apikey = "your api key here"
secretKey = "your secret key here"
'Remove these 2 lines, unless you define 2 constants somewhere ( Public Const secretkey_btce = "the key to use everywhere" etc )
Apikey = apikey_huobi
secretKey = secretkey_huobi
'Put the credentials in a dictionary
Dim Cred As New Dictionary
Cred.Add "apiKey", Apikey
Cred.Add "secretKey", secretKey
' Create a new test suite
Dim Suite As New TestSuite
Suite.Description = "ModExchHuobi"
' Create reporter and attach it to these specs
Dim Reporter As New ImmediateReporter
Reporter.ListenTo Suite
' Create a new test
Dim Test As TestCase
Set Test = Suite.Test("TestHuobiPublic")
'Error, unknown command
TestResult = PublicHuobi("AnUnknownCommand", "GET")
'{"error_nr":404,"error_txt":"HTTP-Not Found","response_txt":0}
Test.IsOk InStr(TestResult, "error") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error_txt"), "HTTP-Not Found"
Test.IsEqual JsonResult("error_nr"), 404
'OK request
TestResult = PublicHuobi("v1/common/timestamp", "GET")
'e.g. {"status":"ok","data":1579706923783}
Test.IsOk InStr(TestResult, "data") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("status"), "ok"
Test.IsOk Val(JsonResult("data")) > 1500000000000#
'Parameters missing
TestResult = PublicHuobi("market/history/kline", "GET")
'e.g. {"ts":1579707152954,"status":"error","err-code":"invalid-parameter","err-msg":"invalid symbol"}
Test.IsOk InStr(TestResult, "error") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("status"), "error"
Test.IsEqual JsonResult("err-msg"), "invalid symbol"
Test.IsOk Val(JsonResult("ts")) > 1500000000000#
'Put parameters/options in a dictionary
'If no parameters are provided, the defaults are used
Dim Params As New Dictionary
Params.Add "period", "1day"
Params.Add "symbol", "btcusdt"
Params.Add "size", 10
TestResult = PublicHuobi("market/history/kline", "GET", Params)
'e.g. {"status":"ok","ch":"market.btcusdt.kline.1day","ts":1579707654120,"data":[{"amount":25326.647313510339831018,"open":8645.130000000000000000,"close":8659.620000000000000000,"high":8817.730000000000000000,"id":1579622400,"count":202979,"low":8500.000000000000000000,"vol":219864523.567705105282063018560000000000000000},{"amount":17344.079067910875891838,"open":8677.970000000000000000,"close":8646.800000000000000000,"high":8744.510000000000000000,"id":1579536000,"count":153447,"low":8607.430000000000000000,"vol":150214939.669388488950943200910000000000000000},{"amount":27195.320357908427801956,"open":8632.820000000000000000,"close":8677.200000000000000000,"high":8756.040000000000000000,"id":1579449600,"count":234172,"low":8480.000000000000000000,"vol":235036539.681727868489706633830000000000000000},
Test.IsOk InStr(TestResult, "market.btcusdt.kline.1day") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk Val(JsonResult("ts")) > 1500000000000#
Test.IsEqual JsonResult("status"), "ok"
Test.IsEqual JsonResult("data").Count, 10
Test.IsOk Val(JsonResult("data")(1)("amount")) > 0
Test.IsOk Val(JsonResult("data")(2)("high")) > 0
Set Test = Suite.Test("TestHuobiPrivate GET")
'Simple test, should return data
TestResult = PrivateHuobi("v1/account/accounts", "GET", Cred)
'{"status":"ok","data":[{"id":9999,"type":"spot","subtype":"","state":"working"}]}
Debug.Print TestResult
Test.IsOk InStr(TestResult, "status") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("status"), "ok"
Test.IsEqual JsonResult("data")(1)("state"), "working"
'Error, forgotten parameter
Dim Params2 As New Dictionary
Params2.Add "size", 10
TestResult = PrivateHuobi("v1/account/history", "GET", Cred, Params2)
'{"status":"error","err-code":"validation-constraints-required","err-msg":"Field is missing: account-id.","data":null}
Test.IsOk InStr(TestResult, "err-msg") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("status"), "error"
Test.IsEqual JsonResult("err-msg"), "Field is missing: account-id."
'Unknown account-id
Dim Params3 As New Dictionary
Params3.Add "account-id", 9999
Params3.Add "size", 50
TestResult = PrivateHuobi("v1/account/history", "GET", Cred, Params3)
'{"status":"error","err-code":"account-get-balance-account-inexistent-error","err-msg":"account for id `6,000,006` and user id `9,999` does not exist","data":null}
Test.IsOk InStr(TestResult, "err-msg") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("status"), "error"
Test.IsEqual JsonResult("err-code"), "account-get-balance-account-inexistent-error"
Set Test = Suite.Test("TestHuobiPrivate POST")
'Get account-id:
TestResult = PrivateHuobi("v1/account/accounts", "GET", Cred)
Set JsonResult = JsonConverter.ParseJson(TestResult)
AccId = JsonResult("data")(1)("id")
'Place order
Dim Params4 As New Dictionary
Params4.Add "account-id", AccId
Params4.Add "amount", 1
Params4.Add "price", 1
Params4.Add "symbol", "ethusdt"
Params4.Add "type", "buy-limit"
TestResult = PrivateHuobi("v1/order/orders/place", "POST", Cred, Params4)
'{"status":"error","err-code":"order-value-min-error","err-msg":"Order total cannot be lower than: `5`","data":null}
Test.IsOk InStr(TestResult, "status") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("status"), "error"
Test.IsEqual JsonResult("err-code"), "order-value-min-error"
End Sub
Function PublicHuobi(Method As String, ReqType As String, Optional ParamDict As Dictionary) As String
Dim url As String
PublicApiSite = "https://api-cloud.huobi.co.kr/"
MethodParams = DictToString(ParamDict, "URLENC")
If MethodParams <> "" Then MethodParams = "?" & MethodParams
urlPath = Method & MethodParams
url = PublicApiSite & urlPath
'Debug.Print Url
PublicHuobi = WebRequestURL(url, ReqType)
End Function
Function PrivateHuobi(Method As String, ReqType As String, Credentials As Dictionary, Optional ParamDict As Dictionary) As String
Dim APIsign As String
Dim ApiEndPoint As String
Dim postdata As String
Dim url As String
'Get a Timestamp
Stamp = GetUTCTime()
StampTxt = URLEncode(Format(Stamp, "YYYY-MM-DDThh:mm:ss"))
HostTxt = "api-cloud.huobi.co.kr"
HostTxt = "api.huobi.pro"
TradeApiSite = "https://" & HostTxt & "/"
url = TradeApiSite & Method
StrHash = ""
postdata = ""
Dim TotDict As New Dictionary
TotDict.Add "AccessKeyId", Credentials("apiKey")
TotDict.Add "SignatureMethod", "HmacSHA256"
TotDict.Add "SignatureVersion", 2
TotDict.Add "Timestamp", StampTxt
If UCase(ReqType) = "POST" Then
'For POST request, all query parameters need to be included in the request body with JSON. (e.g. {"currency":"BTC"}).
MethodParams = DictToString(TotDict, "URLENC")
postdata = JsonConverter.ConvertToJson(ParamDict)
'ApiEndPoint = Url
ElseIf UCase(ReqType) = "GET" Then
If Not ParamDict Is Nothing Then
For Each key In ParamDict.Keys
TotDict(key) = ParamDict(key)
Next key
End If
MethodParams = DictToString(TotDict, "URLENC")
postdata = ""
End If
StrHash = UCase(ReqType) & Chr(10) & HostTxt & Chr(10) & "/" & Method & Chr(10) & MethodParams
If MethodParams <> "" Then MethodParams = "?" & MethodParams
ApiEndPoint = url & MethodParams
'Dim PostDict As New Dictionary
'PostDict.Add "access_token", Credentials("apiKey")
'PostDict.Add "nonce", NonceUnique
'If Not ParamDict Is Nothing Then
' For Each Key In ParamDict.Keys
' PostDict(Key) = ParamDict(Key)
' Next Key
'End If
'postdataUrl = DictToString(PostDict, "URLENC")
'postdataJSON = JsonConverter.ConvertToJson(ParamDict)
'postdata64 = Base64Encode(postdataJSON)
APIsign = ComputeHash_C("SHA256", StrHash, Credentials("secretKey"), "STR64")
APIsignEnc = URLEncode(APIsign)
ApiEndPoint = ApiEndPoint & "&Signature=" & APIsignEnc
Dim headerDict As New Dictionary
headerDict.Add "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
headerDict.Add "Content-Type", "application/json"
'Debug.Print ApiEndPoint
PrivateHuobi = WebRequestURL(ApiEndPoint, ReqType, headerDict, postdata)
End Function
================================================
FILE: ModExchIDEX.bas
================================================
Attribute VB_Name = "ModExchIDEX"
'https://docs.idex.market/#operation/returnCurrencies
Sub TestIDEX()
'Source: https://github.com/krijnsent/crypto_vba
'Documentation: https://docs.idex.io/
'Remember to create a new API key for excel/VBA
Dim Apikey As String
Apikey = "your api key here"
'Remove this lines, unless you define a constant somewhere ( Public Const apikey_idex = "the key to use everywhere" etc )
Apikey = apikey_idex
'Put the credentials in a dictionary
Dim Cred As New Dictionary
Cred.Add "apiKey", Apikey
' Create a new test suite
Dim Suite As New TestSuite
Suite.Description = "ModExchIDEX"
' Create reporter and attach it to these specs
Dim Reporter As New ImmediateReporter
Reporter.ListenTo Suite
' Create a new test
Dim Test As TestCase
Set Test = Suite.Test("TestIDEX")
'Error, unknown command
TestResult = PublicIDEX("AnUnknownCommand", "GET")
'{"error_nr":404,"error_txt":"HTTP-Not Found","response_txt":{"code":"ResourceNotFound","message":"/AnUnknownCommand does not exist"}}
Test.IsOk InStr(TestResult, "error") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error_nr"), 404
'Error, missing parameter
TestResult = PublicIDEX("candles", "GET")
'{"error_nr":400,"error_txt":"HTTP-Bad Request","response_txt":{"code":"REQUIRED_PARAMETER","message":"parameter \"market\" is required but was not provided"}}
Test.IsOk InStr(TestResult, "error") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error_nr"), 400
Test.IsEqual JsonResult("response_txt")("code"), "REQUIRED_PARAMETER"
'GET ticker
Dim Params As New Dictionary
Params.Add "market", "ZRX-ETH"
TestResult = PublicIDEX("tickers", "GET", Params)
'[{"market":"ZRX-ETH","time":1612898636288,"open":null,"high":null,"low":null,"close":null,"closeQuantity":null,"baseVolume":"0.00000000","quoteVolume":"0.00000000","percentChange":"0.00","numTrades":0,"ask":"0.00191918","bid":"0.00034900","sequence":null}]
Test.IsOk InStr(TestResult, "baseVolume") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult(1)("time") >= 0
End Sub
Function PublicIDEX(Method As String, ReqType As String, Optional ParamDict As Dictionary) As String
Dim url As String
Dim postdata As String
PublicApiSite = "https://api-eth.idex.io/v1/"
If UCase(ReqType) = "POST" Then
'For POST request, all query parameters need to be included in the request body with JSON. (e.g. {"currency":"BTC"}).
postdata = JsonConverter.ConvertToJson(ParamDict)
ElseIf UCase(ReqType) = "GET" Then
MethodParams = DictToString(ParamDict, "URLENC")
If MethodParams <> "" Then MethodParams = "?" & MethodParams
ApiEndPoint = ApiEndPoint & MethodParams
postdata = ""
End If
urlPath = "/" & Method & MethodParams
url = PublicApiSite & urlPath
Dim headerDict As New Dictionary
headerDict.Add "Content-Type", "application/json"
PublicIDEX = WebRequestURL(url, ReqType, headerDict, postdata)
End Function
Function PrivateIDEX(Method As String, ReqType As String, Credentials As Dictionary, Optional ParamDict As Dictionary) As String
'Work in Progress
End Function
================================================
FILE: ModExchKraken.bas
================================================
Attribute VB_Name = "ModExchKraken"
Sub TestKraken()
'Source: https://github.com/krijnsent/crypto_vba
'Remember to create a new API key for excel/VBA
'Kraken will require ever increasing values/nonces for the private API and the nonces created in VBA might mismatch that of other sources
'https://www.kraken.com/en-us/help/api#public-market-data
'https://www.kraken.com/help/api#private-user-data
Dim Apikey As String
Dim secretKey As String
Apikey = "your api key here"
secretKey = "your secret key here"
'Remove these 2 lines, unless you define 2 constants somewhere ( Public Const secretkey_kraken = "the key to use everywhere" etc )
Apikey = apikey_kraken
secretKey = secretkey_kraken
'Put the credentials in a dictionary
Dim Cred As New Dictionary
Cred.Add "apiKey", Apikey
Cred.Add "secretKey", secretKey
' Create a new test suite
Dim Suite As New TestSuite
Suite.Description = "ModExchKraken"
' Create reporter and attach it to these specs
Dim Reporter As New ImmediateReporter
Reporter.ListenTo Suite
' Create a new test
Dim Test As TestCase
Set Test = Suite.Test("TestKrakenPublic")
'Error, unknown command
TestResult = PublicKraken("AnUnknownCommand", "GET")
'{"error_nr":404,"error_txt":"HTTP-Not Found","response_txt":{"error":["EGeneral:Unknown method"]}}
Test.IsOk InStr(TestResult, "error") > 0, "test error 1 failed, result: ${1}"
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error_nr"), 404, "test error 2 failed, result: ${1}"
'Error, parameter missing
TestResult = PublicKraken("Ticker", "GET")
'{"error":["EGeneral:Invalid arguments"]}
Test.IsOk InStr(TestResult, "Invalid") > 0, "test error 3 failed, result: ${1}"
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error")(1), "EGeneral:Invalid arguments", "test error 4 failed, result: ${1}"
'Ok request without parameters
TestResult = PublicKraken("Time", "GET")
'Example: {"error":[],"result":{"unixtime":1551737935,"rfc1123":"Mon, 4 Mar 19 22:18:55 +0000"}}
Test.IsOk InStr(TestResult, "unixtime") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult("result")("unixtime") >= 1510000000
Dim Params As New Dictionary
Params.Add "pair", "XXBTZEUR"
TestResult = PublicKraken("OHLC", "GET", Params)
'{"error":[],"result":{"XXBTZEUR":[[1551695100,"3265.8","3265.8","3265.2","3265.2","3265.5","0.53688049",12],[1551695160,"3265.2", etc...
Test.IsOk InStr(TestResult, "XXBTZEUR") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult("result")("XXBTZEUR")(1)(1) >= 1510000000
Set Test = Suite.Test("TestKrakenPrivate")
TestResult = PrivateKraken("Balance", "POST", Cred)
'{"error":[],"result":{"ZEUR":"15.35","KFEE":"935","XXBT": etc...
Test.IsOk InStr(TestResult, "ZEUR") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult("result")("KFEE") >= 0
'Unix time period:
t1 = DateToUnixTime("1/1/2016")
t2 = DateToUnixTime("1/1/2018")
Dim Params2 As New Dictionary
Params2.Add "start", t1
Params2.Add "end", t2
TestResult = PrivateKraken("TradesHistory", "POST", Cred, Params2)
'{"error":[],"result":{"trades":{"TBSI6I-EO4KN-MLU4AI":{"ordertxid":"O7AERY-NCNDR-6WKLMU","pair":"XXMRZEUR","time":1493715960.4854,"type":"buy","ordertype":"limit","price": etc...
Test.IsOk InStr(TestResult, "trades") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult("result")("trades").Count >= 0
End Sub
Function PublicKraken(Method As String, ReqType As String, Optional ParamDict As Dictionary) As String
Dim url As String
PublicApiSite = "https://api.kraken.com"
MethodParams = DictToString(ParamDict, "URLENC")
If MethodParams <> "" Then MethodParams = "?" & MethodParams
urlPath = "/0/public/" & Method & MethodParams
url = PublicApiSite & urlPath
PublicKraken = WebRequestURL(url, ReqType)
End Function
Function PrivateKraken(Method As String, ReqType As String, Credentials As Dictionary, Optional ParamDict As Dictionary) As String
Dim NonceUnique As String
Dim postdata As String
Dim PayloadDict As Dictionary
Dim url As String
'Kraken nonce: 16 characters
NonceUnique = CreateNonce(16)
TradeApiSite = "https://api.kraken.com"
urlPath = "/0/private/" & Method
Set PayloadDict = New Dictionary
If Not ParamDict Is Nothing Then
For Each key In ParamDict.Keys
PayloadDict(key) = ParamDict(key)
Next key
End If
PayloadDict("nonce") = NonceUnique
postdata = DictToString(PayloadDict, "URLENC")
url = TradeApiSite & urlPath
APIsign = ComputeHash_C("SHA512", urlPath & ComputeHash_C("SHA256", NonceUnique & postdata, "", "RAW"), Base64Decode(Credentials("secretKey")), "STR64")
Dim headerDict As New Dictionary
headerDict.Add "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
headerDict.Add "Content-Type", "application/x-www-form-urlencoded"
headerDict.Add "API-Key", Credentials("apiKey")
headerDict.Add "API-Sign", APIsign
PrivateKraken = WebRequestURL(url, ReqType, headerDict, postdata)
End Function
================================================
FILE: ModExchKucoin.bas
================================================
Attribute VB_Name = "ModExchKucoin"
Sub TestKucoin()
'Source: https://github.com/krijnsent/crypto_vba
'https://docs.kucoin.com/
'Remember to create a new API key for excel/VBA
'Kucoin will require ever increasing values/nonces for the private API and the nonces created in VBA might mismatch that of other sources
Dim Apikey As String
Dim secretKey As String
Apikey = "your api key here"
secretKey = "your secret key here"
'Remove these 2 lines, unless you define 2 constants somewhere ( Public Const secretkey_Kucoin = "the key to use everywhere" etc )
Apikey = apikey_kucoin
secretKey = secretkey_kucoin
passphrase = passphrase_kucoin
'Put the credentials in a dictionary
Dim Cred As New Dictionary
Cred.Add "apiKey", Apikey
Cred.Add "secretKey", secretKey
Cred.Add "Passphrase", passphrase
' Create a new test suite
Dim Suite As New TestSuite
Suite.Description = "ModExchKucoin"
' Create reporter and attach it to these specs
Dim Reporter As New ImmediateReporter
Reporter.ListenTo Suite
' Create a new test
Dim Test As TestCase
Set Test = Suite.Test("TestKucoinPublic")
'Error, unknown command
TestResult = PublicKucoin("AnUnknownCommand", "GET")
Test.IsOk InStr(TestResult, "error") > 0, "test error 1 failed, result: ${1}"
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error_nr"), 404, "test error 2 failed, result: ${1}"
'Error, missing parameters
TestResult = PublicKucoin("market/orderbook/level1", "GET")
Test.IsOk InStr(TestResult, "error") > 0, "test error 3 failed, result: ${1}"
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error_nr"), 400, "test error 4 failed, result: ${1}"
TestResult = PublicKucoin("market/allTickers", "GET")
'{"code":"200000","data":{"ticker":[{"symbol":"LOOM-BTC","high":"0.00001204","vol":"39738.31683935","last":"0.00001187","low":"0.00001151","buy":"0.00001172","sell":"0.00001187","changePrice":"0.00000025","changeRate":"0.0215"},etc...
Test.IsOk InStr(TestResult, "code") > 0
Test.IsOk InStr(TestResult, "changePrice") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("code") * 1, 200000
Test.IsOk JsonResult("data")("ticker").Count > 100
Test.IsOk Len(JsonResult("data")("ticker")(9)("symbol")) > 0
Test.IsOk JsonResult("data")("ticker")(3)("vol") > 0
Dim Params As New Dictionary
Params.Add "symbol", "KCS-BTC"
TestResult = PublicKucoin("market/orderbook/level2_20", "GET", Params)
'{"code":"200000","data":{"sequence":"1550467431550","asks":[["0.00011794","184.4706"],["0.00011795","48.7387"],["0.00011796","154.9647"],
Test.IsOk InStr(TestResult, "code") > 0
Test.IsOk InStr(TestResult, "sequence") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("code") * 1, 200000
Test.IsOk JsonResult("data")("time") > 1500000000000#
Test.IsEqual JsonResult("data")("asks").Count, 20
Test.IsEqual JsonResult("data")("bids").Count, 20
Test.IsOk JsonResult("data")("asks")(1)(1) > 0
Test.IsOk JsonResult("data")("asks")(1)(2) > 0
' Create a new test
Set Test = Suite.Test("TestKucoinTime")
TestResult = GetKucoinTime()
Test.IsOk TestResult > 1500000000000#, "test time 1 failed, result: ${1}"
Test.IsOk TestResult < 1700000000000#, "test time 2 failed, result: ${1}"
Set Test = Suite.Test("TestKucoinPrivate")
TestResult = PrivateKucoin("accounts", "GET", Cred)
'{"code":"200000","data":[{"balance":"15.827819","available":"15.827819","holds":"0","currency":"KCS","id":"5c6a4a1d81a34e1da97","type":"trade"},{"balance":"2.12058951","available":"2.12058951",", etc...
Test.IsOk InStr(TestResult, "code") > 0, "test accounts 1a failed, result: ${1}"
Test.IsOk InStr(TestResult, "balance") > 0, "test accounts 1b failed, result: ${1}"
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("code") * 1, 200000, "test accounts 1c failed, result: ${1}"
Test.IsOk JsonResult("data").Count > 20, "test accounts 1d failed, result: ${1}"
Test.IsOk JsonResult("data")(1)("balance") > 0, "test accounts 1e failed, result: ${1}"
'Get only KCS account amount
Dim Params1 As New Dictionary
Params1.Add "currency", "KCS"
TestResult = PrivateKucoin("accounts", "GET", Cred, Params1)
'Debug.Print TestResult
'{"code":"200000","data":[{"balance":"15.82887819","available":"15.82887819","holds":"0","currency":"KCS","id":"5c6a4a1d81a34e1da97","type":"trade"}]}
Test.IsOk InStr(TestResult, "code") > 0, "test accounts 2a failed, result: ${1}"
Test.IsOk InStr(TestResult, "balance") > 0, "test accounts 2b failed, result: ${1}"
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("code") * 1, 200000, "test accounts 2c failed, result: ${1}"
Test.IsOk JsonResult("data").Count >= 1, "test accounts 2d failed, result: ${1}"
Test.IsOk JsonResult("data")(1)("balance") > 0, "test accounts 2e failed, result: ${1}"
'Create a main LTC account (if it doesn't exist)
Dim Params2 As New Dictionary
Params2.Add "currency", "LTC"
TestResult = PrivateKucoin("accounts", "POST", Cred, Params2)
'Debug.Print TestResult
'{"code":"400100","msg":"type can not be empty"}
Test.IsOk InStr(TestResult, "code") > 0
Test.IsOk InStr(TestResult, "msg") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("code") * 1, 400100
Test.IsEqual JsonResult("msg"), "type can not be empty"
Params2.Add "type", "main"
TestResult = PrivateKucoin("accounts", "POST", Cred, Params2)
'Debug.Print TestResult
'FIRST TIME RESULT: {"code":"200000","data":{"id":"5c7556e3cbfc7b24a1a1a1a9"}}
'NEXT RESULT: {"code":"230005","msg":"account already exists"}
Test.IsOk InStr(TestResult, "code") > 0
Test.IsOk InStr(TestResult, "msg") + InStr(TestResult, "data") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult("code") * 1 >= 200000
Test.IsOk JsonResult("code") * 1 <= 230005
Set Test = Suite.Test("TestKucoinPrivate Orders")
'Create orders
'sell 0.01 KCS for a price of 100 KCS per ETH
'price hopefully insane enough never to execute
TempOrderID = CreateNonce()
Dim Params3 As New Dictionary
Params3.Add "clientOid", TempOrderID
Params3.Add "symbol", "KCS-ETH"
Params3.Add "side", "sell"
Params3.Add "price", 100
Params3.Add "size", 0.01
Params3.Add "timeInForce", "GTC"
TestResult = PrivateKucoin("orders", "POST", Cred, Params3)
'Debug.Print TestResult
'{"code":"200000","data":{"orderId":"5ca22ec6513ab9576fb77d92"}}
'{"code":"200004","msg":"Balance insufficient!"}
Test.IsOk InStr(TestResult, "code") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult("code") * 1 >= 200000
Test.IsOk JsonResult("code") * 1 <= 200004
'Add another order
Dim Params4 As New Dictionary
Params4.Add "clientOid", TempOrderID + 3
Params4.Add "symbol", "KCS-BTC"
Params4.Add "side", "sell"
Params4.Add "price", 100
Params4.Add "size", 0.01
Params4.Add "timeInForce", "GTC"
TestResult = PrivateKucoin("orders", "POST", Cred, Params4)
'Debug.Print TestResult
'{"code":"200000","data":{"orderId":"5ca22ec6513ab9576fb77d92"}}
'{"code":"200004","msg":"Balance insufficient!"}
Test.IsOk InStr(TestResult, "code") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult("code") * 1 >= 200000
Test.IsOk JsonResult("code") * 1 <= 200004
'Now get the open orders
TestResult = PrivateKucoin("orders", "GET", Cred)
'{"code":"200000","data":{"totalNum":8,"totalPage":1,"pageSize":50,"currentPage":1,"items":[{"symbol":"KCS-BTC","hidden":false,"opType":"DEAL"
Test.IsOk InStr(TestResult, "code") > 0
Test.IsOk InStr(TestResult, "totalPage") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult("code") * 1 >= 200000
Test.IsOk JsonResult("code") * 1 <= 200004
Test.IsOk JsonResult("data")("items").Count >= 0
'Delete all KCS-BTC orders
Dim Params5 As New Dictionary
Params5.Add "symbol", "KCS-BTC"
TestResult = PrivateKucoin("orders", "DELETE", Cred, Params5)
'{"code":"200000","data":{"cancelledOrderIds":["5ca2798389fc8450590fe207"]}}
Test.IsOk InStr(TestResult, "code") > 0
Test.IsOk InStr(TestResult, "cancelledOrderIds") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult("code") * 1 >= 200000
Test.IsOk JsonResult("code") * 1 <= 200004
'Delete the created KCS-ETH order
Dim Params6 As New Dictionary
Params6.Add "OrderId", JsonResult("data")("orderId")
TestResult = PrivateKucoin("orders", "DELETE", Cred, Params6)
'Debug.Print TestResult
'{"code":"200000","data":{"cancelledOrderIds":["5ca27982054b467eb0d0c8dc"]}}
Test.IsOk InStr(TestResult, "code") > 0
Test.IsOk InStr(TestResult, "cancelledOrderIds") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult("code") * 1 >= 200000
Test.IsOk JsonResult("code") * 1 <= 200004
'Delete all orders (should be none)
TestResult = PrivateKucoin("orders", "DELETE", Cred)
'{"code":"200000","data":{"cancelledOrderIds":[]}}
Test.IsOk InStr(TestResult, "code") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult("code") * 1 >= 200000
Test.IsOk JsonResult("code") * 1 <= 200004
End Sub
Function PublicKucoin(Method As String, ReqType As String, Optional ParamDict As Dictionary) As String
Dim url As String
PublicApiSite = "https://api.kucoin.com/api/v1"
MethodParams = DictToString(ParamDict, "URLENC")
If MethodParams <> "" Then MethodParams = "?" & MethodParams
urlPath = "/" & Method & MethodParams
url = PublicApiSite & urlPath
PublicKucoin = WebRequestURL(url, ReqType)
End Function
Function PrivateKucoin(Method As String, ReqType As String, Credentials As Dictionary, Optional ParamDict As Dictionary) As String
Dim NonceUnique As String
Dim url As String
Dim postdata As String
'Kucoin wants a 13-digit Nonce, use time correction if needed
NonceUnique = GetKucoinTime()
TradeApiSite = "https://api.kucoin.com"
ApiEndPoint = "/api/v1/" & Method
If ReqType = "GET" Or ReqType = "DELETE" Then
'For GET, DELETE request, all query parameters need to be included in the request url. (e.g. /api/v1/accounts?currency=BTC)
If Not ParamDict Is Nothing Then
'OrderId -> add to URL
For Each key In ParamDict.Keys
If LCase(key) = "orderid" Then
ApiEndPoint = ApiEndPoint & "/" & ParamDict(key)
ParamDict.Remove key
Exit For
End If
Next key
End If
MethodTxt = DictToString(ParamDict, "URLENC")
If MethodTxt <> "" Then ApiEndPoint = ApiEndPoint & "?" & MethodTxt
ReqBody = ""
Else
'For POST, PUT request, all query parameters need to be included in the request body with JSON. (e.g. {"currency":"BTC"}). Do not include extra spaces in JSON strings.
MethodTxt = ""
ReqBody = JsonConverter.ConvertToJson(ParamDict)
postdata = ReqBody
End If
ApiForSign = NonceUnique & ReqType & ApiEndPoint & ReqBody
APIsign = ComputeHash_C("SHA256", ApiForSign, Credentials("secretKey"), "STR64")
url = TradeApiSite & ApiEndPoint
Dim headerDict As New Dictionary
headerDict.Add "KC-API-KEY", Credentials("apiKey")
headerDict.Add "KC-API-SIGN", APIsign
headerDict.Add "KC-API-TIMESTAMP", NonceUnique
headerDict.Add "KC-API-PASSPHRASE", Credentials("Passphrase")
headerDict.Add "Content-Type", "application/json"
PrivateKucoin = WebRequestURL(url, ReqType, headerDict, postdata)
End Function
Function GetKucoinTime() As Double
Dim JsonResponse As String
Dim Json As Object
'PublicKucoin time
JsonResponse = PublicKucoin("timestamp", "GET")
Set Json = JsonConverter.ParseJson(JsonResponse)
GetKucoinTime = Json("data")
If GetKucoinTime = 0 Then
TimeCorrection = -3600
GetKucoinTime = DateDiff("s", "1/1/1970", Now)
GetKucoinTime = Trim(Str((Val(GetKucoinTime) + TimeCorrection)) & Right(Int(Timer * 100), 2) & "0")
End If
Set Json = Nothing
End Function
================================================
FILE: ModExchOKEx.bas
================================================
Attribute VB_Name = "ModExchOkex"
Sub TestOKEx()
'Source: https://github.com/krijnsent/crypto_vba
'https://www.okex.com/docs/en/
'Remember to create a new API key for excel/VBA
Dim Apikey As String
Dim secretKey As String
Apikey = "your api key here"
secretKey = "your secret key here"
'Remove these 2 lines, unless you define 2 constants somewhere ( Public Const secretkey_okex = "the key to use everywhere" etc )
Apikey = apikey_okex
secretKey = secretkey_okex
passphrase = passphrase_okex
'Put the credentials in a dictionary
Dim Cred As New Dictionary
Cred.Add "apiKey", Apikey
Cred.Add "secretKey", secretKey
Cred.Add "Passphrase", passphrase
' Create a new test suite
Dim Suite As New TestSuite
Suite.Description = "ModExchOKEx"
' Create reporter and attach it to these specs
Dim Reporter As New ImmediateReporter
Reporter.ListenTo Suite
' Create a new test
Dim Test As TestCase
Set Test = Suite.Test("TestOKExPublic")
'Error, unknown command, returns invalid JSON
TestResult = PublicOKEx("AnUnknownCommand", "GET")
Test.IsOk InStr(TestResult, "error") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error_nr"), 403
'Error, missing parameter
TestResult = PublicOKEx("spot/v3/instruments/EOS-BTC/", "GET")
Test.IsOk InStr(TestResult, "error") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error_nr"), 404
'Error, unknown pair
TestResult = PublicOKEx("spot/v3/instruments/EOS-BLA/ticker", "GET")
Test.IsOk InStr(TestResult, "error") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error_nr"), 400
Test.IsEqual JsonResult("response_txt")("code"), 30032
Test.IsEqual JsonResult("response_txt")("message"), "The currency pair does not exist"
TestResult = PublicOKEx("spot/v3/instruments/ticker", "GET")
'[{"best_ask":"0.006388","best_bid":"0.006387","instrument_id":"LTC-BTC","product_id":"LTC-BTC","last":"0.006387","ask":"0.006388","bid":"0.006387","open_24h":"0.006532","high_24h":"0.006727","low_24h":"0.006359","base_volume_24h":"221873.685698","timestamp":"2019-09-04T09:31:50.304Z","quote_volume_24h":"1445.8081"},{"best_ask":"0.01685","best_bid":"0.01684","instrument_id":"ETH-BTC","product_id":"ETH-BTC" etc...
Test.IsOk InStr(TestResult, "best_bid") > 0
Test.IsOk InStr(TestResult, "product_id") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult.Count > 100
Test.IsOk JsonResult(1)("last") * 1 > 0
Test.IsOk Len(JsonResult(2)("instrument_id")) > 0
Dim Params As New Dictionary
Params.Add "granularity", 14400 '14400 seconds = 6 hours
Params.Add "start", "2020-12-15T08%3A28%3A48.899Z" 'ISO 8601
Params.Add "end", "2020-12-19T09%3A28%3A48.899Z"
TestResult = PublicOKEx("spot/v3/instruments/ETH-USDT/candles", "GET", Params)
'Result: TOHLCV
'[["2019-03-19T08:00:00.000Z","137.74","138.69","137.38","137.79","107365.43315"],["2019-03-19T04:00:00.000Z","137.76","138","136.97","137.73","85020.919026"],["2019-03-19T00:00:00.000Z","137.61","139.41","137.31","137.74","94292.72983"],["2019-03-18T20:00:00.000Z","137.44","138.33","137.42","137.63","63587.691327"],["2019-03-18T16:00:00.000Z","137.59","137.91","137.09","137.42","58001.277483"],["2019-03-18T12:00:00.000Z","137.27","138.03","137","137.6","83512.951662"]]
Test.IsOk InStr(TestResult, "2020-12-19") > 0
Test.IsOk InStr(TestResult, "2020-12-18") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult(1)(1), "2020-12-19T08:00:00.000Z"
Test.IsEqual JsonResult(1)(2), "648.67"
Test.IsEqual JsonResult.Count, 24
' Create a new test
Set Test = Suite.Test("TestOKExTime")
TestResult = GetOKExTime()
Test.IsOk TestResult > 1500000000#
Test.IsOk TestResult < 1700000000#
Set Test = Suite.Test("TestOKExPrivate")
TestResult = PrivateOKEx("spot/v3/accounts", "GET", Cred)
'[{"frozen":"0","hold":"0","id":"","currency":"BTC","balance":"0","available":"0","holds":"0"},{"frozen":"0","hold":"0","id":"","currency":"XAS","balance":"0.000233","available":"0.000233","holds":"0"}]
Test.IsOk InStr(TestResult, "currency") > 0
Test.IsOk InStr(TestResult, "balance") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult.Count >= 2
Test.IsOk JsonResult(1)("balance") * 1 >= 0
Test.IsOk JsonResult(1)("holds") * 1 >= 0
'Invalid token
TestResult = PrivateOKEx("account/v3/wallet/BLA", "GET", Cred)
'{"error_nr":400,"error_txt":"HTTP-","response_txt":{"code":30031,"message":"BLA is an invalid token"}}
Test.IsOk InStr(TestResult, "error") > 0
Test.IsOk InStr(TestResult, 30031) > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("response_txt")("code"), 30031
Test.IsEqual JsonResult("response_txt")("message"), "BLA is an invalid token"
Set Test = Suite.Test("TestOKExPrivate Orders")
'Create order
'BUY 100 BTC for a price of 1 USDT per BTC
'price hopefully insane enough never to execute
Dim Params2 As New Dictionary
Params2.Add "instrument_id", "BTC-USDT"
Params2.Add "type", "limit"
Params2.Add "side", "buy"
Params2.Add "price", 1
Params2.Add "size", 100
Params2.Add "order_type", 3 '3-Immediate Or Cancel
TestResult = PrivateOKEx("spot/v3/orders", "POST", Cred, Params2)
'e.g. {"client_oid":"","error_code":"33017","error_message":"Greater than the maximum available balance","order_id":"-1","result":false}
Test.IsOk InStr(TestResult, "code") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult("error_code") * 1 = 33017
Test.IsOk JsonResult("error_message") = "Greater than the maximum available balance"
Dim Params3 As New Dictionary
Params3.Add "instrument_id", "XMR-BTC"
ClientIdOrderId = "12345"
TestResult = PrivateOKEx("spot/v3/cancel_orders/" & ClientIdOrderId, "POST", Cred, Params3)
'{"client_oid":"","code":"33014","error_code":"33014","error_message":"Order does not exist","message":"Order does not exist","order_id":"12345","result":false}
Test.IsOk InStr(TestResult, "code") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult("code") * 1 = 33014
Test.IsOk JsonResult("message") = "Order does not exist"
Dim Params4 As New Dictionary
Params4.Add "instrument_id", "XMR-BTC"
Params4.Add "limit", 4
TestResult = PrivateOKEx("spot/v3/orders_pending", "GET", Cred, Params4)
'[] (no orders), [[{"client_oid":"oktspot86","created_at":"2019-03-20T03:28:14.000Z",etc...
If TestResult = "[]" Then
'No orders
Else
Test.IsOk InStr(TestResult, "created_at") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult(1)("instrument_id") = "XMR-BTC"
Test.IsOk Len(JsonResult(1)("order_id")) > 0
End If
Dim Params5 As New Dictionary
instrument_id = "XAS-BTC"
Params5.Add "instrument_id", instrument_id
JsonResponse = PrivateOKEx("spot/v3/fills", "GET", Cred, Params5)
'e.g. []
If TestResult = "[]" Then
'No orders
Else
Test.IsOk InStr(TestResult, "created_at") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult(1)("instrument_id") = "XAS-BTC"
End If
End Sub
Function PublicOKEx(Method As String, ReqType As String, Optional ParamDict As Dictionary) As String
Dim url As String
PublicApiSite = "https://www.okex.com/api"
MethodParams = DictToString(ParamDict, "URLENC")
If MethodParams <> "" Then MethodParams = "?" & MethodParams
urlPath = "/" & Method & MethodParams
url = PublicApiSite & urlPath
PublicOKEx = WebRequestURL(url, ReqType)
End Function
Function PrivateOKEx(Method As String, ReqType As String, Credentials As Dictionary, Optional ParamDict As Dictionary) As String
Dim NonceUnique As String
Dim url As String
Dim postdata As String
TradeApiSite = "https://www.okex.com"
ApiEndPoint = "/api/" & Method
'OKEx nonce
NonceUnique = GetOKExTime() & ".00" 'Should be string
If UCase(ReqType) = "POST" Then
'For POST request, all query parameters need to be included in the request body with JSON. (e.g. {"currency":"BTC"}).
postdata = JsonConverter.ConvertToJson(ParamDict)
ElseIf UCase(ReqType) = "GET" Then
MethodParams = DictToString(ParamDict, "URLENC")
If MethodParams <> "" Then MethodParams = "?" & MethodParams
ApiEndPoint = ApiEndPoint & MethodParams
End If
ApiForSign = NonceUnique & UCase(ReqType) & ApiEndPoint & postdata
APIsign = ComputeHash_C("SHA256", ApiForSign, Credentials("secretKey"), "STR64")
url = TradeApiSite & ApiEndPoint
Dim headerDict As New Dictionary
headerDict.Add "OK-ACCESS-KEY", Credentials("apiKey")
headerDict.Add "OK-ACCESS-SIGN", APIsign
headerDict.Add "OK-ACCESS-TIMESTAMP", NonceUnique
headerDict.Add "OK-ACCESS-PASSPHRASE", Credentials("Passphrase")
headerDict.Add "Content-Type", "application/json"
PrivateOKEx = WebRequestURL(url, ReqType, headerDict, postdata)
End Function
Function GetOKExTime() As Double
Dim JsonResponse As String
Dim Json As Object
'PublicOKEx time
JsonResponse = PublicOKEx("general/v3/time", "GET")
Set Json = JsonConverter.ParseJson(JsonResponse)
If InStr(Json("epoch"), ".") Then
GetOKExTime = Left(Json("epoch"), InStr(Json("epoch"), "."))
Else
GetOKExTime = Json("epoch")
End If
If GetOKExTime = 0 Then
TimeCorrection = -3600
GetOKExTime = DateDiff("s", "1/1/1970", Now)
GetOKExTime = Trim(Str((Val(GetOKExTime) + TimeCorrection)) & Right(Int(Timer * 100), 2) & "0")
End If
Set Json = Nothing
End Function
================================================
FILE: ModExchPoloniex.bas
================================================
Attribute VB_Name = "ModExchPoloniex"
Sub TestPoloniex()
'Source: https://github.com/krijnsent/crypto_vba
'Remember to create a new API key for excel/VBA
'https://docs.poloniex.com/#http-api
'Poloniex will require ever increasing values/nonces for the private API and the nonces created in VBA might mismatch that of other sources
Dim Apikey As String
Dim secretKey As String
Apikey = "your api key here"
secretKey = "your secret key here"
'Remove these 2 lines, unless you define 2 constants somewhere ( Public Const secretkey_poloniex = "the key to use everywhere" etc )
Apikey = apikey_poloniex
secretKey = secretkey_poloniex
'Put the credentials in a dictionary
Dim Cred As New Dictionary
Cred.Add "apiKey", Apikey
Cred.Add "secretKey", secretKey
' Create a new test suite
Dim Suite As New TestSuite
Suite.Description = "ModExchPoloniex"
' Create reporter and attach it to these specs
Dim Reporter As New ImmediateReporter
Reporter.ListenTo Suite
' Create a new test
Dim Test As TestCase
Set Test = Suite.Test("TestPoloniexPublic")
'Error, unknown command
TestResult = PublicPoloniex("returnUnknownCommand", "GET")
'{"error":"Invalid command."}
Test.IsOk InStr(TestResult, "error") > 0, "test error 1 failed, result: ${1}"
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error"), "Invalid command.", "test error 2 failed, result: ${1}"
'Error, missing parameters
TestResult = PublicPoloniex("returnOrderBook", "GET")
'{"error":"Please specify a currency pair."}
Test.IsOk InStr(TestResult, "error") > 0, "test error 3 failed, result: ${1}"
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error"), "Please specify a currency pair.", "test error 4 failed, result: ${1}"
'Testing error catching and replies
TestResult = PublicPoloniex("returnTicker", "GET")
'{"BTC_BCN":{"id":7,"last":"0.00000120","lowestAsk":"0.00000120","highestBid":"0.00000119","percentChange":"1.00000000","baseVolume":"21570.44763887","quoteVolume":"21082615430.89178085", etc...
Test.IsOk InStr(TestResult, "lowestAsk") > 0
Test.IsOk InStr(TestResult, "BTC_ETH"":") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error"), ""
Test.IsEqual JsonResult("BTC_ETH")("id"), 148
Test.IsOk JsonResult("BTC_ETH")("highestBid") > 0
'Put the parameters in a dictionary
Dim Params As New Dictionary
Params.Add "currencyPair", "BTC_ETH"
Params.Add "depth", 10
TestResult = PublicPoloniex("returnOrderBook", "GET", Params)
'{"asks":[["0.03530499",1.18647302],["0.03530500",110.78279995],["0.03531880",0.70796807],["0.03534095",2.12187844],["0.03534099",0.11553593],["0.03534767",29.95566069],["0.03534768",3.99999999],["0.03535000",0.99900001],["0.03535497",14.16571992],["0.03535498",0.6221801]],"bids":[["0.03528822",0.0031],["0.03528813",0.06749181],["0.03528730",0.0674917],["0.03528711",0.0674917],["0.03528638",0.0673596],["0.03528531",0.01],["0.03528303",0.01417112],["0.03527231",16.12158867],["0.03527000",110.5868],["0.03526147",33.74922032]],"isFrozen":"0","seq":644421713}
Test.IsOk InStr(TestResult, "],[") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("asks").Count, 10
Test.IsEqual JsonResult("bids").Count, 10
Test.IsOk JsonResult("asks")(1)(2) > 0
'Unix time period:
Set Test = Suite.Test("TestPoloniexPrivate")
t1 = DateToUnixTime("1/1/2016")
t2 = DateToUnixTime("1/1/2019")
TestResult = PrivatePoloniex("returnBalances", "POST", Cred)
'{"1CR":"0.00000000","ABY":"0.00000000","AC":"0.00000000","ACH":"0.00000000","ADN":"0.00000000","AEON":"0.00000000" etc...
Test.IsOk InStr(TestResult, "BTC") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult.Count >= 10
Test.IsOk JsonResult("ETH") >= 0
'Put the parameters in a dictionary
Dim Params2 As New Dictionary
Params2.Add "currencyPair", "all"
Params2.Add "start", t1
Params2.Add "end", t2
TestResult = PrivatePoloniex("returnTradeHistory", "POST", Cred, Params2)
If InStr(TestResult, "globalTradeID") > 0 Then
'has some results
'e.g.: {"BTC_ETH":[{"globalTradeID":108848981,"tradeID":"22880801","date":"2017-04-19 23:26:55","rate":"0.03900000","amount":"65.35644222","total":"2.54890124", etc...
Test.IsOk InStr(TestResult, "amount") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
For Each k In JsonResult.Keys()
Test.IsOk JsonResult(k).Count >= 1
Next k
Else
'no results
'Empty: []
Test.IsEqual TestResult, "[]"
End If
'Put the parameters in a dictionary
Dim Params3 As New Dictionary
Params3.Add "currencyPair", "BTC_ETH"
Params3.Add "rate", 0.001
Params3.Add "amount", 3
Params3.Add "fillOrKill", 1
TestResult = PrivatePoloniex("buy", "POST", Cred, Params3)
'{"error":"This API key does not have permission to trade."}
'{orderNumber: '514845991795',resultingTrades:[{amount: '3.0',Date: '2018-10-25 23:03:21',rate:'0.0002',total:'0.0006',tradeID:'251834',type:'buy'}]}
'{"error":"Not enough BTC.","fee":"0.00125000","currencyPair":"BTC_ETH"}
If InStr(TestResult, "error") > 0 Then
Test.IsOk InStr(TestResult, "currencyPair") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsEqual JsonResult("error"), "Not enough BTC."
Else
Test.IsOk InStr(TestResult, "resultingTrades") > 0
Set JsonResult = JsonConverter.ParseJson(TestResult)
Test.IsOk JsonResult("orderNumber") >= 0
End If
End Sub
Function PublicPoloniex(Method As String, ReqType As String, Optional ParamDict As Dictionary) As String
Dim url As String
PublicApiSite = "https://poloniex.com"
MethodParams = DictToString(ParamDict, "URLENC")
If MethodParams <> "" Then MethodParams = "&" & MethodParams
urlPath = "/public?command=" & Method & MethodParams
url = PublicApiSite & urlPath
PublicPoloniex = WebRequestURL(url, ReqType)
End Function
Function PrivatePoloniex(Method As String, ReqType As String, Credentials As Dictionary, Optional ParamDict As Dictionary) As String
Dim NonceUnique As String
Dim postdata As String
Dim PayloadDict As Dictionary
Dim url As String
'Poloniex nonce
NonceUnique = CreateNonce(16)
url = "https://poloniex.com/tradingApi"
Set PayloadDict = New Dictionary
PayloadDict("command") = Method
If Not ParamDict Is Nothing Then
For Each key I
gitextract__zi_j_oj/ ├── .gitignore ├── ImmediateReporter.cls ├── JsonConverter.bas ├── LICENSE ├── ModExchBinance.bas ├── ModExchBitVavo.bas ├── ModExchBitfinex.bas ├── ModExchBitmex.bas ├── ModExchBitstamp.bas ├── ModExchBittrex.bas ├── ModExchBybit.bas ├── ModExchCoinbase.bas ├── ModExchCoinbasePro.bas ├── ModExchCoinone.bas ├── ModExchCoinspot.bas ├── ModExchHitBTC.bas ├── ModExchHuobi.bas ├── ModExchIDEX.bas ├── ModExchKraken.bas ├── ModExchKucoin.bas ├── ModExchOKEx.bas ├── ModExchPoloniex.bas ├── ModFunctions.bas ├── ModHash.bas ├── ModJSON.bas ├── ModSrcCoinGecko.bas ├── ModSrcCryptocompare.bas ├── ModWeb.bas ├── TestCase.cls ├── TestSuite.cls ├── WorkbookReporter.cls ├── _config.yml ├── crypto_vba_example.xlsm └── readme.md
Condensed preview — 34 files, each showing path, character count, and a content snippet. Download the .json file or copy for the full structured content (322K chars).
[
{
"path": ".gitignore",
"chars": 54,
"preview": "~$crypto_vba_example.xlsm\ncrypto_vba_example_dev.xlsm\n"
},
{
"path": "ImmediateReporter.cls",
"chars": 3229,
"preview": "VERSION 1.0 CLASS\nBEGIN\n MultiUse = -1 'True\nEND\nAttribute VB_Name = \"ImmediateReporter\"\nAttribute VB_GlobalNameSpace "
},
{
"path": "JsonConverter.bas",
"chars": 44205,
"preview": "Attribute VB_Name = \"JsonConverter\"\n'Attribute VB_Name = \"JsonConverter\"\n''\n' VBA-JSON v2.3.1\n' (c) Tim Hall - https://g"
},
{
"path": "LICENSE",
"chars": 1070,
"preview": "MIT License\n\nCopyright (c) 2017 Koen Rijnsent\n\nPermission is hereby granted, free of charge, to any person obtaining a c"
},
{
"path": "ModExchBinance.bas",
"chars": 10063,
"preview": "Attribute VB_Name = \"ModExchBinance\"\nSub TestBinance()\n\n'Source: https://github.com/krijnsent/crypto_vba\n'Documentation:"
},
{
"path": "ModExchBitVavo.bas",
"chars": 8943,
"preview": "Attribute VB_Name = \"ModExchBitVavo\"\nSub TestBitVavo()\n\n'Source: https://github.com/krijnsent/crypto_vba\n'Documentation:"
},
{
"path": "ModExchBitfinex.bas",
"chars": 10041,
"preview": "Attribute VB_Name = \"ModExchBitfinex\"\nSub TestBitfinex()\n\n'Source: https://github.com/krijnsent/crypto_vba\n'Documentatio"
},
{
"path": "ModExchBitmex.bas",
"chars": 8637,
"preview": "Attribute VB_Name = \"ModExchBitmex\"\nSub TestBitmex()\n\n'Source: https://github.com/krijnsent/crypto_vba\n'Documentation: h"
},
{
"path": "ModExchBitstamp.bas",
"chars": 6876,
"preview": "Attribute VB_Name = \"ModExchBitstamp\"\nSub TestBitstamp()\n\n'Source: https://github.com/krijnsent/crypto_vba\n'Documentatio"
},
{
"path": "ModExchBittrex.bas",
"chars": 10229,
"preview": "Attribute VB_Name = \"ModExchBittrex\"\nSub TestBittrex()\n\n'Source: https://github.com/krijnsent/crypto_vba\n'Documentation:"
},
{
"path": "ModExchBybit.bas",
"chars": 11306,
"preview": "Attribute VB_Name = \"ModExchBybit\"\nSub TestBybit()\n\n'Source: https://github.com/krijnsent/crypto_vba\n'https://doc.Bybit."
},
{
"path": "ModExchCoinbase.bas",
"chars": 10490,
"preview": "Attribute VB_Name = \"ModExchCoinbase\"\nSub TestCoinbase()\n\n'Standard Coinbase, for CoinbasePro (formerly known as GDAX), "
},
{
"path": "ModExchCoinbasePro.bas",
"chars": 7568,
"preview": "Attribute VB_Name = \"ModExchCoinbasePro\"\nSub TestCoinbasePro()\n\n'CoinbasePro, formerly known as GDAX\n'For normal Coinbas"
},
{
"path": "ModExchCoinone.bas",
"chars": 6425,
"preview": "Attribute VB_Name = \"ModExchCoinone\"\nSub TestCoinone()\n\n'Source: https://github.com/krijnsent/crypto_vba\n'https://doc.co"
},
{
"path": "ModExchCoinspot.bas",
"chars": 4384,
"preview": "Attribute VB_Name = \"ModExchCoinspot\"\nSub TestCoinspot()\n\n'Source: https://github.com/krijnsent/crypto_vba\n'Documentatio"
},
{
"path": "ModExchHitBTC.bas",
"chars": 10107,
"preview": "Attribute VB_Name = \"ModExchHitBTC\"\nSub TestHitBTC()\n\n'Source: https://github.com/krijnsent/crypto_vba\n'Remember to crea"
},
{
"path": "ModExchHuobi.bas",
"chars": 8337,
"preview": "Attribute VB_Name = \"ModExchHuobi\"\nSub TestHuobi()\n\n'Source: https://github.com/krijnsent/crypto_vba\n'https://alphaex-ap"
},
{
"path": "ModExchIDEX.bas",
"chars": 3125,
"preview": "Attribute VB_Name = \"ModExchIDEX\"\n'https://docs.idex.market/#operation/returnCurrencies\n\nSub TestIDEX()\n\n'Source: https:"
},
{
"path": "ModExchKraken.bas",
"chars": 4982,
"preview": "Attribute VB_Name = \"ModExchKraken\"\nSub TestKraken()\n\n'Source: https://github.com/krijnsent/crypto_vba\n'Remember to crea"
},
{
"path": "ModExchKucoin.bas",
"chars": 11687,
"preview": "Attribute VB_Name = \"ModExchKucoin\"\nSub TestKucoin()\n\n'Source: https://github.com/krijnsent/crypto_vba\n'https://docs.kuc"
},
{
"path": "ModExchOKEx.bas",
"chars": 9278,
"preview": "Attribute VB_Name = \"ModExchOkex\"\nSub TestOKEx()\n\n'Source: https://github.com/krijnsent/crypto_vba\n'https://www.okex.com"
},
{
"path": "ModExchPoloniex.bas",
"chars": 6822,
"preview": "Attribute VB_Name = \"ModExchPoloniex\"\nSub TestPoloniex()\n\n'Source: https://github.com/krijnsent/crypto_vba\n'Remember to "
},
{
"path": "ModFunctions.bas",
"chars": 9368,
"preview": "Attribute VB_Name = \"ModFunctions\"\nDeclare PtrSafe Sub GetSystemTime Lib \"kernel32\" (ByRef lpSystemTime As SYSTEMTIME)\n\n"
},
{
"path": "ModHash.bas",
"chars": 8338,
"preview": "Attribute VB_Name = \"ModHash\"\n'Public Function Suite() As TestSuite\n' Set Suite = New TestSuite\n' Suite.Description = "
},
{
"path": "ModJSON.bas",
"chars": 20161,
"preview": "Attribute VB_Name = \"ModJSON\"\n'Functions in module:\n'MaxDepth - integer with the maximum depth of the JSON\n'JsonToArray "
},
{
"path": "ModSrcCoinGecko.bas",
"chars": 2861,
"preview": "Attribute VB_Name = \"ModSrcCoinGecko\"\n'Two variables for caching, so the formulas don't update every recalculation\nPubli"
},
{
"path": "ModSrcCryptocompare.bas",
"chars": 18814,
"preview": "Attribute VB_Name = \"ModSrcCryptocompare\"\n'Two variables for caching, so the formulas don't update every recalculation\nP"
},
{
"path": "ModWeb.bas",
"chars": 10224,
"preview": "Attribute VB_Name = \"ModWeb\"\n 'Source: https://github.com/krijnsent/crypto_vba\n'Remember to create a new API key for "
},
{
"path": "TestCase.cls",
"chars": 17264,
"preview": "VERSION 1.0 CLASS\nBEGIN\n MultiUse = -1 'True\nEND\nAttribute VB_Name = \"TestCase\"\nAttribute VB_GlobalNameSpace = False\nA"
},
{
"path": "TestSuite.cls",
"chars": 3413,
"preview": "VERSION 1.0 CLASS\nBEGIN\n MultiUse = -1 'True\nEND\nAttribute VB_Name = \"TestSuite\"\nAttribute VB_GlobalNameSpace = False\n"
},
{
"path": "WorkbookReporter.cls",
"chars": 6145,
"preview": "VERSION 1.0 CLASS\nBEGIN\n MultiUse = -1 'True\nEND\nAttribute VB_Name = \"WorkbookReporter\"\nAttribute VB_GlobalNameSpace ="
},
{
"path": "_config.yml",
"chars": 28,
"preview": "theme: jekyll-theme-leap-day"
},
{
"path": "readme.md",
"chars": 5698,
"preview": "# crypto_vba\nAn Excel/VBA project to communicate with various cryptocurrency exchanges APIs. Tested on Windows 10 & Exce"
}
]
// ... and 1 more files (download for full content)
About this extraction
This page contains the full source code of the krijnsent/crypto_vba GitHub repository, extracted and formatted as plain text for AI agents and large language models (LLMs). The extraction includes 34 files (293.1 KB), approximately 86.6k tokens. Use this with OpenClaw, Claude, ChatGPT, Cursor, Windsurf, or any other AI tool that accepts text input. You can copy the full output to your clipboard or download it as a .txt file.
Extracted by GitExtract — free GitHub repo to text converter for AI. Built by Nikandr Surkov.