[ { "path": ".gitignore", "content": "~$crypto_vba_example.xlsm\ncrypto_vba_example_dev.xlsm\n" }, { "path": "ImmediateReporter.cls", "content": "VERSION 1.0 CLASS\nBEGIN\n MultiUse = -1 'True\nEND\nAttribute VB_Name = \"ImmediateReporter\"\nAttribute VB_GlobalNameSpace = False\nAttribute VB_Creatable = False\nAttribute VB_PredeclaredId = False\nAttribute VB_Exposed = True\n''\n' ImmediateReporter v2.0.0-beta.3\n' (c) Tim Hall - https://github.com/VBA-tools/VBA-TDD\n'\n' Report results to Immediate Window\n'\n' @class ImmediateReporter\n' @author tim.hall.engr@gmail.com\n' @license MIT (https://opensource.org/licenses/MIT)\n' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '\nOption Explicit\n\n' --------------------------------------------- '\n' Constants and Private Variables\n' --------------------------------------------- '\n\nPrivate WithEvents pSuite As TestSuite\nAttribute pSuite.VB_VarHelpID = -1\nPrivate Finished As Boolean\n\n' ============================================= '\n' Public Methods\n' ============================================= '\n\n''\n' Listen to given TestSuite\n'\n' @method ListenTo\n' @param {TestSuite} Suite\n''\nPublic Sub ListenTo(Suite As TestSuite)\n If Not pSuite Is Nothing Then\n Done\n End If\n \n Debug.Print \"===\" & IIf(Suite.Description <> \"\", \" \" & Suite.Description & \" ===\", \"\")\n Set pSuite = Suite\n Finished = False\nEnd Sub\n\n''\n' Finish report for SpecSuite\n'\n' @method Done\n''\nPublic Function Done()\n Finished = True\n \n Debug.Print \"= \" & Summary & \" = \" & Now & \" =\" & vbNewLine\nEnd Function\n\n' ============================================= '\n' Private Functions\n' ============================================= '\n\nPrivate Function ResultTypeToString(ResultType As TestResultType) As String\n Select Case ResultType\n Case TestResultType.Pass\n ResultTypeToString = \"+\"\n Case TestResultType.Fail\n ResultTypeToString = \"X\"\n Case TestResultType.Pending\n ResultTypeToString = \".\"\n End Select\nEnd Function\n\nPrivate Function Summary() As String\n Dim total As Long\n Dim Passed As Long\n Dim Failed As Long\n Dim Pending As Long\n Dim Skipped As Long\n \n total = pSuite.Tests.Count\n Passed = pSuite.PassedTests.Count\n Failed = pSuite.FailedTests.Count\n Pending = pSuite.PendingTests.Count\n Skipped = pSuite.SkippedTests.Count\n \n Dim SummaryMessage As String\n If Failed > 0 Then\n SummaryMessage = \"FAIL (\" & Failed & \" of \" & total & \" failed\"\n Else\n SummaryMessage = \"PASS (\" & Passed & \" of \" & total & \" passed\"\n End If\n If Pending > 0 Then\n SummaryMessage = SummaryMessage & \", \" & Pending & \" pending\"\n End If\n If Skipped > 0 Then\n SummaryMessage = SummaryMessage & \", \" & Skipped & \" skipped)\"\n Else\n SummaryMessage = SummaryMessage & \")\"\n End If\n \n Summary = SummaryMessage\nEnd Function\n\nPrivate Sub pSuite_Result(Test As TestCase)\n If Test.Result = TestResultType.Skipped Then\n Exit Sub\n End If\n\n Debug.Print ResultTypeToString(Test.Result) & \" \" & Test.Name\n \n If Test.Result = TestResultType.Fail Then\n Dim Failure As Variant\n For Each Failure In Test.Failures\n Debug.Print \" \" & Failure\n Next Failure\n End If\nEnd Sub\n\nPrivate Sub Class_Terminate()\n If Not Finished Then\n Done\n End If\nEnd Sub\n" }, { "path": "JsonConverter.bas", "content": "Attribute VB_Name = \"JsonConverter\"\n'Attribute VB_Name = \"JsonConverter\"\n''\n' VBA-JSON v2.3.1\n' (c) Tim Hall - https://github.com/VBA-tools/VBA-JSON\n'\n' JSON Converter for VBA\n'\n' Errors:\n' 10001 - JSON parse error\n'\n' @class JsonConverter\n' @author tim.hall.engr@gmail.com\n' @license MIT (http://www.opensource.org/licenses/mit-license.php)\n'' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '\n'\n' Based originally on vba-json (with extensive changes)\n' BSD license included below\n'\n' JSONLib, http://code.google.com/p/vba-json/\n'\n' Copyright (c) 2013, Ryo Yokoyama\n' All rights reserved.\n'\n' Redistribution and use in source and binary forms, with or without\n' modification, are permitted provided that the following conditions are met:\n' * Redistributions of source code must retain the above copyright\n' notice, this list of conditions and the following disclaimer.\n' * Redistributions in binary form must reproduce the above copyright\n' notice, this list of conditions and the following disclaimer in the\n' documentation and/or other materials provided with the distribution.\n' * Neither the name of the nor the\n' names of its contributors may be used to endorse or promote products\n' derived from this software without specific prior written permission.\n'\n' THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS \"AS IS\" AND\n' ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED\n' WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE\n' DISCLAIMED. IN NO EVENT SHALL BE LIABLE FOR ANY\n' DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES\n' (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;\n' LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND\n' ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT\n' (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS\n' SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.\n' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '\nOption Explicit\n\n' === VBA-UTC Headers\n#If Mac Then\n\n#If VBA7 Then\n\n' 64-bit Mac (2016)\nPrivate Declare PtrSafe Function utc_popen Lib \"/usr/lib/libc.dylib\" Alias \"popen\" _\n (ByVal utc_Command As String, ByVal utc_Mode As String) As LongPtr\nPrivate Declare PtrSafe Function utc_pclose Lib \"/usr/lib/libc.dylib\" Alias \"pclose\" _\n (ByVal utc_File As LongPtr) As LongPtr\nPrivate Declare PtrSafe Function utc_fread Lib \"/usr/lib/libc.dylib\" Alias \"fread\" _\n (ByVal utc_Buffer As String, ByVal utc_Size As LongPtr, ByVal utc_Number As LongPtr, ByVal utc_File As LongPtr) As LongPtr\nPrivate Declare PtrSafe Function utc_feof Lib \"/usr/lib/libc.dylib\" Alias \"feof\" _\n (ByVal utc_File As LongPtr) As LongPtr\n\n#Else\n\n' 32-bit Mac\nPrivate Declare Function utc_popen Lib \"libc.dylib\" Alias \"popen\" _\n (ByVal utc_Command As String, ByVal utc_Mode As String) As Long\nPrivate Declare Function utc_pclose Lib \"libc.dylib\" Alias \"pclose\" _\n (ByVal utc_File As Long) As Long\nPrivate Declare Function utc_fread Lib \"libc.dylib\" Alias \"fread\" _\n (ByVal utc_Buffer As String, ByVal utc_Size As Long, ByVal utc_Number As Long, ByVal utc_File As Long) As Long\nPrivate Declare Function utc_feof Lib \"libc.dylib\" Alias \"feof\" _\n (ByVal utc_File As Long) As Long\n\n#End If\n\n#ElseIf VBA7 Then\n\n' http://msdn.microsoft.com/en-us/library/windows/desktop/ms724421.aspx\n' http://msdn.microsoft.com/en-us/library/windows/desktop/ms724949.aspx\n' http://msdn.microsoft.com/en-us/library/windows/desktop/ms725485.aspx\nPrivate Declare PtrSafe Function utc_GetTimeZoneInformation Lib \"kernel32\" Alias \"GetTimeZoneInformation\" _\n (utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION) As Long\nPrivate Declare PtrSafe Function utc_SystemTimeToTzSpecificLocalTime Lib \"kernel32\" Alias \"SystemTimeToTzSpecificLocalTime\" _\n (utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION, utc_lpUniversalTime As utc_SYSTEMTIME, utc_lpLocalTime As utc_SYSTEMTIME) As Long\nPrivate Declare PtrSafe Function utc_TzSpecificLocalTimeToSystemTime Lib \"kernel32\" Alias \"TzSpecificLocalTimeToSystemTime\" _\n (utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION, utc_lpLocalTime As utc_SYSTEMTIME, utc_lpUniversalTime As utc_SYSTEMTIME) As Long\n\n#Else\n\nPrivate Declare Function utc_GetTimeZoneInformation Lib \"kernel32\" Alias \"GetTimeZoneInformation\" _\n (utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION) As Long\nPrivate Declare Function utc_SystemTimeToTzSpecificLocalTime Lib \"kernel32\" Alias \"SystemTimeToTzSpecificLocalTime\" _\n (utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION, utc_lpUniversalTime As utc_SYSTEMTIME, utc_lpLocalTime As utc_SYSTEMTIME) As Long\nPrivate Declare Function utc_TzSpecificLocalTimeToSystemTime Lib \"kernel32\" Alias \"TzSpecificLocalTimeToSystemTime\" _\n (utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION, utc_lpLocalTime As utc_SYSTEMTIME, utc_lpUniversalTime As utc_SYSTEMTIME) As Long\n\n#End If\n\n#If Mac Then\n\n#If VBA7 Then\nPrivate Type utc_ShellResult\n utc_Output As String\n utc_ExitCode As LongPtr\nEnd Type\n\n#Else\n\nPrivate Type utc_ShellResult\n utc_Output As String\n utc_ExitCode As Long\nEnd Type\n\n#End If\n\n#Else\n\nPrivate Type utc_SYSTEMTIME\n utc_wYear As Integer\n utc_wMonth As Integer\n utc_wDayOfWeek As Integer\n utc_wDay As Integer\n utc_wHour As Integer\n utc_wMinute As Integer\n utc_wSecond As Integer\n utc_wMilliseconds As Integer\nEnd Type\n\nPrivate Type utc_TIME_ZONE_INFORMATION\n utc_Bias As Long\n utc_StandardName(0 To 31) As Integer\n utc_StandardDate As utc_SYSTEMTIME\n utc_StandardBias As Long\n utc_DaylightName(0 To 31) As Integer\n utc_DaylightDate As utc_SYSTEMTIME\n utc_DaylightBias As Long\nEnd Type\n\n#End If\n' === End VBA-UTC\n\nPrivate Type json_Options\n ' VBA only stores 15 significant digits, so any numbers larger than that are truncated\n ' 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\n ' See: http://support.microsoft.com/kb/269370\n '\n ' By default, VBA-JSON will use String for numbers longer than 15 characters that contain only digits\n ' to override set `JsonConverter.JsonOptions.UseDoubleForLargeNumbers = True`\n UseDoubleForLargeNumbers As Boolean\n\n ' The JSON standard requires object keys to be quoted (\" or '), use this option to allow unquoted keys\n AllowUnquotedKeys As Boolean\n\n ' The solidus (/) is not required to be escaped, use this option to escape them as \\/ in ConvertToJson\n EscapeSolidus As Boolean\nEnd Type\nPublic JsonOptions As json_Options\n\n' ============================================= '\n' Public Methods\n' ============================================= '\n\n''\n' Convert JSON string to object (Dictionary/Collection)\n'\n' @method ParseJson\n' @param {String} json_String\n' @return {Object} (Dictionary or Collection)\n' @throws 10001 - JSON parse error\n''\nPublic Function ParseJson(ByVal JsonString As String) As Object\n Dim json_Index As Long\n json_Index = 1\n\n ' Remove vbCr, vbLf, and vbTab from json_String\n JsonString = VBA.Replace(VBA.Replace(VBA.Replace(JsonString, VBA.vbCr, \"\"), VBA.vbLf, \"\"), VBA.vbTab, \"\")\n \n json_SkipSpaces JsonString, json_Index\n Select Case VBA.Mid$(JsonString, json_Index, 1)\n Case \"{\"\n Set ParseJson = json_ParseObject(JsonString, json_Index)\n Case \"[\"\n Set ParseJson = json_ParseArray(JsonString, json_Index)\n Case Else\n ' Error: Invalid JSON string\n Err.Raise 10001, \"JSONConverter\", json_ParseErrorMessage(JsonString, json_Index, \"Expecting '{' or '['\")\n End Select\nEnd Function\n\n''\n' Convert object (Dictionary/Collection/Array) to JSON\n'\n' @method ConvertToJson\n' @param {Variant} JsonValue (Dictionary, Collection, or Array)\n' @param {Integer|String} Whitespace \"Pretty\" print json with given number of spaces per indentation (Integer) or given string\n' @return {String}\n''\nPublic Function ConvertToJson(ByVal JsonValue As Variant, Optional ByVal Whitespace As Variant, Optional ByVal json_CurrentIndentation As Long = 0) As String\n Dim json_Buffer As String\n Dim json_BufferPosition As Long\n Dim json_BufferLength As Long\n Dim json_Index As Long\n Dim json_LBound As Long\n Dim json_UBound As Long\n Dim json_IsFirstItem As Boolean\n Dim json_Index2D As Long\n Dim json_LBound2D As Long\n Dim json_UBound2D As Long\n Dim json_IsFirstItem2D As Boolean\n Dim json_Key As Variant\n Dim json_Value As Variant\n Dim json_DateStr As String\n Dim json_Converted As String\n Dim json_SkipItem As Boolean\n Dim json_PrettyPrint As Boolean\n Dim json_Indentation As String\n Dim json_InnerIndentation As String\n\n json_LBound = -1\n json_UBound = -1\n json_IsFirstItem = True\n json_LBound2D = -1\n json_UBound2D = -1\n json_IsFirstItem2D = True\n json_PrettyPrint = Not IsMissing(Whitespace)\n\n Select Case VBA.VarType(JsonValue)\n Case VBA.vbNull\n ConvertToJson = \"null\"\n Case VBA.vbDate\n ' Date\n json_DateStr = ConvertToIso(VBA.CDate(JsonValue))\n\n ConvertToJson = \"\"\"\" & json_DateStr & \"\"\"\"\n Case VBA.vbString\n ' String (or large number encoded as string)\n If Not JsonOptions.UseDoubleForLargeNumbers And json_StringIsLargeNumber(JsonValue) Then\n ConvertToJson = JsonValue\n Else\n ConvertToJson = \"\"\"\" & json_Encode(JsonValue) & \"\"\"\"\n End If\n Case VBA.vbBoolean\n If JsonValue Then\n ConvertToJson = \"true\"\n Else\n ConvertToJson = \"false\"\n End If\n Case VBA.vbArray To VBA.vbArray + VBA.vbByte\n If json_PrettyPrint Then\n If VBA.VarType(Whitespace) = VBA.vbString Then\n json_Indentation = VBA.String$(json_CurrentIndentation + 1, Whitespace)\n json_InnerIndentation = VBA.String$(json_CurrentIndentation + 2, Whitespace)\n Else\n json_Indentation = VBA.Space$((json_CurrentIndentation + 1) * Whitespace)\n json_InnerIndentation = VBA.Space$((json_CurrentIndentation + 2) * Whitespace)\n End If\n End If\n\n ' Array\n json_BufferAppend json_Buffer, \"[\", json_BufferPosition, json_BufferLength\n\n On Error Resume Next\n\n json_LBound = LBound(JsonValue, 1)\n json_UBound = UBound(JsonValue, 1)\n json_LBound2D = LBound(JsonValue, 2)\n json_UBound2D = UBound(JsonValue, 2)\n\n If json_LBound >= 0 And json_UBound >= 0 Then\n For json_Index = json_LBound To json_UBound\n If json_IsFirstItem Then\n json_IsFirstItem = False\n Else\n ' Append comma to previous line\n json_BufferAppend json_Buffer, \",\", json_BufferPosition, json_BufferLength\n End If\n\n If json_LBound2D >= 0 And json_UBound2D >= 0 Then\n ' 2D Array\n If json_PrettyPrint Then\n json_BufferAppend json_Buffer, vbNewLine, json_BufferPosition, json_BufferLength\n End If\n json_BufferAppend json_Buffer, json_Indentation & \"[\", json_BufferPosition, json_BufferLength\n\n For json_Index2D = json_LBound2D To json_UBound2D\n If json_IsFirstItem2D Then\n json_IsFirstItem2D = False\n Else\n json_BufferAppend json_Buffer, \",\", json_BufferPosition, json_BufferLength\n End If\n\n json_Converted = ConvertToJson(JsonValue(json_Index, json_Index2D), Whitespace, json_CurrentIndentation + 2)\n\n ' For Arrays/Collections, undefined (Empty/Nothing) is treated as null\n If json_Converted = \"\" Then\n ' (nest to only check if converted = \"\")\n If json_IsUndefined(JsonValue(json_Index, json_Index2D)) Then\n json_Converted = \"null\"\n End If\n End If\n\n If json_PrettyPrint Then\n json_Converted = vbNewLine & json_InnerIndentation & json_Converted\n End If\n\n json_BufferAppend json_Buffer, json_Converted, json_BufferPosition, json_BufferLength\n Next json_Index2D\n\n If json_PrettyPrint Then\n json_BufferAppend json_Buffer, vbNewLine, json_BufferPosition, json_BufferLength\n End If\n\n json_BufferAppend json_Buffer, json_Indentation & \"]\", json_BufferPosition, json_BufferLength\n json_IsFirstItem2D = True\n Else\n ' 1D Array\n json_Converted = ConvertToJson(JsonValue(json_Index), Whitespace, json_CurrentIndentation + 1)\n\n ' For Arrays/Collections, undefined (Empty/Nothing) is treated as null\n If json_Converted = \"\" Then\n ' (nest to only check if converted = \"\")\n If json_IsUndefined(JsonValue(json_Index)) Then\n json_Converted = \"null\"\n End If\n End If\n\n If json_PrettyPrint Then\n json_Converted = vbNewLine & json_Indentation & json_Converted\n End If\n\n json_BufferAppend json_Buffer, json_Converted, json_BufferPosition, json_BufferLength\n End If\n Next json_Index\n End If\n\n On Error GoTo 0\n\n If json_PrettyPrint Then\n json_BufferAppend json_Buffer, vbNewLine, json_BufferPosition, json_BufferLength\n\n If VBA.VarType(Whitespace) = VBA.vbString Then\n json_Indentation = VBA.String$(json_CurrentIndentation, Whitespace)\n Else\n json_Indentation = VBA.Space$(json_CurrentIndentation * Whitespace)\n End If\n End If\n\n json_BufferAppend json_Buffer, json_Indentation & \"]\", json_BufferPosition, json_BufferLength\n\n ConvertToJson = json_BufferToString(json_Buffer, json_BufferPosition)\n\n ' Dictionary or Collection\n Case VBA.vbObject\n If json_PrettyPrint Then\n If VBA.VarType(Whitespace) = VBA.vbString Then\n json_Indentation = VBA.String$(json_CurrentIndentation + 1, Whitespace)\n Else\n json_Indentation = VBA.Space$((json_CurrentIndentation + 1) * Whitespace)\n End If\n End If\n\n ' Dictionary\n If VBA.TypeName(JsonValue) = \"Dictionary\" Then\n json_BufferAppend json_Buffer, \"{\", json_BufferPosition, json_BufferLength\n For Each json_Key In JsonValue.Keys\n ' For Objects, undefined (Empty/Nothing) is not added to object\n json_Converted = ConvertToJson(JsonValue(json_Key), Whitespace, json_CurrentIndentation + 1)\n If json_Converted = \"\" Then\n json_SkipItem = json_IsUndefined(JsonValue(json_Key))\n Else\n json_SkipItem = False\n End If\n\n If Not json_SkipItem Then\n If json_IsFirstItem Then\n json_IsFirstItem = False\n Else\n json_BufferAppend json_Buffer, \",\", json_BufferPosition, json_BufferLength\n End If\n\n If json_PrettyPrint Then\n json_Converted = vbNewLine & json_Indentation & \"\"\"\" & json_Key & \"\"\": \" & json_Converted\n Else\n json_Converted = \"\"\"\" & json_Key & \"\"\":\" & json_Converted\n End If\n\n json_BufferAppend json_Buffer, json_Converted, json_BufferPosition, json_BufferLength\n End If\n Next json_Key\n\n If json_PrettyPrint Then\n json_BufferAppend json_Buffer, vbNewLine, json_BufferPosition, json_BufferLength\n\n If VBA.VarType(Whitespace) = VBA.vbString Then\n json_Indentation = VBA.String$(json_CurrentIndentation, Whitespace)\n Else\n json_Indentation = VBA.Space$(json_CurrentIndentation * Whitespace)\n End If\n End If\n\n json_BufferAppend json_Buffer, json_Indentation & \"}\", json_BufferPosition, json_BufferLength\n\n ' Collection\n ElseIf VBA.TypeName(JsonValue) = \"Collection\" Then\n json_BufferAppend json_Buffer, \"[\", json_BufferPosition, json_BufferLength\n For Each json_Value In JsonValue\n If json_IsFirstItem Then\n json_IsFirstItem = False\n Else\n json_BufferAppend json_Buffer, \",\", json_BufferPosition, json_BufferLength\n End If\n\n json_Converted = ConvertToJson(json_Value, Whitespace, json_CurrentIndentation + 1)\n\n ' For Arrays/Collections, undefined (Empty/Nothing) is treated as null\n If json_Converted = \"\" Then\n ' (nest to only check if converted = \"\")\n If json_IsUndefined(json_Value) Then\n json_Converted = \"null\"\n End If\n End If\n\n If json_PrettyPrint Then\n json_Converted = vbNewLine & json_Indentation & json_Converted\n End If\n\n json_BufferAppend json_Buffer, json_Converted, json_BufferPosition, json_BufferLength\n Next json_Value\n\n If json_PrettyPrint Then\n json_BufferAppend json_Buffer, vbNewLine, json_BufferPosition, json_BufferLength\n\n If VBA.VarType(Whitespace) = VBA.vbString Then\n json_Indentation = VBA.String$(json_CurrentIndentation, Whitespace)\n Else\n json_Indentation = VBA.Space$(json_CurrentIndentation * Whitespace)\n End If\n End If\n\n json_BufferAppend json_Buffer, json_Indentation & \"]\", json_BufferPosition, json_BufferLength\n End If\n\n ConvertToJson = json_BufferToString(json_Buffer, json_BufferPosition)\n Case VBA.vbInteger, VBA.vbLong, VBA.vbSingle, VBA.vbDouble, VBA.vbCurrency, VBA.vbDecimal\n ' Number (use decimals for numbers)\n ConvertToJson = VBA.Replace(JsonValue, \",\", \".\")\n Case Else\n ' vbEmpty, vbError, vbDataObject, vbByte, vbUserDefinedType\n ' Use VBA's built-in to-string\n On Error Resume Next\n ConvertToJson = JsonValue\n On Error GoTo 0\n End Select\nEnd Function\n\n' ============================================= '\n' Private Functions\n' ============================================= '\n\nPrivate Function json_ParseObject(json_String As String, ByRef json_Index As Long) As Dictionary\n Dim json_Key As String\n Dim json_NextChar As String\n\n Set json_ParseObject = New Dictionary\n json_SkipSpaces json_String, json_Index\n If VBA.Mid$(json_String, json_Index, 1) <> \"{\" Then\n Err.Raise 10001, \"JSONConverter\", json_ParseErrorMessage(json_String, json_Index, \"Expecting '{'\")\n Else\n json_Index = json_Index + 1\n\n Do\n json_SkipSpaces json_String, json_Index\n If VBA.Mid$(json_String, json_Index, 1) = \"}\" Then\n json_Index = json_Index + 1\n Exit Function\n ElseIf VBA.Mid$(json_String, json_Index, 1) = \",\" Then\n json_Index = json_Index + 1\n json_SkipSpaces json_String, json_Index\n End If\n\n json_Key = json_ParseKey(json_String, json_Index)\n json_NextChar = json_Peek(json_String, json_Index)\n If json_NextChar = \"[\" Or json_NextChar = \"{\" Then\n Set json_ParseObject.Item(json_Key) = json_ParseValue(json_String, json_Index)\n Else\n json_ParseObject.Item(json_Key) = json_ParseValue(json_String, json_Index)\n End If\n Loop\n End If\nEnd Function\n\nPrivate Function json_ParseArray(json_String As String, ByRef json_Index As Long) As Collection\n Set json_ParseArray = New Collection\n\n json_SkipSpaces json_String, json_Index\n If VBA.Mid$(json_String, json_Index, 1) <> \"[\" Then\n Err.Raise 10001, \"JSONConverter\", json_ParseErrorMessage(json_String, json_Index, \"Expecting '['\")\n Else\n json_Index = json_Index + 1\n\n Do\n json_SkipSpaces json_String, json_Index\n If VBA.Mid$(json_String, json_Index, 1) = \"]\" Then\n json_Index = json_Index + 1\n Exit Function\n ElseIf VBA.Mid$(json_String, json_Index, 1) = \",\" Then\n json_Index = json_Index + 1\n json_SkipSpaces json_String, json_Index\n End If\n\n json_ParseArray.Add json_ParseValue(json_String, json_Index)\n Loop\n End If\nEnd Function\n\nPrivate Function json_ParseValue(json_String As String, ByRef json_Index As Long) As Variant\n json_SkipSpaces json_String, json_Index\n Select Case VBA.Mid$(json_String, json_Index, 1)\n Case \"{\"\n Set json_ParseValue = json_ParseObject(json_String, json_Index)\n Case \"[\"\n Set json_ParseValue = json_ParseArray(json_String, json_Index)\n Case \"\"\"\", \"'\"\n json_ParseValue = json_ParseString(json_String, json_Index)\n Case Else\n If VBA.Mid$(json_String, json_Index, 4) = \"true\" Then\n json_ParseValue = True\n json_Index = json_Index + 4\n ElseIf VBA.Mid$(json_String, json_Index, 5) = \"false\" Then\n json_ParseValue = False\n json_Index = json_Index + 5\n ElseIf VBA.Mid$(json_String, json_Index, 4) = \"null\" Then\n json_ParseValue = Null\n json_Index = json_Index + 4\n ElseIf VBA.InStr(\"+-0123456789\", VBA.Mid$(json_String, json_Index, 1)) Then\n json_ParseValue = json_ParseNumber(json_String, json_Index)\n Else\n Err.Raise 10001, \"JSONConverter\", json_ParseErrorMessage(json_String, json_Index, \"Expecting 'STRING', 'NUMBER', null, true, false, '{', or '['\")\n End If\n End Select\nEnd Function\n\nPrivate Function json_ParseString(json_String As String, ByRef json_Index As Long) As String\n Dim json_Quote As String\n Dim json_Char As String\n Dim json_Code As String\n Dim json_Buffer As String\n Dim json_BufferPosition As Long\n Dim json_BufferLength As Long\n\n json_SkipSpaces json_String, json_Index\n\n ' Store opening quote to look for matching closing quote\n json_Quote = VBA.Mid$(json_String, json_Index, 1)\n json_Index = json_Index + 1\n\n Do While json_Index > 0 And json_Index <= Len(json_String)\n json_Char = VBA.Mid$(json_String, json_Index, 1)\n\n Select Case json_Char\n Case \"\\\"\n ' Escaped string, \\\\, or \\/\n json_Index = json_Index + 1\n json_Char = VBA.Mid$(json_String, json_Index, 1)\n\n Select Case json_Char\n Case \"\"\"\", \"\\\", \"/\", \"'\"\n json_BufferAppend json_Buffer, json_Char, json_BufferPosition, json_BufferLength\n json_Index = json_Index + 1\n Case \"b\"\n json_BufferAppend json_Buffer, vbBack, json_BufferPosition, json_BufferLength\n json_Index = json_Index + 1\n Case \"f\"\n json_BufferAppend json_Buffer, vbFormFeed, json_BufferPosition, json_BufferLength\n json_Index = json_Index + 1\n Case \"n\"\n json_BufferAppend json_Buffer, vbCrLf, json_BufferPosition, json_BufferLength\n json_Index = json_Index + 1\n Case \"r\"\n json_BufferAppend json_Buffer, vbCr, json_BufferPosition, json_BufferLength\n json_Index = json_Index + 1\n Case \"t\"\n json_BufferAppend json_Buffer, vbTab, json_BufferPosition, json_BufferLength\n json_Index = json_Index + 1\n Case \"u\"\n ' Unicode character escape (e.g. \\u00a9 = Copyright)\n json_Index = json_Index + 1\n json_Code = VBA.Mid$(json_String, json_Index, 4)\n json_BufferAppend json_Buffer, VBA.ChrW(VBA.Val(\"&h\" + json_Code)), json_BufferPosition, json_BufferLength\n json_Index = json_Index + 4\n End Select\n Case json_Quote\n json_ParseString = json_BufferToString(json_Buffer, json_BufferPosition)\n json_Index = json_Index + 1\n Exit Function\n Case Else\n json_BufferAppend json_Buffer, json_Char, json_BufferPosition, json_BufferLength\n json_Index = json_Index + 1\n End Select\n Loop\nEnd Function\n\nPrivate Function json_ParseNumber(json_String As String, ByRef json_Index As Long) As Variant\n Dim json_Char As String\n Dim json_Value As String\n Dim json_IsLargeNumber As Boolean\n\n json_SkipSpaces json_String, json_Index\n\n Do While json_Index > 0 And json_Index <= Len(json_String)\n json_Char = VBA.Mid$(json_String, json_Index, 1)\n\n If VBA.InStr(\"+-0123456789.eE\", json_Char) Then\n ' Unlikely to have massive number, so use simple append rather than buffer here\n json_Value = json_Value & json_Char\n json_Index = json_Index + 1\n Else\n ' Excel only stores 15 significant digits, so any numbers larger than that are truncated\n ' 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\n ' See: http://support.microsoft.com/kb/269370\n '\n ' Fix: Parse -> String, Convert -> String longer than 15/16 characters containing only numbers and decimal points -> Number\n ' (decimal doesn't factor into significant digit count, so if present check for 15 digits + decimal = 16)\n json_IsLargeNumber = IIf(InStr(json_Value, \".\"), Len(json_Value) >= 17, Len(json_Value) >= 16)\n If Not JsonOptions.UseDoubleForLargeNumbers And json_IsLargeNumber Then\n json_ParseNumber = json_Value\n Else\n ' VBA.Val does not use regional settings, so guard for comma is not needed\n json_ParseNumber = VBA.Val(json_Value)\n End If\n Exit Function\n End If\n Loop\nEnd Function\n\nPrivate Function json_ParseKey(json_String As String, ByRef json_Index As Long) As String\n ' Parse key with single or double quotes\n If VBA.Mid$(json_String, json_Index, 1) = \"\"\"\" Or VBA.Mid$(json_String, json_Index, 1) = \"'\" Then\n json_ParseKey = json_ParseString(json_String, json_Index)\n ElseIf JsonOptions.AllowUnquotedKeys Then\n Dim json_Char As String\n Do While json_Index > 0 And json_Index <= Len(json_String)\n json_Char = VBA.Mid$(json_String, json_Index, 1)\n If (json_Char <> \" \") And (json_Char <> \":\") Then\n json_ParseKey = json_ParseKey & json_Char\n json_Index = json_Index + 1\n Else\n Exit Do\n End If\n Loop\n Else\n Err.Raise 10001, \"JSONConverter\", json_ParseErrorMessage(json_String, json_Index, \"Expecting '\"\"' or '''\")\n End If\n\n ' Check for colon and skip if present or throw if not present\n json_SkipSpaces json_String, json_Index\n If VBA.Mid$(json_String, json_Index, 1) <> \":\" Then\n Err.Raise 10001, \"JSONConverter\", json_ParseErrorMessage(json_String, json_Index, \"Expecting ':'\")\n Else\n json_Index = json_Index + 1\n End If\nEnd Function\n\nPrivate Function json_IsUndefined(ByVal json_Value As Variant) As Boolean\n ' Empty / Nothing -> undefined\n Select Case VBA.VarType(json_Value)\n Case VBA.vbEmpty\n json_IsUndefined = True\n Case VBA.vbObject\n Select Case VBA.TypeName(json_Value)\n Case \"Empty\", \"Nothing\"\n json_IsUndefined = True\n End Select\n End Select\nEnd Function\n\nPrivate Function json_Encode(ByVal json_Text As Variant) As String\n ' Reference: http://www.ietf.org/rfc/rfc4627.txt\n ' Escape: \", \\, /, backspace, form feed, line feed, carriage return, tab\n Dim json_Index As Long\n Dim json_Char As String\n Dim json_AscCode As Long\n Dim json_Buffer As String\n Dim json_BufferPosition As Long\n Dim json_BufferLength As Long\n\n For json_Index = 1 To VBA.Len(json_Text)\n json_Char = VBA.Mid$(json_Text, json_Index, 1)\n json_AscCode = VBA.AscW(json_Char)\n\n ' When AscW returns a negative number, it returns the twos complement form of that number.\n ' To convert the twos complement notation into normal binary notation, add 0xFFF to the return result.\n ' https://support.microsoft.com/en-us/kb/272138\n If json_AscCode < 0 Then\n json_AscCode = json_AscCode + 65536\n End If\n\n ' From spec, \", \\, and control characters must be escaped (solidus is optional)\n\n Select Case json_AscCode\n Case 34\n ' \" -> 34 -> \\\"\n json_Char = \"\\\"\"\"\n Case 92\n ' \\ -> 92 -> \\\\\n json_Char = \"\\\\\"\n Case 47\n ' / -> 47 -> \\/ (optional)\n If JsonOptions.EscapeSolidus Then\n json_Char = \"\\/\"\n End If\n Case 8\n ' backspace -> 8 -> \\b\n json_Char = \"\\b\"\n Case 12\n ' form feed -> 12 -> \\f\n json_Char = \"\\f\"\n Case 10\n ' line feed -> 10 -> \\n\n json_Char = \"\\n\"\n Case 13\n ' carriage return -> 13 -> \\r\n json_Char = \"\\r\"\n Case 9\n ' tab -> 9 -> \\t\n json_Char = \"\\t\"\n Case 0 To 31, 127 To 65535\n ' Non-ascii characters -> convert to 4-digit hex\n json_Char = \"\\u\" & VBA.Right$(\"0000\" & VBA.Hex$(json_AscCode), 4)\n End Select\n\n json_BufferAppend json_Buffer, json_Char, json_BufferPosition, json_BufferLength\n Next json_Index\n\n json_Encode = json_BufferToString(json_Buffer, json_BufferPosition)\nEnd Function\n\nPrivate Function json_Peek(json_String As String, ByVal json_Index As Long, Optional json_NumberOfCharacters As Long = 1) As String\n ' \"Peek\" at the next number of characters without incrementing json_Index (ByVal instead of ByRef)\n json_SkipSpaces json_String, json_Index\n json_Peek = VBA.Mid$(json_String, json_Index, json_NumberOfCharacters)\nEnd Function\n\nPrivate Sub json_SkipSpaces(json_String As String, ByRef json_Index As Long)\n ' Increment index to skip over spaces\n Do While json_Index > 0 And json_Index <= VBA.Len(json_String) And VBA.Mid$(json_String, json_Index, 1) = \" \"\n json_Index = json_Index + 1\n Loop\nEnd Sub\n\nPrivate Function json_StringIsLargeNumber(json_String As Variant) As Boolean\n ' Check if the given string is considered a \"large number\"\n ' (See json_ParseNumber)\n\n Dim json_Length As Long\n Dim json_CharIndex As Long\n json_Length = VBA.Len(json_String)\n\n ' Length with be at least 16 characters and assume will be less than 100 characters\n If json_Length >= 16 And json_Length <= 100 Then\n Dim json_CharCode As String\n\n json_StringIsLargeNumber = True\n\n For json_CharIndex = 1 To json_Length\n json_CharCode = VBA.Asc(VBA.Mid$(json_String, json_CharIndex, 1))\n Select Case json_CharCode\n ' Look for .|0-9|E|e\n Case 46, 48 To 57, 69, 101\n ' Continue through characters\n Case Else\n json_StringIsLargeNumber = False\n Exit Function\n End Select\n Next json_CharIndex\n End If\nEnd Function\n\nPrivate Function json_ParseErrorMessage(json_String As String, ByRef json_Index As Long, ErrorMessage As String)\n ' Provide detailed parse error message, including details of where and what occurred\n '\n ' Example:\n ' Error parsing JSON:\n ' {\"abcde\":True}\n ' ^\n ' Expecting 'STRING', 'NUMBER', null, true, false, '{', or '['\n\n Dim json_StartIndex As Long\n Dim json_StopIndex As Long\n\n ' Include 10 characters before and after error (if possible)\n json_StartIndex = json_Index - 10\n json_StopIndex = json_Index + 10\n If json_StartIndex <= 0 Then\n json_StartIndex = 1\n End If\n If json_StopIndex > VBA.Len(json_String) Then\n json_StopIndex = VBA.Len(json_String)\n End If\n\n json_ParseErrorMessage = \"Error parsing JSON:\" & VBA.vbNewLine & _\n VBA.Mid$(json_String, json_StartIndex, json_StopIndex - json_StartIndex + 1) & VBA.vbNewLine & _\n VBA.Space$(json_Index - json_StartIndex) & \"^\" & VBA.vbNewLine & _\n ErrorMessage\nEnd Function\n\nPrivate Sub json_BufferAppend(ByRef json_Buffer As String, _\n ByRef json_Append As Variant, _\n ByRef json_BufferPosition As Long, _\n ByRef json_BufferLength As Long)\n ' VBA can be slow to append strings due to allocating a new string for each append\n ' Instead of using the traditional append, allocate a large empty string and then copy string at append position\n '\n ' Example:\n ' Buffer: \"abc \"\n ' Append: \"def\"\n ' Buffer Position: 3\n ' Buffer Length: 5\n '\n ' Buffer position + Append length > Buffer length -> Append chunk of blank space to buffer\n ' Buffer: \"abc \"\n ' Buffer Length: 10\n '\n ' Put \"def\" into buffer at position 3 (0-based)\n ' Buffer: \"abcdef \"\n '\n ' Approach based on cStringBuilder from vbAccelerator\n ' http://www.vbaccelerator.com/home/VB/Code/Techniques/RunTime_Debug_Tracing/VB6_Tracer_Utility_zip_cStringBuilder_cls.asp\n '\n ' and clsStringAppend from Philip Swannell\n ' https://github.com/VBA-tools/VBA-JSON/pull/82\n\n Dim json_AppendLength As Long\n Dim json_LengthPlusPosition As Long\n\n json_AppendLength = VBA.Len(json_Append)\n json_LengthPlusPosition = json_AppendLength + json_BufferPosition\n\n If json_LengthPlusPosition > json_BufferLength Then\n ' Appending would overflow buffer, add chunk\n ' (double buffer length or append length, whichever is bigger)\n Dim json_AddedLength As Long\n json_AddedLength = IIf(json_AppendLength > json_BufferLength, json_AppendLength, json_BufferLength)\n\n json_Buffer = json_Buffer & VBA.Space$(json_AddedLength)\n json_BufferLength = json_BufferLength + json_AddedLength\n End If\n\n ' Note: Namespacing with VBA.Mid$ doesn't work properly here, throwing compile error:\n ' Function call on left-hand side of assignment must return Variant or Object\n Mid$(json_Buffer, json_BufferPosition + 1, json_AppendLength) = CStr(json_Append)\n json_BufferPosition = json_BufferPosition + json_AppendLength\nEnd Sub\n\nPrivate Function json_BufferToString(ByRef json_Buffer As String, ByVal json_BufferPosition As Long) As String\n If json_BufferPosition > 0 Then\n json_BufferToString = VBA.Left$(json_Buffer, json_BufferPosition)\n End If\nEnd Function\n\n''\n' VBA-UTC v1.0.6\n' (c) Tim Hall - https://github.com/VBA-tools/VBA-UtcConverter\n'\n' UTC/ISO 8601 Converter for VBA\n'\n' Errors:\n' 10011 - UTC parsing error\n' 10012 - UTC conversion error\n' 10013 - ISO 8601 parsing error\n' 10014 - ISO 8601 conversion error\n'\n' @module UtcConverter\n' @author tim.hall.engr@gmail.com\n' @license MIT (http://www.opensource.org/licenses/mit-license.php)\n'' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '\n\n' (Declarations moved to top)\n\n' ============================================= '\n' Public Methods\n' ============================================= '\n\n''\n' Parse UTC date to local date\n'\n' @method ParseUtc\n' @param {Date} UtcDate\n' @return {Date} Local date\n' @throws 10011 - UTC parsing error\n''\nPublic Function ParseUtc(utc_UtcDate As Date) As Date\n On Error GoTo utc_ErrorHandling\n\n#If Mac Then\n ParseUtc = utc_ConvertDate(utc_UtcDate)\n#Else\n Dim utc_TimeZoneInfo As utc_TIME_ZONE_INFORMATION\n Dim utc_LocalDate As utc_SYSTEMTIME\n\n utc_GetTimeZoneInformation utc_TimeZoneInfo\n utc_SystemTimeToTzSpecificLocalTime utc_TimeZoneInfo, utc_DateToSystemTime(utc_UtcDate), utc_LocalDate\n\n ParseUtc = utc_SystemTimeToDate(utc_LocalDate)\n#End If\n\n Exit Function\n\nutc_ErrorHandling:\n Err.Raise 10011, \"UtcConverter.ParseUtc\", \"UTC parsing error: \" & Err.Number & \" - \" & Err.Description\nEnd Function\n\n''\n' Convert local date to UTC date\n'\n' @method ConvertToUrc\n' @param {Date} utc_LocalDate\n' @return {Date} UTC date\n' @throws 10012 - UTC conversion error\n''\nPublic Function ConvertToUtc(utc_LocalDate As Date) As Date\n On Error GoTo utc_ErrorHandling\n\n#If Mac Then\n ConvertToUtc = utc_ConvertDate(utc_LocalDate, utc_ConvertToUtc:=True)\n#Else\n Dim utc_TimeZoneInfo As utc_TIME_ZONE_INFORMATION\n Dim utc_UtcDate As utc_SYSTEMTIME\n\n utc_GetTimeZoneInformation utc_TimeZoneInfo\n utc_TzSpecificLocalTimeToSystemTime utc_TimeZoneInfo, utc_DateToSystemTime(utc_LocalDate), utc_UtcDate\n\n ConvertToUtc = utc_SystemTimeToDate(utc_UtcDate)\n#End If\n\n Exit Function\n\nutc_ErrorHandling:\n Err.Raise 10012, \"UtcConverter.ConvertToUtc\", \"UTC conversion error: \" & Err.Number & \" - \" & Err.Description\nEnd Function\n\n''\n' Parse ISO 8601 date string to local date\n'\n' @method ParseIso\n' @param {Date} utc_IsoString\n' @return {Date} Local date\n' @throws 10013 - ISO 8601 parsing error\n''\nPublic Function ParseIso(utc_IsoString As String) As Date\n On Error GoTo utc_ErrorHandling\n\n Dim utc_Parts() As String\n Dim utc_DateParts() As String\n Dim utc_TimeParts() As String\n Dim utc_OffsetIndex As Long\n Dim utc_HasOffset As Boolean\n Dim utc_NegativeOffset As Boolean\n Dim utc_OffsetParts() As String\n Dim utc_Offset As Date\n\n utc_Parts = VBA.Split(utc_IsoString, \"T\")\n utc_DateParts = VBA.Split(utc_Parts(0), \"-\")\n ParseIso = VBA.DateSerial(VBA.CInt(utc_DateParts(0)), VBA.CInt(utc_DateParts(1)), VBA.CInt(utc_DateParts(2)))\n\n If UBound(utc_Parts) > 0 Then\n If VBA.InStr(utc_Parts(1), \"Z\") Then\n utc_TimeParts = VBA.Split(VBA.Replace(utc_Parts(1), \"Z\", \"\"), \":\")\n Else\n utc_OffsetIndex = VBA.InStr(1, utc_Parts(1), \"+\")\n If utc_OffsetIndex = 0 Then\n utc_NegativeOffset = True\n utc_OffsetIndex = VBA.InStr(1, utc_Parts(1), \"-\")\n End If\n\n If utc_OffsetIndex > 0 Then\n utc_HasOffset = True\n utc_TimeParts = VBA.Split(VBA.Left$(utc_Parts(1), utc_OffsetIndex - 1), \":\")\n utc_OffsetParts = VBA.Split(VBA.Right$(utc_Parts(1), Len(utc_Parts(1)) - utc_OffsetIndex), \":\")\n\n Select Case UBound(utc_OffsetParts)\n Case 0\n utc_Offset = TimeSerial(VBA.CInt(utc_OffsetParts(0)), 0, 0)\n Case 1\n utc_Offset = TimeSerial(VBA.CInt(utc_OffsetParts(0)), VBA.CInt(utc_OffsetParts(1)), 0)\n Case 2\n ' VBA.Val does not use regional settings, use for seconds to avoid decimal/comma issues\n utc_Offset = TimeSerial(VBA.CInt(utc_OffsetParts(0)), VBA.CInt(utc_OffsetParts(1)), Int(VBA.Val(utc_OffsetParts(2))))\n End Select\n\n If utc_NegativeOffset Then: utc_Offset = -utc_Offset\n Else\n utc_TimeParts = VBA.Split(utc_Parts(1), \":\")\n End If\n End If\n\n Select Case UBound(utc_TimeParts)\n Case 0\n ParseIso = ParseIso + VBA.TimeSerial(VBA.CInt(utc_TimeParts(0)), 0, 0)\n Case 1\n ParseIso = ParseIso + VBA.TimeSerial(VBA.CInt(utc_TimeParts(0)), VBA.CInt(utc_TimeParts(1)), 0)\n Case 2\n ' VBA.Val does not use regional settings, use for seconds to avoid decimal/comma issues\n ParseIso = ParseIso + VBA.TimeSerial(VBA.CInt(utc_TimeParts(0)), VBA.CInt(utc_TimeParts(1)), Int(VBA.Val(utc_TimeParts(2))))\n End Select\n\n ParseIso = ParseUtc(ParseIso)\n\n If utc_HasOffset Then\n ParseIso = ParseIso - utc_Offset\n End If\n End If\n\n Exit Function\n\nutc_ErrorHandling:\n Err.Raise 10013, \"UtcConverter.ParseIso\", \"ISO 8601 parsing error for \" & utc_IsoString & \": \" & Err.Number & \" - \" & Err.Description\nEnd Function\n\n''\n' Convert local date to ISO 8601 string\n'\n' @method ConvertToIso\n' @param {Date} utc_LocalDate\n' @return {Date} ISO 8601 string\n' @throws 10014 - ISO 8601 conversion error\n''\nPublic Function ConvertToIso(utc_LocalDate As Date) As String\n On Error GoTo utc_ErrorHandling\n\n ConvertToIso = VBA.Format$(ConvertToUtc(utc_LocalDate), \"yyyy-mm-ddTHH:mm:ss.000Z\")\n\n Exit Function\n\nutc_ErrorHandling:\n Err.Raise 10014, \"UtcConverter.ConvertToIso\", \"ISO 8601 conversion error: \" & Err.Number & \" - \" & Err.Description\nEnd Function\n\n' ============================================= '\n' Private Functions\n' ============================================= '\n\n#If Mac Then\n\nPrivate Function utc_ConvertDate(utc_Value As Date, Optional utc_ConvertToUtc As Boolean = False) As Date\n Dim utc_ShellCommand As String\n Dim utc_Result As utc_ShellResult\n Dim utc_Parts() As String\n Dim utc_DateParts() As String\n Dim utc_TimeParts() As String\n\n If utc_ConvertToUtc Then\n utc_ShellCommand = \"date -ur `date -jf '%Y-%m-%d %H:%M:%S' \" & _\n \"'\" & VBA.Format$(utc_Value, \"yyyy-mm-dd HH:mm:ss\") & \"' \" & _\n \" +'%s'` +'%Y-%m-%d %H:%M:%S'\"\n Else\n utc_ShellCommand = \"date -jf '%Y-%m-%d %H:%M:%S %z' \" & _\n \"'\" & VBA.Format$(utc_Value, \"yyyy-mm-dd HH:mm:ss\") & \" +0000' \" & _\n \"+'%Y-%m-%d %H:%M:%S'\"\n End If\n\n utc_Result = utc_ExecuteInShell(utc_ShellCommand)\n\n If utc_Result.utc_Output = \"\" Then\n Err.Raise 10015, \"UtcConverter.utc_ConvertDate\", \"'date' command failed\"\n Else\n utc_Parts = Split(utc_Result.utc_Output, \" \")\n utc_DateParts = Split(utc_Parts(0), \"-\")\n utc_TimeParts = Split(utc_Parts(1), \":\")\n\n utc_ConvertDate = DateSerial(utc_DateParts(0), utc_DateParts(1), utc_DateParts(2)) + _\n TimeSerial(utc_TimeParts(0), utc_TimeParts(1), utc_TimeParts(2))\n End If\nEnd Function\n\nPrivate Function utc_ExecuteInShell(utc_ShellCommand As String) As utc_ShellResult\n#If VBA7 Then\n Dim utc_File As LongPtr\n Dim utc_Read As LongPtr\n#Else\n Dim utc_File As Long\n Dim utc_Read As Long\n#End If\n\n Dim utc_Chunk As String\n\n On Error GoTo utc_ErrorHandling\n utc_File = utc_popen(utc_ShellCommand, \"r\")\n\n If utc_File = 0 Then: Exit Function\n\n Do While utc_feof(utc_File) = 0\n utc_Chunk = VBA.Space$(50)\n utc_Read = CLng(utc_fread(utc_Chunk, 1, Len(utc_Chunk) - 1, utc_File))\n If utc_Read > 0 Then\n utc_Chunk = VBA.Left$(utc_Chunk, CLng(utc_Read))\n utc_ExecuteInShell.utc_Output = utc_ExecuteInShell.utc_Output & utc_Chunk\n End If\n Loop\n\nutc_ErrorHandling:\n utc_ExecuteInShell.utc_ExitCode = CLng(utc_pclose(utc_File))\nEnd Function\n\n#Else\n\nPrivate Function utc_DateToSystemTime(utc_Value As Date) As utc_SYSTEMTIME\n utc_DateToSystemTime.utc_wYear = VBA.Year(utc_Value)\n utc_DateToSystemTime.utc_wMonth = VBA.Month(utc_Value)\n utc_DateToSystemTime.utc_wDay = VBA.Day(utc_Value)\n utc_DateToSystemTime.utc_wHour = VBA.Hour(utc_Value)\n utc_DateToSystemTime.utc_wMinute = VBA.Minute(utc_Value)\n utc_DateToSystemTime.utc_wSecond = VBA.Second(utc_Value)\n utc_DateToSystemTime.utc_wMilliseconds = 0\nEnd Function\n\nPrivate Function utc_SystemTimeToDate(utc_Value As utc_SYSTEMTIME) As Date\n utc_SystemTimeToDate = DateSerial(utc_Value.utc_wYear, utc_Value.utc_wMonth, utc_Value.utc_wDay) + _\n TimeSerial(utc_Value.utc_wHour, utc_Value.utc_wMinute, utc_Value.utc_wSecond)\nEnd Function\n\n#End If\n" }, { "path": "LICENSE", "content": "MIT License\n\nCopyright (c) 2017 Koen Rijnsent\n\nPermission is hereby granted, free of charge, to any person obtaining a copy\nof this software and associated documentation files (the \"Software\"), to deal\nin the Software without restriction, including without limitation the rights\nto use, copy, modify, merge, publish, distribute, sublicense, and/or sell\ncopies of the Software, and to permit persons to whom the Software is\nfurnished to do so, subject to the following conditions:\n\nThe above copyright notice and this permission notice shall be included in all\ncopies or substantial portions of the Software.\n\nTHE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR\nIMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,\nFITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE\nAUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER\nLIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,\nOUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE\nSOFTWARE.\n" }, { "path": "ModExchBinance.bas", "content": "Attribute VB_Name = \"ModExchBinance\"\nSub TestBinance()\n\n'Source: https://github.com/krijnsent/crypto_vba\n'Documentation: https://github.com/binance/binance-spot-api-docs/blob/master/rest-api.md\n'Remember to create a new API key for excel/VBA\n\nDim Apikey As String\nDim secretKey As String\n\nApikey = \"your api key here\"\nsecretKey = \"your secret key here\"\n\n'Remove these 2 lines, unless you define 2 constants somewhere ( Public Const secretkey_btce = \"the key to use everywhere\" etc )\nApikey = apikey_binance2\nsecretKey = secretkey_binance2\n\n'Put the credentials in a dictionary\nDim Cred As New Dictionary\nCred.Add \"apiKey\", Apikey\nCred.Add \"secretKey\", secretKey\n\n' Create a new test suite\nDim Suite As New TestSuite\nSuite.Description = \"ModExchBinance\"\n\n' Create reporter and attach it to these specs\nDim Reporter As New ImmediateReporter\nReporter.ListenTo Suite\n \n' Create a new test\nDim Test As TestCase\nSet Test = Suite.Test(\"TestBinancePublic\")\n\n'Error, unknown command\nTestResult = PublicBinance(\"AnUnknownCommand\", \"GET\")\nTest.IsOk InStr(TestResult, \"error\") > 0, \"test UnknownCommand 1a failed, result: ${1}\"\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"error_nr\"), 404, \"test UnknownCommand 1b failed, result: ${1}\"\n\n'Error, command without parameters\nTestResult = PublicBinance(\"depth\", \"GET\")\nTest.IsOk InStr(TestResult, \"error\") > 0, \"test MissingParams 1a failed, result: ${1}\"\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"error_nr\"), 400, \"test MissingParams 1b failed, result: ${1}\"\n\n'OK request\nTestResult = PublicBinance(\"time\", \"GET\")\n'{\"serverTime\":1513605418615}\nTest.IsOk InStr(TestResult, \"serverTime\") > 0, \"test Time 1a failed, result: ${1}\"\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk JsonResult(\"serverTime\") > 1510000000000#, \"test Time 1b failed, result: ${1}\"\n\n'Put parameters/options in a dictionary\nDim Params As New Dictionary\nParams.Add \"symbol\", \"ETHBTC\"\nTestResult = PublicBinance(\"ticker/24hr\", \"GET\", Params)\n'{\"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}\nTest.IsOk InStr(TestResult, \"priceChange\") > 0, \"test Ticker 1a failed, result: ${1}\"\nTest.IsOk InStr(TestResult, \"closeTime\") > 0, \"test Ticker 1b failed, result: ${1}\"\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"symbol\"), \"ETHBTC\", \"test Ticker 1c failed, result: ${1}\"\nTest.IsOk JsonResult(\"lastPrice\") > 0, \"test Ticker 1d failed, result: ${1}\"\n\nTestResult = GetBinanceTime()\n'e.g. 1516565004894\nTest.IsOk TestResult > 1510000000000#, \"test GetTime failed, result: ${1}\"\n\n'Unix time period:\nt1 = DateToUnixTime(\"1/1/2014\")\nt2 = DateToUnixTime(\"1/1/2018\")\n\nSet Test = Suite.Test(\"TestBinancePrivate GET\")\n'Binance always requires a timestamp parameter, first test without\nTestResult = PrivateBinance(\"api/v3/account\", \"GET\", Cred)\n'{\"code\":-1102,\"msg\":\"Mandatory parameter 'timestamp' was not sent, was empty/null, or malformed.\"}\nTest.IsOk InStr(TestResult, \"code\") > 0, \"test Private GET 1a failed, result: ${1}\"\nTest.IsOk InStr(TestResult, \"Mandatory parameter\") > 0, \"test Private GET 1b failed, result: ${1}\"\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"response_txt\")(\"code\"), -1102, \"test Private GET 1c failed, result: ${1}\"\n\n'Add timestamp to the parameters and try again\nDim Params2 As New Dictionary\nParams2.Add \"timestamp\", GetBinanceTime()\nTestResult = PrivateBinance(\"api/v3/account\", \"GET\", Cred, Params2)\n'{\"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\"},{...\nTest.IsOk InStr(TestResult, \"takerCommission\") > 0, \"test Private GET 1d failed, result: ${1}\"\nTest.IsOk InStr(TestResult, \"locked\") > 0, \"test Private GET 1e failed, result: ${1}\"\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk JsonResult(\"takerCommission\") > 0, \"test Private GET 1f failed, result: ${1}\"\nTest.IsOk JsonResult(\"balances\").Count > 10, \"test Private GET 1g failed, result: ${1}\"\n\nSet Test = Suite.Test(\"TestBinancePrivate POST/DELETE\")\n'Test a test order\nDim Params3 As New Dictionary\nParams3.Add \"symbol\", \"LTCBTC\"\nParams3.Add \"side\", \"BUY\"\nParams3.Add \"type\", \"LIMIT\"\nParams3.Add \"price\", 0.01\nParams3.Add \"quantity\", 1\nParams3.Add \"timeInForce\", \"GTC\"\nParams3.Add \"timestamp\", GetBinanceTime()\nTestResult = PrivateBinance(\"api/v3/order/test\", \"POST\", Cred, Params3)\nTest.IsEqual TestResult, \"{}\", \"test Private POST order 1a failed, result: ${1}\"\n\n'Delete a non-existing order\nDim Params4 As New Dictionary\nParams4.Add \"symbol\", \"LTCBTC\"\nParams4.Add \"orderId\", 987654\nParams4.Add \"timestamp\", GetBinanceTime()\nTestResult = PrivateBinance(\"api/v3/order\", \"DELETE\", Cred, Params4)\n'{\"error_nr\":400,\"error_txt\":\"HTTP-Bad Request\",\"response_txt\":{\"code\":-2011,\"msg\":\"Unknown order sent.\"}}\nTest.IsOk InStr(TestResult, \"code\") > 0, \"test Private DELETE order 1a failed, result: ${1}\"\nTest.IsOk InStr(TestResult, \"Unknown order\") > 0, \"test Private DELETE order 1b failed, result: ${1}\"\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"response_txt\")(\"code\"), -2011, \"test Private DELETE order 1c failed, result: ${1}\"\n\n\n'Use the Wallet end point\nDim Params5 As New Dictionary\nParams5.Add \"timestamp\", GetBinanceTime()\nTestResult = PrivateBinance(\"sapi/v1/system/status\", \"GET\", Cred, Params5)\n'{\"status\":0,\"msg\":\"normal\"}\nTest.IsOk InStr(TestResult, \"msg\") > 0, \"test Private System Status 1a failed, result: ${1}\"\nTest.IsOk InStr(TestResult, \"status\") > 0, \"test Private System Status 1b failed, result: ${1}\"\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"msg\"), \"normal\", \"test Private System Status 1c failed, result: ${1}\"\n\nDim Params6 As New Dictionary\nParams6.Add \"timestamp\", GetBinanceTime()\nTestResult = PrivateBinance(\"sapi/v1/capital/withdraw/history\", \"GET\", Cred, Params6)\n'e.g. [] (none) or\n'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\"}]\nIf TestResult = \"[]\" Then\n 'Empty result, OK\n Test.IsEqual TestResult, \"[]\", \"test Private Withdraw History 1a failed, result: ${1}\"\nElse\n Test.IsOk InStr(TestResult, \"address\") > 0, \"test Private Withdraw History 1b failed, result: ${1}\"\n Test.IsOk InStr(TestResult, \"coin\") > 0, \"test Private Withdraw History 1c failed, result: ${1}\"\n Set JsonResult = JsonConverter.ParseJson(TestResult)\n Test.IsOk JsonResult(1)(\"amount\") * 1 > 0, \"test Private Withdraw History 1d failed, result: ${1}\"\nEnd If\n\nEnd Sub\n\nFunction PublicBinance(Method As String, ReqType As String, Optional ParamDict As Dictionary) As String\n\nDim url As String\nPublicApiSite = \"https://api.binance.com\"\n\nMethodParams = DictToString(ParamDict, \"URLENC\")\nIf MethodParams <> \"\" Then MethodParams = \"?\" & MethodParams\nurlPath = \"/api/v1/\" & Method & MethodParams\nurl = PublicApiSite & urlPath\n\nPublicBinance = WebRequestURL(url, ReqType)\n\nEnd Function\nFunction PrivateBinance(Method As String, ReqType As String, Credentials As Dictionary, Optional ParamDict As Dictionary) As String\n\nDim NonceUnique As String\nDim TimeCorrection As Long\nDim url As String\n\nTradeApiSite = \"https://api.binance.com/\"\n\nMethodParams = DictToString(ParamDict, \"URLENC\")\nIf MethodParams <> \"\" Then MethodParams = \"&\" & MethodParams\n\nAPIsign = ComputeHash_C(\"SHA256\", MethodParams, Credentials(\"secretKey\"), \"STRHEX\")\nurl = TradeApiSite & Method & \"?\" & MethodParams & \"&signature=\" & APIsign\n\nDim UrlHeaders As New Dictionary\nUrlHeaders.Add \"User-Agent\", \"Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)\"\nUrlHeaders.Add \"Content-Type\", \"application/x-www-form-urlencoded\"\nUrlHeaders.Add \"X-MBX-APIKEY\", Credentials(\"apiKey\")\nPrivateBinance = WebRequestURL(url, ReqType, UrlHeaders)\n\nEnd Function\n\nFunction GetBinanceTime() As Double\n\nDim JsonResponse As String\nDim Json As Object\n\n'PublicBinance time\nJsonResponse = PublicBinance(\"time\", \"GET\")\nSet Json = JsonConverter.ParseJson(JsonResponse)\nGetBinanceTime = Json(\"serverTime\")\n\nSet Json = Nothing\n\nEnd Function\n\n" }, { "path": "ModExchBitVavo.bas", "content": "Attribute VB_Name = \"ModExchBitVavo\"\nSub TestBitVavo()\n\n'Source: https://github.com/krijnsent/crypto_vba\n'Documentation: https://docs.bitvavo.com/\n'Remember to create a new API key for excel/VBA\n\nDim Apikey As String\nDim secretKey As String\n\nApikey = \"your api key here\"\nsecretKey = \"your secret key here\"\n\n'Remove these 2 lines, unless you define 2 constants somewhere ( Public Const secretkey_btce = \"the key to use everywhere\" etc )\nApikey = apikey_bitvavo\nsecretKey = secretkey_bitvavo\n\n'Put the credentials in a dictionary\nDim Cred As New Dictionary\nCred.Add \"apiKey\", Apikey\nCred.Add \"secretKey\", secretKey\n\n' Create a new test suite\nDim Suite As New TestSuite\nSuite.Description = \"ModExchBitVavo\"\n\n' Create reporter and attach it to these specs\nDim Reporter As New ImmediateReporter\nReporter.ListenTo Suite\n \n' Create a new test\nDim Test As TestCase\nSet Test = Suite.Test(\"TestBitVavoPublic\")\n\n'Error, unknown command\nTestResult = PublicBitVavo(\"AnUnknownCommand\", \"GET\")\n'{\"error_nr\":404,\"error_txt\":\"HTTP-Not Found\",\"response_txt\":{\"errorCode\":110,\"error\":\"Invalid endpoint. Please check url and HTTP method.\"}}\nTest.IsOk InStr(TestResult, \"error\") > 0, \"test error 1a failed, result: ${1}\"\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"error_nr\"), 404, \"test error 1b failed, result: ${1}\"\n\n'Error, parameter missing\nTestResult = PublicBitVavo(\"BTC-EUR/candles\", \"GET\")\n'{\"error_nr\":400,\"error_txt\":\"HTTP-Bad Request\",\"response_txt\":{\"errorCode\":203,\"error\":\"interval parameter is required.\"}}\nTest.IsOk InStr(TestResult, \"error\") > 0, \"test error 2a failed, result: ${1}\"\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"error_nr\"), 400, \"test error 2b failed, result: ${1}\"\nTest.IsEqual JsonResult(\"response_txt\")(\"error\"), \"interval parameter is required.\", \"test error 2c failed, result: ${1}\"\n\n'OK simple time request\nTestResult = PublicBitVavo(\"time\", \"GET\")\n'e.g. {\"time\":1617720826734}\nTest.IsOk InStr(TestResult, \"time\") > 0, \"test time 1 failed, result: ${1}\"\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk JsonResult(\"time\") > 1600000000000#, \"test time 2 failed, result: ${1}\"\n\n'OK request with parameter\nDim Params As New Dictionary\nParams.Add \"interval\", \"1d\"\nParams.Add \"limit\", 10\nTestResult = PublicBitVavo(\"BTC-EUR/candles\", \"GET\", Params)\n'[[1617667200000,\"49950\",\"50300\",\"48547\",\"49010\",\"455.91371112\"],[1617580800000,\"49590\",\"50200\",\"48500\",\"49870\",\"555.41905353\"], etc.\n'returns: time, OHLCV\nTest.IsOk InStr(TestResult, \"error\") = 0, \"test candles 1 failed, result: ${1}\"\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nFor N = 1 To JsonResult.Count\n Test.IsOk JsonResult(N)(1) > 1600000000000#, \"test candles 2-\" & N & \" failed, result: ${1}\" 'check time of record\n Test.IsOk JsonResult(N)(2) > 0, \"test candles 3-\" & N & \" failed, result: ${1}\" 'check Open of record\nNext N\n\n\nSet Test = Suite.Test(\"TestBitVavoPrivate\")\nTestResult = PrivateBitVavo(\"account\", \"GET\", Cred)\n'e.g. {\"fees\":{\"taker\":\"0.0025\",\"maker\":\"0.0015\",\"volume\":\"0.00\"}}\nTest.IsOk InStr(TestResult, \"fees\") > 0, \"test private account 1 failed, result: ${1}\"\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk JsonResult(\"fees\")(\"taker\") >= 0, \"test private account 2 failed, result: ${1}\"\n\n'Private GET request that requires a parameter\nTestResult = PrivateBitVavo(\"deposit\", \"GET\", Cred)\n'{\"error_nr\":400,\"error_txt\":\"HTTP-Bad Request\",\"response_txt\":{\"errorCode\":203,\"error\":\"symbol parameter is required.\"}}\nTest.IsOk InStr(TestResult, \"error_txt\") > 0, \"test private deposit 1 failed, result: ${1}\"\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"response_txt\")(\"error\"), \"symbol parameter is required.\", \"test private deposit 2 failed, result: ${1}\"\n\n\nDim Params2 As New Dictionary\nParams2.Add \"symbol\", \"ETH\"\nTestResult = PrivateBitVavo(\"deposit\", \"GET\", Cred, Params2)\n'{\"errorCode\":412,\"error\":\"crypto_bank_required.\"} - no deposit address set\n'Or {\"address\": \"CryptoCurrencyAddress\",\"paymentId\": \"10002653\"} - deposit address set\nAddrSet = False\nIf InStr(TestResult, \"address\") > 0 Then AddrSet = True\nSet JsonResult = JsonConverter.ParseJson(TestResult)\n\nIf AddrSet Then\n Test.IsOk JsonResult(\"address\") <> \"\", \"test private deposit 3b failed, result: ${1}\"\nElse\n Test.IsEqual JsonResult(\"response_txt\")(\"error\"), \"crypto_bank_required.\", \"test private deposit 3a failed, result: ${1}\"\nEnd If\n\n'Sign test case from API docs\nTestMsgToSign = \"1548172481125POST/v2/order{\"\"market\"\":\"\"BTC-EUR\"\",\"\"side\"\":\"\"buy\"\",\"\"price\"\":\"\"5000\"\",\"\"amount\"\":\"\"1.23\"\",\"\"orderType\"\":\"\"limit\"\"}\"\nTestSign = ComputeHash_C(\"SHA256\", TestMsgToSign, \"bitvavo\", \"STRHEX\")\nTest.IsEqual TestSign, \"44d022723a20973a18f7ee97398b9fdd405d2d019c8d39e24b8cc0dcb39ca016\", \"test sign failed, result: ${1}\"\n\n\n'Buy order, buying 1 BTC for 100 EUR/BTC\nDim Params3 As New Dictionary\nParams3.Add \"market\", \"BTC-EUR\"\nParams3.Add \"side\", \"buy\"\nParams3.Add \"orderType\", \"limit\"\nParams3.Add \"amount\", 1\nParams3.Add \"price\", 100\nParams3.Add \"timeInForce\", \"FOK\"\nTestResult = PrivateBitVavo(\"order\", \"POST\", Cred, Params3)\n'{\"error_nr\":400,\"error_txt\":\"HTTP-Bad Request\",\"response_txt\":{\"errorCode\":216,\"error\":\"You do not have sufficient balance to complete this operation.\"}}\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"error_nr\"), 400, \"test private order 1 failed, result: ${1}\"\nTest.IsEqual JsonResult(\"response_txt\")(\"errorCode\"), 216, \"test private order 2 failed, result: ${1}\"\n\n\n'Deleting not existing order\nDim Params4 As New Dictionary\nParams4.Add \"market\", \"ETH-EUR\"\nParams4.Add \"orderId\", \"ff403e21-e270-4584-bc9e-9c4b18461465\"\nTestResult = PrivateBitVavo(\"order\", \"DELETE\", Cred, Params4)\n'{\"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.\"}}\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"error_nr\"), 404, \"test private delete order 1 failed, result: ${1}\"\nTest.IsEqual JsonResult(\"response_txt\")(\"errorCode\"), 240, \"test private delete order 2 failed, result: ${1}\"\n\n'Test by default switched off... Deletes all open orders...\n'Dim Params5 As New Dictionary\n'TestResult = PrivateBitVavo(\"orders\", \"DELETE\", Cred, Params5)\n'TestResult = \"{\"\"orderId\"\": \"\"2e7ce7fc-44e2-4d80-a4a7-d079c4750b61\"\"}\"\n'If InStr(TestResult, \"orderId\") > 0 Then\n' 'has some results\n' 'e.g.: {\"orderId\": \"2e7ce7fc-44e2-4d80-a4a7-d079c4750b61\"}\n' Test.IsOk InStr(TestResult, \"orderId\") > 0\n' Set JsonResult = JsonConverter.ParseJson(TestResult)\n' For Each k In JsonResult.Keys()\n' Test.IsOk Len(JsonResult(k)) >= 10\n' Next k\n'Else\n' 'no results\n' 'Empty: []\n' Test.IsEqual TestResult, \"[]\"\n'End If\n\n\nEnd Sub\n\nFunction PublicBitVavo(Method As String, ReqType As String, Optional ParamDict As Dictionary) As String\n\nDim url As String\nPublicApiSite = \"https://api.bitvavo.com\"\n\nMethodParams = DictToString(ParamDict, \"URLENC\")\nIf MethodParams <> \"\" Then MethodParams = \"?\" & MethodParams\nurlPath = \"/v2/\" & Method & MethodParams\nurl = PublicApiSite & urlPath\n\nPublicBitVavo = WebRequestURL(url, ReqType)\n\nEnd Function\nFunction PrivateBitVavo(Method As String, ReqType As String, Credentials As Dictionary, Optional ParamDict As Dictionary) As String\n\nDim NonceUnique As String\nDim MethodParams As String\nDim postdata As String\nDim url As String\n\nTradeApiSite = \"https://api.bitvavo.com\"\nApiEndPoint = \"/v2/\" & Method\npostdata = \"\"\nNonceUnique = GetBitVavoTime\n\nIf UCase(ReqType) = \"POST\" Then\n 'For POST request, all query parameters need to be included in the request body with JSON. (e.g. {\"currency\":\"BTC\"}).\n postdata = JsonConverter.ConvertToJson(ParamDict)\n If postdata = \"{}\" Then postdata = \"\"\nElseIf UCase(ReqType) = \"GET\" Or UCase(ReqType) = \"DELETE\" Or UCase(ReqType) = \"PUT\" Then\n MethodParams = DictToString(ParamDict, \"URLENC\")\n If MethodParams <> \"\" Then MethodParams = \"?\" & MethodParams\n ApiEndPoint = ApiEndPoint & MethodParams\nEnd If\n\nStrToHash = NonceUnique & ReqType & ApiEndPoint & postdata\nAPIsign = ComputeHash_C(\"SHA256\", StrToHash, Credentials(\"secretKey\"), \"STRHEX\")\nurl = TradeApiSite & ApiEndPoint\n\nDim UrlHeaders As New Dictionary\nUrlHeaders.Add \"User-Agent\", \"Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)\"\nUrlHeaders.Add \"Content-Type\", \"application/json\"\nUrlHeaders.Add \"BITVAVO-ACCESS-TIMESTAMP\", NonceUnique\nUrlHeaders.Add \"BITVAVO-ACCESS-KEY\", Credentials(\"apiKey\")\nUrlHeaders.Add \"BITVAVO-ACCESS-SIGNATURE\", APIsign\nPrivateBitVavo = WebRequestURL(url, ReqType, UrlHeaders, postdata)\n\nEnd Function\n\n\nFunction GetBitVavoTime() As Double\n\nDim JsonResponse As String\nDim Json As Object\n\n'PublicBinance time\nJsonResponse = PublicBitVavo(\"time\", \"GET\")\nSet Json = JsonConverter.ParseJson(JsonResponse)\nGetBitVavoTime = Json(\"time\")\n\nSet Json = Nothing\n\nEnd Function\n\n\n" }, { "path": "ModExchBitfinex.bas", "content": "Attribute VB_Name = \"ModExchBitfinex\"\nSub TestBitfinex()\n\n'Source: https://github.com/krijnsent/crypto_vba\n'Documentation: https://docs.bitfinex.com/docs/rest-auth\n'Note: there are two versions, v1 and v2, v2 is in Beta and does not have all functions\n'Remember to create a new API key for excel/VBA\n\nDim Apikey As String\nDim secretKey As String\n\nApikey = \"your api key here\"\nsecretKey = \"your secret key here\"\n\n'Remove these 2 lines, unless you define 2 constants somewhere ( Public Const secretkey_bitfinex = \"the key to use everywhere\" etc )\nApikey = apikey_bitfinex\nsecretKey = secretkey_bitfinex\n\n'Put the credentials in a dictionary\nDim Cred As New Dictionary\nCred.Add \"apiKey\", Apikey\nCred.Add \"secretKey\", secretKey\n\n' Create a new test suite\nDim Suite As New TestSuite\nSuite.Description = \"ModExchBitfinex\"\n\n' Create reporter and attach it to these specs\nDim Reporter As New ImmediateReporter\nReporter.ListenTo Suite\n \n' Create a new test\nDim Test As TestCase\n\nSet Test = Suite.Test(\"TestBitfinexPublic v1\")\n'Error, unknown command\nTestResult = PublicBitfinex1(\"AnUnknownCommand\", \"GET\")\n'{\"error_nr\":404,\"error_txt\":\"HTTP-Not Found\",\"response_txt\":0}\nTest.IsOk InStr(TestResult, \"error\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"error_nr\"), 404\n\n'Error, wrong parameter\nTestResult = PublicBitfinex1(\"ticker/bogus_here\", \"GET\")\n'{\"error_nr\":400,\"error_txt\":\"HTTP-Bad Request\",\"response_txt\":{\"message\":\"Unknown symbol\"}}\nTest.IsOk InStr(TestResult, \"error\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"error_nr\"), 400\nTest.IsEqual JsonResult(\"response_txt\")(\"message\"), \"Unknown symbol\"\n\n'OK request\nTestResult = PublicBitfinex1(\"symbols\", \"GET\")\n'[\"btcusd\",\"ltcusd\",\"ltcbtc\",\"ethusd\",\"ethbtc\",\"etcbtc\",\nTest.IsOk InStr(TestResult, \"ethbtc\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(1), \"btcusd\"\n\n'OK request with details\nTestResult = PublicBitfinex1(\"stats/BTCUSD\", \"GET\")\n'[{\"period\":1,\"volume\":\"6815.19360556\"},{\"period\":7,\"volume\":\"98002.43336128\"},{\"period\":30,\"volume\":\"387511.06628926\"}]\nTest.IsOk InStr(TestResult, \"volume\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(1)(\"period\"), 1\nTest.IsOk JsonResult(1)(\"volume\") > 0\n\n\nSet Test = Suite.Test(\"TestBitfinexPrivate v1 Balances\")\nTestResult = PrivateBitfinex1(\"balances\", \"POST\", Cred)\n'[{\"type\":\"exchange\",\"currency\":\"btc\",\"amount\":\"5.15334045\",\"available\":\"5.15334045\"},{\"type\":\"exchange\",\"currency\":\"eos\",\"amount\":\"15.0\",\"available\":\"15.0\"}]\nTest.IsOk InStr(TestResult, \"currency\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk InStr(JsonResult(1)(\"type\"), \"exchange\") + InStr(JsonResult(1)(\"type\"), \"margin\") + InStr(JsonResult(1)(\"type\"), \"funding\") > 0\nTest.IsOk Len(JsonResult(1)(\"currency\")) >= 3\nTest.IsOk Len(JsonResult(1)(\"amount\")) >= 0\n\n\nSet Test = Suite.Test(\"TestBitfinexPrivate v1 Orders\")\nDim Params1o As New Dictionary\nParams1o.Add \"symbol\", \"BTCUSD\"\nParams1o.Add \"amount\", \"1.33\"\nParams1o.Add \"price\", \"9\"\nParams1o.Add \"side\", \"buy\"\nParams1o.Add \"type\", \"fill-or-kill\"\nTestResult = PrivateBitfinex1(\"order/new\", \"POST\", Cred, Params1o)\n'e.g. {\"error_nr\":403,\"error_txt\":\"HTTP-Forbidden\",\"response_txt\":{\"message\":\"This API key does not have permission for this action\"}}\n'or: {\"id\":448364249,\"symbol\":\"btcusd\",\"exchange\":\"bitfinex\",etc.\nIf InStr(TestResult, \"error\") > 0 Then\n Test.IsOk InStr(TestResult, \"message\") > 0\n Set JsonResult = JsonConverter.ParseJson(TestResult)\n Test.IsEqual JsonResult(\"error_nr\"), 403\nElse\n Test.IsOk InStr(TestResult, \"symbol\") > 0\n Set JsonResult = JsonConverter.ParseJson(TestResult)\n Test.IsOk JsonResult(\"id\") > 0\n Test.IsEqual JsonResult(\"symbol\"), \"btcusd\"\nEnd If\n\n\nSet Test = Suite.Test(\"TestBitfinexPublic v2\")\n\n'Error, unknown command\nTestResult = PublicBitfinex2(\"AnUnknownCommand\", \"GET\")\n'{\"error_nr\":404,\"error_txt\":\"HTTP-Not Found\",\"response_txt\":0}\nTest.IsOk InStr(TestResult, \"error\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"error_nr\"), 404\n\n'Error, wrong parameter\nTestResult = PublicBitfinex2(\"ticker/bogus_here\", \"GET\")\n'{\"error_nr\":500,\"error_txt\":\"HTTP-\",\"response_txt\":[\"error\",10020,\"symbol: invalid\"]}\nTest.IsOk InStr(TestResult, \"error\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"error_nr\"), 500\nTest.IsEqual JsonResult(\"response_txt\")(2), 10020\n\n'OK request\nTestResult = PublicBitfinex2(\"platform/status\", \"GET\")\n'[1] -> 1 = active, 0=maintenance\nTest.IsOk InStr(TestResult, \"]\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(1), 1\n\n'OK request with parameters\nDim Params As New Dictionary\nParams.Add \"symbols\", \"tBTCUSD,tNEOETH\"\nTestResult = PublicBitfinex2(\"tickers\", \"GET\", Params)\n'[[\"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]]\nTest.IsOk InStr(TestResult, \"tNEOETH\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(1)(1), \"tBTCUSD\"\nTest.IsOk JsonResult(1)(2) > 100\n\nSet Test = Suite.Test(\"TestBitfinexPublic v2 POST\")\n'OK POST request with parameters, no credentials needed\nDim Params2 As New Dictionary\nParams2.Add \"symbol\", \"tBTCUSD\"\nParams2.Add \"amount\", \"-2.5\"\nTestResult = PublicBitfinex2(\"calc/trade/avg\", \"POST\", Params2)\n'[3905,-2.5]\nTest.IsOk InStr(TestResult, \"]\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk JsonResult(1) > 100\nTest.IsEqual JsonResult(2), -2.5\n\n\nSet Test = Suite.Test(\"TestBitfinexPrivate v2 Wallets\")\nTestResult = PrivateBitfinex2(\"auth/r/wallets\", \"POST\", Cred)\n'e.g. [[\"exchange\",\"BTC\",5.15334045,0,null],[\"exchange\",\"EOS\",15,0,null]]\nTest.IsOk InStr(TestResult, \"]]\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\n'Test first result for being one of three types exchange, margin, funding\nTest.IsOk InStr(JsonResult(1)(1), \"exchange\") + InStr(JsonResult(1)(1), \"margin\") + InStr(JsonResult(1)(1), \"funding\") > 0\nTest.IsOk Len(JsonResult(1)(2)) >= 3\nTest.IsOk Len(JsonResult(1)(3)) >= 0\n\nSet Test = Suite.Test(\"TestBitfinexPrivate v2 Trades\")\n'Unix time period (add 3 zeros for ms):\nt1 = DateToUnixTime(\"1/1/2016\") & \"000\"\nt2 = DateToUnixTime(\"1/1/2018\") & \"000\"\n\nDim Params3 As New Dictionary\nParams3.Add \"start\", t1\nParams3.Add \"end\", t2\nParams3.Add \"limit\", 25\nTestResult = PrivateBitfinex2(\"auth/r/ledgers/BTC/hist\", \"POST\", Cred, Params3)\n'[] for empty or [[ID,CURRENCY,null,TIMESTAMP_MILLI,null,AMOUNT,BALANCE,null,Description]]\nTest.IsOk InStr(TestResult, \"]\") > 0\nIf Len(TestResult) > 2 Then\n 'Results, some more tests\n Set JsonResult = JsonConverter.ParseJson(TestResult)\n Test.IsOk JsonResult(1)(1) > 0\n Test.IsOk Len(JsonResult(1)(2)) >= 3\n Test.IsOk JsonResult(1)(4) > 1400000000000#\nEnd If\n\n\nEnd Sub\n\n'Version 2 APIs below\nFunction PublicBitfinex1(Method As String, ReqType As String, Optional ParamDict As Dictionary) As String\n\nDim url As String\nPublicApiSite = \"https://api.bitfinex.com\"\n\nMethodParams = DictToString(ParamDict, \"URLENC\")\nIf MethodParams <> \"\" Then MethodParams = \"?\" & MethodParams\nurlPath = \"/v1/\" & Method & MethodParams\nurl = PublicApiSite & urlPath\n\nPublicBitfinex1 = WebRequestURL(url, ReqType)\n\nEnd Function\nFunction PrivateBitfinex1(Method As String, ReqType As String, Credentials As Dictionary, Optional ParamDict As Dictionary) As String\n\n'Thanks to balin77!\nDim NonceUnique As String\nDim TimeCorrection As Long\nDim url As String\n\nNonceUnique = CreateNonce(15)\nTradeApiSite = \"https://api.bitfinex.com\"\nApiPath = \"/v1/\" & Method\n\nMethodParams = DictToString(ParamDict, \"URLENC\")\nIf MethodParams <> \"\" Then MethodParams = \"?\" & MethodParams\n\nSet PayloadDict = New Dictionary\nPayloadDict(\"request\") = ApiPath\nPayloadDict(\"nonce\") = NonceUnique\nIf Not ParamDict Is Nothing Then\n For Each key In ParamDict.Keys\n PayloadDict(key) = ParamDict(key)\n Next key\nEnd If\n \nJson = Replace(ConvertToJson(PayloadDict), \"/\", \"\\/\")\npayload = Base64Encode(Json)\nAPIsign = ComputeHash_C(\"SHA384\", payload, Credentials(\"secretKey\"), \"STRHEX\")\n\nurl = TradeApiSite & ApiPath\n\nDim UrlHeaders As New Dictionary\nUrlHeaders.Add \"User-Agent\", \"Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)\"\nUrlHeaders.Add \"Content-Type\", \"application/x-www-form-urlencoded\"\nUrlHeaders.Add \"X-BFX-APIKEY\", Credentials(\"apiKey\")\nUrlHeaders.Add \"X-BFX-PAYLOAD\", payload\nUrlHeaders.Add \"X-BFX-SIGNATURE\", APIsign\nPrivateBitfinex1 = WebRequestURL(url, ReqType, UrlHeaders)\n\nEnd Function\n\n\nFunction PublicBitfinex2(Method As String, ReqType As String, Optional ParamDict As Dictionary) As String\n\nDim url As String\nPublicApiSite = \"https://api-pub.bitfinex.com\"\n\nMethodParams = DictToString(ParamDict, \"URLENC\")\nIf MethodParams <> \"\" Then MethodParams = \"?\" & MethodParams\nurlPath = \"/v2/\" & Method & MethodParams\nurl = PublicApiSite & urlPath\n\nPublicBitfinex2 = WebRequestURL(url, ReqType)\n\nEnd Function\nFunction PrivateBitfinex2(Method As String, ReqType As String, Credentials As Dictionary, Optional ParamDict As Dictionary) As String\n\nDim NonceUnique As String\nDim TimeCorrection As Long\nDim url As String\n\nNonceUnique = CreateNonce(15)\nTradeApiSite = \"https://api.bitfinex.com/\"\nApiPath = \"v2/\" & Method\n\nMethodParams = DictToString(ParamDict, \"URLENC\")\nIf MethodParams <> \"\" Then MethodParams = \"?\" & MethodParams\n\nToSign = \"/api/\" & ApiPath & NonceUnique\nAPIsign = ComputeHash_C(\"SHA384\", ToSign, Credentials(\"secretKey\"), \"STRHEX\")\n\nurl = TradeApiSite & ApiPath & MethodParams\n\nDim UrlHeaders As New Dictionary\nUrlHeaders.Add \"User-Agent\", \"Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)\"\nUrlHeaders.Add \"Content-Type\", \"application/x-www-form-urlencoded\"\nUrlHeaders.Add \"bfx-nonce\", NonceUnique\nUrlHeaders.Add \"bfx-apikey\", Credentials(\"apiKey\")\nUrlHeaders.Add \"bfx-signature\", APIsign\nPrivateBitfinex2 = WebRequestURL(url, ReqType, UrlHeaders)\n\n\nEnd Function\n" }, { "path": "ModExchBitmex.bas", "content": "Attribute VB_Name = \"ModExchBitmex\"\nSub TestBitmex()\n\n'Source: https://github.com/krijnsent/crypto_vba\n'Documentation: https://www.bitmex.com/app/restAPI\n'Commands: https://www.bitmex.com/api/explorer/\n'VBA example: https://github.com/BitMEX/api-connectors/tree/master/official-http/vba\n'Remember to create a new API key for excel/VBA\n\nDim Apikey As String\nDim secretKey As String\n\nApikey = \"your api key here\"\nsecretKey = \"your secret key here\"\n\n'Remove these 2 lines, unless you define 2 constants somewhere ( Public Const secretkey_btce = \"the key to use everywhere\" etc )\nApikey = apikey_bitmex\nsecretKey = secretkey_bitmex\n\n'Put the credentials in a dictionary\nDim Cred As New Dictionary\nCred.Add \"apiKey\", Apikey\nCred.Add \"secretKey\", secretKey\n\n' Create a new test suite\nDim Suite As New TestSuite\nSuite.Description = \"ModExchBitmex\"\n\n' Create reporter and attach it to these specs\nDim Reporter As New ImmediateReporter\nReporter.ListenTo Suite\n \n' Create a new test\nDim Test As TestCase\nSet Test = Suite.Test(\"TestBitmexPublic\")\n\n'Error, unknown command\nTestResult = PublicBitmex(\"AnUnknownCommand\", \"GET\")\n'{\"error_nr\":404,\"error_txt\":\"HTTP-Not Found\",\"response_txt\":{\"error\":{\"message\":\"Not Found\",\"name\":\"HTTPError\"}}}\nTest.IsOk InStr(TestResult, \"error\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"error_nr\"), 404\n\n'Error, command without parameters\nTestResult = PublicBitmex(\"orderBook/L2\", \"GET\")\n'{\"error_nr\":400,\"error_txt\":\"HTTP-Bad Request\",\"response_txt\":{\"error\":{\"message\":\"'symbol' is a required arg.\",\"name\":\"HTTPError\"}}}\nTest.IsOk InStr(TestResult, \"error\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"error_nr\"), 400\n\n'OK request\nTestResult = PublicBitmex(\"stats\", \"GET\")\n'[{\"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.\nTest.IsOk InStr(TestResult, \"ETH\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nFor N = 1 To JsonResult.Count\n Test.IsEqual JsonResult(N)(\"currency\"), \"XBt\"\n If JsonResult(N)(\"rootSymbol\") <> \"Total\" Then Test.IsOk JsonResult(N)(\"volume24h\") >= 0\nNext N\n\n'Put parameters/options in a dictionary\nDim Params As New Dictionary\nParams.Add \"symbol\", \"XBT\"\nParams.Add \"depth\", 5\nTestResult = PublicBitmex(\"orderBook/L2\", \"GET\", Params)\n'[{\"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}]\nTest.IsOk InStr(TestResult, \"symbol\") > 0\nTest.IsOk InStr(TestResult, \"side\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(1)(\"symbol\"), \"XBTUSD\"\nTest.IsOk JsonResult(1)(\"id\") > 0\nTest.IsOk JsonResult(1)(\"size\") > 0\nTest.IsOk JsonResult(1)(\"price\") > 0\n\n'GET private API\nSet Test = Suite.Test(\"TestBitmexPrivate GET\")\n\n'Use TESTNET\n\n'Test an invalid command\nDim Params2 As New Dictionary\nParams2.Add \"testnet\", 1\nTestResult = PrivateBitmex(\"not_a_command\", \"GET\", Cred, Params2)\n'{\"error_nr\":404,\"error_txt\":\"HTTP-Not Found\",\"response_txt\":{\"error\":{\"message\":\"Not Found\",\"name\":\"HTTPError\"}}}\nTest.IsOk InStr(TestResult, \"error\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"error_nr\"), 404\n\n'Simple GET without parameters\nDim Params3 As New Dictionary\nParams3.Add \"testnet\", 1\nTestResult = PrivateBitmex(\"user\", \"GET\", Cred, Params3)\n'{\"id\":30219,\"ownerId\":null,\"lastname\":\"Rijnsent\",\"username\":\"rijnsent\",\"email\":\"rijnsent\",etc..}\nTest.IsOk InStr(TestResult, \"lastname\") > 0\nTest.IsOk InStr(TestResult, \"username\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk JsonResult(\"id\") > 0\n\n'Simple GET without parameters\nDim Params4 As New Dictionary\nParams4.Add \"testnet\", 1\nParams4.Add \"currency\", \"XBt\"\nParams4.Add \"count\", 5\nTestResult = PrivateBitmex(\"user/walletHistory\", \"GET\", Cred, Params4)\n'[{\"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\"}]\nTest.IsOk InStr(TestResult, \"transactID\") > 0\nTest.IsOk InStr(TestResult, \"currency\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk JsonResult(1)(\"amount\") > 0\n\n\nSet Test = Suite.Test(\"TestBitmexPrivate POST/DELETE\")\n'Test delete all orders\nDim Params5 As New Dictionary\nParams5.Add \"testnet\", 1\nTestResult = PrivateBitmex(\"order/all\", \"DELETE\", Cred, Params5)\nTest.IsEqual TestResult, \"[]\"\n\n'Test delete all orders\nDim Params6 As New Dictionary\nParams6.Add \"testnet\", 1\nParams6.Add \"symbol\", \"XBTUSD\"\nParams6.Add \"price\", 2\nParams6.Add \"orderQty\", 0.00000002\nParams6.Add \"clOrdID\", \"MyTestOrderIDHere\"\nTestResult = PrivateBitmex(\"order\", \"POST\", Cred, Params6)\n'{\"error_nr\":403,\"error_txt\":\"HTTP-Forbidden\",\"response_txt\":{\"error\":{\"message\":\"Access Denied\",\"name\":\"HTTPError\"}}}\nTest.IsOk InStr(TestResult, \"error_nr\") > 0\nTest.IsOk InStr(TestResult, \"error\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"error_nr\"), 403\n\n\nEnd Sub\n\nFunction PublicBitmex(Method As String, ReqType As String, Optional ParamDict As Dictionary) As String\n\nDim url As String\nPublicApiSite = \"https://www.bitmex.com\"\n\nMethodParams = DictToString(ParamDict, \"URLENC\")\nIf MethodParams <> \"\" Then MethodParams = \"?\" & MethodParams\nurlPath = \"/api/v1/\" & Method & MethodParams\nurl = PublicApiSite & urlPath\n\nPublicBitmex = WebRequestURL(url, ReqType)\n\nEnd Function\nFunction PrivateBitmex(Method As String, ReqType As String, Credentials As Dictionary, Optional ParamDict As Dictionary) As String\n\nDim NonceUnique As String\nDim MethodParams As String\nDim postdata As String\nDim url As String\n\nTradeApiSite = \"https://www.bitmex.com\"\nIf Not ParamDict Is Nothing Then\n If ParamDict.Exists(\"testnet\") Then\n ParamDict.Remove \"testnet\"\n TradeApiSite = \"https://testnet.bitmex.com\"\n End If\nEnd If\nApiEndPoint = \"/api/v1/\" & Method\npostdata = \"\"\nNonceUnique = CreateNonce(13)\n\nIf UCase(ReqType) = \"POST\" Then\n 'For POST request, all query parameters need to be included in the request body with JSON. (e.g. {\"currency\":\"BTC\"}).\n postdata = JsonConverter.ConvertToJson(ParamDict)\nElseIf UCase(ReqType) = \"GET\" Then\n MethodParams = DictToString(ParamDict, \"URLENC\")\n If MethodParams <> \"\" Then MethodParams = \"?\" & MethodParams\n ApiEndPoint = ApiEndPoint & MethodParams\nEnd If\n\n\nStrToHash = ReqType & ApiEndPoint & NonceUnique & postdata\nAPIsign = ComputeHash_C(\"SHA256\", StrToHash, Credentials(\"secretKey\"), \"STRHEX\")\nurl = TradeApiSite & ApiEndPoint\n\nDim UrlHeaders As New Dictionary\nUrlHeaders.Add \"User-Agent\", \"Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)\"\nUrlHeaders.Add \"Content-Type\", \"application/x-www-form-urlencoded\"\nUrlHeaders.Add \"api-nonce\", NonceUnique 'NOT USED ANYMORE\nUrlHeaders.Add \"api-key\", Credentials(\"apiKey\")\nUrlHeaders.Add \"api-signature\", APIsign\nPrivateBitmex = WebRequestURL(url, ReqType, UrlHeaders, postdata)\n\nEnd Function\n" }, { "path": "ModExchBitstamp.bas", "content": "Attribute VB_Name = \"ModExchBitstamp\"\nSub TestBitstamp()\n\n'Source: https://github.com/krijnsent/crypto_vba\n'Documentation: https://Bitstamp.com/home/api\n'Remember to create a new API key for excel/VBA\n\nDim Apikey As String\nDim secretKey As String\n\nApikey = \"your api key here\"\nsecretKey = \"your secret key here\"\ncustomerID = \"your customer id here\"\n\n'Remove these 3 lines, unless you define 3 constants somewhere ( Public Const secretkey_btce = \"the key to use everywhere\" etc )\nApikey = apikey_bitstamp\nsecretKey = secretkey_bitstamp\ncustomerID = customer_id_bitstamp\n\n'Put the credentials in a dictionary\nDim Cred As New Dictionary\nCred.Add \"apiKey\", Apikey\nCred.Add \"secretKey\", secretKey\nCred.Add \"customerID\", customerID\n\n' Create a new test suite\nDim Suite As New TestSuite\nSuite.Description = \"ModExchBitstamp\"\n\n' Create reporter and attach it to these specs\nDim Reporter As New ImmediateReporter\nReporter.ListenTo Suite\n \n' Create a new test\nDim Test As TestCase\nSet Test = Suite.Test(\"TestBitstampPublic\")\n\n'Error, unknown command\nTestResult = PublicBitstamp(\"AnUnknownCommand\", \"GET\")\n'{\"error_nr\":404,\"error_txt\":\"HTTP-Not Found\",\"response_txt\":0}\nTest.IsOk InStr(TestResult, \"error\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"error_nr\"), 404\n\n'Error, parameter missing\nTestResult = PublicBitstamp(\"v2/ticker_hour/\", \"GET\")\n'{\"error_nr\":404,\"error_txt\":\"HTTP-NOT FOUND\",\"response_txt\":0}\nTest.IsOk InStr(TestResult, \"error\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"error_nr\"), 404\n\n'Request without parameters\nTestResult = PublicBitstamp(\"ticker/\", \"GET\")\n'{\"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}\nTest.IsOk InStr(TestResult, \"timestamp\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk JsonResult(\"timestamp\") * 1 >= 1510000000\nTest.IsOk JsonResult(\"bid\") >= 0\n\n'Put variables in\nTestResult = PublicBitstamp(\"v2/ticker_hour/btceur/\", \"GET\")\n'{\"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\"}\nTest.IsOk InStr(TestResult, \"timestamp\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk JsonResult(\"timestamp\") * 1 >= 1510000000\nTest.IsOk JsonResult(\"bid\") >= 0\n\n'Unix time period:\nSet Test = Suite.Test(\"TestBitstampPrivate\")\n\nTestResult = PrivateBitstamp(\"balance/\", \"POST\", Cred)\n'{\"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\"}\nTest.IsOk InStr(TestResult, \"eur_balance\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk JsonResult(\"eur_balance\") >= 0\nTest.IsOk JsonResult(\"usd_balance\") >= 0\n\nTestResult = PrivateBitstamp(\"v2/balance/\", \"POST\", Cred)\n'{\"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\"}\nTest.IsOk InStr(TestResult, \"btc_balance\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk JsonResult(\"bch_balance\") >= 0\nTest.IsOk JsonResult(\"eth_balance\") >= 0\n\nTestResult = PrivateBitstamp(\"order_status/\", \"POST\", Cred)\n'{\"error\": \"Missing id POST param\"}\nTest.IsOk InStr(TestResult, \"Missing\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"error\"), \"Missing id POST param\"\n\n'Put the parameters in a dictionary\nDim Params As New Dictionary\nParams.Add \"id\", 12345\nTestResult = PrivateBitstamp(\"order_status/\", \"POST\", Cred, Params)\n'{\"error\": \"Order not found\"}\nTest.IsOk InStr(TestResult, \"found\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"error\"), \"Order not found\"\n\n\n'Set a buy order, put the parameters in a dictionary\nDim Params2 As New Dictionary\nParams2.Add \"amount\", 1\nParams2.Add \"price\", 3\nParams2.Add \"ioc_order\", True\nTestResult = PrivateBitstamp(\"v2/buy/etheur/\", \"POST\", Cred, Params2)\n'{\"status\": \"error\", \"reason\": {\"__all__\": [\"Minimum order size is 5.0 EUR.\"]}}\nTest.IsOk InStr(TestResult, \"Minimum order size\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"status\"), \"error\"\n\n\nEnd Sub\n\nFunction PublicBitstamp(Method As String, ReqType As String, Optional ParamDict As Dictionary) As String\n\nDim url As String\nPublicApiSite = \"https://www.bitstamp.net\"\n\nMethodParams = DictToString(ParamDict, \"URLENC\")\nIf MethodParams <> \"\" Then MethodParams = \"?\" & MethodParams\nurlPath = \"/api/\" & Method & MethodParams\nurl = PublicApiSite & urlPath\n\nPublicBitstamp = WebRequestURL(url, ReqType)\n\nEnd Function\nFunction PrivateBitstamp(Method As String, ReqType As String, Credentials As Dictionary, Optional ParamDict As Dictionary) As String\n\nDim NonceUnique As String\nDim message As String\nDim PostMsg As String\nDim url As String\nDim PayloadDict As Dictionary\n\n'Get a Nonce\nNonceUnique = CreateNonce()\nTradeApiSite = \"https://www.bitstamp.net/api/\"\n\nmessage = NonceUnique & Credentials(\"customerID\") & Credentials(\"apiKey\")\nAPIsign = UCase(ComputeHash_C(\"SHA256\", message, Credentials(\"secretKey\"), \"STRHEX\"))\n\nSet PayloadDict = New Dictionary\nPayloadDict(\"key\") = Credentials(\"apiKey\")\nPayloadDict(\"signature\") = APIsign\nPayloadDict(\"nonce\") = NonceUnique\nIf Not ParamDict Is Nothing Then\n For Each key In ParamDict.Keys\n PayloadDict(key) = ParamDict(key)\n Next key\nEnd If\nPostMsg = DictToString(PayloadDict, \"URLENC\")\n\nDim headerDict As New Dictionary\nheaderDict.Add \"User-Agent\", \"Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)\"\nheaderDict.Add \"Content-Type\", \"application/x-www-form-urlencoded\"\n\nurl = TradeApiSite & Method\nPrivateBitstamp = WebRequestURL(url, ReqType, headerDict, PostMsg)\n\nEnd Function\n\n\n" }, { "path": "ModExchBittrex.bas", "content": "Attribute VB_Name = \"ModExchBittrex\"\nSub TestBittrex()\n\n'Source: https://github.com/krijnsent/crypto_vba\n'Documentation: https://bittrex.com/home/api\n'v3 - https://bittrex.github.io/api/v3\n'Remember to create a new API key for excel/VBA\n\nDim Apikey As String\nDim secretKey As String\n\nApikey = \"your api key here\"\nsecretKey = \"your secret key here\"\n\n'Remove these 2 lines, unless you define 2 constants somewhere ( Public Const secretkey_btce = \"the key to use everywhere\" etc )\nApikey = apikey_bittrex\nsecretKey = secretkey_bittrex\n\n'Put the credentials in a dictionary\nDim Cred As New Dictionary\nCred.Add \"apiKey\", Apikey\nCred.Add \"secretKey\", secretKey\n\n' Create a new test suite\nDim Suite As New TestSuite\nSuite.Description = \"ModExchBittrex\"\n\n' Create reporter and attach it to these specs\nDim Reporter As New ImmediateReporter\nReporter.ListenTo Suite\n \n' Create a new test\nDim Test As TestCase\nSet Test = Suite.Test(\"TestBittrexPublic\")\n\n'Error, unknown/wrong command\nTestResult = PublicBittrex(\"AnUnknownCommand\", \"GET\")\n'{\"error_nr\":404,\"error_txt\":\"HTTP-Not Found\",\"response_txt\":{\"code\":\"NOT_FOUND\"}}\nTest.IsOk InStr(TestResult, \"error\") > 0, \"test error 1 failed, result: ${1}\"\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"error_nr\"), 404, \"test error 2 failed, result: ${1}\"\n\n'Request without parameters\nTestResult = PublicBittrex(\"markets\", \"GET\")\n'[{\"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.\nTest.IsOk InStr(TestResult, \"quoteCurrencySymbol\") > 0, \"test markets 1 failed, result: ${1}\"\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(1)(\"quoteCurrencySymbol\"), \"BTC\", \"test markets 2 failed, result: ${1}\"\nTest.IsOk JsonResult(1)(\"precision\") > 0, \"test markets 3 failed, result: ${1}\"\n\n'Put parameters/options in a dictionary for a summary of one coin, wrong input\nDim Params As New Dictionary\nParams.Add \"market\", \"BTC-DOGE\"\nTestResult = PublicBittrex(\"markets\", \"GET\", Params)\n'{\"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\"}}}\nTest.IsOk InStr(TestResult, \"error\") > 0, \"test error2 1 failed, result: ${1}\"\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"error_nr\"), 404, \"test error2 2 failed, result: ${1}\"\n\n'Parameter in a dictionary\nDim Params2 As New Dictionary\nParams2.Add \"market\", \"DOGE-BTC\"\nTestResult = PublicBittrex(\"markets\", \"GET\", Params2)\n'{\"symbol\":\"DOGE-BTC\",\"baseCurrencySymbol\":\"DOGE\",\"quoteCurrencySymbol\":\"BTC\",\"minTradeSize\":\"1000.00000000\",\"precision\":8,\"status\":\"ONLINE\",\"createdAt\":\"2014-02-13T00:00:00Z\",\"prohibitedIn\":[],\"associatedTermsOfService\":[]}\nTest.IsOk InStr(TestResult, \"baseCurrencySymbol\") > 0, \"test markets detail 1 failed, result: ${1}\"\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"quoteCurrencySymbol\"), \"BTC\", \"test markets detail 2 failed, result: ${1}\"\nTest.IsEqual JsonResult(\"precision\"), 8, \"test markets detail 3 failed, result: ${1}\"\nTest.IsEqual JsonResult(\"baseCurrencySymbol\"), \"DOGE\", \"test markets detail 4 failed, result: ${1}\"\n\n'Parameters in a dictionary get '/markets/{marketSymbol}/candles/{candleInterval}/recent\nDim Params3 As New Dictionary\nParams3.Add \"market\", \"ETH-BTC\"\nParams3.Add \"type1\", \"candles\"\nParams3.Add \"candleInterval\", \"HOUR_1\"\nParams3.Add \"type2\", \"recent\"\nTestResult = PublicBittrex(\"markets\", \"GET\", Params3)\n'[{\"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...\nTest.IsOk InStr(TestResult, \"startsAt\") > 0, \"test candles 1 failed, result: ${1}\"\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk JsonResult(1)(\"open\") > 0, \"test candles 2 failed, result: ${1}\"\nTest.IsOk JsonResult(1)(\"high\") > 0, \"test candles 3 failed, result: ${1}\"\nTest.IsOk JsonResult(1)(\"low\") > 0, \"test candles 4 failed, result: ${1}\"\n\n\n'Get bittrex time from ping\nSet Test = Suite.Test(\"TestBittrexTime\")\nTestResult = GetBittrexTime()\nTest.IsOk TestResult > 0, \"test time 2 failed, result: ${1}\"\n\n\n'Test private API\nSet Test = Suite.Test(\"TestBittrexPrivate\")\nTestResult = PrivateBittrex(\"balances\", \"GET\", Cred)\n'[{\"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...\nTest.IsOk InStr(TestResult, \"currencySymbol\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk Len(JsonResult(1)(\"currencySymbol\")) >= 3\nTest.IsOk JsonResult(1)(\"Balance\") >= 0\n\n\nDim Params4 As New Dictionary\nParams4.Add \"marketSymbol\", \"XRP-BTC\"\nTestResult = PrivateBittrex(\"orders/open\", \"GET\", Cred, Params4)\n'[] (assuming no open orders DOGE-BTC, why would you have any...?\nTest.IsEqual TestResult, \"[]\"\n\n'Buy 1 BTC for a crazy low price of 0.1 USD :-)\nDim Params5 As New Dictionary\nParams5.Add \"marketSymbol\", \"BTC-USD\"\nParams5.Add \"direction\", \"BUY\"\nParams5.Add \"type\", \"LIMIT\"\nParams5.Add \"timeInForce\", \"FILL_OR_KILL\"\nParams5.Add \"quantity\", 1\nParams5.Add \"limit\", 0.1\nTestResult = PrivateBittrex(\"orders\", \"POST\", Cred, Params5)\nDebug.Print TestResult\nIf InStr(TestResult, \"error_nr\") Then\n 'e.g. {\"error_nr\":400,\"error_txt\":\"HTTP-Bad Request\",\"response_txt\":{\"code\":\"SOURCE_OF_FUNDS_REQUIRED\"}}\n Set JsonResult = JsonConverter.ParseJson(TestResult)\n Test.IsOk JsonResult(\"error_nr\") >= 400\nElse\n '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)\"}}\n Test.IsOk InStr(TestResult, \"marketSymbol\") > 0\n Set JsonResult = JsonConverter.ParseJson(TestResult)\n Test.IsEqual JsonResult(\"direction\"), \"BUY\"\nEnd If\n\n'Cancel order with id\nDim Params6 As New Dictionary\nParams6.Add \"uuid\", \"orderid-bla\"\nTestResult = PrivateBittrex(\"orders\", \"DELETE\", Cred, Params6)\n'{\"error_nr\":404,\"error_txt\":\"HTTP-Not Found\",\"response_txt\":{\"code\":\"NOT_FOUND\"}}\nTest.IsOk InStr(TestResult, \"error_nr\") > 0\nTest.IsOk InStr(TestResult, \"NOT_FOUND\") > 0\n\nEnd Sub\n\nFunction PublicBittrex(Method As String, ReqType As String, Optional ParamDict As Dictionary) As String\n\nDim url As String\nPublicApiSite = \"https://api.bittrex.com\"\n\nMethodParams = \"\"\nIf Not ParamDict Is Nothing Then\n For Each itm In ParamDict\n MethodParams = MethodParams & ParamDict(itm) & \"/\"\n Next itm\nEnd If\n\nurlPath = \"/v3/\" & Method & \"/\" & MethodParams\nurl = PublicApiSite & urlPath\n\nPublicBittrex = WebRequestURL(url, ReqType)\n\nEnd Function\nFunction PrivateBittrex(Method As String, ReqType As String, Credentials As Dictionary, Optional ParamDict As Dictionary) As String\n\nDim NonceUnique As String\nDim postdata As String\nDim url As String\nDim Uri As String\n\n'Get a 13-digit Nonce from the server time\nNonceUnique = GetBittrexTime\nTradeApiSite = \"https://api.bittrex.com/v3/\"\n\nurl = TradeApiSite & Method\npostdata = \"\"\nIf ReqType = \"DELETE\" Then\n For Each itm In ParamDict\n url = url & \"/\" & ParamDict(itm)\n Next itm\nElseIf ReqType = \"GET\" And Not ParamDict Is Nothing Then\n url = url & \"?\" & DictToString(ParamDict, \"URLENC\")\nElseIf ReqType = \"POST\" Then\n postdata = JsonConverter.ConvertToJson(ParamDict)\nEnd If\n\ncontentHash = ComputeHash_C(\"SHA512\", postdata, \"\", \"STRHEX\")\npreSign = NonceUnique & url & ReqType & contentHash\nAPIsign = ComputeHash_C(\"SHA512\", preSign, Credentials(\"secretKey\"), \"STRHEX\")\n\nDim headerDict As New Dictionary\nheaderDict.Add \"User-Agent\", \"Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)\"\nheaderDict.Add \"Content-Type\", \"application/json\"\nheaderDict.Add \"Api-Key\", Credentials(\"apiKey\")\nheaderDict.Add \"Api-Timestamp\", NonceUnique\nheaderDict.Add \"Api-Content-Hash\", contentHash\nheaderDict.Add \"Api-Signature\", APIsign\n\n'Debug.Print url, postdata\nPrivateBittrex = WebRequestURL(url, ReqType, headerDict, postdata)\n\nEnd Function\n\n\nFunction GetBittrexTime() As Double\n\nDim JsonResponse As String\nDim Json As Object\n\n'GetBittrexTime time from ping\nJsonResponse = PublicBittrex(\"ping\", \"GET\")\nSet Json = JsonConverter.ParseJson(JsonResponse)\nGetBittrexTime = Json(\"serverTime\")\nNonceUnique = CreateNonce(13)\n\nIf GetBittrexTime = 0 Then\n TimeCorrection = -3600\n GetBittrexTime = DateDiff(\"s\", \"1/1/1970\", Now)\n GetBittrexTime = Trim(Str((Val(GetBittrexTime) + TimeCorrection)) & Right(Int(Timer * 100), 2) & \"0\")\nEnd If\n\nSet Json = Nothing\n\nEnd Function\n\n" }, { "path": "ModExchBybit.bas", "content": "Attribute VB_Name = \"ModExchBybit\"\nSub TestBybit()\n\n'Source: https://github.com/krijnsent/crypto_vba\n'https://doc.Bybit.co.kr/#section/V2-version\n'Remember to create a new API key for excel/VBA\n\nDim Apikey As String\nDim secretKey As String\n\nApikey = \"your api key here\"\nsecretKey = \"your secret key here\"\n\n'Remove these 2 lines, unless you define 2 constants somewhere ( Public Const secretkey_btce = \"the key to use everywhere\" etc )\nApikey = apikey_bybit\nsecretKey = secretkey_bybit\n\n'Put the credentials in a dictionary\nDim Cred As New Dictionary\nCred.Add \"apiKey\", Apikey\nCred.Add \"secretKey\", secretKey\n\n' Create a new test suite\nDim Suite As New TestSuite\nSuite.Description = \"ModExchBybit\"\n\n' Create reporter and attach it to these specs\nDim Reporter As New ImmediateReporter\nReporter.ListenTo Suite\n \n' Create a new test\nDim Test As TestCase\nSet Test = Suite.Test(\"TestBybitPublic\")\n\n'Error, unknown command\nTestResult = PublicBybit(\"AnUnknownCommand\", \"GET\")\n'{\"error_nr\":404,\"error_txt\":\"HTTP-Not Found\",\"response_txt\":0}\nTest.IsOk InStr(TestResult, \"error\") > 0, \"unknowncommand 1 failed, result: ${1}\"\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"error_txt\"), \"HTTP-Not Found\", \"unknowncommand 2 failed, result: ${1}\"\nTest.IsEqual JsonResult(\"error_nr\"), 404, \"unknowncommand 3 failed, result: ${1}\"\n\n'OK request\nTestResult = PublicBybit(\"time\", \"GET\")\n'e.g. {\"ret_code\":0,\"ret_msg\":\"OK\",\"ext_code\":\"\",\"ext_info\":\"\",\"result\":{},\"time_now\":\"1572094930.589837\"}\nTest.IsOk InStr(TestResult, \"time_now\") > 0, \"time 1 failed, result: ${1}\"\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"ret_msg\"), \"OK\", \"time 1 failed, result: ${1}\"\nTest.IsOk Val(JsonResult(\"time_now\")) > 1500000000#, \"time 1 failed, result: ${1}\"\n\n'GET with parameter for orderBook\nDim Params1 As New Dictionary\nParams1.Add \"symbol\", \"BTCUSD\"\nTestResult = PublicBybit(\"orderBook/L2\", \"GET\", Params1)\n'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\"},\nTest.IsEqual JsonResult(\"ret_msg\"), \"OK\", \"orderbook 1 failed, result: ${1}\"\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk JsonResult(\"result\").Count > 0, \"orderbook 2 failed, result: ${1}\"\nTest.IsEqual JsonResult(\"result\")(1)(\"symbol\"), \"BTCUSD\", \"orderbook 3 failed, result: ${1}\"\nTest.Includes Array(\"Buy\", \"Sell\"), JsonResult(\"result\")(1)(\"side\"), \"orderbook 4 failed, result: ${1}\"\n\n'GET all tickers -> add a parameter like above to only get one\nTestResult = PublicBybit(\"tickers\", \"GET\")\n'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\",\nTest.IsEqual JsonResult(\"ret_msg\"), \"OK\", \"tickers 1 failed, result: ${1}\"\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk JsonResult(\"result\").Count > 0, \"tickers 2 failed, result: ${1}\"\nTest.IsOk Val(JsonResult(\"result\")(1)(\"bid_price\")) > 0, \"tickers 3 failed, result: ${1}\"\nTest.IsOk Val(JsonResult(\"result\")(1)(\"prev_price_24h\")) > 0, \"tickers 4 failed, result: ${1}\"\n\nDim Params1a As New Dictionary\nDim LimitTime As Double\nDim ResTime As Long\nParams1a.Add \"symbol\", \"BTCUSD\"\nParams1a.Add \"interval\", 60 'TimeFrame in minutes\nParams1a.Add \"limit\", 2\nLimitTime = Round(GetBybitTime() / 1000, 0) - 60 * 60 * 2\n'GetByBitTime returns time in ms (microseconds, 13 digits), and this function takes seconds (10 digits)\n'In order to get the past 2 hours, deduct that time in seconds: interval*limit*60\nParams1a.Add \"from\", LimitTime\nTestResult = PublicBybit(\"kline/list\", \"GET\", Params1a)\nTest.IsEqual JsonResult(\"ret_msg\"), \"OK\", \"kline 1 failed, result: ${1}\"\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk JsonResult(\"result\").Count > 0, \"kline 2 failed, result: ${1}\"\nTest.IsEqual JsonResult(\"result\")(1)(\"symbol\"), \"BTCUSD\", \"kline 3 failed, result: ${1}\"\nTest.IsOk Val(JsonResult(\"result\")(1)(\"high\")) > 0, \"kline 4 failed, result: ${1}\"\n'ResTime = JsonResult(\"result\")(1)(\"open_time\")\n'Debug.Print ResTime, UnixTimeToDate(ResTime)\n'ResTime = JsonResult(\"result\")(2)(\"open_time\")\n'Debug.Print ResTime, UnixTimeToDate(ResTime)\n\n' Create a new test\nSet Test = Suite.Test(\"TestBybitTime\")\nTestResult = GetBybitTime()\nTest.IsOk TestResult > 1500000000000#, \"bybit time 1 failed, result: ${1}\"\nTest.IsOk TestResult < 1600000000000#, \"bybit time 2 failed, result: ${1}\"\n\n\nSet Test = Suite.Test(\"TestBybitPrivate\")\n\n'Api key properties\nTestResult = PrivateBybit(\"open-api/api-key\", \"GET\", Cred)\n'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}\nTest.IsOk InStr(TestResult, \"ret_msg\") > 0\n'Debug.Print TestResult\nSet JsonResult = JsonConverter.ParseJson(TestResult)\n\nIf JsonResult(\"ret_msg\") = \"ok\" Then\n Test.IsOk Len(JsonResult(\"result\")(1)(\"api_key\")) >= 10\n Test.IsOk JsonResult(\"result\")(1)(\"user_id\") > 0\nElse\n 'E.g. IP-address block\n Test.IsEqual Left(JsonResult(\"ret_msg\"), 12), \"unmatched IP\"\n Test.IsUndefined JsonResult(\"result\")\nEnd If\n\n'Example set leverage\nDim Params2 As New Dictionary\nParams2.Add \"symbol\", \"ETHUSD\"\nParams2.Add \"leverage\", 1\nTestResult = PrivateBybit(\"user/leverage/save\", \"POST\", Cred, Params2)\n'Debug.Print TestResult\n'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}\n'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}\nTest.IsOk InStr(TestResult, \"ret_msg\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nIf JsonResult(\"ret_msg\") = \"ok\" Then\n Test.IsEqual JsonResult(\"ret_msg\"), \"ok\"\n Test.IsEqual JsonResult(\"result\"), 1 'same as input leverage\nElse\n 'Assume leverage is the same as before\n Test.IsEqual JsonResult(\"ret_msg\"), \"cannot set leverage which is same to the old leverage\"\n Test.IsUndefined JsonResult(\"result\")\nEnd If\n\n'Example set leverage\nTm = GetBybitTime()\n'e.g. 1583401823000 -> milliseconds\nHrs = 24\nDim Params3 As New Dictionary\nParams3.Add \"symbol\", \"ETHUSD\"\nParams3.Add \"limit\", 1\nParams3.Add \"start_time\", Tm - 3600000 * Hrs\nTestResult = PrivateBybit(\"v2/private/execution/list\", \"GET\", Cred, Params3)\n'Debug.Print Tm\n'Debug.Print TestResult\n'{\"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}\n\n\n'/v2/private/execution/list\n\nEnd Sub\n\nFunction PublicBybit(Method As String, ReqType As String, Optional ParamDict As Dictionary) As String\n\nDim url As String\nPublicApiSite = \"https://api.bybit.com/v2/public/\"\n \n'symbols, orderBook/L2 +symbol , time, tickers (+symbol)\n\nMethodParams = DictToString(ParamDict, \"URLENC\")\nIf MethodParams <> \"\" Then MethodParams = \"?\" & MethodParams\nurlPath = Method & MethodParams\nurl = PublicApiSite & urlPath\n\nPublicBybit = WebRequestURL(url, ReqType)\n\nEnd Function\nFunction PrivateBybit(Method As String, ReqType As String, Credentials As Dictionary, Optional ParamDict As Dictionary) As String\n\nDim NonceUnique As String\nDim postdata As String\nDim postdataUrl As String\nDim postdataJSON As String\nDim url As String\n\n'Get a 10-digit Nonce\nNonceUnique = GetBybitTime()\nTradeApiSite = \"https://api.bybit.com/\"\n\nurl = TradeApiSite & Method\n\nDim PostDict As New Dictionary\nPostDict.Add \"api_key\", Credentials(\"apiKey\")\nPostDict.Add \"timestamp\", NonceUnique\nIf Not ParamDict Is Nothing Then\n For Each key In ParamDict.Keys\n PostDict(key) = ParamDict(key)\n Next key\nEnd If\n'Sort alphabetically\nCall SortDictByKey(PostDict)\n\n'All parameters are in the PostDict dictionary, merge them to a string\nMsgToSign = DictToString(PostDict, \"URLENC\")\nAPIsign = ComputeHash_C(\"SHA256\", MsgToSign, Credentials(\"secretKey\"), \"STRHEX\")\nPostDict.Add \"sign\", APIsign\n\nIf UCase(ReqType) = \"GET\" Then\n MethodParams = DictToString(PostDict, \"URLENC\")\n If MethodParams <> \"\" Then MethodParams = \"?\" & MethodParams\n contentFormat = \"application/x-www-form-urlencoded\"\nElseIf UCase(ReqType) = \"POST\" Then\n postdataJSON = JsonConverter.ConvertToJson(ParamDict)\n contentFormat = \"application/json\"\n MethodParams = \"\"\nElse\n 'Wrong Method, error out\n Exit Function\nEnd If\n\nDim headerDict As New Dictionary\nheaderDict.Add \"User-Agent\", \"Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)\"\nheaderDict.Add \"Content-Type\", contentFormat\n\nurl = TradeApiSite & Method & MethodParams\n\nPrivateBybit = WebRequestURL(url, ReqType, headerDict, postdataJSON)\n\nEnd Function\n\n\nFunction GetBybitTime() As Double\n\nDim BybitTime As String\nDim ValBybitTime As Double\nDim JsonResponse As String\nDim Json As Object\n\n'PublicBybit time, 13 digit (ms)\nJsonResponse = PublicBybit(\"time\", \"GET\")\nSet Json = JsonConverter.ParseJson(JsonResponse)\nBybitTime = Left(Json(\"time_now\"), InStr(Json(\"time_now\"), \".\") - 1) & \"000\"\n\nIf Len(BybitTime) = 0 Then\n TimeCorrection = -3600\n ValBybitTime = DateDiff(\"s\", \"1/1/1970\", Now) + TimeCorrection\n BybitTime = Trim(Str(ValBybitTime) & Right(Int(Timer * 100), 2) & \"0\")\nEnd If\n\n'Debug.Print BybitTime\n\nGetBybitTime = Val(BybitTime)\n\nSet Json = Nothing\n\nEnd Function\n" }, { "path": "ModExchCoinbase.bas", "content": "Attribute VB_Name = \"ModExchCoinbase\"\nSub TestCoinbase()\n\n'Standard Coinbase, for CoinbasePro (formerly known as GDAX), see that Module\n'https://developers.coinbase.com/api/v2#introduction\n'Source: https://github.com/krijnsent/crypto_vba\n'Remember to create a new API key for excel/VBA\n\nDim Apikey As String\nDim secretKey As String\n\nApikey = \"your api key here\"\nsecretKey = \"your secret key here\"\n\n'Remove these 3 lines, unless you define 3 constants somewhere ( Public Const secretkey_gdax = \"the key to use everywhere\" etc )\nApikey = apikey_coinbase\nsecretKey = secretkey_coinbase\n\n'Put the credentials in a dictionary\nDim Cred As New Dictionary\nCred.Add \"apiKey\", Apikey\nCred.Add \"secretKey\", secretKey\n\n' Create a new test suite\nDim Suite As New TestSuite\nSuite.Description = \"ModExchCoinbase\"\n\n' Create reporter and attach it to these specs\nDim Reporter As New ImmediateReporter\nReporter.ListenTo Suite\n \n' Create a new test\nDim Test As TestCase\nSet Test = Suite.Test(\"TestCoinbasePublic\")\n\n'Error, unknown command\nTestResult = PublicCoinbase(\"AnUnknownCommand\", \"GET\")\n'{\"error_nr\":404,\"error_txt\":\"HTTP-Not Found\",\"response_txt\":{\"errors\":[{\"id\":\"not_found\",\"message\":\"Not found\"}]}}\nTest.IsOk InStr(TestResult, \"error\") > 0, \"test UnknownCommand 1a failed, result: ${1}\"\nTest.IsOk InStr(TestResult, \"not_found\") > 0, \"test UnknownCommand 1b failed, result: ${1}\"\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"error_nr\"), 404, \"test UnknownCommand 1c failed, result: ${1}\"\n\n'Request wrong parameter\nDim Params As New Dictionary\nParams.Add \"currency\", \"XY\"\nTestResult = PublicCoinbase(\"exchange-rates\", \"GET\", Params)\n'{\"error_nr\":400,\"error_txt\":\"HTTP-Bad Request\",\"response_txt\":{\"errors\":[{\"id\":\"invalid_request\",\"message\":\"Invalid currency (X)\"}]}}\nTest.IsOk InStr(TestResult, \"error\") > 0, \"test Rates 1a failed, result: ${1}\"\nTest.IsOk InStr(TestResult, \"invalid_request\") > 0, \"test Rates 1b failed, result: ${1}\"\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"error_nr\"), 400, \"test Rates 1c failed, result: ${1}\"\n\n'Simpel request without parameters\nTestResult = PublicCoinbase(\"currencies\", \"GET\")\n'{\"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\"},\nTest.IsOk InStr(TestResult, \"min_size\") > 0, \"test Currencies 1a failed, result: ${1}\"\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk JsonResult(\"data\").Count >= 20, \"test Currencies 1b failed, result: ${1}\"\nTest.IsEqual JsonResult(\"data\")(1)(\"id\"), \"AED\", \"test Currencies 1c failed, result: ${1}\"\nTest.IsEqual JsonResult(\"data\")(1)(\"name\"), \"United Arab Emirates Dirham\", \"test Currencies 1d failed, result: ${1}\"\nTest.IsEqual Val(JsonResult(\"data\")(1)(\"min_size\")), 0.01, \"test Currencies 1e failed, result: ${1}\"\n\n'Request with parameter\nDim Params2 As New Dictionary\nParams2.Add \"currency\", \"ETH\"\nTestResult = PublicCoinbase(\"exchange-rates\", \"GET\", Params2)\n'{\"data\":{\"currency\":\"ETH\",\"rates\":{\"AED\":\"503.843775\",\"AFN\":\"10260.72100155\",\"ALL\":\"15205.84875\",\"AMD\":\"66996.080561325\",\"ANG\":\"250.3323036\", etc\nTest.IsOk InStr(TestResult, \"EUR\") > 0, \"test Rates 2a failed, result: ${1}\"\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"data\")(\"currency\"), \"ETH\", \"test Rates 2b failed, result: ${1}\"\nTest.IsEqual Val(JsonResult(\"data\")(\"rates\")(\"ETH\")), 1, \"test Rates 2c failed, result: ${1}\"\nTest.IsOk Val(JsonResult(\"data\")(\"rates\")(\"USD\")) > 0, \"test Rates 2d failed, result: ${1}\"\n\n'Coinbase time\nTestResult = GetCoinbaseTime\nTest.IsOk TestResult > 1550000000, \"test Time failed, result: ${1}\"\n\nSet Test = Suite.Test(\"TestCoinbasePrivate\")\nTestResult = PrivateCoinbase(\"accounts\", \"GET\", Cred)\n'Debug.Print TestResult\n'{\"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...\nTest.IsOk InStr(TestResult, \"currency\") > 0\nTest.IsOk InStr(TestResult, \"warnings\") > 0\nTest.IsOk InStr(TestResult, \"balance\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"pagination\")(\"limit\"), 74\nTest.IsOk JsonResult(\"data\").Count >= 1\nTest.IsEqual JsonResult(\"warnings\")(1)(\"id\"), \"missing_version\"\n\n'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\n'Request with CB-VERSION\nDim Params3 As New Dictionary\nParams3.Add \"CB-VERSION\", \"2005-05-05\"\nTestResult = PrivateCoinbase(\"user\", \"GET\", Cred, Params3)\n'{\"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\":\"\"}}}\nTest.IsEqual InStr(TestResult, \"warnings\"), 0\nTest.IsOk InStr(TestResult, \"profile_location\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk Len(JsonResult(\"data\")(\"id\")) > 10\nTest.IsOk Len(JsonResult(\"data\")(\"native_currency\")) >= 3\n\n'Update the default currency to EUR\nDim Params4 As New Dictionary\nParams4.Add \"CB-VERSION\", \"2005-05-05\"\nParams4.Add \"native_currency\", \"EUR\"\nTestResult = PrivateCoinbase(\"user\", \"PUT\", Cred, Params4)\n'{\"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\":\"\"}}}\nTest.IsEqual InStr(TestResult, \"warnings\"), 0\nTest.IsOk InStr(TestResult, \"profile_location\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk Len(JsonResult(\"data\")(\"id\")) > 10\nTest.IsEqual JsonResult(\"data\")(\"referral_money\")(\"currency\"), \"EUR\"\n\n'Buy order that errors out\nDim Params5 As New Dictionary\nParams5.Add \"CB-VERSION\", \"2005-05-05\"\nParams5.Add \"amount\", 3\nParams5.Add \"currency\", \"BTC\"\nParams5.Add \"quote\", \"true\"\nTestResult = PrivateCoinbase(\"accounts/the_right_account_here/buys\", \"POST\", Cred, Params5)\n'error with account: {\"error_nr\":400,\"error_txt\":\"HTTP-Bad Request\",\"response_txt\":{\"errors\":[{\"id\":\"invalid_request\",\"message\":\"Can't buy with this account\"}]}}\n'unknown account id: {\"error_nr\":404,\"error_txt\":\"HTTP-Not Found\",\"response_txt\":{\"errors\":[{\"id\":\"not_found\",\"message\":\"Not found\"}]}}\nTest.IsOk InStr(TestResult, \"errors\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk JsonResult(\"response_txt\")(\"errors\").Count >= 1\n\n\nEnd Sub\n\nFunction PublicCoinbase(Method As String, ReqType As String, Optional ParamDict As Dictionary) As String\n\nDim url As String\nPublicApiSite = \"https://api.coinbase.com\"\n\nMethodParams = DictToString(ParamDict, \"URLENC\")\nIf MethodParams <> \"\" Then MethodParams = \"?\" & MethodParams\nurlPath = \"/v2/\" & Method & MethodParams\nurl = PublicApiSite & urlPath\n\nPublicCoinbase = WebRequestURL(url, ReqType)\n\nEnd Function\nFunction PrivateCoinbase(Method As String, ReqType As String, Credentials As Dictionary, Optional ParamDict As Dictionary) As String\n\nDim NonceUnique As String\nDim url As String\nDim CBVersion As String\nDim MethodParams As String\n\n'Get a 10-digit Nonce\nNonceUnique = GetCoinbaseTime\nTradeApiSite = \"https://api.coinbase.com/v2/\"\n\n'If a CB-VERSION is present, put it in a variable and remove it from the Parameter dictionary\nCBVersion = \"\"\nMethodParams = \"\"\nIf Not ParamDict Is Nothing Then\n If ParamDict.Exists(\"CB-VERSION\") Then\n CBVersion = ParamDict(\"CB-VERSION\")\n ParamDict.Remove \"CB-VERSION\"\n End If\n 'Change the rest of the parameters to JSON\n MethodParams = JsonConverter.ConvertToJson(ParamDict)\n If MethodParams = \"{}\" Then MethodParams = \"\"\nEnd If\n\nSignMsg = NonceUnique & UCase(ReqType) & \"/v2/\" & Method & MethodParams\nAPIsign = ComputeHash_C(\"SHA256\", SignMsg, Credentials(\"secretKey\"), \"STRHEX\")\n\nDim headerDict As New Dictionary\nheaderDict.Add \"User-Agent\", \"Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)\"\nheaderDict.Add \"Content-Type\", \"application/json\"\nheaderDict.Add \"CB-ACCESS-KEY\", Credentials(\"apiKey\")\nheaderDict.Add \"CB-ACCESS-SIGN\", APIsign\nheaderDict.Add \"CB-ACCESS-TIMESTAMP\", NonceUnique\nIf CBVersion <> \"\" Then\n headerDict.Add \"CB-VERSION\", CBVersion\nEnd If\n\nurl = TradeApiSite & Method\nPrivateCoinbase = WebRequestURL(url, ReqType, headerDict, MethodParams)\n\n\nEnd Function\n\nFunction GetCoinbaseTime() As Double\n\nDim JsonResponse As String\nDim Json As Object\n\nJsonResponse = PublicCoinbase(\"time\", \"GET\")\nSet Json = JsonConverter.ParseJson(JsonResponse)\nGetCoinbaseTime = Int(Json(\"data\")(\"epoch\"))\nIf GetCoinbaseTime = 0 Then\n TimeCorrection = -3600\n GetCoinbaseTime = CreateNonce(10)\n GetCoinbaseTime = Trim(Str((Val(GetCoinbaseTime) + TimeCorrection)) & Right(Int(Timer * 100), 2) & \"0\")\nEnd If\n\nSet Json = Nothing\n\nEnd Function\n\n\n" }, { "path": "ModExchCoinbasePro.bas", "content": "Attribute VB_Name = \"ModExchCoinbasePro\"\nSub TestCoinbasePro()\n\n'CoinbasePro, formerly known as GDAX\n'For normal Coinbase, see the Coinbase API\n'API docs: https://docs.pro.coinbase.com/\n'Source: https://github.com/krijnsent/crypto_vba\n'Remember to create a new API key for excel/VBA\n\nDim Apikey As String\nDim secretKey As String\nDim passphrase As String\n\nApikey = \"your api key here\"\nsecretKey = \"your secret key here\"\npassphrase = \"your passphrase here\"\n\n'Remove these 3 lines, unless you define 3 constants somewhere ( Public Const secretkey_gdax = \"the key to use everywhere\" etc )\nApikey = apikey_coinbase_pro\nsecretKey = secretkey_coinbase_pro\npassphrase = passphrase_coinbase_pro\n\n'Put the credentials in a dictionary\nDim Cred As New Dictionary\nCred.Add \"apiKey\", Apikey\nCred.Add \"secretKey\", secretKey\nCred.Add \"Passphrase\", passphrase\n\n' Create a new test suite\nDim Suite As New TestSuite\nSuite.Description = \"ModExchCoinbasePro\"\n\n' Create reporter and attach it to these specs\nDim Reporter As New ImmediateReporter\nReporter.ListenTo Suite\n \n' Create a new test\nDim Test As TestCase\nSet Test = Suite.Test(\"TestCoinbaseProPublic\")\n\n'Error, unknown command\nTestResult = PublicCoinbasePro(\"AnUnknownCommand\", \"GET\")\n'{\"error_nr\":401,\"error_txt\":\"HTTP-Unauthorized\",\"response_txt\":{\"message\":\"CB-ACCESS-KEY header is required\"}}\nTest.IsOk InStr(TestResult, \"message\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"error_nr\"), 401\nTest.IsEqual JsonResult(\"response_txt\")(\"message\"), \"Unauthorized.\"\n\n'Request wrong parameters\nDim Params As New Dictionary\nParams.Add \"level\", 5\nTestResult = PublicCoinbasePro(\"products/BTC-USD/book\", \"GET\", Params)\n'{\"error_nr\":400,\"error_txt\":\"HTTP-Bad Request\",\"response_txt\":{\"message\":\"Bad Request\"}}\nTest.IsOk InStr(TestResult, \"message\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"error_nr\"), 400\nTest.IsEqual JsonResult(\"response_txt\")(\"message\"), \"unexpected level: _\"\n\n'Request with parameter\nDim Params2 As New Dictionary\nParams2.Add \"level\", 1\nTestResult = PublicCoinbasePro(\"products/ETH-EUR/book\", \"GET\", Params2)\n'{\"sequence\":2052119022,\"bids\":[[\"118.04\",\"200.16128756\",5]],\"asks\":[[\"118.05\",\"30.06104554\",4]]}\nTest.IsOk InStr(TestResult, \"asks\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk JsonResult(\"sequence\") > 1\nTest.IsEqual JsonResult(\"bids\").Count, 1\nTest.IsEqual JsonResult(\"asks\").Count, 1\n\n'Coinbase time\nTestResult = GetCoinbaseProTime\nTest.IsOk TestResult > 1550000000\n\nSet Test = Suite.Test(\"TestCoinbaseProPrivate\")\nTestResult = PrivateCoinbasePro(\"accounts\", \"GET\", Cred)\n'[{\"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...\nTest.IsOk InStr(TestResult, \"profile_id\") > 0\nTest.IsOk InStr(TestResult, \"balance\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk JsonResult.Count > 1\nTest.IsEqual JsonResult(1)(\"currency\"), \"BAT\"\nTest.IsOk JsonResult(1)(\"balance\") >= 0\n\nDim Params8 As New Dictionary\nParams8.Add \"size\", 0.01\nParams8.Add \"price\", 100.1\nParams8.Add \"side\", \"buy\"\nParams8.Add \"product_id\", \"BTC-EUR\"\nTestResult = PrivateCoinbasePro(\"orders\", \"POST\", Cred, Params8)\nIf InStr(TestResult, \"error_txt\") > 0 Then\n 'Error result, assume insufficient funds, but could also be Product not found\n '{\"error_nr\":400,\"error_txt\":\"HTTP-Bad Request\",\"response_txt\":{\"message\":\"Insufficient funds\"}}\n Test.IsOk InStr(TestResult, \"response_txt\") > 0\n Set JsonResult = JsonConverter.ParseJson(TestResult)\n Test.IsEqual JsonResult(\"response_txt\")(\"message\"), \"Insufficient funds\"\nElse\n 'Normal result\n '{\"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}\n Test.IsOk InStr(TestResult, \"created_at\") > 0\n Set JsonResult = JsonConverter.ParseJson(TestResult)\n Test.IsOk Len(JsonResult(\"id\")) > 10\n Test.IsEqual JsonResult(\"product_id\"), \"BTC-EUR\"\nEnd If\n\n\n'Delete all BTC-EUR orders\nDim Params3 As New Dictionary\nParams3.Add \"product_id\", \"BTC-EUR\"\nTestResult = PrivateCoinbasePro(\"orders\", \"DELETE\", Cred, Params3)\n'No orders to delete: []\nTest.IsEqual TestResult, \"[]\"\n\n\n'Withdraw one BAT to an invalid account\nDim Params4 As New Dictionary\nParams4.Add \"amount\", 1\nParams4.Add \"currency\", \"BAT\"\nParams4.Add \"crypto_address\", \"0x0\"\nTestResult = PrivateCoinbasePro(\"withdrawals/crypto\", \"POST\", Cred, Params4)\n'E.g. {\"error_nr\":403,\"error_txt\":\"HTTP-Forbidden\",\"response_txt\":{\"message\":\"Forbidden\"}}\nTest.IsOk InStr(TestResult, \"Forbidden\") > 0\n\n\nDim Params5 As New Dictionary\nParams5.Add \"product_id\", \"ETH-USD\"\nTestResult = PrivateCoinbasePro(\"fills\", \"GET\", Cred, Params5)\nTest.IsEqual TestResult, \"[]\"\n\n\n'{\"error_nr\":401,\"error_txt\":\"HTTP-Unauthorized\",\"response_txt\":{\"message\":\"invalid signature\"}}\n\nEnd Sub\n\nFunction PublicCoinbasePro(Method As String, ReqType As String, Optional ParamDict As Dictionary) As String\n\nDim url As String\nPublicApiSite = \"https://api.pro.coinbase.com\"\n\nMethodParams = DictToString(ParamDict, \"URLENC\")\nIf MethodParams <> \"\" Then MethodParams = \"?\" & MethodParams\nurlPath = \"/\" & Method & MethodParams\nurl = PublicApiSite & urlPath\n\nPublicCoinbasePro = WebRequestURL(url, ReqType)\n\nEnd Function\nFunction PrivateCoinbasePro(Method As String, ReqType As String, Credentials As Dictionary, Optional ParamDict As Dictionary) As String\n\nDim NonceUnique As String\nDim url As String\nDim MethodParams As String\n\n'Get a 10-digit Nonce\nNonceUnique = GetCoinbaseProTime\nTradeApiSite = \"https://api.pro.coinbase.com\"\n\n'Change the parameters to JSON HEREHERE\nIf ReqType = \"GET\" Then\n MethodParams = DictToString(ParamDict, \"URLENC\")\n If MethodParams <> \"\" Then MethodParams = \"?\" & MethodParams\nElse\n 'e.g. POST\n MethodParams = JsonConverter.ConvertToJson(ParamDict)\n If MethodParams = \"{}\" Then MethodParams = \"\"\nEnd If\n \nSignMsg = NonceUnique & UCase(ReqType) & \"/\" & Method & \"\" & MethodParams\nAPIsign = Base64Encode(ComputeHash_C(\"SHA256\", SignMsg, Base64Decode(Credentials(\"secretKey\")), \"RAW\"))\n\nDim headerDict As New Dictionary\nheaderDict.Add \"User-Agent\", \"Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)\"\nheaderDict.Add \"Content-Type\", \"application/json\"\nheaderDict.Add \"CB-ACCESS-KEY\", Credentials(\"apiKey\")\nheaderDict.Add \"CB-ACCESS-SIGN\", APIsign\nheaderDict.Add \"CB-ACCESS-TIMESTAMP\", NonceUnique\nheaderDict.Add \"CB-ACCESS-PASSPHRASE\", Credentials(\"Passphrase\")\n\nurl = TradeApiSite & \"/\" & Method\nIf ReqType = \"GET\" Then url = url & MethodParams\nPrivateCoinbasePro = WebRequestURL(url, ReqType, headerDict, MethodParams)\n\nEnd Function\n\nFunction GetCoinbaseProTime() As Double\n\nDim JsonResponse As String\nDim Json As Object\n\n'PublicCoinbasePro time\nJsonResponse = PublicCoinbasePro(\"time\", \"GET\")\nSet Json = JsonConverter.ParseJson(JsonResponse)\nGetCoinbaseProTime = Int(Json(\"epoch\"))\nIf GetCoinbaseProTime = 0 Then\n TimeCorrection = -3600\n GetCoinbaseProTime = CreateNonce(10)\n GetCoinbaseProTime = Trim(Str((Val(GetGDAXTime) + TimeCorrection)) & Right(Int(Timer * 100), 2) & \"0\")\nEnd If\n\nSet Json = Nothing\n\nEnd Function\n\n" }, { "path": "ModExchCoinone.bas", "content": "Attribute VB_Name = \"ModExchCoinone\"\nSub TestCoinone()\n\n'Source: https://github.com/krijnsent/crypto_vba\n'https://doc.coinone.co.kr/#section/V2-version\n'Remember to create a new API key for excel/VBA\n\nDim Apikey As String\nDim secretKey As String\n\nApikey = \"your api key here\"\nsecretKey = \"your secret key here\"\n\n'Remove these 2 lines, unless you define 2 constants somewhere ( Public Const secretkey_btce = \"the key to use everywhere\" etc )\nApikey = apikey_coinone\nsecretKey = secretkey_coinone\n\n'Put the credentials in a dictionary\nDim Cred As New Dictionary\nCred.Add \"apiKey\", Apikey\nCred.Add \"secretKey\", secretKey\n\n' Create a new test suite\nDim Suite As New TestSuite\nSuite.Description = \"ModExchCoinone\"\n\n' Create reporter and attach it to these specs\nDim Reporter As New ImmediateReporter\nReporter.ListenTo Suite\n \n' Create a new test\nDim Test As TestCase\nSet Test = Suite.Test(\"TestCoinonePublic\")\n\n'Error, unknown command\nTestResult = PublicCoinone(\"AnUnknownCommand\", \"GET\")\n'{\"error_nr\":200,\"error_txt\":\"NO JSON BUT HTML RETURNED\",\"response_txt\":0}\nTest.IsOk InStr(TestResult, \"error\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"error_txt\"), \"HTTP-Found\"\nTest.IsEqual JsonResult(\"error_nr\"), 302\n\n'OK request\nTestResult = PublicCoinone(\"ticker\", \"GET\")\n'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\"}\nTest.IsOk InStr(TestResult, \"yesterday_last\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk Val(JsonResult(\"last\")) > 0\nTest.IsEqual JsonResult(\"currency\"), \"btc\"\nTest.IsOk Val(JsonResult(\"timestamp\")) > 1500000000#\n\n'Put parameters/options in a dictionary\n'If no parameters are provided, the defaults are used\n'If WRONG PARAMETERS are provided, the defaults will be used: the API fails \"silently\" and gives no error but default BTC data\nDim Params As New Dictionary\nParams.Add \"currency\", \"eth\"\nParams.Add \"period\", \"hour\"\nTestResult = PublicCoinone(\"trades\", \"GET\", Params)\n'e.g. {\"errorCode\":\"0\",\"timestamp\":\"1554107995\",\"completeOrders\":[{\"is_ask\":\"0\",\"timestamp\":\"1554107949\",\"price\":\"161600.0\",\"id\":\"395377\",\"qty\":\"1.6044\"},\nTest.IsOk InStr(TestResult, \"completeOrders\") > 0\nTest.IsOk InStr(TestResult, \"timestamp\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk Val(JsonResult(\"timestamp\")) > 1500000000#\nTest.IsEqual JsonResult(\"errorCode\"), \"0\"\nTest.IsEqual JsonResult(\"completeOrders\").Count, 200\nTest.IsOk Val(JsonResult(\"completeOrders\")(1)(\"id\")) > 0\nTest.IsOk Val(JsonResult(\"completeOrders\")(1)(\"qty\")) > 0\n\n\nSet Test = Suite.Test(\"TestCoinonePrivate\")\n\nTestResult = PrivateCoinone2(\"account/balance\", \"POST\", Cred)\n'{\"btt\": {\"avail\": \"0.0\", \"balance\": \"0.0\"}, \"edna\": {\"avail\": \"0.0\", \"balance\": \"0.0\"}, etc.\nTest.IsOk InStr(TestResult, \"avail\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"result\"), \"success\"\nTest.IsEqual JsonResult(\"errorCode\"), \"0\"\nTest.IsOk JsonResult(\"eos\")(\"avail\") >= 0\nTest.IsOk JsonResult(\"btc\")(\"balance\") >= 0\n\nDim Params2 As New Dictionary\nParams2.Add \"price\", 100\nParams2.Add \"qty\", 3\nParams2.Add \"currency\", \"EOS\"\nTestResult = PrivateCoinone2(\"order/limit_buy\", \"POST\", Cred, Params2)\n'{\"errorCode\":\"103\",\"errorMsg\":\"Lack of Balance\",\"result\":\"error\"}\n'{\"errorCode\":\"113\",\"errorMsg\":\"Quantity is too low\",\"result\":\"error\"}\n'{\"result\": \"success\",\"errorCode\": \"0\",\"orderId\": \"8a82c561-40b4-4cb3-9bc0-9ac9ffc1d63b\"}\nTest.IsOk InStr(TestResult, \"errorCode\") > 0\nTest.IsOk InStr(TestResult, \"result\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nIf Val(JsonResult(\"errorCode\")) = 0 Then\n 'No error\n Test.IsEqual JsonResult(\"result\"), \"success\"\n Test.IsEqual JsonResult(\"errorCode\"), \"0\"\n Test.IsOk Len(JsonResult(\"orderId\")) > 10\nElse\n 'Error\n Test.IsEqual JsonResult(\"result\"), \"error\"\n Test.IsOk Len(JsonResult(\"errorMsg\")) > 0\nEnd If\n\nDim Params3 As New Dictionary\nParams3.Add \"currency\", \"ETH\"\nTestResult = PrivateCoinone2(\"order/complete_orders\", \"POST\", Cred, Params3)\n'{\"errorCode\": \"0\", \"completeOrders\": [], \"result\": \"success\"}\n'{\"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\"}]}\nTest.IsOk InStr(TestResult, \"completeOrders\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"result\"), \"success\"\nTest.IsEqual JsonResult(\"errorCode\"), \"0\"\nTest.IsOk JsonResult(\"completeOrders\").Count >= 0\n\nEnd Sub\n\nFunction PublicCoinone(Method As String, ReqType As String, Optional ParamDict As Dictionary) As String\n\nDim url As String\nPublicApiSite = \"https://api.coinone.co.kr/\"\n\nMethodParams = DictToString(ParamDict, \"URLENC\")\nIf MethodParams <> \"\" Then MethodParams = \"?\" & MethodParams\nurlPath = Method & MethodParams\nurl = PublicApiSite & urlPath\n\nPublicCoinone = WebRequestURL(url, ReqType)\n\nEnd Function\nFunction PrivateCoinone2(Method As String, ReqType As String, Credentials As Dictionary, Optional ParamDict As Dictionary) As String\n\nDim NonceUnique As String\nDim postdata As String\nDim postdataUrl As String\nDim postdataJSON As String\nDim url As String\n\n'Get a 14-digit Nonce\nNonceUnique = CreateNonce(14)\nTradeApiSite = \"https://api.coinone.co.kr/v2/\"\n\nurl = TradeApiSite & Method\n\nDim PostDict As New Dictionary\nPostDict.Add \"access_token\", Credentials(\"apiKey\")\nPostDict.Add \"nonce\", NonceUnique\nIf Not ParamDict Is Nothing Then\n For Each key In ParamDict.Keys\n PostDict(key) = ParamDict(key)\n Next key\nEnd If\n\npostdataUrl = DictToString(PostDict, \"URLENC\")\npostdataJSON = JsonConverter.ConvertToJson(PostDict)\npostdata64 = Base64Encode(postdataJSON)\n\nAPIsign = ComputeHash_C(\"SHA512\", postdata64, Credentials(\"secretKey\"), \"STRHEX\")\n\nDim headerDict As New Dictionary\nheaderDict.Add \"User-Agent\", \"Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)\"\nheaderDict.Add \"Content-Type\", \"application/json\"\nheaderDict.Add \"X-COINONE-PAYLOAD\", postdata64\nheaderDict.Add \"X-COINONE-SIGNATURE\", APIsign\n\nurl = TradeApiSite & Method\nPrivateCoinone2 = WebRequestURL(url, ReqType, headerDict, postdataUrl)\n\nEnd Function\n" }, { "path": "ModExchCoinspot.bas", "content": "Attribute VB_Name = \"ModExchCoinspot\"\nSub TestCoinspot()\n\n'Source: https://github.com/krijnsent/crypto_vba\n'Documentation: https://www.coinspot.com.au/api\n'Remember to create a new API key for excel/VBA\n\nDim Apikey As String\nDim secretKey As String\n\nApikey = \"your api key here\"\nsecretKey = \"your secret key here\"\n\n'Remove these 2 lines, unless you define 2 constants somewhere ( Public Const secretkey_btce = \"the key to use everywhere\" etc )\nApikey = apikey_coinspot\nsecretKey = secretkey_coinspot\n\n'Put the credentials in a dictionary\nDim Cred As New Dictionary\nCred.Add \"apiKey\", Apikey\nCred.Add \"secretKey\", secretKey\n\n' Create a new test suite\nDim Suite As New TestSuite\nSuite.Description = \"ModExchCoinspot\"\n\n' Create reporter and attach it to these specs\nDim Reporter As New ImmediateReporter\nReporter.ListenTo Suite\n \n' Create a new test\nDim Test As TestCase\nSet Test = Suite.Test(\"TestCoinspotPublic\")\n\n'Error, unknown command\nTestResult = PublicCoinspot(\"AnUnknownCommand\", \"GET\")\n'{\"error_nr\":404,\"error_txt\":\"HTTP-Not Found\",\"response_txt\":0}\nTest.IsOk InStr(TestResult, \"error\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"error_nr\"), 404\n\n'Request without parameters (for Coinspot only public request)\nTestResult = PublicCoinspot(\"latest\", \"GET\")\n'{\"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\"}}}\nTest.IsOk InStr(TestResult, \"btc\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"status\"), \"ok\"\nTest.IsOk JsonResult(\"prices\").Count >= 3\nTest.IsOk JsonResult(\"prices\")(\"btc\")(\"last\") > 0\n\n\nSet Test = Suite.Test(\"TestCoinspotPrivate\")\nTestResult = PrivateCoinspot(\"my/balances\", \"POST\", Cred)\n'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}}\nTest.IsOk InStr(TestResult, \"balance\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"status\"), \"ok\"\nTest.IsOk JsonResult(\"balance\")(\"btc\") >= 0\nTest.IsOk JsonResult(\"balance\")(\"doge\") >= 0\n\n'Put the parameters in a dictionary\nDim Params As New Dictionary\nParams.Add \"cointype\", \"DOGE\"\nParams.Add \"amount\", 10000\nTestResult = PrivateCoinspot(\"quote/buy\", \"POST\", Cred, Params)\n'e.g. {\"status\":\"ok\",\"quote\":0.001619,\"timeframe\":0}\nTest.IsOk InStr(TestResult, \"quote\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"status\"), \"ok\"\nTest.IsOk JsonResult(\"quote\") >= 0\nTest.IsOk JsonResult(\"timeframe\") >= 0\n\n\nEnd Sub\n\nFunction PublicCoinspot(Method As String, ReqType As String, Optional ParamDict As Dictionary) As String\n\nDim url As String\nPublicApiSite = \"https://www.coinspot.com.au\"\n\nMethodParams = DictToString(ParamDict, \"URLENC\")\nIf MethodParams <> \"\" Then MethodParams = \"&\" & MethodParams\nurlPath = \"/pubapi/\" & Method & MethodOptions\nurl = PublicApiSite & urlPath\n\nPublicCoinspot = WebRequestURL(url, ReqType)\n\nEnd Function\nFunction PrivateCoinspot(Method As String, ReqType As String, Credentials As Dictionary, Optional ParamDict As Dictionary) As String\n\nDim NonceUnique As String\nDim postdata As String\nDim url As String\nDim PayloadDict As Dictionary\nDim MethodParams As String\n\n'Get a Nonce\nNonceUnique = CreateNonce()\nTradeApiSite = \"https://www.coinspot.com.au\"\n\nSet PayloadDict = New Dictionary\nPayloadDict(\"nonce\") = Val(NonceUnique)\nIf Not ParamDict Is Nothing Then\n For Each key In ParamDict.Keys\n PayloadDict(key) = ParamDict(key)\n Next key\nEnd If\nMethodParams = JsonConverter.ConvertToJson(PayloadDict)\n\nPostPath = \"/api/\" & Method\nAPIsign = ComputeHash_C(\"SHA512\", MethodParams, Credentials(\"secretKey\"), \"STRHEX\")\n\nDim headerDict As New Dictionary\nheaderDict.Add \"User-Agent\", \"Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)\"\nheaderDict.Add \"Content-Type\", \"application/json\"\nheaderDict.Add \"sign\", APIsign\nheaderDict.Add \"key\", Credentials(\"apiKey\")\n\nurl = TradeApiSite & PostPath\nPrivateCoinspot = WebRequestURL(url, \"POST\", headerDict, MethodParams)\n\nEnd Function\n\n\n" }, { "path": "ModExchHitBTC.bas", "content": "Attribute VB_Name = \"ModExchHitBTC\"\nSub TestHitBTC()\n\n'Source: https://github.com/krijnsent/crypto_vba\n'Remember to create a new API key for excel/VBA\n'https://api.hitbtc.com/api/2/explore/\n'https://github.com/hitbtc-com/hitbtc-api#rest-api-reference\n'HitBTC will require ever increasing values/nonces for the private API and the nonces created in VBA might mismatch that of other sources\n\nDim Apikey As String\nDim secretKey As String\n\nApikey = \"your api key here\"\nsecretKey = \"your secret key here\"\n\n'Remove these 2 lines, unless you define 2 constants somewhere ( Public Const secretkey_HitBTC = \"the key to use everywhere\" etc )\nApikey = apikey_hitbtc\nsecretKey = secretkey_hitbtc\n\n'Put the credentials in a dictionary\nDim Cred As New Dictionary\nCred.Add \"apiKey\", Apikey\nCred.Add \"secretKey\", secretKey\n\n' Create a new test suite\nDim Suite As New TestSuite\nSuite.Description = \"ModExchHitBTC\"\n\n' Create reporter and attach it to these specs\nDim Reporter As New ImmediateReporter\nReporter.ListenTo Suite\n \n' Create a new test\nDim Test As TestCase\nSet Test = Suite.Test(\"TestHitBTCPublic v2\")\n\n'Error, unknown command\nTestResult = PublicHitBTCv2(\"AnUnknownCommand\", \"GET\")\n'{\"error_nr\":404,\"error_txt\":\"HTTP-Not Found\",\"response_txt\":0}\nTest.IsOk InStr(TestResult, \"error\") > 0, \"unknowncommand 1 failed, result: ${1}\"\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"error_nr\"), 503, \"unknowncommand 2 failed, result: ${1}\"\n\n\n'Error, wrong parameter\nDim Params As New Dictionary\nParams.Add \"symbol\", \"BLABLA\"\nTestResult = PublicHitBTCv2(\"trades\", \"GET\", Params)\n'{\"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\"}}\nTest.IsOk InStr(TestResult, \"error\") > 0, \"trades params 1 failed, result: ${1}\"\nTest.IsOk InStr(TestResult, \"No such symbol\") > 0, \"trades params 2 failed, result: ${1}\"\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"error_nr\"), 400, \"trades params 3 failed, result: ${1}\"\nTest.IsEqual JsonResult(\"response_txt\")(\"error\")(\"code\"), 2001, \"trades params 4 failed, result: ${1}\"\n\n'Simple request without parameters\nTestResult = PublicHitBTCv2(\"currency\", \"GET\")\n'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...\nTest.IsOk InStr(TestResult, \"payoutFee\") > 0, \"currency 1 failed, result: ${1}\"\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk JsonResult.Count >= 100, \"currency 2 failed, result: ${1}\"\nTest.IsOk Len(JsonResult(1)(\"id\")) >= 3, \"currency 3 failed, result: ${1}\"\n\n'Request with parameter\nDim Params2 As New Dictionary\nParams2.Add \"currency\", \"ETH\"\nTestResult = PublicHitBTCv2(\"currency\", \"GET\", Params2)\n'{\"id\":\"ETH\",\"fullName\":\"Ethereum\",\"crypto\":true,\"payinEnabled\":true,\"payinPaymentId\":false,\"payinConfirmations\":2,\"payoutEnabled\":true,\"payoutIsPaymentId\":false,\"transferEnabled\":true,\"delisted\":false,\"payoutFee\":\"0.0428\"}\nTest.IsOk InStr(TestResult, \"Ethereum\") > 0, \"currency params 1 failed, result: ${1}\"\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"id\"), \"ETH\", \"currency params 2 failed, result: ${1}\"\nTest.IsEqual JsonResult(\"crypto\"), True, \"currency params 3 failed, result: ${1}\"\nTest.IsEqual JsonResult(\"delisted\"), False, \"currency params 4 failed, result: ${1}\"\n\n'Request with parameters\nDim Params3 As New Dictionary\nParams3.Add \"symbol\", \"ETHBTC\"\nParams3.Add \"sort\", \"ASC\"\nParams3.Add \"limit\", 10\nTestResult = PublicHitBTCv2(\"trades\", \"GET\", Params3)\n'[{\"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...\nTest.IsOk InStr(TestResult, \"timestamp\") > 0, \"trades2 params 1 failed, result: ${1}\"\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk JsonResult(1)(\"id\") > 0, \"trades2 params 2 failed, result: ${1}\"\nTest.IsOk Val(JsonResult(1)(\"quantity\")) > 0, \"trades2 params 3 failed, result: ${1}\"\nTest.IsEqual JsonResult(1)(\"side\"), \"buy\", \"trades2 params 4 failed, result: ${1}\"\n\nSet Test = Suite.Test(\"TestHitBTCPrivate v2\")\n\nTestResult = PrivateHitBTCv2(\"trading/balance\", \"GET\", Cred)\n'[{\"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...\nTest.IsOk InStr(TestResult, \"available\") > 0\nTest.IsOk InStr(TestResult, \"reserved\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\n'Loop through all coins\nFor Each Coin In JsonResult\n If Coin(\"available\") + Coin(\"reserved\") > 0 Then\n 'Debug.Print Coin(\"currency\"), Coin(\"available\") + Coin(\"reserved\")\n Test.IsOk Len(Coin(\"currency\")) >= 3\n End If\nNext Coin\nTest.IsOk Len(JsonResult(1)(\"currency\")) > 0\nTest.IsOk Val(JsonResult(2)(\"available\")) >= 0\n\nDim Params4 As New Dictionary\nParams4.Add \"symbol\", \"DOGEETH\"\nTestResult = PrivateHitBTCv2(\"history/trades\", \"GET\", Cred, Params4)\n'e.g. [{\"id\":215639995,\"clientOrderId\":\"4ab37988ea9545aeb325fc60931fbaa3\",\"orderId\":19837911730,\"symbol\":\"DOGEETH\",\"side\":\"sell\",\"quantity\": etc.\nIf TestResult = \"[]\" Then\n Test.IsEqual TestResult, \"[]\"\nElse\n Test.IsOk InStr(TestResult, \"clientOrderId\") > 0\n Test.IsOk InStr(TestResult, \"symbol\") > 0\n Set JsonResult = JsonConverter.ParseJson(TestResult)\n Test.IsOk Len(JsonResult(1)(\"symbol\")) >= 6\n Test.IsOk JsonResult(2)(\"orderId\") > 0\nEnd If\n\n'Delete all orders DOGE-ETH\nDim Params5 As New Dictionary\nParams5.Add \"symbol\", \"DOGEETH\"\nTestResult = PrivateHitBTCv2(\"order\", \"DELETE\", Cred, Params5)\n'e.g. [{\"id\": 0,\"clientOrderId\": \"d8574207d9e3b16a4a5511753eeef175\",\"symbol\": \"DOGEETH\",\"side\": \"sell\",\"status\": \"canceled\",\"type\": \"limit\", etc...\nIf InStr(TestResult, \"NO VALID JSON RETURNED\") > 0 Then\n Test.IsOk InStr(TestResult, \":200\") > 0\nElse\n If TestResult <> \"[]\" Then\n Test.IsOk InStr(TestResult, \"clientOrderId\") > 0\n Test.IsOk InStr(TestResult, \"symbol\") > 0\n Set JsonResult = JsonConverter.ParseJson(TestResult)\n Test.IsEqual JsonResult(1)(\"symbol\"), \"DOGEETH\"\n Test.IsOk Len(JsonResult(1)(\"side\")) >= 3\n End If\nEnd If\n\n'Create an order, but trigger an error\nDim Params6 As New Dictionary\nParams6.Add \"symbol\", \"ETHBTC\"\nParams6.Add \"side\", \"sell\"\nParams6.Add \"quantity\", \"0.000005\"\nParams6.Add \"price\", \"1\"\nTestResult = PrivateHitBTCv2(\"order\", \"POST\", Cred, Params6)\n'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\"}}}\n'{\"error_nr\":400,\"error_txt\":\"HTTP-Bad Request\",\"response_txt\":{\"error\":{\"code\":2011,\"message\":\"Quantity too low\",\"description\":\"Minimum quantity 0.0001\"}}}\n'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\"}\nIf InStr(TestResult, \"clientOrderId\") > 0 Then\n 'Shouldn't happen with current test, for successfull orders\n Test.IsOk InStr(TestResult, \"symbol\") > 0\n Set JsonResult = JsonConverter.ParseJson(TestResult)\n Test.IsEqual JsonResult(1)(\"symbol\"), \"ETHBTC\"\n Test.IsOk Len(JsonResult(1)(\"side\")) >= 3\nElse\n Test.IsOk InStr(TestResult, \"message\") > 0\n Set JsonResult = JsonConverter.ParseJson(TestResult)\n Test.IsEqual JsonResult(\"response_txt\")(\"error\")(\"code\"), 2011\n Test.IsEqual JsonResult(\"response_txt\")(\"error\")(\"message\"), \"Quantity too low\"\nEnd If\n\nEnd Sub\n\nFunction PublicHitBTCv2(Method As String, ReqType As String, Optional ParamDict As Dictionary) As String\n\nDim url As String\nDim PayloadDict As New Dictionary\n\nPublicApiSite = \"https://api.hitbtc.com\"\n\n'Get special parameters currency and symbol and add them to the URL\nIf Not ParamDict Is Nothing Then\n For Each key In ParamDict.Keys\n If LCase(key) = \"currency\" Or LCase(key) = \"symbol\" Then\n Method = Method & \"/\" & ParamDict(key)\n Else\n PayloadDict(key) = ParamDict(key)\n End If\n Next key\nEnd If\n\n\nMethodParams = DictToString(PayloadDict, \"URLENC\")\nIf MethodParams <> \"\" Then MethodParams = \"?\" & MethodParams\nurlPath = \"/api/2/public/\" & Method & MethodParams\nurl = PublicApiSite & urlPath\n\nPublicHitBTCv2 = WebRequestURL(url, ReqType)\n\nEnd Function\nFunction PrivateHitBTCv2(Method As String, ReqType As String, Credentials As Dictionary, Optional ParamDict As Dictionary) As String\n\nDim NonceUnique As String\nDim postdata As String\nDim url As String\nDim MethodParams As String\n\nNonceUnique = CreateNonce(10)\nTradeApiSite = \"https://api.hitbtc.com\"\nurlPath = \"/api/2/\" & Method\nMethodParams = DictToString(ParamDict, \"URLENC\")\npostdata = JsonConverter.ConvertToJson(ParamDict)\nIf MethodParams <> \"\" Then MethodParams = \"?\" & MethodParams\n\nurl = TradeApiSite & urlPath\n\nDim headerDict As New Dictionary\nheaderDict.Add \"Content-Type\", \"application/json\"\n'Credentials in a special format\nheaderDict.Add \"Authorization\", \"Basic \" & Base64Encode(Credentials(\"apiKey\") & \":\" & Credentials(\"secretKey\"))\n\nurl = TradeApiSite & urlPath & MethodParams\nPrivateHitBTCv2 = WebRequestURL(url, ReqType, headerDict, postdata)\n\nEnd Function\n" }, { "path": "ModExchHuobi.bas", "content": "Attribute VB_Name = \"ModExchHuobi\"\nSub TestHuobi()\n\n'Source: https://github.com/krijnsent/crypto_vba\n'https://alphaex-api.github.io/openapi/spot/v1/en/#introduction\n'Remember to create a new API key for excel/VBA\n\nDim Apikey As String\nDim secretKey As String\n\nApikey = \"your api key here\"\nsecretKey = \"your secret key here\"\n\n'Remove these 2 lines, unless you define 2 constants somewhere ( Public Const secretkey_btce = \"the key to use everywhere\" etc )\nApikey = apikey_huobi\nsecretKey = secretkey_huobi\n\n'Put the credentials in a dictionary\nDim Cred As New Dictionary\nCred.Add \"apiKey\", Apikey\nCred.Add \"secretKey\", secretKey\n\n' Create a new test suite\nDim Suite As New TestSuite\nSuite.Description = \"ModExchHuobi\"\n\n' Create reporter and attach it to these specs\nDim Reporter As New ImmediateReporter\nReporter.ListenTo Suite\n \n' Create a new test\nDim Test As TestCase\nSet Test = Suite.Test(\"TestHuobiPublic\")\n\n'Error, unknown command\nTestResult = PublicHuobi(\"AnUnknownCommand\", \"GET\")\n'{\"error_nr\":404,\"error_txt\":\"HTTP-Not Found\",\"response_txt\":0}\nTest.IsOk InStr(TestResult, \"error\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"error_txt\"), \"HTTP-Not Found\"\nTest.IsEqual JsonResult(\"error_nr\"), 404\n\n'OK request\nTestResult = PublicHuobi(\"v1/common/timestamp\", \"GET\")\n'e.g. {\"status\":\"ok\",\"data\":1579706923783}\nTest.IsOk InStr(TestResult, \"data\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"status\"), \"ok\"\nTest.IsOk Val(JsonResult(\"data\")) > 1500000000000#\n\n'Parameters missing\nTestResult = PublicHuobi(\"market/history/kline\", \"GET\")\n'e.g. {\"ts\":1579707152954,\"status\":\"error\",\"err-code\":\"invalid-parameter\",\"err-msg\":\"invalid symbol\"}\nTest.IsOk InStr(TestResult, \"error\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"status\"), \"error\"\nTest.IsEqual JsonResult(\"err-msg\"), \"invalid symbol\"\nTest.IsOk Val(JsonResult(\"ts\")) > 1500000000000#\n\n'Put parameters/options in a dictionary\n'If no parameters are provided, the defaults are used\nDim Params As New Dictionary\nParams.Add \"period\", \"1day\"\nParams.Add \"symbol\", \"btcusdt\"\nParams.Add \"size\", 10\nTestResult = PublicHuobi(\"market/history/kline\", \"GET\", Params)\n'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},\nTest.IsOk InStr(TestResult, \"market.btcusdt.kline.1day\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk Val(JsonResult(\"ts\")) > 1500000000000#\nTest.IsEqual JsonResult(\"status\"), \"ok\"\nTest.IsEqual JsonResult(\"data\").Count, 10\nTest.IsOk Val(JsonResult(\"data\")(1)(\"amount\")) > 0\nTest.IsOk Val(JsonResult(\"data\")(2)(\"high\")) > 0\n\n\nSet Test = Suite.Test(\"TestHuobiPrivate GET\")\n'Simple test, should return data\nTestResult = PrivateHuobi(\"v1/account/accounts\", \"GET\", Cred)\n'{\"status\":\"ok\",\"data\":[{\"id\":9999,\"type\":\"spot\",\"subtype\":\"\",\"state\":\"working\"}]}\nDebug.Print TestResult\nTest.IsOk InStr(TestResult, \"status\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"status\"), \"ok\"\nTest.IsEqual JsonResult(\"data\")(1)(\"state\"), \"working\"\n\n'Error, forgotten parameter\nDim Params2 As New Dictionary\nParams2.Add \"size\", 10\nTestResult = PrivateHuobi(\"v1/account/history\", \"GET\", Cred, Params2)\n'{\"status\":\"error\",\"err-code\":\"validation-constraints-required\",\"err-msg\":\"Field is missing: account-id.\",\"data\":null}\nTest.IsOk InStr(TestResult, \"err-msg\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"status\"), \"error\"\nTest.IsEqual JsonResult(\"err-msg\"), \"Field is missing: account-id.\"\n\n'Unknown account-id\nDim Params3 As New Dictionary\nParams3.Add \"account-id\", 9999\nParams3.Add \"size\", 50\nTestResult = PrivateHuobi(\"v1/account/history\", \"GET\", Cred, Params3)\n'{\"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}\nTest.IsOk InStr(TestResult, \"err-msg\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"status\"), \"error\"\nTest.IsEqual JsonResult(\"err-code\"), \"account-get-balance-account-inexistent-error\"\n\n\nSet Test = Suite.Test(\"TestHuobiPrivate POST\")\n'Get account-id:\nTestResult = PrivateHuobi(\"v1/account/accounts\", \"GET\", Cred)\nSet JsonResult = JsonConverter.ParseJson(TestResult)\n AccId = JsonResult(\"data\")(1)(\"id\")\n'Place order\nDim Params4 As New Dictionary\nParams4.Add \"account-id\", AccId\nParams4.Add \"amount\", 1\nParams4.Add \"price\", 1\nParams4.Add \"symbol\", \"ethusdt\"\nParams4.Add \"type\", \"buy-limit\"\nTestResult = PrivateHuobi(\"v1/order/orders/place\", \"POST\", Cred, Params4)\n'{\"status\":\"error\",\"err-code\":\"order-value-min-error\",\"err-msg\":\"Order total cannot be lower than: `5`\",\"data\":null}\nTest.IsOk InStr(TestResult, \"status\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"status\"), \"error\"\nTest.IsEqual JsonResult(\"err-code\"), \"order-value-min-error\"\n\n\n\nEnd Sub\n\nFunction PublicHuobi(Method As String, ReqType As String, Optional ParamDict As Dictionary) As String\n\nDim url As String\nPublicApiSite = \"https://api-cloud.huobi.co.kr/\"\n\nMethodParams = DictToString(ParamDict, \"URLENC\")\nIf MethodParams <> \"\" Then MethodParams = \"?\" & MethodParams\nurlPath = Method & MethodParams\nurl = PublicApiSite & urlPath\n\n'Debug.Print Url\n\nPublicHuobi = WebRequestURL(url, ReqType)\n\nEnd Function\nFunction PrivateHuobi(Method As String, ReqType As String, Credentials As Dictionary, Optional ParamDict As Dictionary) As String\n\nDim APIsign As String\nDim ApiEndPoint As String\nDim postdata As String\nDim url As String\n\n'Get a Timestamp\nStamp = GetUTCTime()\nStampTxt = URLEncode(Format(Stamp, \"YYYY-MM-DDThh:mm:ss\"))\n\nHostTxt = \"api-cloud.huobi.co.kr\"\nHostTxt = \"api.huobi.pro\"\nTradeApiSite = \"https://\" & HostTxt & \"/\"\n\nurl = TradeApiSite & Method\nStrHash = \"\"\npostdata = \"\"\n\nDim TotDict As New Dictionary\nTotDict.Add \"AccessKeyId\", Credentials(\"apiKey\")\nTotDict.Add \"SignatureMethod\", \"HmacSHA256\"\nTotDict.Add \"SignatureVersion\", 2\nTotDict.Add \"Timestamp\", StampTxt\n\nIf UCase(ReqType) = \"POST\" Then\n 'For POST request, all query parameters need to be included in the request body with JSON. (e.g. {\"currency\":\"BTC\"}).\n MethodParams = DictToString(TotDict, \"URLENC\")\n \n postdata = JsonConverter.ConvertToJson(ParamDict)\n 'ApiEndPoint = Url\nElseIf UCase(ReqType) = \"GET\" Then\n If Not ParamDict Is Nothing Then\n For Each key In ParamDict.Keys\n TotDict(key) = ParamDict(key)\n Next key\n End If\n MethodParams = DictToString(TotDict, \"URLENC\")\n postdata = \"\"\nEnd If\n\nStrHash = UCase(ReqType) & Chr(10) & HostTxt & Chr(10) & \"/\" & Method & Chr(10) & MethodParams\n\nIf MethodParams <> \"\" Then MethodParams = \"?\" & MethodParams\nApiEndPoint = url & MethodParams\n\n\n'Dim PostDict As New Dictionary\n'PostDict.Add \"access_token\", Credentials(\"apiKey\")\n'PostDict.Add \"nonce\", NonceUnique\n'If Not ParamDict Is Nothing Then\n' For Each Key In ParamDict.Keys\n' PostDict(Key) = ParamDict(Key)\n' Next Key\n'End If\n'postdataUrl = DictToString(PostDict, \"URLENC\")\n'postdataJSON = JsonConverter.ConvertToJson(ParamDict)\n'postdata64 = Base64Encode(postdataJSON)\n\nAPIsign = ComputeHash_C(\"SHA256\", StrHash, Credentials(\"secretKey\"), \"STR64\")\nAPIsignEnc = URLEncode(APIsign)\nApiEndPoint = ApiEndPoint & \"&Signature=\" & APIsignEnc\n\nDim headerDict As New Dictionary\nheaderDict.Add \"User-Agent\", \"Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)\"\nheaderDict.Add \"Content-Type\", \"application/json\"\n\n'Debug.Print ApiEndPoint\n\nPrivateHuobi = WebRequestURL(ApiEndPoint, ReqType, headerDict, postdata)\n\nEnd Function\n" }, { "path": "ModExchIDEX.bas", "content": "Attribute VB_Name = \"ModExchIDEX\"\n'https://docs.idex.market/#operation/returnCurrencies\n\nSub TestIDEX()\n\n'Source: https://github.com/krijnsent/crypto_vba\n'Documentation: https://docs.idex.io/\n'Remember to create a new API key for excel/VBA\n\nDim Apikey As String\n\nApikey = \"your api key here\"\n\n'Remove this lines, unless you define a constant somewhere ( Public Const apikey_idex = \"the key to use everywhere\" etc )\nApikey = apikey_idex\n\n'Put the credentials in a dictionary\nDim Cred As New Dictionary\nCred.Add \"apiKey\", Apikey\n\n' Create a new test suite\nDim Suite As New TestSuite\nSuite.Description = \"ModExchIDEX\"\n\n' Create reporter and attach it to these specs\nDim Reporter As New ImmediateReporter\nReporter.ListenTo Suite\n \n' Create a new test\nDim Test As TestCase\n\nSet Test = Suite.Test(\"TestIDEX\")\n'Error, unknown command\nTestResult = PublicIDEX(\"AnUnknownCommand\", \"GET\")\n'{\"error_nr\":404,\"error_txt\":\"HTTP-Not Found\",\"response_txt\":{\"code\":\"ResourceNotFound\",\"message\":\"/AnUnknownCommand does not exist\"}}\nTest.IsOk InStr(TestResult, \"error\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"error_nr\"), 404\n\n'Error, missing parameter\nTestResult = PublicIDEX(\"candles\", \"GET\")\n'{\"error_nr\":400,\"error_txt\":\"HTTP-Bad Request\",\"response_txt\":{\"code\":\"REQUIRED_PARAMETER\",\"message\":\"parameter \\\"market\\\" is required but was not provided\"}}\nTest.IsOk InStr(TestResult, \"error\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"error_nr\"), 400\nTest.IsEqual JsonResult(\"response_txt\")(\"code\"), \"REQUIRED_PARAMETER\"\n\n'GET ticker\nDim Params As New Dictionary\nParams.Add \"market\", \"ZRX-ETH\"\nTestResult = PublicIDEX(\"tickers\", \"GET\", Params)\n'[{\"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}]\nTest.IsOk InStr(TestResult, \"baseVolume\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk JsonResult(1)(\"time\") >= 0\n\nEnd Sub\n\n\nFunction PublicIDEX(Method As String, ReqType As String, Optional ParamDict As Dictionary) As String\n\nDim url As String\nDim postdata As String\nPublicApiSite = \"https://api-eth.idex.io/v1/\"\n\nIf UCase(ReqType) = \"POST\" Then\n 'For POST request, all query parameters need to be included in the request body with JSON. (e.g. {\"currency\":\"BTC\"}).\n postdata = JsonConverter.ConvertToJson(ParamDict)\nElseIf UCase(ReqType) = \"GET\" Then\n MethodParams = DictToString(ParamDict, \"URLENC\")\n If MethodParams <> \"\" Then MethodParams = \"?\" & MethodParams\n ApiEndPoint = ApiEndPoint & MethodParams\n postdata = \"\"\nEnd If\n\nurlPath = \"/\" & Method & MethodParams\nurl = PublicApiSite & urlPath\n\nDim headerDict As New Dictionary\nheaderDict.Add \"Content-Type\", \"application/json\"\n\nPublicIDEX = WebRequestURL(url, ReqType, headerDict, postdata)\n\nEnd Function\nFunction PrivateIDEX(Method As String, ReqType As String, Credentials As Dictionary, Optional ParamDict As Dictionary) As String\n\n'Work in Progress\n\nEnd Function\n" }, { "path": "ModExchKraken.bas", "content": "Attribute VB_Name = \"ModExchKraken\"\nSub TestKraken()\n\n'Source: https://github.com/krijnsent/crypto_vba\n'Remember to create a new API key for excel/VBA\n'Kraken will require ever increasing values/nonces for the private API and the nonces created in VBA might mismatch that of other sources\n'https://www.kraken.com/en-us/help/api#public-market-data\n'https://www.kraken.com/help/api#private-user-data\n\nDim Apikey As String\nDim secretKey As String\n\nApikey = \"your api key here\"\nsecretKey = \"your secret key here\"\n\n'Remove these 2 lines, unless you define 2 constants somewhere ( Public Const secretkey_kraken = \"the key to use everywhere\" etc )\nApikey = apikey_kraken\nsecretKey = secretkey_kraken\n\n'Put the credentials in a dictionary\nDim Cred As New Dictionary\nCred.Add \"apiKey\", Apikey\nCred.Add \"secretKey\", secretKey\n\n' Create a new test suite\nDim Suite As New TestSuite\nSuite.Description = \"ModExchKraken\"\n\n' Create reporter and attach it to these specs\nDim Reporter As New ImmediateReporter\nReporter.ListenTo Suite\n \n' Create a new test\nDim Test As TestCase\nSet Test = Suite.Test(\"TestKrakenPublic\")\n\n'Error, unknown command\nTestResult = PublicKraken(\"AnUnknownCommand\", \"GET\")\n'{\"error_nr\":404,\"error_txt\":\"HTTP-Not Found\",\"response_txt\":{\"error\":[\"EGeneral:Unknown method\"]}}\nTest.IsOk InStr(TestResult, \"error\") > 0, \"test error 1 failed, result: ${1}\"\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"error_nr\"), 404, \"test error 2 failed, result: ${1}\"\n\n'Error, parameter missing\nTestResult = PublicKraken(\"Ticker\", \"GET\")\n'{\"error\":[\"EGeneral:Invalid arguments\"]}\nTest.IsOk InStr(TestResult, \"Invalid\") > 0, \"test error 3 failed, result: ${1}\"\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"error\")(1), \"EGeneral:Invalid arguments\", \"test error 4 failed, result: ${1}\"\n\n'Ok request without parameters\nTestResult = PublicKraken(\"Time\", \"GET\")\n'Example: {\"error\":[],\"result\":{\"unixtime\":1551737935,\"rfc1123\":\"Mon, 4 Mar 19 22:18:55 +0000\"}}\nTest.IsOk InStr(TestResult, \"unixtime\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk JsonResult(\"result\")(\"unixtime\") >= 1510000000\n\nDim Params As New Dictionary\nParams.Add \"pair\", \"XXBTZEUR\"\nTestResult = PublicKraken(\"OHLC\", \"GET\", Params)\n'{\"error\":[],\"result\":{\"XXBTZEUR\":[[1551695100,\"3265.8\",\"3265.8\",\"3265.2\",\"3265.2\",\"3265.5\",\"0.53688049\",12],[1551695160,\"3265.2\", etc...\nTest.IsOk InStr(TestResult, \"XXBTZEUR\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk JsonResult(\"result\")(\"XXBTZEUR\")(1)(1) >= 1510000000\n\nSet Test = Suite.Test(\"TestKrakenPrivate\")\nTestResult = PrivateKraken(\"Balance\", \"POST\", Cred)\n'{\"error\":[],\"result\":{\"ZEUR\":\"15.35\",\"KFEE\":\"935\",\"XXBT\": etc...\nTest.IsOk InStr(TestResult, \"ZEUR\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk JsonResult(\"result\")(\"KFEE\") >= 0\n\n'Unix time period:\nt1 = DateToUnixTime(\"1/1/2016\")\nt2 = DateToUnixTime(\"1/1/2018\")\n\nDim Params2 As New Dictionary\nParams2.Add \"start\", t1\nParams2.Add \"end\", t2\nTestResult = PrivateKraken(\"TradesHistory\", \"POST\", Cred, Params2)\n'{\"error\":[],\"result\":{\"trades\":{\"TBSI6I-EO4KN-MLU4AI\":{\"ordertxid\":\"O7AERY-NCNDR-6WKLMU\",\"pair\":\"XXMRZEUR\",\"time\":1493715960.4854,\"type\":\"buy\",\"ordertype\":\"limit\",\"price\": etc...\nTest.IsOk InStr(TestResult, \"trades\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk JsonResult(\"result\")(\"trades\").Count >= 0\n\n\nEnd Sub\n\nFunction PublicKraken(Method As String, ReqType As String, Optional ParamDict As Dictionary) As String\n\nDim url As String\nPublicApiSite = \"https://api.kraken.com\"\n\nMethodParams = DictToString(ParamDict, \"URLENC\")\nIf MethodParams <> \"\" Then MethodParams = \"?\" & MethodParams\nurlPath = \"/0/public/\" & Method & MethodParams\nurl = PublicApiSite & urlPath\n\nPublicKraken = WebRequestURL(url, ReqType)\n\nEnd Function\nFunction PrivateKraken(Method As String, ReqType As String, Credentials As Dictionary, Optional ParamDict As Dictionary) As String\n\nDim NonceUnique As String\nDim postdata As String\nDim PayloadDict As Dictionary\nDim url As String\n\n'Kraken nonce: 16 characters\nNonceUnique = CreateNonce(16)\n\nTradeApiSite = \"https://api.kraken.com\"\nurlPath = \"/0/private/\" & Method\n\nSet PayloadDict = New Dictionary\nIf Not ParamDict Is Nothing Then\n For Each key In ParamDict.Keys\n PayloadDict(key) = ParamDict(key)\n Next key\nEnd If\nPayloadDict(\"nonce\") = NonceUnique\npostdata = DictToString(PayloadDict, \"URLENC\")\n\nurl = TradeApiSite & urlPath\nAPIsign = ComputeHash_C(\"SHA512\", urlPath & ComputeHash_C(\"SHA256\", NonceUnique & postdata, \"\", \"RAW\"), Base64Decode(Credentials(\"secretKey\")), \"STR64\")\n\nDim headerDict As New Dictionary\nheaderDict.Add \"User-Agent\", \"Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)\"\nheaderDict.Add \"Content-Type\", \"application/x-www-form-urlencoded\"\nheaderDict.Add \"API-Key\", Credentials(\"apiKey\")\nheaderDict.Add \"API-Sign\", APIsign\n\nPrivateKraken = WebRequestURL(url, ReqType, headerDict, postdata)\n\nEnd Function\n" }, { "path": "ModExchKucoin.bas", "content": "Attribute VB_Name = \"ModExchKucoin\"\nSub TestKucoin()\n\n'Source: https://github.com/krijnsent/crypto_vba\n'https://docs.kucoin.com/\n'Remember to create a new API key for excel/VBA\n'Kucoin will require ever increasing values/nonces for the private API and the nonces created in VBA might mismatch that of other sources\n\nDim Apikey As String\nDim secretKey As String\n\nApikey = \"your api key here\"\nsecretKey = \"your secret key here\"\n\n'Remove these 2 lines, unless you define 2 constants somewhere ( Public Const secretkey_Kucoin = \"the key to use everywhere\" etc )\nApikey = apikey_kucoin\nsecretKey = secretkey_kucoin\npassphrase = passphrase_kucoin\n\n'Put the credentials in a dictionary\nDim Cred As New Dictionary\nCred.Add \"apiKey\", Apikey\nCred.Add \"secretKey\", secretKey\nCred.Add \"Passphrase\", passphrase\n\n' Create a new test suite\nDim Suite As New TestSuite\nSuite.Description = \"ModExchKucoin\"\n\n' Create reporter and attach it to these specs\nDim Reporter As New ImmediateReporter\nReporter.ListenTo Suite\n \n' Create a new test\nDim Test As TestCase\nSet Test = Suite.Test(\"TestKucoinPublic\")\n\n'Error, unknown command\nTestResult = PublicKucoin(\"AnUnknownCommand\", \"GET\")\nTest.IsOk InStr(TestResult, \"error\") > 0, \"test error 1 failed, result: ${1}\"\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"error_nr\"), 404, \"test error 2 failed, result: ${1}\"\n\n'Error, missing parameters\nTestResult = PublicKucoin(\"market/orderbook/level1\", \"GET\")\nTest.IsOk InStr(TestResult, \"error\") > 0, \"test error 3 failed, result: ${1}\"\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"error_nr\"), 400, \"test error 4 failed, result: ${1}\"\n\nTestResult = PublicKucoin(\"market/allTickers\", \"GET\")\n'{\"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...\nTest.IsOk InStr(TestResult, \"code\") > 0\nTest.IsOk InStr(TestResult, \"changePrice\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"code\") * 1, 200000\nTest.IsOk JsonResult(\"data\")(\"ticker\").Count > 100\nTest.IsOk Len(JsonResult(\"data\")(\"ticker\")(9)(\"symbol\")) > 0\nTest.IsOk JsonResult(\"data\")(\"ticker\")(3)(\"vol\") > 0\n\nDim Params As New Dictionary\nParams.Add \"symbol\", \"KCS-BTC\"\nTestResult = PublicKucoin(\"market/orderbook/level2_20\", \"GET\", Params)\n'{\"code\":\"200000\",\"data\":{\"sequence\":\"1550467431550\",\"asks\":[[\"0.00011794\",\"184.4706\"],[\"0.00011795\",\"48.7387\"],[\"0.00011796\",\"154.9647\"],\nTest.IsOk InStr(TestResult, \"code\") > 0\nTest.IsOk InStr(TestResult, \"sequence\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"code\") * 1, 200000\nTest.IsOk JsonResult(\"data\")(\"time\") > 1500000000000#\nTest.IsEqual JsonResult(\"data\")(\"asks\").Count, 20\nTest.IsEqual JsonResult(\"data\")(\"bids\").Count, 20\nTest.IsOk JsonResult(\"data\")(\"asks\")(1)(1) > 0\nTest.IsOk JsonResult(\"data\")(\"asks\")(1)(2) > 0\n\n' Create a new test\nSet Test = Suite.Test(\"TestKucoinTime\")\nTestResult = GetKucoinTime()\nTest.IsOk TestResult > 1500000000000#, \"test time 1 failed, result: ${1}\"\nTest.IsOk TestResult < 1700000000000#, \"test time 2 failed, result: ${1}\"\n\nSet Test = Suite.Test(\"TestKucoinPrivate\")\n\nTestResult = PrivateKucoin(\"accounts\", \"GET\", Cred)\n'{\"code\":\"200000\",\"data\":[{\"balance\":\"15.827819\",\"available\":\"15.827819\",\"holds\":\"0\",\"currency\":\"KCS\",\"id\":\"5c6a4a1d81a34e1da97\",\"type\":\"trade\"},{\"balance\":\"2.12058951\",\"available\":\"2.12058951\",\", etc...\nTest.IsOk InStr(TestResult, \"code\") > 0, \"test accounts 1a failed, result: ${1}\"\nTest.IsOk InStr(TestResult, \"balance\") > 0, \"test accounts 1b failed, result: ${1}\"\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"code\") * 1, 200000, \"test accounts 1c failed, result: ${1}\"\nTest.IsOk JsonResult(\"data\").Count > 20, \"test accounts 1d failed, result: ${1}\"\nTest.IsOk JsonResult(\"data\")(1)(\"balance\") > 0, \"test accounts 1e failed, result: ${1}\"\n\n'Get only KCS account amount\nDim Params1 As New Dictionary\nParams1.Add \"currency\", \"KCS\"\nTestResult = PrivateKucoin(\"accounts\", \"GET\", Cred, Params1)\n'Debug.Print TestResult\n'{\"code\":\"200000\",\"data\":[{\"balance\":\"15.82887819\",\"available\":\"15.82887819\",\"holds\":\"0\",\"currency\":\"KCS\",\"id\":\"5c6a4a1d81a34e1da97\",\"type\":\"trade\"}]}\nTest.IsOk InStr(TestResult, \"code\") > 0, \"test accounts 2a failed, result: ${1}\"\nTest.IsOk InStr(TestResult, \"balance\") > 0, \"test accounts 2b failed, result: ${1}\"\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"code\") * 1, 200000, \"test accounts 2c failed, result: ${1}\"\nTest.IsOk JsonResult(\"data\").Count >= 1, \"test accounts 2d failed, result: ${1}\"\nTest.IsOk JsonResult(\"data\")(1)(\"balance\") > 0, \"test accounts 2e failed, result: ${1}\"\n\n'Create a main LTC account (if it doesn't exist)\nDim Params2 As New Dictionary\nParams2.Add \"currency\", \"LTC\"\nTestResult = PrivateKucoin(\"accounts\", \"POST\", Cred, Params2)\n'Debug.Print TestResult\n'{\"code\":\"400100\",\"msg\":\"type can not be empty\"}\nTest.IsOk InStr(TestResult, \"code\") > 0\nTest.IsOk InStr(TestResult, \"msg\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"code\") * 1, 400100\nTest.IsEqual JsonResult(\"msg\"), \"type can not be empty\"\n\nParams2.Add \"type\", \"main\"\nTestResult = PrivateKucoin(\"accounts\", \"POST\", Cred, Params2)\n'Debug.Print TestResult\n'FIRST TIME RESULT: {\"code\":\"200000\",\"data\":{\"id\":\"5c7556e3cbfc7b24a1a1a1a9\"}}\n'NEXT RESULT: {\"code\":\"230005\",\"msg\":\"account already exists\"}\nTest.IsOk InStr(TestResult, \"code\") > 0\nTest.IsOk InStr(TestResult, \"msg\") + InStr(TestResult, \"data\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk JsonResult(\"code\") * 1 >= 200000\nTest.IsOk JsonResult(\"code\") * 1 <= 230005\n\nSet Test = Suite.Test(\"TestKucoinPrivate Orders\")\n'Create orders\n'sell 0.01 KCS for a price of 100 KCS per ETH\n'price hopefully insane enough never to execute\nTempOrderID = CreateNonce()\nDim Params3 As New Dictionary\nParams3.Add \"clientOid\", TempOrderID\nParams3.Add \"symbol\", \"KCS-ETH\"\nParams3.Add \"side\", \"sell\"\nParams3.Add \"price\", 100\nParams3.Add \"size\", 0.01\nParams3.Add \"timeInForce\", \"GTC\"\nTestResult = PrivateKucoin(\"orders\", \"POST\", Cred, Params3)\n'Debug.Print TestResult\n'{\"code\":\"200000\",\"data\":{\"orderId\":\"5ca22ec6513ab9576fb77d92\"}}\n'{\"code\":\"200004\",\"msg\":\"Balance insufficient!\"}\nTest.IsOk InStr(TestResult, \"code\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk JsonResult(\"code\") * 1 >= 200000\nTest.IsOk JsonResult(\"code\") * 1 <= 200004\n\n'Add another order\nDim Params4 As New Dictionary\nParams4.Add \"clientOid\", TempOrderID + 3\nParams4.Add \"symbol\", \"KCS-BTC\"\nParams4.Add \"side\", \"sell\"\nParams4.Add \"price\", 100\nParams4.Add \"size\", 0.01\nParams4.Add \"timeInForce\", \"GTC\"\nTestResult = PrivateKucoin(\"orders\", \"POST\", Cred, Params4)\n'Debug.Print TestResult\n'{\"code\":\"200000\",\"data\":{\"orderId\":\"5ca22ec6513ab9576fb77d92\"}}\n'{\"code\":\"200004\",\"msg\":\"Balance insufficient!\"}\nTest.IsOk InStr(TestResult, \"code\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk JsonResult(\"code\") * 1 >= 200000\nTest.IsOk JsonResult(\"code\") * 1 <= 200004\n\n'Now get the open orders\nTestResult = PrivateKucoin(\"orders\", \"GET\", Cred)\n'{\"code\":\"200000\",\"data\":{\"totalNum\":8,\"totalPage\":1,\"pageSize\":50,\"currentPage\":1,\"items\":[{\"symbol\":\"KCS-BTC\",\"hidden\":false,\"opType\":\"DEAL\"\nTest.IsOk InStr(TestResult, \"code\") > 0\nTest.IsOk InStr(TestResult, \"totalPage\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk JsonResult(\"code\") * 1 >= 200000\nTest.IsOk JsonResult(\"code\") * 1 <= 200004\nTest.IsOk JsonResult(\"data\")(\"items\").Count >= 0\n\n'Delete all KCS-BTC orders\nDim Params5 As New Dictionary\nParams5.Add \"symbol\", \"KCS-BTC\"\nTestResult = PrivateKucoin(\"orders\", \"DELETE\", Cred, Params5)\n'{\"code\":\"200000\",\"data\":{\"cancelledOrderIds\":[\"5ca2798389fc8450590fe207\"]}}\nTest.IsOk InStr(TestResult, \"code\") > 0\nTest.IsOk InStr(TestResult, \"cancelledOrderIds\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk JsonResult(\"code\") * 1 >= 200000\nTest.IsOk JsonResult(\"code\") * 1 <= 200004\n\n'Delete the created KCS-ETH order\nDim Params6 As New Dictionary\nParams6.Add \"OrderId\", JsonResult(\"data\")(\"orderId\")\nTestResult = PrivateKucoin(\"orders\", \"DELETE\", Cred, Params6)\n'Debug.Print TestResult\n'{\"code\":\"200000\",\"data\":{\"cancelledOrderIds\":[\"5ca27982054b467eb0d0c8dc\"]}}\nTest.IsOk InStr(TestResult, \"code\") > 0\nTest.IsOk InStr(TestResult, \"cancelledOrderIds\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk JsonResult(\"code\") * 1 >= 200000\nTest.IsOk JsonResult(\"code\") * 1 <= 200004\n\n'Delete all orders (should be none)\nTestResult = PrivateKucoin(\"orders\", \"DELETE\", Cred)\n'{\"code\":\"200000\",\"data\":{\"cancelledOrderIds\":[]}}\nTest.IsOk InStr(TestResult, \"code\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk JsonResult(\"code\") * 1 >= 200000\nTest.IsOk JsonResult(\"code\") * 1 <= 200004\n\nEnd Sub\n\nFunction PublicKucoin(Method As String, ReqType As String, Optional ParamDict As Dictionary) As String\n\nDim url As String\nPublicApiSite = \"https://api.kucoin.com/api/v1\"\n\nMethodParams = DictToString(ParamDict, \"URLENC\")\nIf MethodParams <> \"\" Then MethodParams = \"?\" & MethodParams\nurlPath = \"/\" & Method & MethodParams\nurl = PublicApiSite & urlPath\n\nPublicKucoin = WebRequestURL(url, ReqType)\n\nEnd Function\nFunction PrivateKucoin(Method As String, ReqType As String, Credentials As Dictionary, Optional ParamDict As Dictionary) As String\n\nDim NonceUnique As String\nDim url As String\nDim postdata As String\n\n'Kucoin wants a 13-digit Nonce, use time correction if needed\nNonceUnique = GetKucoinTime()\n\nTradeApiSite = \"https://api.kucoin.com\"\nApiEndPoint = \"/api/v1/\" & Method\n\nIf ReqType = \"GET\" Or ReqType = \"DELETE\" Then\n 'For GET, DELETE request, all query parameters need to be included in the request url. (e.g. /api/v1/accounts?currency=BTC)\n If Not ParamDict Is Nothing Then\n 'OrderId -> add to URL\n For Each key In ParamDict.Keys\n If LCase(key) = \"orderid\" Then\n ApiEndPoint = ApiEndPoint & \"/\" & ParamDict(key)\n ParamDict.Remove key\n Exit For\n End If\n Next key\n End If\n \n MethodTxt = DictToString(ParamDict, \"URLENC\")\n If MethodTxt <> \"\" Then ApiEndPoint = ApiEndPoint & \"?\" & MethodTxt\n ReqBody = \"\"\nElse\n '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.\n MethodTxt = \"\"\n ReqBody = JsonConverter.ConvertToJson(ParamDict)\n postdata = ReqBody\nEnd If\n\nApiForSign = NonceUnique & ReqType & ApiEndPoint & ReqBody\nAPIsign = ComputeHash_C(\"SHA256\", ApiForSign, Credentials(\"secretKey\"), \"STR64\")\n\nurl = TradeApiSite & ApiEndPoint\n\nDim headerDict As New Dictionary\nheaderDict.Add \"KC-API-KEY\", Credentials(\"apiKey\")\nheaderDict.Add \"KC-API-SIGN\", APIsign\nheaderDict.Add \"KC-API-TIMESTAMP\", NonceUnique\nheaderDict.Add \"KC-API-PASSPHRASE\", Credentials(\"Passphrase\")\nheaderDict.Add \"Content-Type\", \"application/json\"\n\nPrivateKucoin = WebRequestURL(url, ReqType, headerDict, postdata)\n\nEnd Function\n\nFunction GetKucoinTime() As Double\n\nDim JsonResponse As String\nDim Json As Object\n\n'PublicKucoin time\nJsonResponse = PublicKucoin(\"timestamp\", \"GET\")\nSet Json = JsonConverter.ParseJson(JsonResponse)\nGetKucoinTime = Json(\"data\")\nIf GetKucoinTime = 0 Then\n TimeCorrection = -3600\n GetKucoinTime = DateDiff(\"s\", \"1/1/1970\", Now)\n GetKucoinTime = Trim(Str((Val(GetKucoinTime) + TimeCorrection)) & Right(Int(Timer * 100), 2) & \"0\")\nEnd If\n\nSet Json = Nothing\n\nEnd Function\n" }, { "path": "ModExchOKEx.bas", "content": "Attribute VB_Name = \"ModExchOkex\"\nSub TestOKEx()\n\n'Source: https://github.com/krijnsent/crypto_vba\n'https://www.okex.com/docs/en/\n'Remember to create a new API key for excel/VBA\n\nDim Apikey As String\nDim secretKey As String\n\nApikey = \"your api key here\"\nsecretKey = \"your secret key here\"\n\n'Remove these 2 lines, unless you define 2 constants somewhere ( Public Const secretkey_okex = \"the key to use everywhere\" etc )\nApikey = apikey_okex\nsecretKey = secretkey_okex\npassphrase = passphrase_okex\n\n'Put the credentials in a dictionary\nDim Cred As New Dictionary\nCred.Add \"apiKey\", Apikey\nCred.Add \"secretKey\", secretKey\nCred.Add \"Passphrase\", passphrase\n\n' Create a new test suite\nDim Suite As New TestSuite\nSuite.Description = \"ModExchOKEx\"\n\n' Create reporter and attach it to these specs\nDim Reporter As New ImmediateReporter\nReporter.ListenTo Suite\n \n' Create a new test\nDim Test As TestCase\nSet Test = Suite.Test(\"TestOKExPublic\")\n\n'Error, unknown command, returns invalid JSON\nTestResult = PublicOKEx(\"AnUnknownCommand\", \"GET\")\nTest.IsOk InStr(TestResult, \"error\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"error_nr\"), 403\n\n'Error, missing parameter\nTestResult = PublicOKEx(\"spot/v3/instruments/EOS-BTC/\", \"GET\")\nTest.IsOk InStr(TestResult, \"error\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"error_nr\"), 404\n\n'Error, unknown pair\nTestResult = PublicOKEx(\"spot/v3/instruments/EOS-BLA/ticker\", \"GET\")\nTest.IsOk InStr(TestResult, \"error\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"error_nr\"), 400\nTest.IsEqual JsonResult(\"response_txt\")(\"code\"), 30032\nTest.IsEqual JsonResult(\"response_txt\")(\"message\"), \"The currency pair does not exist\"\n\nTestResult = PublicOKEx(\"spot/v3/instruments/ticker\", \"GET\")\n'[{\"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...\nTest.IsOk InStr(TestResult, \"best_bid\") > 0\nTest.IsOk InStr(TestResult, \"product_id\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk JsonResult.Count > 100\nTest.IsOk JsonResult(1)(\"last\") * 1 > 0\nTest.IsOk Len(JsonResult(2)(\"instrument_id\")) > 0\n\n\nDim Params As New Dictionary\nParams.Add \"granularity\", 14400 '14400 seconds = 6 hours\nParams.Add \"start\", \"2020-12-15T08%3A28%3A48.899Z\" 'ISO 8601\nParams.Add \"end\", \"2020-12-19T09%3A28%3A48.899Z\"\nTestResult = PublicOKEx(\"spot/v3/instruments/ETH-USDT/candles\", \"GET\", Params)\n'Result: TOHLCV\n'[[\"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\"]]\nTest.IsOk InStr(TestResult, \"2020-12-19\") > 0\nTest.IsOk InStr(TestResult, \"2020-12-18\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(1)(1), \"2020-12-19T08:00:00.000Z\"\nTest.IsEqual JsonResult(1)(2), \"648.67\"\nTest.IsEqual JsonResult.Count, 24\n\n' Create a new test\nSet Test = Suite.Test(\"TestOKExTime\")\nTestResult = GetOKExTime()\nTest.IsOk TestResult > 1500000000#\nTest.IsOk TestResult < 1700000000#\n\n\nSet Test = Suite.Test(\"TestOKExPrivate\")\n\nTestResult = PrivateOKEx(\"spot/v3/accounts\", \"GET\", Cred)\n'[{\"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\"}]\nTest.IsOk InStr(TestResult, \"currency\") > 0\nTest.IsOk InStr(TestResult, \"balance\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk JsonResult.Count >= 2\nTest.IsOk JsonResult(1)(\"balance\") * 1 >= 0\nTest.IsOk JsonResult(1)(\"holds\") * 1 >= 0\n\n'Invalid token\nTestResult = PrivateOKEx(\"account/v3/wallet/BLA\", \"GET\", Cred)\n'{\"error_nr\":400,\"error_txt\":\"HTTP-\",\"response_txt\":{\"code\":30031,\"message\":\"BLA is an invalid token\"}}\nTest.IsOk InStr(TestResult, \"error\") > 0\nTest.IsOk InStr(TestResult, 30031) > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"response_txt\")(\"code\"), 30031\nTest.IsEqual JsonResult(\"response_txt\")(\"message\"), \"BLA is an invalid token\"\n\nSet Test = Suite.Test(\"TestOKExPrivate Orders\")\n'Create order\n'BUY 100 BTC for a price of 1 USDT per BTC\n'price hopefully insane enough never to execute\nDim Params2 As New Dictionary\nParams2.Add \"instrument_id\", \"BTC-USDT\"\nParams2.Add \"type\", \"limit\"\nParams2.Add \"side\", \"buy\"\nParams2.Add \"price\", 1\nParams2.Add \"size\", 100\nParams2.Add \"order_type\", 3 '3-Immediate Or Cancel\nTestResult = PrivateOKEx(\"spot/v3/orders\", \"POST\", Cred, Params2)\n'e.g. {\"client_oid\":\"\",\"error_code\":\"33017\",\"error_message\":\"Greater than the maximum available balance\",\"order_id\":\"-1\",\"result\":false}\nTest.IsOk InStr(TestResult, \"code\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk JsonResult(\"error_code\") * 1 = 33017\nTest.IsOk JsonResult(\"error_message\") = \"Greater than the maximum available balance\"\n\nDim Params3 As New Dictionary\nParams3.Add \"instrument_id\", \"XMR-BTC\"\nClientIdOrderId = \"12345\"\nTestResult = PrivateOKEx(\"spot/v3/cancel_orders/\" & ClientIdOrderId, \"POST\", Cred, Params3)\n'{\"client_oid\":\"\",\"code\":\"33014\",\"error_code\":\"33014\",\"error_message\":\"Order does not exist\",\"message\":\"Order does not exist\",\"order_id\":\"12345\",\"result\":false}\nTest.IsOk InStr(TestResult, \"code\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk JsonResult(\"code\") * 1 = 33014\nTest.IsOk JsonResult(\"message\") = \"Order does not exist\"\n\nDim Params4 As New Dictionary\nParams4.Add \"instrument_id\", \"XMR-BTC\"\nParams4.Add \"limit\", 4\nTestResult = PrivateOKEx(\"spot/v3/orders_pending\", \"GET\", Cred, Params4)\n'[] (no orders), [[{\"client_oid\":\"oktspot86\",\"created_at\":\"2019-03-20T03:28:14.000Z\",etc...\nIf TestResult = \"[]\" Then\n 'No orders\nElse\n Test.IsOk InStr(TestResult, \"created_at\") > 0\n Set JsonResult = JsonConverter.ParseJson(TestResult)\n Test.IsOk JsonResult(1)(\"instrument_id\") = \"XMR-BTC\"\n Test.IsOk Len(JsonResult(1)(\"order_id\")) > 0\nEnd If\n\nDim Params5 As New Dictionary\ninstrument_id = \"XAS-BTC\"\nParams5.Add \"instrument_id\", instrument_id\nJsonResponse = PrivateOKEx(\"spot/v3/fills\", \"GET\", Cred, Params5)\n'e.g. []\nIf TestResult = \"[]\" Then\n 'No orders\nElse\n Test.IsOk InStr(TestResult, \"created_at\") > 0\n Set JsonResult = JsonConverter.ParseJson(TestResult)\n Test.IsOk JsonResult(1)(\"instrument_id\") = \"XAS-BTC\"\nEnd If\n\n\nEnd Sub\n\nFunction PublicOKEx(Method As String, ReqType As String, Optional ParamDict As Dictionary) As String\n\nDim url As String\nPublicApiSite = \"https://www.okex.com/api\"\n\nMethodParams = DictToString(ParamDict, \"URLENC\")\nIf MethodParams <> \"\" Then MethodParams = \"?\" & MethodParams\nurlPath = \"/\" & Method & MethodParams\nurl = PublicApiSite & urlPath\n\nPublicOKEx = WebRequestURL(url, ReqType)\n\nEnd Function\nFunction PrivateOKEx(Method As String, ReqType As String, Credentials As Dictionary, Optional ParamDict As Dictionary) As String\n\nDim NonceUnique As String\nDim url As String\nDim postdata As String\n\nTradeApiSite = \"https://www.okex.com\"\nApiEndPoint = \"/api/\" & Method\n\n'OKEx nonce\nNonceUnique = GetOKExTime() & \".00\" 'Should be string\n\nIf UCase(ReqType) = \"POST\" Then\n 'For POST request, all query parameters need to be included in the request body with JSON. (e.g. {\"currency\":\"BTC\"}).\n postdata = JsonConverter.ConvertToJson(ParamDict)\nElseIf UCase(ReqType) = \"GET\" Then\n MethodParams = DictToString(ParamDict, \"URLENC\")\n If MethodParams <> \"\" Then MethodParams = \"?\" & MethodParams\n ApiEndPoint = ApiEndPoint & MethodParams\nEnd If\n\nApiForSign = NonceUnique & UCase(ReqType) & ApiEndPoint & postdata\nAPIsign = ComputeHash_C(\"SHA256\", ApiForSign, Credentials(\"secretKey\"), \"STR64\")\n\nurl = TradeApiSite & ApiEndPoint\n\nDim headerDict As New Dictionary\nheaderDict.Add \"OK-ACCESS-KEY\", Credentials(\"apiKey\")\nheaderDict.Add \"OK-ACCESS-SIGN\", APIsign\nheaderDict.Add \"OK-ACCESS-TIMESTAMP\", NonceUnique\nheaderDict.Add \"OK-ACCESS-PASSPHRASE\", Credentials(\"Passphrase\")\nheaderDict.Add \"Content-Type\", \"application/json\"\n\nPrivateOKEx = WebRequestURL(url, ReqType, headerDict, postdata)\n\nEnd Function\n\nFunction GetOKExTime() As Double\n\nDim JsonResponse As String\nDim Json As Object\n\n'PublicOKEx time\nJsonResponse = PublicOKEx(\"general/v3/time\", \"GET\")\nSet Json = JsonConverter.ParseJson(JsonResponse)\nIf InStr(Json(\"epoch\"), \".\") Then\n GetOKExTime = Left(Json(\"epoch\"), InStr(Json(\"epoch\"), \".\"))\nElse\n GetOKExTime = Json(\"epoch\")\nEnd If\nIf GetOKExTime = 0 Then\n TimeCorrection = -3600\n GetOKExTime = DateDiff(\"s\", \"1/1/1970\", Now)\n GetOKExTime = Trim(Str((Val(GetOKExTime) + TimeCorrection)) & Right(Int(Timer * 100), 2) & \"0\")\nEnd If\n\nSet Json = Nothing\n\nEnd Function\n" }, { "path": "ModExchPoloniex.bas", "content": "Attribute VB_Name = \"ModExchPoloniex\"\nSub TestPoloniex()\n\n'Source: https://github.com/krijnsent/crypto_vba\n'Remember to create a new API key for excel/VBA\n'https://docs.poloniex.com/#http-api\n'Poloniex will require ever increasing values/nonces for the private API and the nonces created in VBA might mismatch that of other sources\n\nDim Apikey As String\nDim secretKey As String\n\nApikey = \"your api key here\"\nsecretKey = \"your secret key here\"\n\n'Remove these 2 lines, unless you define 2 constants somewhere ( Public Const secretkey_poloniex = \"the key to use everywhere\" etc )\nApikey = apikey_poloniex\nsecretKey = secretkey_poloniex\n\n'Put the credentials in a dictionary\nDim Cred As New Dictionary\nCred.Add \"apiKey\", Apikey\nCred.Add \"secretKey\", secretKey\n\n' Create a new test suite\nDim Suite As New TestSuite\nSuite.Description = \"ModExchPoloniex\"\n\n' Create reporter and attach it to these specs\nDim Reporter As New ImmediateReporter\nReporter.ListenTo Suite\n \n' Create a new test\nDim Test As TestCase\nSet Test = Suite.Test(\"TestPoloniexPublic\")\n\n'Error, unknown command\nTestResult = PublicPoloniex(\"returnUnknownCommand\", \"GET\")\n'{\"error\":\"Invalid command.\"}\nTest.IsOk InStr(TestResult, \"error\") > 0, \"test error 1 failed, result: ${1}\"\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"error\"), \"Invalid command.\", \"test error 2 failed, result: ${1}\"\n\n'Error, missing parameters\nTestResult = PublicPoloniex(\"returnOrderBook\", \"GET\")\n'{\"error\":\"Please specify a currency pair.\"}\nTest.IsOk InStr(TestResult, \"error\") > 0, \"test error 3 failed, result: ${1}\"\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"error\"), \"Please specify a currency pair.\", \"test error 4 failed, result: ${1}\"\n\n'Testing error catching and replies\nTestResult = PublicPoloniex(\"returnTicker\", \"GET\")\n'{\"BTC_BCN\":{\"id\":7,\"last\":\"0.00000120\",\"lowestAsk\":\"0.00000120\",\"highestBid\":\"0.00000119\",\"percentChange\":\"1.00000000\",\"baseVolume\":\"21570.44763887\",\"quoteVolume\":\"21082615430.89178085\", etc...\nTest.IsOk InStr(TestResult, \"lowestAsk\") > 0\nTest.IsOk InStr(TestResult, \"BTC_ETH\"\":\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"error\"), \"\"\nTest.IsEqual JsonResult(\"BTC_ETH\")(\"id\"), 148\nTest.IsOk JsonResult(\"BTC_ETH\")(\"highestBid\") > 0\n\n'Put the parameters in a dictionary\nDim Params As New Dictionary\nParams.Add \"currencyPair\", \"BTC_ETH\"\nParams.Add \"depth\", 10\nTestResult = PublicPoloniex(\"returnOrderBook\", \"GET\", Params)\n'{\"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}\nTest.IsOk InStr(TestResult, \"],[\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"asks\").Count, 10\nTest.IsEqual JsonResult(\"bids\").Count, 10\nTest.IsOk JsonResult(\"asks\")(1)(2) > 0\n\n'Unix time period:\nSet Test = Suite.Test(\"TestPoloniexPrivate\")\nt1 = DateToUnixTime(\"1/1/2016\")\nt2 = DateToUnixTime(\"1/1/2019\")\n\nTestResult = PrivatePoloniex(\"returnBalances\", \"POST\", Cred)\n'{\"1CR\":\"0.00000000\",\"ABY\":\"0.00000000\",\"AC\":\"0.00000000\",\"ACH\":\"0.00000000\",\"ADN\":\"0.00000000\",\"AEON\":\"0.00000000\" etc...\nTest.IsOk InStr(TestResult, \"BTC\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk JsonResult.Count >= 10\nTest.IsOk JsonResult(\"ETH\") >= 0\n\n'Put the parameters in a dictionary\nDim Params2 As New Dictionary\nParams2.Add \"currencyPair\", \"all\"\nParams2.Add \"start\", t1\nParams2.Add \"end\", t2\n\nTestResult = PrivatePoloniex(\"returnTradeHistory\", \"POST\", Cred, Params2)\nIf InStr(TestResult, \"globalTradeID\") > 0 Then\n 'has some results\n '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...\n Test.IsOk InStr(TestResult, \"amount\") > 0\n Set JsonResult = JsonConverter.ParseJson(TestResult)\n For Each k In JsonResult.Keys()\n Test.IsOk JsonResult(k).Count >= 1\n Next k\nElse\n 'no results\n 'Empty: []\n Test.IsEqual TestResult, \"[]\"\nEnd If\n\n'Put the parameters in a dictionary\nDim Params3 As New Dictionary\nParams3.Add \"currencyPair\", \"BTC_ETH\"\nParams3.Add \"rate\", 0.001\nParams3.Add \"amount\", 3\nParams3.Add \"fillOrKill\", 1\n\nTestResult = PrivatePoloniex(\"buy\", \"POST\", Cred, Params3)\n'{\"error\":\"This API key does not have permission to trade.\"}\n'{orderNumber: '514845991795',resultingTrades:[{amount: '3.0',Date: '2018-10-25 23:03:21',rate:'0.0002',total:'0.0006',tradeID:'251834',type:'buy'}]}\n'{\"error\":\"Not enough BTC.\",\"fee\":\"0.00125000\",\"currencyPair\":\"BTC_ETH\"}\nIf InStr(TestResult, \"error\") > 0 Then\n Test.IsOk InStr(TestResult, \"currencyPair\") > 0\n Set JsonResult = JsonConverter.ParseJson(TestResult)\n Test.IsEqual JsonResult(\"error\"), \"Not enough BTC.\"\nElse\n Test.IsOk InStr(TestResult, \"resultingTrades\") > 0\n Set JsonResult = JsonConverter.ParseJson(TestResult)\n Test.IsOk JsonResult(\"orderNumber\") >= 0\nEnd If\n\n\nEnd Sub\n\nFunction PublicPoloniex(Method As String, ReqType As String, Optional ParamDict As Dictionary) As String\n\nDim url As String\nPublicApiSite = \"https://poloniex.com\"\n\nMethodParams = DictToString(ParamDict, \"URLENC\")\nIf MethodParams <> \"\" Then MethodParams = \"&\" & MethodParams\nurlPath = \"/public?command=\" & Method & MethodParams\nurl = PublicApiSite & urlPath\n\nPublicPoloniex = WebRequestURL(url, ReqType)\n\nEnd Function\nFunction PrivatePoloniex(Method As String, ReqType As String, Credentials As Dictionary, Optional ParamDict As Dictionary) As String\n\nDim NonceUnique As String\nDim postdata As String\nDim PayloadDict As Dictionary\nDim url As String\n\n'Poloniex nonce\nNonceUnique = CreateNonce(16)\n\nurl = \"https://poloniex.com/tradingApi\"\n\nSet PayloadDict = New Dictionary\nPayloadDict(\"command\") = Method\nIf Not ParamDict Is Nothing Then\n For Each key In ParamDict.Keys\n PayloadDict(key) = ParamDict(key)\n Next key\nEnd If\nPayloadDict(\"&nonce\") = NonceUnique\n\npostdata = DictToString(PayloadDict, \"URLENC\")\nAPIsign = ComputeHash_C(\"SHA512\", postdata, Credentials(\"secretKey\"), \"STRHEX\")\n\nDim headerDict As New Dictionary\nheaderDict.Add \"User-Agent\", \"Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)\"\nheaderDict.Add \"Content-Type\", \"application/x-www-form-urlencoded\"\nheaderDict.Add \"Key\", Credentials(\"apiKey\")\nheaderDict.Add \"Sign\", APIsign\n\nPrivatePoloniex = WebRequestURL(url, ReqType, headerDict, postdata)\n\nEnd Function\n" }, { "path": "ModFunctions.bas", "content": "Attribute VB_Name = \"ModFunctions\"\nDeclare PtrSafe Sub GetSystemTime Lib \"kernel32\" (ByRef lpSystemTime As SYSTEMTIME)\n\nType SYSTEMTIME\n wYear As Integer\n wMonth As Integer\n wDayOfWeek As Integer\n wDay As Integer\n wHour As Integer\n wMinute As Integer\n wSecond As Integer\n wMilliseconds As Integer\nEnd Type\n\n'Functions in module:\n'DateToUnixTime - retuns the UnixTime of a date/time\n'UnixTimeToDate - returns the date/time of a UnixTime\n'TransposeArr - Custom transpose function, worksheetfunction.transpose won't handle long strings\n'URLEncode - especially for Excel 2013 and before, afterwards it's a standard function\n'Source: https://github.com/krijnsent/crypto_vba\nSub TestFunctions()\n\n' Create a new test suite\nDim Suite As New TestSuite\nSuite.Description = \"ModFunctions\"\n' Create reporter and attach it to these specs\nDim Reporter As New ImmediateReporter\nReporter.ListenTo Suite\n' Create a new test\nDim Test As TestCase\n\n\nSet Test = Suite.Test(\"CreateNonce\")\nTestResult = CreateNonce()\nTest.IsOk TestResult > 151802369827#\nTest.IsEqual Len(TestResult), 12\n\nTestResult = CreateNonce(\"10\")\nTest.IsOk TestResult > 1518023698\nTest.IsEqual Len(TestResult), 10\n\nTestResult = CreateNonce(3)\nTest.IsOk TestResult >= 151\nTest.IsEqual Len(TestResult), 3\n\nTestResult = CreateNonce(15)\nTest.IsOk TestResult > 151802369827000#\nTest.IsEqual Len(TestResult), 15\n\n\nSet Test = Suite.Test(\"DateToUnixTime\")\nTestResult = DateToUnixTime(#4/26/2017#)\nTest.IsEqual TestResult, 1493164800\nTest.IsEqual Len(TestResult), 10\n\nTestResult = DateToUnixTime(Now)\nTest.IsOk TestResult > 1511958343\nTest.IsEqual Len(TestResult), 10\n\n\nSet Test = Suite.Test(\"UnixTimeToDate\")\nTestResult = UnixTimeToDate(1493164800)\nTest.IsEqual TestResult, #4/26/2017#\nTest.IsEqual Len(TestResult), 9\n\nTestResult = UnixTimeToDate(1511958343)\nTest.IsEqual TestResult, #11/29/2017 12:25:43 PM#\nTest.IsEqual Len(TestResult), 19\n\n\nSet Test = Suite.Test(\"TransposeArr\")\n' Declare a two dimensional array, Fill the array with text made up of i and j values\nDim TestArr(1 To 3, 1 To 2) As Variant\nDim i As Long, j As Long\nFor i = LBound(TestArr) To UBound(TestArr)\n For j = LBound(TestArr, 2) To UBound(TestArr, 2)\n TestArr(i, j) = CStr(i) & \":\" & CStr(j)\n Next j\nNext i\nFlipArr = TransposeArr(TestArr)\nTest.IsEqual TestArr(1, 2), \"1:2\"\nTest.IsEqual TestArr(1, 2), FlipArr(2, 1)\n\n'Test URLEncode\nSet Test = Suite.Test(\"URLEncode\")\nTestResult = URLEncode(\"http://www.github.com/\")\nTest.IsEqual TestResult, \"http%3A%2F%2Fwww.github.com%2F\"\n\nTestResult = URLEncode(\"https://github.com/search?q=crypto_vba&type=\")\nTest.IsEqual TestResult, \"https%3A%2F%2Fgithub.com%2Fsearch%3Fq%3Dcrypto_vba%26type%3D\"\n\n\n'TestDictToString\n'Only works for 1-level Dicts, for multilevel, use JsonConverter.ConvertToJson(testDict)\nSet Test = Suite.Test(\"TestDictToString\")\nDim testDict As New Dictionary\n\n'Empty Dict\nTestResult = DictToString(testDict, \"JSON\")\nTest.IsEqual TestResult, \"{}\"\n\n'Unknown type\nTestResult = DictToString(testDict, \"-\")\nTest.IsEqual TestResult, \"UNKNOWN_TYPE\"\n\n'Fill dictionary\ntestDict.Add \"option1\", \"BTC-ETH\"\ntestDict.Add \"another_option\", \"16\"\nJsonTxt = \"{\"\"option1\"\":\"\"BTC-ETH\"\",\"\"another_option\"\":\"\"16\"\"}\"\nTestResult = DictToString(testDict, \"JSON\")\nTest.IsEqual TestResult, JsonTxt\nUrlTxt = \"option1=BTC-ETH&another_option=16\"\nTestResult = DictToString(testDict, \"URLENC\")\nTest.IsEqual TestResult, UrlTxt\n\nDim testDict2 As New Dictionary\n'Fill dictionary\ntestDict2.Add \"value1\", 9\ntestDict2.Add \"value_2\", 0.154\ntestDict2.Add \"value_as_string\", \"1.87\"\ntestDict2.Add \"commaval_as_str\", \"2,16\"\nTestResult = DictToString(testDict2, \"JSON\")\nJsonTxt = \"{\"\"value1\"\":9,\"\"value_2\"\":0.154,\"\"value_as_string\"\":\"\"1.87\"\",\"\"commaval_as_str\"\":\"\"2,16\"\"}\"\nTest.IsEqual TestResult, JsonTxt\nTestResult = DictToString(testDict2, \"URLENC\")\nUrlTxt = \"value1=9&value_2=0.154&value_as_string=1.87&commaval_as_str=2,16\"\nTest.IsEqual TestResult, UrlTxt\n\n\n'TestSortDict\nSet Test = Suite.Test(\"TestSortDict\")\n\n'Function: Sort dictionaries\nDim testDict3 As New Dictionary\n'Fill dictionary\ntestDict3.Add \"d\", 9\ntestDict3.Add \"e\", 0.154\ntestDict3.Add \"c\", \"1.87\"\ntestDict3.Add \"b\", \"2,16\"\n\n'Sort normally\nCall SortDictByKey(testDict3)\nTest.IsEqual testDict3.Count, 4\nTest.IsEqual testDict3.Keys(0), \"b\"\nTest.IsEqual testDict3.Keys(3), \"e\"\nTest.IsEqual testDict3.Items(3), 0.154\n\n'Sort desc\nCall SortDictByKey(testDict3, False)\nTest.IsEqual testDict3.Count, 4\nTest.IsEqual testDict3.Keys(0), \"e\"\nTest.IsEqual testDict3.Keys(3), \"b\"\nTest.IsEqual testDict3.Items(3), \"2,16\"\n\n\nEnd Sub\n\nFunction DateToUnixTime(dt) As Long\n DateToUnixTime = 0\n On Error Resume Next\n DateToUnixTime = DateDiff(\"s\", \"1/1/1970\", dt)\n On Error GoTo 0\nEnd Function\n\nFunction UnixTimeToDate(ts As Long) As Date\n 'http://www.vbforums.com/showthread.php?513727-RESOLVED-Convert-Unix-Time-to-Date&p=3168062&viewfull=1#post3168062\n Dim intDays As Integer, intHours As Integer, intMins As Integer, intSecs As Integer\n \n intDays = ts \\ 86400\n intHours = (ts Mod 86400) \\ 3600\n intMins = (ts Mod 3600) \\ 60\n intSecs = ts Mod 60\n \n UnixTimeToDate = DateSerial(1970, 1, intDays + 1) + TimeSerial(intHours, intMins, intSecs)\nEnd Function\nFunction CreateNonce(Optional NonceLength As Integer = 12) As String\n \n Dim ScsLng As Long\n ScsLng = Int(Timer() * 100)\n \n NonceUnique = DateDiff(\"s\", \"1/1/1970\", Now)\n If NonceLength >= 12 Then\n CreateNonce = NonceUnique & Right(ScsLng, 2) & String(NonceLength - 12, \"0\")\n ElseIf NonceLength >= 1 Then\n CreateNonce = Left(NonceUnique & Right(ScsLng, 2), NonceLength)\n Else\n CreateNonce = 0\n End If\n\nEnd Function\n\nFunction GetUTCTime() As Date\n\nDim t As SYSTEMTIME\nDim currentime As String\nGetSystemTime t\ncurrentTime = t.wYear & \"/\" & t.wMonth & \"/\" & t.wDay & \" \" & t.wHour & \":\" & t.wMinute & \":\" & t.wSecond\nGetUTCTime = currentTime\n\nEnd Function\n\nFunction TransposeArr(ArrIn As Variant)\n\n 'Custom transpose function, worksheetfunction.transpose won't handle long strings\n 'It will give error 13, https://stackoverflow.com/questions/23315252/vba-tranpose-type-mismatch-error\n Dim TempArr As Variant\n\n ReDim TempArr(1 To UBound(ArrIn, 2), 1 To UBound(ArrIn, 1))\n For i = 1 To UBound(ArrIn, 2)\n For j = 1 To UBound(ArrIn, 1)\n TempArr(i, j) = ArrIn(j, i)\n Next\n Next\n \n TransposeArr = TempArr\n \nEnd Function\n\nPublic Function URLEncode(StringVal As String, Optional SpaceAsPlus As Boolean = False) As String\n'https://stackoverflow.com/questions/218181/how-can-i-url-encode-a-string-in-excel-vba\n Dim StringLen As Long: StringLen = Len(StringVal)\n\n If StringLen > 0 Then\n ReDim Result(StringLen) As String\n Dim i As Long, CharCode As Integer\n Dim Char As String, Space As String\n\n If SpaceAsPlus Then Space = \"+\" Else Space = \"%20\"\n\n For i = 1 To StringLen\n Char = Mid$(StringVal, i, 1)\n CharCode = Asc(Char)\n Select Case CharCode\n Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126\n Result(i) = Char\n Case 32\n Result(i) = Space\n Case 0 To 15\n Result(i) = \"%0\" & Hex(CharCode)\n Case Else\n Result(i) = \"%\" & Hex(CharCode)\n End Select\n Next i\n URLEncode = Join(Result, \"\")\n End If\nEnd Function\n\n\nFunction DictToString(DictIn As Dictionary, OutputType As String) As String\n\nDim OutputTxt As String\nDim ValStr As String\n\nIf DictIn Is Nothing Then\n DictToString = \"\"\n Exit Function\nEnd If\n\nIf OutputType = \"JSON\" Then\n OutputTxt = \"{\"\n For Each opt In DictIn.Keys()\n If OutputTxt <> \"{\" Then OutputTxt = OutputTxt & \",\"\n 'If a string came in, put double quotes around it\n ValD = DictIn(opt)\n Separ = \"\"\n If VarType(ValD) = vbString Then Separ = \"\"\"\"\n \n 'Value: correct for comma decimal system if a value was supplied\n ValStr = ValD\n If VarType(ValD) <> vbString Then ValStr = Replace(ValStr, \",\", \".\")\n OutputTxt = OutputTxt & \"\"\"\" & opt & \"\"\"\" & \":\" & Separ & ValStr & Separ\n Next\n OutputTxt = OutputTxt & \"}\"\nElseIf OutputType = \"URLENC\" Then\n OutputTxt = \"\"\n For Each opt In DictIn.Keys()\n If OutputTxt <> \"\" Then OutputTxt = OutputTxt & \"&\"\n ValD = DictIn(opt)\n ValStr = ValD\n If VarType(ValD) <> vbString Then ValStr = Replace(ValStr, \",\", \".\")\n OutputTxt = OutputTxt & opt & \"=\" & ValStr\n Next\nElse\n OutputTxt = \"UNKNOWN_TYPE\"\nEnd If\n\nDictToString = OutputTxt\n\nEnd Function\n\n\nSub SortDictByKey(DictIn As Dictionary, Optional SortAsc As Boolean = True)\n 'Default: sort dictionary Ascending by Key\n 'Inspired by https://excelmacromastery.com/vba-dictionary/#Sorting_the_Dictionary\n \n Dim ResDict As New Dictionary\n Set arrayList = CreateObject(\"System.Collections.ArrayList\")\n \n 'Exit if DictIn is empty or only has max 1 item\n If DictIn Is Nothing Then\n Exit Sub\n Else\n If DictIn.Count <= 1 Then\n Exit Sub\n End If\n End If\n \n ' Put keys in array and sort (asc/desc)\n For Each key In DictIn.Keys\n arrayList.Add key\n Next key\n arrayList.Sort\n If SortAsc = False Then\n arrayList.Reverse\n End If\n \n 'Loop through array\n For Each va In arrayList\n ResDict.Add va, DictIn(va)\n Next va\n \n Set DictIn = ResDict\n\nEnd Sub\n\n" }, { "path": "ModHash.bas", "content": "Attribute VB_Name = \"ModHash\"\n'Public Function Suite() As TestSuite\n' Set Suite = New TestSuite\n' Suite.Description = \"...\"\n'\n' ' Create reporter and attach it to these specs\n' Dim Reporter As New ImmediateReporter\n' Reporter.ListenTo Suite\n'\n'\n' ' -> Reporter will now output results as they are generated\n'End Function\n\nSub TestHash()\n\n' Create a new test suite\nDim Suite As New TestSuite\nSuite.Description = \"ModHash\"\n\n' Create reporter and attach it to these specs\nDim Reporter As New ImmediateReporter\nReporter.ListenTo Suite\n \n' Create a new test\nDim Test As TestCase\nSet Test = Suite.Test(\"TestHashes\")\n\n'9f54d278014e50f71c789e6fba09c6cfb0945d9253eb8dc5f91ecf52e9996ab9\nTestResult = ComputeHash_C(\"SHA256\", \"input_string\", \"\", \"STRHEX\")\nTest.IsEqual Len(TestResult), 64\nTest.IsEqual TestResult, \"9f54d278014e50f71c789e6fba09c6cfb0945d9253eb8dc5f91ecf52e9996ab9\"\n\n'9DsHyKCMZmDa5+y2I4v9ErMAa4rTWXVZVqDA5HOuScHFJBjUJeJW11B6CojHJHQHIzXJc8tkneRLRCqaZfV05A==\nTestResult = ComputeHash_C(\"SHA512\", \"input_string\", \"my_key\", \"STR64\")\nTest.IsEqual Len(TestResult), 88\nTest.IsEqual TestResult, \"9DsHyKCMZmDa5+y2I4v9ErMAa4rTWXVZVqDA5HOuScHFJBjUJeJW11B6CojHJHQHIzXJc8tkneRLRCqaZfV05A==\"\n\n'29u\u0004D{SÑ¢9KË­SÕ©k46\u001egyRe\nTestResult = ComputeHash_C(\"SHA384\", \"input_string\", \"\", \"RAW\")\n'If Len(TestResult) = 48 And Left(TestResult, 4) = \"29u\" Then\nTest.IsEqual Len(TestResult), 48\nTest.IsEqual Left(TestResult, 4), \"29u\"\n\nEnd Sub\n\nFunction ComputeHash_C(Meth As String, ByVal clearText As String, ByVal key As String, Optional OutType As String) As Variant\n\n 'Created by Koen Rijnsent, www.castoro.nl\n 'Function to return a hash\n 'Methods: default SHA1, other options SHA512, SHA384 and SHA256\n 'Key: \"\" for no key\n 'Output: STR64, STRHEX, RAW or bytes\n \n Dim BKey() As Byte\n Dim BTxt() As Byte\n \n Dim oT As Object\n Dim TextToHash() As Byte\n Dim bytes() As Byte\n \n BTxt = StrConv(clearText, vbFromUnicode)\n BKey = StrConv(key, vbFromUnicode)\n \n If key <> \"\" Then\n 'MD5 does not work with a key, no error catching yet\n If Meth = \"SHA512\" Then\n Set SHAhasher = CreateObject(\"System.Security.Cryptography.HMACSHA512\")\n ElseIf Meth = \"SHA384\" Then\n Set SHAhasher = CreateObject(\"System.Security.Cryptography.HMACSHA384\")\n ElseIf Meth = \"SHA256\" Then\n Set SHAhasher = CreateObject(\"System.Security.Cryptography.HMACSHA256\")\n Else\n Set SHAhasher = CreateObject(\"System.Security.Cryptography.HMACSHA1\")\n End If\n SHAhasher.key = BKey\n bytes = SHAhasher.computeHash_2(BTxt)\n Else\n If Meth = \"SHA512\" Then\n Set SHAhasher = CreateObject(\"System.Security.Cryptography.SHA512Managed\")\n ElseIf Meth = \"SHA256\" Then\n Set SHAhasher = CreateObject(\"System.Security.Cryptography.SHA256Managed\")\n ElseIf Meth = \"SHA384\" Then\n Set SHAhasher = CreateObject(\"System.Security.Cryptography.SHA384Managed\")\n ElseIf Meth = \"MD5\" Then\n Set SHAhasher = CreateObject(\"System.Security.Cryptography.MD5CryptoServiceProvider\")\n Else\n Set SHAhasher = CreateObject(\"System.Security.Cryptography.SHA1Managed\")\n End If\n Set oT = CreateObject(\"System.Text.UTF8Encoding\")\n TextToHash = oT.GetBytes_4(clearText)\n bytes = SHAhasher.computeHash_2((TextToHash))\n End If\n \n If OutType = \"STR64\" Then\n ComputeHash_C = ConvToBase64String(bytes)\n ElseIf OutType = \"STRHEX\" Then\n ComputeHash_C = ConvToHexString(bytes)\n ElseIf OutType = \"RAW\" Then\n ComputeHash_C = Base64Decode(ConvToBase64String(bytes))\n Else\n ComputeHash_C = bytes\n End If\n Set SHAhaser = Nothing\n\nEnd Function\n\nFunction ConvToBase64String(vIn As Variant) As Variant\n\n 'Source: https://en.wikibooks.org/wiki/Visual_Basic_for_Applications/File_Hashing_in_VBA\n Dim oD As Object\n Set oD = CreateObject(\"MSXML2.DOMDocument\")\n With oD\n .LoadXML \"\"\n .DocumentElement.DataType = \"bin.base64\"\n .DocumentElement.nodeTypedValue = vIn\n End With\n ConvToBase64String = Replace(oD.DocumentElement.Text, vbLf, \"\")\n \n Set oD = Nothing\n\nEnd Function\n\nFunction ConvToHexString(vIn As Variant) As Variant\n\n 'Source: https://en.wikibooks.org/wiki/Visual_Basic_for_Applications/File_Hashing_in_VBA\n Dim oD As Object\n Set oD = CreateObject(\"MSXML2.DOMDocument\")\n \n With oD\n .LoadXML \"\"\n .DocumentElement.DataType = \"bin.Hex\"\n .DocumentElement.nodeTypedValue = vIn\n End With\n ConvToHexString = Replace(oD.DocumentElement.Text, vbLf, \"\")\n \n Set oD = Nothing\n\nEnd Function\n\n\n' Decodes a base-64 encoded string (BSTR type).\n' 1999 - 2004 Antonin Foller, http://www.motobit.com\n' 1.01 - solves problem with Access And 'Compare Database' (InStr)\nFunction Base64Decode(ByVal base64String)\n 'rfc1521\n '1999 Antonin Foller, Motobit Software, http://Motobit.cz\n Const Base64 = \"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/\"\n Dim dataLength, sOut, groupBegin\n \n 'remove white spaces, If any\n base64String = Replace(base64String, vbCrLf, \"\")\n base64String = Replace(base64String, vbTab, \"\")\n base64String = Replace(base64String, \" \", \"\")\n \n 'The source must consists from groups with Len of 4 chars\n dataLength = Len(base64String)\n If dataLength Mod 4 <> 0 Then\n Err.Raise 1, \"Base64Decode\", \"Bad Base64 string.\"\n Exit Function\n End If\n\n \n ' Now decode each group:\n For groupBegin = 1 To dataLength Step 4\n Dim numDataBytes, CharCounter, thisChar, thisData, nGroup, pOut\n ' Each data group encodes up To 3 actual bytes.\n numDataBytes = 3\n nGroup = 0\n\n For CharCounter = 0 To 3\n ' Convert each character into 6 bits of data, And add it To\n ' an integer For temporary storage. If a character is a '=', there\n ' is one fewer data byte. (There can only be a maximum of 2 '=' In\n ' the whole string.)\n\n thisChar = Mid(base64String, groupBegin + CharCounter, 1)\n\n If thisChar = \"=\" Then\n numDataBytes = numDataBytes - 1\n thisData = 0\n Else\n thisData = InStr(1, Base64, thisChar, vbBinaryCompare) - 1\n End If\n If thisData = -1 Then\n Err.Raise 2, \"Base64Decode\", \"Bad character In Base64 string.\"\n Exit Function\n End If\n\n nGroup = 64 * nGroup + thisData\n Next\n \n 'Hex splits the long To 6 groups with 4 bits\n nGroup = Hex(nGroup)\n \n 'Add leading zeros\n nGroup = String(6 - Len(nGroup), \"0\") & nGroup\n \n 'Convert the 3 byte hex integer (6 chars) To 3 characters\n pOut = Chr(CByte(\"&H\" & Mid(nGroup, 1, 2))) + _\n Chr(CByte(\"&H\" & Mid(nGroup, 3, 2))) + _\n Chr(CByte(\"&H\" & Mid(nGroup, 5, 2)))\n \n 'add numDataBytes characters To out string\n sOut = sOut & Left(pOut, numDataBytes)\n Next\n\n Base64Decode = sOut\nEnd Function\n\nFunction Base64Encode(inData)\n 'rfc1521\n '2001 Antonin Foller, Motobit Software, http://Motobit.cz\n Const Base64 = \"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/\"\n Dim cOut, sOut, i\n \n 'For each group of 3 bytes\n For i = 1 To Len(inData) Step 3\n Dim nGroup, pOut, sGroup\n \n 'Create one long from this 3 bytes.\n nGroup = &H10000 * Asc(Mid(inData, i, 1)) + _\n &H100 * MyASC(Mid(inData, i + 1, 1)) + MyASC(Mid(inData, i + 2, 1))\n \n 'Oct splits the long To 8 groups with 3 bits\n nGroup = Oct(nGroup)\n \n 'Add leading zeros\n nGroup = String(8 - Len(nGroup), \"0\") & nGroup\n \n 'Convert To base64\n pOut = Mid(Base64, CLng(\"&o\" & Mid(nGroup, 1, 2)) + 1, 1) + _\n Mid(Base64, CLng(\"&o\" & Mid(nGroup, 3, 2)) + 1, 1) + _\n Mid(Base64, CLng(\"&o\" & Mid(nGroup, 5, 2)) + 1, 1) + _\n Mid(Base64, CLng(\"&o\" & Mid(nGroup, 7, 2)) + 1, 1)\n \n 'Add the part To OutPut string\n sOut = sOut + pOut\n \n 'Add a new line For Each 76 chars In dest (76*3/4 = 57)\n 'If (I + 2) Mod 57 = 0 Then sOut = sOut + vbCrLf\n Next\n Select Case Len(inData) Mod 3\n Case 1: '8 bit final\n sOut = Left(sOut, Len(sOut) - 2) + \"==\"\n Case 2: '16 bit final\n sOut = Left(sOut, Len(sOut) - 1) + \"=\"\n End Select\n Base64Encode = sOut\nEnd Function\n\nFunction MyASC(OneChar)\n If OneChar = \"\" Then MyASC = 0 Else MyASC = Asc(OneChar)\nEnd Function\n\n\n" }, { "path": "ModJSON.bas", "content": "Attribute VB_Name = \"ModJSON\"\n'Functions in module:\n'MaxDepth - integer with the maximum depth of the JSON\n'JsonToArray - transforms JSON into an array with an internal tree structure\n'ArrayTable - transforms JsonToArray (internal tree) into a flat table for output\n'Source: https://github.com/krijnsent/crypto_vba\n\nSub TestJson()\n\nDim JsonResponse As String\nDim Json As Object 'Can be dictionary - json starting {} or collection - json starting []\nDim JsonRes As Dictionary\n' Create a new test suite\nDim Suite As New TestSuite\nSuite.Description = \"ModJSON\"\n\n' Create reporter and attach it to these specs\nDim Reporter As New ImmediateReporter\nReporter.ListenTo Suite\n \n' Create a new test\nDim Test As TestCase\nSet Test = Suite.Test(\"TestDepth\")\n'Kraken Time\nJsonResponse = \"{\"\"error\"\":[],\"\"result\"\":{\"\"unixtime\"\":1495455831,\"\"rfc1123\"\":\"\"Mon, 22 May 17 12:23:51 +0000\"\"}}\"\nSet Json = JsonConverter.ParseJson(JsonResponse)\nSet JsonRes = Json(\"result\")\nTestResult = MaxDepth(JsonRes)\nTest.IsEqual TestResult, 1\n\n'Poloniex returnTicker\nJsonResponse = \"{\"\"BTC_BCN\"\":{\"\"id\"\":7,\"\"last\"\":\"\"0.00000210\"\",\"\"lowestAsk\"\":\"\"0.00000210\"\",\"\"highestBid\"\":\"\"0.00000208\"\",\"\"percentChange\"\":\"\"0.73553719\"\",\"\"baseVolume\"\":\"\"26784.80209760\"\",\"\"quoteVolume\"\":\"\"13894501407.13100815\"\",\"\"isFrozen\"\":\"\"0\"\",\"\"high24hr\"\":\"\"0.00000280\"\",\"\"low24hr\"\":\"\"0.00000118\"\"},\"\"BTC_DASH\"\":{\"\"id\"\":24,\"\"last\"\":\"\"0.04775443\"\",\"\"lowestAsk\"\":\"\"0.04781078\"\",\"\"highestBid\"\":\"\"0.04775443\"\",\"\"percentChange\"\":\"\"0.00446825\"\",\"\"baseVolume\"\":\"\"2884.45152468\"\",\"\"quoteVolume\"\":\"\"60634.59565660\"\",\"\"isFrozen\"\":\"\"0\"\",\"\"high24hr\"\":\"\"0.05035290\"\",\"\"low24hr\"\":\"\"0.04430738\"\"}}\"\nSet Json = JsonConverter.ParseJson(JsonResponse)\nTestResult = MaxDepth(Json)\nTest.IsEqual TestResult, 2\n\n'Kraken OHLC\nJsonResponse = \"{\"\"error\"\":[],\"\"result\"\":{\"\"XXBTZEUR\"\":[[1492606800,\"\"1121.990\"\",\"\"1124.912\"\",\"\"1119.680\"\",\"\"1124.912\"\",\"\"1122.345\"\",\"\"352.76808800\"\",602],[1492610400,\"\"1124.499\"\",\"\"1124.980\"\",\"\"1119.680\"\",\"\"1122.000\"\",\"\"1122.194\"\",\"\"218.62127780\"\",713],[1492614000,\"\"1121.311\"\",\"\"1122.900\"\",\"\"1120.501\"\",\"\"1122.899\"\",\"\"1122.266\"\",\"\"445.46426003\"\",851],[1492617600,\"\"1122.894\"\",\"\"1124.499\"\",\"\"1120.710\"\",\"\"1123.291\"\",\"\"1123.068\"\",\"\"253.55336370\"\",860],[1492621200,\"\"1124.406\"\",\"\"1126.000\"\",\"\"1123.017\"\",\"\"1125.990\"\",\"\"1124.775\"\",\"\"234.27612705\"\",918],[1492624800,\"\"1125.610\"\",\"\"1126.231\"\",\"\"1123.010\"\",\"\"1126.229\"\",\"\"1125.453\"\",\"\"243.42246123\"\",772]],\"\"last\"\":1495191600}}\"\nSet Json = JsonConverter.ParseJson(JsonResponse)\nSet JsonRes = Json(\"result\")\nTestResult = MaxDepth(JsonRes)\nTest.IsEqual TestResult, 3\n\n'WEXnz depth\nJsonResponse = \"{\"\"btc_eur\"\":{\"\"asks\"\":[[1919.99999,0.1111724],[1920,0.30236723],[1924.41,0.00601202],[1924.41522,0.009536]]}}\"\nSet Json = JsonConverter.ParseJson(JsonResponse)\nTestResult = MaxDepth(Json)\nTest.IsEqual TestResult, 4\n\n\n'TestJsonToArray\nSet Test = Suite.Test(\"TestJsonToArray\")\n'Kraken Time\nJsonResponse = \"{\"\"error\"\":[],\"\"result\"\":{\"\"unixtime\"\":1495455831,\"\"rfc1123\"\":\"\"Mon, 22 May 17 12:23:51 +0000\"\"}}\"\nSet Json = JsonConverter.ParseJson(JsonResponse)\nSet JsonRes = Json(\"result\")\nTestResult = JsonToArray(JsonRes)\nTest.IsEqual UBound(TestResult, 1), 5\nTest.IsEqual UBound(TestResult, 2), 3\nTest.IsEqual TestResult(3, 2), \"unixtime\"\nTest.IsEqual TestResult(3, 3), \"rfc1123\"\n\n'Poloniex returnTicker\nJsonResponse = \"{\"\"BTC_BCN\"\":{\"\"id\"\":7,\"\"last\"\":\"\"0.00000210\"\",\"\"lowestAsk\"\":\"\"0.00000210\"\",\"\"highestBid\"\":\"\"0.00000208\"\",\"\"percentChange\"\":\"\"0.73553719\"\",\"\"baseVolume\"\":\"\"26784.80209760\"\",\"\"quoteVolume\"\":\"\"13894501407.13100815\"\",\"\"isFrozen\"\":\"\"0\"\",\"\"high24hr\"\":\"\"0.00000280\"\",\"\"low24hr\"\":\"\"0.00000118\"\"},\"\"BTC_DASH\"\":{\"\"id\"\":24,\"\"last\"\":\"\"0.04775443\"\",\"\"lowestAsk\"\":\"\"0.04781078\"\",\"\"highestBid\"\":\"\"0.04775443\"\",\"\"percentChange\"\":\"\"0.00446825\"\",\"\"baseVolume\"\":\"\"2884.45152468\"\",\"\"quoteVolume\"\":\"\"60634.59565660\"\",\"\"isFrozen\"\":\"\"0\"\",\"\"high24hr\"\":\"\"0.05035290\"\",\"\"low24hr\"\":\"\"0.04430738\"\"}}\"\nSet Json = JsonConverter.ParseJson(JsonResponse)\nTestResult = JsonToArray(Json)\nTest.IsEqual UBound(TestResult, 1), 5\nTest.IsEqual UBound(TestResult, 2), 23\nTest.IsEqual TestResult(3, 11), \"high24hr\"\nTest.IsEqual TestResult(4, 14), 24\n\n'Kraken OHLC\nJsonResponse = \"{\"\"error\"\":[],\"\"result\"\":{\"\"XXBTZEUR\"\":[[1492606800,\"\"1121.990\"\",\"\"1124.912\"\",\"\"1119.680\"\",\"\"1124.912\"\",\"\"1122.345\"\",\"\"352.76808800\"\",602],[1492610400,\"\"1124.499\"\",\"\"1124.980\"\",\"\"1119.680\"\",\"\"1122.000\"\",\"\"1122.194\"\",\"\"218.62127780\"\",713],[1492614000,\"\"1121.311\"\",\"\"1122.900\"\",\"\"1120.501\"\",\"\"1122.899\"\",\"\"1122.266\"\",\"\"445.46426003\"\",851],[1492617600,\"\"1122.894\"\",\"\"1124.499\"\",\"\"1120.710\"\",\"\"1123.291\"\",\"\"1123.068\"\",\"\"253.55336370\"\",860],[1492621200,\"\"1124.406\"\",\"\"1126.000\"\",\"\"1123.017\"\",\"\"1125.990\"\",\"\"1124.775\"\",\"\"234.27612705\"\",918],[1492624800,\"\"1125.610\"\",\"\"1126.231\"\",\"\"1123.010\"\",\"\"1126.229\"\",\"\"1125.453\"\",\"\"243.42246123\"\",772]],\"\"last\"\":1495191600}}\"\nSet Json = JsonConverter.ParseJson(JsonResponse)\nSet JsonRes = Json(\"result\")\nTestResult = JsonToArray(JsonRes)\nTest.IsEqual UBound(TestResult, 1), 5\nTest.IsEqual UBound(TestResult, 2), 57\nTest.IsEqual TestResult(3, 11), 8\nTest.IsEqual TestResult(4, 14), \"1124.499\"\n\n'BTCe depth\nJsonResponse = \"{\"\"btc_eur\"\":{\"\"asks\"\":[[1919.99999,0.1111724],[1920,0.30236723],[1924.41,0.00601202],[1924.41522,0.009536]]}}\"\nSet Json = JsonConverter.ParseJson(JsonResponse)\nTestResult = JsonToArray(Json)\nTest.IsEqual UBound(TestResult, 1), 5\nTest.IsEqual UBound(TestResult, 2), 15\nTest.IsEqual TestResult(3, 11), 1\nTest.IsEqual TestResult(4, 14), 1924.41522\n\n\n'TestArrayTable\nSet Test = Suite.Test(\"TestArrayTable\")\n\n'Kraken Time\nJsonResponse = \"{\"\"error\"\":[],\"\"result\"\":{\"\"unixtime\"\":1495455831,\"\"rfc1123\"\":\"\"Mon, 22 May 17 12:23:51 +0000\"\"}}\"\nSet Json = JsonConverter.ParseJson(JsonResponse)\nSet JsonRes = Json(\"result\")\nResArr = JsonToArray(JsonRes)\nTestResult = ArrayTable(ResArr, True)\nTest.IsEqual UBound(TestResult, 1), 2\nTest.IsEqual UBound(TestResult, 2), 2\nTest.IsEqual TestResult(1, 1), \"unixtime\"\nTest.IsEqual TestResult(2, 2), \"Mon, 22 May 17 12:23:51 +0000\"\n\n'Poloniex returnTicker\nJsonResponse = \"{\"\"BTC_BCN\"\":{\"\"id\"\":7,\"\"last\"\":\"\"0.00000210\"\",\"\"lowestAsk\"\":\"\"0.00000210\"\",\"\"highestBid\"\":\"\"0.00000208\"\",\"\"percentChange\"\":\"\"0.73553719\"\",\"\"baseVolume\"\":\"\"26784.80209760\"\",\"\"quoteVolume\"\":\"\"13894501407.13100815\"\",\"\"isFrozen\"\":\"\"0\"\",\"\"high24hr\"\":\"\"0.00000280\"\",\"\"low24hr\"\":\"\"0.00000118\"\"},\"\"BTC_DASH\"\":{\"\"id\"\":24,\"\"last\"\":\"\"0.04775443\"\",\"\"lowestAsk\"\":\"\"0.04781078\"\",\"\"highestBid\"\":\"\"0.04775443\"\",\"\"percentChange\"\":\"\"0.00446825\"\",\"\"baseVolume\"\":\"\"2884.45152468\"\",\"\"quoteVolume\"\":\"\"60634.59565660\"\",\"\"isFrozen\"\":\"\"0\"\",\"\"high24hr\"\":\"\"0.05035290\"\",\"\"low24hr\"\":\"\"0.04430738\"\"}}\"\nSet Json = JsonConverter.ParseJson(JsonResponse)\nResArr = JsonToArray(Json)\nTestResult = ArrayTable(ResArr, True)\nTest.IsEqual UBound(TestResult, 1), 11\nTest.IsEqual UBound(TestResult, 2), 3\nTest.IsEqual TestResult(1, 2), \"BTC_BCN\"\nTest.IsEqual TestResult(3, 3), \"0.04775443\"\n\n'Kraken OHLC\nJsonResponse = \"{\"\"error\"\":[],\"\"result\"\":{\"\"XXBTZEUR\"\":[[1492606800,\"\"1121.990\"\",\"\"1124.912\"\",\"\"1119.680\"\",\"\"1124.912\"\",\"\"1122.345\"\",\"\"352.76808800\"\",602],[1492610400,\"\"1124.499\"\",\"\"1124.980\"\",\"\"1119.680\"\",\"\"1122.000\"\",\"\"1122.194\"\",\"\"218.62127780\"\",713],[1492614000,\"\"1121.311\"\",\"\"1122.900\"\",\"\"1120.501\"\",\"\"1122.899\"\",\"\"1122.266\"\",\"\"445.46426003\"\",851],[1492617600,\"\"1122.894\"\",\"\"1124.499\"\",\"\"1120.710\"\",\"\"1123.291\"\",\"\"1123.068\"\",\"\"253.55336370\"\",860],[1492621200,\"\"1124.406\"\",\"\"1126.000\"\",\"\"1123.017\"\",\"\"1125.990\"\",\"\"1124.775\"\",\"\"234.27612705\"\",918],[1492624800,\"\"1125.610\"\",\"\"1126.231\"\",\"\"1123.010\"\",\"\"1126.229\"\",\"\"1125.453\"\",\"\"243.42246123\"\",772]],\"\"last\"\":1495191600}}\"\nSet Json = JsonConverter.ParseJson(JsonResponse)\nSet JsonRes = Json(\"result\")\nResArr = JsonToArray(Json)\nTestResult = ArrayTable(ResArr, True)\nTest.IsEqual UBound(TestResult, 1), 11\nTest.IsEqual UBound(TestResult, 2), 7\nTest.IsEqual TestResult(1, 2), \"result\"\nTest.IsEqual TestResult(4, 4), 1492614000\n\n'BTCe depth\nJsonResponse = \"{\"\"btc_eur\"\":{\"\"asks\"\":[[1919.99999,0.1111724],[1920,0.30236723],[1924.41,0.00601202],[1924.41522,0.009536]]}}\"\nSet Json = JsonConverter.ParseJson(JsonResponse)\nResArr = JsonToArray(Json)\nTestResult = ArrayTable(ResArr, True)\nTest.IsEqual UBound(TestResult, 1), 5\nTest.IsEqual UBound(TestResult, 2), 5\nTest.IsEqual TestResult(1, 2), \"btc_eur\"\nTest.IsEqual TestResult(4, 4), 1924.41\n\n'Poloniex deposit/withdrawal, no header output\nJsonResponse = \"{\"\"deposits\"\":[{\"\"currency\"\":\"\"BTC\"\",\"\"address\"\":\"\"DEP1\"\",\"\"amount\"\":\"\"0.01006132\"\",\"\"confirmations\"\":10,\"\"txid\"\":\"\"17f819a91369a9ff6c4a34216d434597cfc1b4a3d0489b46bd6f924137a47701\"\",\"\"timestamp\"\":1399305798,\"\"status\"\":\"\"COMPLETE\"\"},{\"\"currency\"\":\"\"BTC\"\",\"\"address\"\":\"\"DEP2\"\",\"\"amount\"\":\"\"0.00404104\"\",\"\"confirmations\"\":10,\"\"txid\"\":\"\"7acb90965b252e55a894b535ef0b0b65f45821f2899e4a379d3e43799604695c\"\",\"\"timestamp\"\":1399245916,\"\"status\"\":\"\"COMPLETE\"\"}],\"\"withdrawals\"\":[{\"\"withdrawalNumber\"\":134933,\"\"currency\"\":\"\"BTC\"\",\"\"address\"\":\"\"1N2i5n8DwTGzUq2Vmn9TUL8J1vdr1XBDFg\"\",\"\"amount\"\":\"\"5.00010000\"\", \"\"timestamp\"\":1399267904,\"\"status\"\":\"\"COMPLETE: 36e483efa6aff9fd53a235177579d98451c4eb237c210e66cd2b9a2d4a988f8e\"\",\"\"ipAddress\"\":\"\"IP192\"\"}]}\"\nSet Json = JsonConverter.ParseJson(JsonResponse)\nResArr = JsonToArray(Json)\nTestResult = ArrayTable(ResArr, False)\nTest.IsEqual UBound(TestResult, 1), 11\nTest.IsEqual UBound(TestResult, 2), 3\nTest.IsEqual TestResult(1, 2), \"deposits\"\nTest.IsEqual TestResult(4, 2), \"DEP2\"\n\n'Test no header reply\nJsonResponse = \"{\"\"error\"\":[],\"\"result\"\":{\"\"XXBTZEUR\"\":[[1492606800,\"\"1121.990\"\",\"\"1124.912\"\",\"\"1119.680\"\",\"\"1124.912\"\",\"\"1122.345\"\",\"\"352.76808800\"\",602],[1492610400,\"\"1124.499\"\",\"\"1124.980\"\",\"\"1119.680\"\",\"\"1122.000\"\",\"\"1122.194\"\",\"\"218.62127780\"\",713],[1492614000,\"\"1121.311\"\",\"\"1122.900\"\",\"\"1120.501\"\",\"\"1122.899\"\",\"\"1122.266\"\",\"\"445.46426003\"\",851],[1492617600,\"\"1122.894\"\",\"\"1124.499\"\",\"\"1120.710\"\",\"\"1123.291\"\",\"\"1123.068\"\",\"\"253.55336370\"\",860],[1492621200,\"\"1124.406\"\",\"\"1126.000\"\",\"\"1123.017\"\",\"\"1125.990\"\",\"\"1124.775\"\",\"\"234.27612705\"\",918],[1492624800,\"\"1125.610\"\",\"\"1126.231\"\",\"\"1123.010\"\",\"\"1126.229\"\",\"\"1125.453\"\",\"\"243.42246123\"\",772]],\"\"last\"\":1495191600}}\"\nSet Json = JsonConverter.ParseJson(JsonResponse)\nSet JsonRes = Json(\"result\")\nResArr = JsonToArray(Json)\nTestResult = ArrayTable(ResArr, False)\nTest.IsEqual UBound(TestResult, 1), 11\nTest.IsEqual UBound(TestResult, 2), 6\nTest.IsEqual TestResult(1, 2), \"result\"\nTest.IsEqual TestResult(4, 2), 1492610400\n\n'Empty data set returned 1\nJsonResponse = \"{\"\"success\"\":true,\"\"message\"\":\"\"\"\",\"\"result\"\":[]}\"\nSet Json = JsonConverter.ParseJson(JsonResponse)\nResArr = JsonToArray(Json)\nTestResult = ArrayTable(ResArr, True)\nTest.IsEqual UBound(TestResult, 1), 3\nTest.IsEqual UBound(TestResult, 2), 2\nTest.IsEqual TestResult(1, 2), True\nTest.IsEqual TestResult(3, 2), 0\n\n'Empty data set returned 2\nJsonResponse = \"{\"\"success\"\":false,\"\"message\"\":\"\"APISIGN_NOT_PROVIDED\"\",\"\"result\"\":null}\"\nSet Json = JsonConverter.ParseJson(JsonResponse)\nResArr = JsonToArray(Json)\nTestResult = ArrayTable(ResArr, True)\nTest.IsEqual UBound(TestResult, 1), 3\nTest.IsEqual UBound(TestResult, 2), 2\nTest.IsEqual TestResult(1, 2), False\nTest.IsEqual TestResult(2, 2), \"APISIGN_NOT_PROVIDED\"\n\n'Error set - only if Json is defined as Dictionary, as Object is okay\nJsonResponse = \"[{\"\"balance\"\":0,\"\"pendingFunds\"\":0,\"\"currency\"\":\"\"BCH\"\"},{\"\"balance\"\":41,\"\"pendingFunds\"\":0,\"\"currency\"\":\"\"AUD\"\"},{\"\"balance\"\":145,\"\"pendingFunds\"\":0,\"\"currency\"\":\"\"BTC\"\"},{\"\"balance\"\":0,\"\"pendingFunds\"\":0,\"\"currency\"\":\"\"LTC\"\"}]\"\nSet Json = JsonConverter.ParseJson(JsonResponse)\nResArr = JsonToArray(Json)\nTestResult = ArrayTable(ResArr, True)\nTest.IsEqual UBound(TestResult, 1), 4\nTest.IsEqual UBound(TestResult, 2), 5\nTest.IsEqual TestResult(2, 3), 41\nTest.IsEqual TestResult(4, 4), \"BTC\"\n\n'NEW TEST, UNFINISHED\nPrTxt = \"{\"\"ret_msg\"\": \"\"ok\"\",\"\"ext_code\"\": \"\"\"\",\"\"result\"\": {\"\"BTCUSD\"\": {\"\"leverage\"\": 1},\"\"EOSUSD\"\": {\"\"leverage\"\": 1}},\"\"time_now\"\": \"\"1567608910.732004\"\"}\"\nSet Json = JsonConverter.ParseJson(PrTxt)\nSet Res1 = Json(\"result\")\n'Res2 = json(\"result\") '-> error, doesn't work...\nFor Each elm In Json(\"result\")\n 'Debug.Print elm\n 'Debug.Print json(\"result\")(elm)\n Set Res3 = Json(\"result\")(elm)\n 'Debug.Print json(\"result\")(elm)(\"leverage\")\nNext elm\n\n\nEnd Sub\n\nFunction MaxDepth(ObjIn As Object, Optional MaxLvl As Integer = 1, Optional NodeLvl As Integer = 1) As Integer\n \n Dim CollIn As New Collection\n Dim DictIn As New Scripting.Dictionary\n Dim iO As Object\n Dim Lvl As Integer\n \n If TypeName(ObjIn) = \"Collection\" Then\n 'arrays ([]) to collections, arrays only have values\n Set CollIn = ObjIn\n For i = 1 To CollIn.Count\n 'item could be value, object or array, determine:\n Set iO = Nothing\n On Error Resume Next\n Set iO = CollIn(i)\n On Error GoTo 0\n\n 'item/value\n If Not (iO Is Nothing) Then\n If NodeLvl + 1 > MaxLvl Then MaxLvl = NodeLvl + 1\n NextLvl = MaxDepth(iO, MaxLvl, NodeLvl + 1)\n End If\n Next i\n ElseIf TypeName(ObjIn) = \"Dictionary\" Then\n 'objects ({}) to dictionaries, Objects have key:values\n Set DictIn = ObjIn\n For Each k In DictIn.Keys\n 'item could be value, object or array, determine:\n IV = \"\"\n Set iO = Nothing\n On Error Resume Next\n IV = DictIn(k)\n Set iO = DictIn(k)\n On Error GoTo 0\n \n 'item/value\n If Not (iO Is Nothing) Then\n If NodeLvl + 1 > MaxLvl Then MaxLvl = NodeLvl + 1\n NextLvl = MaxDepth(iO, MaxLvl, NodeLvl + 1)\n End If\n Next k\n End If\n \n MaxDepth = MaxLvl\n \nEnd Function\n\n\n\nFunction JsonToArray(ObjIn As Object, Optional ParentKey As String = \"MAIN\", Optional NodeLvl As Integer = 1, Optional ResArr As Variant) As Variant\n 'Dim TempResArr() As Variant\n \n If IsMissing(ResArr) Then\n ReDim ResArr(1 To 5, 1 To 1)\n ResArr(1, 1) = \"NODE_LVL\"\n ResArr(2, 1) = \"PARENT\"\n ResArr(3, 1) = \"KEY\"\n ResArr(4, 1) = \"VALUE\"\n ResArr(5, 1) = \"TYPE\"\n End If\n\n Dim CollIn As New Collection\n Dim DictIn As New Scripting.Dictionary\n Dim iO As Object\n Dim CurK As String\n Dim Lvl As Integer\n \n If TypeName(ObjIn) = \"Collection\" Then\n 'arrays ([]) to collections, arrays only have values\n Set CollIn = ObjIn\n For i = 1 To CollIn.Count\n 'item could be value, object or array, determine:\n IV = \"\"\n Set iO = Nothing\n On Error Resume Next\n IV = CollIn(i)\n Set iO = CollIn(i)\n On Error GoTo 0\n\n 'item/value\n If Not (iO Is Nothing) Then\n 'Collection or Array, store and go one level deeper\n ReDim Preserve ResArr(1 To 5, 1 To UBound(ResArr, 2) + 1)\n ResArr(1, UBound(ResArr, 2)) = NodeLvl\n ResArr(2, UBound(ResArr, 2)) = ParentKey\n ResArr(3, UBound(ResArr, 2)) = i\n ResArr(4, UBound(ResArr, 2)) = iO.Count\n ResArr(5, UBound(ResArr, 2)) = \"OBJ\"\n 'Debug.Print \"LVL: \" & NodeLvl & \", PARENT: \" & ParentKey & \" , KEY: \" & I & \" VALUE: count: \" & iO.Count & \" , TYPE:OBJ\"\n ParentKey = i\n NextLvl = JsonToArray(iO, Str(i), NodeLvl + 1, ResArr)\n Else\n 'item, write simple value\n 'Debug.Print \"LVL: \" & NodeLvl & \", PARENT: \" & ParentKey & \" , KEY: \" & I & \" VALUE:\" & iV & \" , TYPE:VAL\"\n ReDim Preserve ResArr(1 To 5, 1 To UBound(ResArr, 2) + 1)\n ResArr(1, UBound(ResArr, 2)) = NodeLvl\n ResArr(2, UBound(ResArr, 2)) = ParentKey\n ResArr(3, UBound(ResArr, 2)) = i\n ResArr(4, UBound(ResArr, 2)) = IV\n ResArr(5, UBound(ResArr, 2)) = \"VAL\"\n End If\n Next i\n ElseIf TypeName(ObjIn) = \"Dictionary\" Then\n 'objects ({}) to dictionaries, Objects have key:values\n Set DictIn = ObjIn\n For Each k In DictIn.Keys\n 'item could be value, object or array, determine:\n IV = \"\"\n Set iO = Nothing\n On Error Resume Next\n IV = DictIn(k)\n Set iO = DictIn(k)\n On Error GoTo 0\n \n 'item/value\n If Not (iO Is Nothing) Then\n 'Collection or Array, store and go one level deeper\n 'Debug.Print \"LVL: \" & NodeLvl & \", PARENT: \" & ParentKey & \" , KEY: \" & k & \" VALUE: count: \" & iO.Count & \" , TYPE:OBJ\"\n ReDim Preserve ResArr(1 To 5, 1 To UBound(ResArr, 2) + 1)\n ResArr(1, UBound(ResArr, 2)) = NodeLvl\n ResArr(2, UBound(ResArr, 2)) = ParentKey\n ResArr(3, UBound(ResArr, 2)) = k\n ResArr(4, UBound(ResArr, 2)) = iO.Count\n ResArr(5, UBound(ResArr, 2)) = \"OBJ\"\n CurK = k\n NextLvl = JsonToArray(iO, CurK, NodeLvl + 1, ResArr)\n Else\n 'item, write simple value\n 'Debug.Print \"LVL: \" & NodeLvl & \", PARENT: \" & ParentKey & \" , KEY: \" & k & \" VALUE:\" & iV & \" , TYPE:VAL\"\n ReDim Preserve ResArr(1 To 5, 1 To UBound(ResArr, 2) + 1)\n ResArr(1, UBound(ResArr, 2)) = NodeLvl\n ResArr(2, UBound(ResArr, 2)) = ParentKey\n ResArr(3, UBound(ResArr, 2)) = k\n ResArr(4, UBound(ResArr, 2)) = IV\n ResArr(5, UBound(ResArr, 2)) = \"VAL\"\n End If\n Next k\n End If\n \n JsonToArray = ResArr\n\nEnd Function\nFunction ArrayTable(ArrIn As Variant, Optional ReturnHeader As Boolean = True) As Variant\n\n'Expected input: NODE_LVL -- PARENT -- KEY -- VALUE -- TYPE\nDim NrIt As Integer\nDim MaxD As Integer\nDim TblHeaders As New Scripting.Dictionary\n\n'Get max depth and max items at that level\nMaxD = 0\n'Find maximum depth\nFor rw = LBound(ArrIn, 2) To UBound(ArrIn, 2)\n If Val(ArrIn(1, rw)) > MaxD Then\n MaxD = ArrIn(1, rw)\n End If\nNext\n\n'Get unique headers\nOn Error Resume Next\nFor rw = LBound(ArrIn, 2) To UBound(ArrIn, 2)\n Lvl = Val(ArrIn(1, rw))\n If Lvl < MaxD And Lvl > 0 Then\n TblHeaders.Add \"GROUP_\" & Lvl, \"GROUP_\" & Lvl\n 'ElseIf Lvl = MaxD And ArrIn(5, rw) = \"VAL\" Then\n ElseIf Lvl = MaxD Then\n If Val(ArrIn(3, rw)) > 0 Then\n TblHeaders.Add \"VAL_\" & ArrIn(3, rw), \"VAL_\" & ArrIn(3, rw)\n Else\n TblHeaders.Add ArrIn(3, rw), ArrIn(3, rw)\n End If\n End If\nNext\nOn Error GoTo 0\n\nIf ReturnHeader = True Then\n HeadRw = 1\nElse\n HeadRw = 0\nEnd If\nReDim ResArr(1 To TblHeaders.Count, 1 To 1 + HeadRw)\n\nTempRw = 0\nResRw = 1 + HeadRw\n\nFor rw = LBound(ArrIn, 2) To UBound(ArrIn, 2)\n Lvl = Val(ArrIn(1, rw))\n If rw < UBound(ArrIn, 2) Then\n NextLvl = Val(ArrIn(1, rw + 1))\n Else\n NextLvl = 0\n End If\n If Lvl = MaxD Then\n 'Get result column\n Idx = 0\n If Val(ArrIn(3, rw)) > 0 Then\n Idx = Application.Match(\"VAL_\" & ArrIn(3, rw), TblHeaders.Keys, 0)\n If ReturnHeader = True Then\n ResArr(Idx, 1) = \"VAL_\" & ArrIn(3, rw)\n End If\n Else\n Idx = Application.Match(ArrIn(3, rw), TblHeaders.Keys, 0)\n If ReturnHeader = True Then\n ResArr(Idx, 1) = ArrIn(3, rw)\n End If\n End If\n \n ResArr(Idx, ResRw) = ArrIn(4, rw)\n For k = 1 To Lvl\n If IsEmpty(ResArr(k, ResRw)) Then ResArr(k, ResRw) = ResArr(k, ResRw - 1)\n Next k\n TempRw = TempRw + 1\n If rw < UBound(ArrIn, 2) And NextLvl < Lvl Then\n TempRw = 0\n ResRw = ResRw + 1\n ReDim Preserve ResArr(1 To TblHeaders.Count, 1 To ResRw)\n End If\n ElseIf Lvl > 0 Then\n If ReturnHeader = True Then\n ResArr(Lvl, 1) = \"GROUP_\" & Lvl\n End If\n ResArr(Lvl, ResRw) = ArrIn(3, rw)\n End If\nNext\n\n'Strip last line if that wasn't a max depth record\nIf Lvl < MaxD Then\n ReDim Preserve ResArr(1 To TblHeaders.Count, 1 To ResRw - 1)\nEnd If\nArrayTable = ResArr\n\nEnd Function\n" }, { "path": "ModSrcCoinGecko.bas", "content": "Attribute VB_Name = \"ModSrcCoinGecko\"\n'Two variables for caching, so the formulas don't update every recalculation\nPublic Const CGCacheSeconds = 6000 'Nr of seconds cache, default >= 60\nPublic CGDict As New Scripting.Dictionary\n\nSub TestSrcCoinGecko()\n\n'https://www.coingecko.com/en/api\n'https://www.coingecko.com/api/documentations/v3\n\n' Create a new test suite\nDim Suite As New TestSuite\nSuite.Description = \"ModSrcCoinGecko\"\n' Create reporter and attach it to these specs\nDim Reporter As New ImmediateReporter\nReporter.ListenTo Suite\n' Create a new test\nDim Test As TestCase\nSet Test = Suite.Test(\"TestPublicCoinGeckoData\")\n\n'Test for errors first\nTestResult = PublicCoinGeckoData(\"unknown_command\")\n'{\"error_nr\":404,\"error_txt\":\"HTTP-Not Found\",\"response_txt\":{\"error\":\"Incorrect path. Please check https://www.coingecko.com/api/\"}}\nTest.IsOk InStr(TestResult, \"error\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"error_nr\"), 404\n'Test.IsEqual JsonResult(\"response_txt\")(\"error\"), \"Incorrect path. Please check https://www.coingecko.com/api/\"\n\n'Simple ping\nTestResult = PublicCoinGeckoData(\"ping\")\n'{\"gecko_says\":\"(V3) To the Moon!\"}\nTest.IsOk InStr(TestResult, \"gecko\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"gecko_says\"), \"(V3) To the Moon!\"\n\n'Simple price\nDim Params As New Dictionary\nParams.Add \"ids\", \"bitcoin\"\nParams.Add \"vs_currencies\", \"eur\"\nTestResult = PublicCoinGeckoData(\"simple/price\", Params)\n'e.g. {\"bitcoin\":{\"eur\":7272.72}}\nTest.IsOk InStr(TestResult, \"bitcoin\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsOk JsonResult(\"bitcoin\")(\"eur\") > 0\n\n\nEnd Sub\n\nFunction PublicCoinGeckoData(Method As String, Optional ParamDict As Dictionary) As String\n\nDim url As String\nDim TempData As String\nDim Sec As Double\n\nPublicApiSite = \"https://api.coingecko.com/api/v3\"\n\nMethodParams = \"\"\nIf Not ParamDict Is Nothing Then\n 'Change the rest of the parameters to JSON\n MethodParams = DictToString(ParamDict, \"URLENC\")\n If MethodParams <> \"\" Then MethodParams = \"?\" & MethodParams\nEnd If\n\nurlPath = Method & MethodParams\nurl = PublicApiSite & \"/\" & urlPath\n\nGetNewData = False\nIsInDict = CGDict.Exists(urlPath)\nIf IsInDict = True Then\n 'In dictionary, check time\n If CGDict(urlPath) + TimeSerial(0, 0, CGCacheSeconds) < Now() Then\n 'Has not been updated recently, update now\n CGDict.Remove urlPath\n CGDict.Add urlPath, Now()\n If CGDict.Exists(\"DATA-\" & urlPath) Then CGDict.Remove \"DATA-\" & urlPath\n GetNewData = True\n End If\nElse\n CGDict.Add urlPath, Now()\n GetNewData = True\nEnd If\n\nIf GetNewData = True Then\n TempData = WebRequestURL(url, \"GET\")\n CGDict.Add \"DATA-\" & urlPath, TempData\nElse\n TempData = CGDict(\"DATA-\" & urlPath)\nEnd If\n\nPublicCoinGeckoData = TempData\n\nEnd Function\n" }, { "path": "ModSrcCryptocompare.bas", "content": "Attribute VB_Name = \"ModSrcCryptocompare\"\n'Two variables for caching, so the formulas don't update every recalculation\nPublic Const CCCacheSeconds = 3000 'Nr of seconds cache, default >= 60\nPublic CCDict As New Scripting.Dictionary\n\nSub TestSrcCryptocompare()\n\n'This module contains functions to use in a sheet or in VBA\n'Source: https://github.com/krijnsent/crypto_vba\n'Note: the functions currently slow down the sheets massively, use max 10 functions per workbook, otherwise your workbook might CRASH\n'ToDo: better error catching\n'For cryptocompare, please get a free API key at https://www.cryptocompare.com\n\n'Functions in this module:\n'C_LAST_PRICE - price?fsym=BTC&tsyms=USD,EUR&e=Coinbase\n'C_HIST_PRICE - pricehistorical?fsym=BTC&tsyms=USD,EUR&e=Coinbase&ts=1452680400\n'C_DAY_AVG_PRICE - dayAvg?fsym=BTC&tsym=USD&toTs=1487116800&e=Bitfinex\n'C_ARR_OHLCV - histoday?fsym=GBP&tsym=USD&limit=30&aggregate=1&e=CCCAGG\n\nDim Apikey As String\nApikey = \"your_api_key_here\" 'empty if you don't use an API key\n\n'Remove this line, unless you define a constant somewhere ( Public Const apikey_cryptocompare = \"the key to use everywhere\" etc )\nApikey = apikey_cryptocompare\n\n' Create a new test suite\nDim Suite As New TestSuite\nSuite.Description = \"ModSrcCryptocompare\"\n' Create reporter and attach it to these specs\nDim Reporter As New ImmediateReporter\nReporter.ListenTo Suite\n' Create a new test\nDim Test As TestCase\nSet Test = Suite.Test(\"TestPublicCryptoCompareData\")\n\n'Error, unknown command\nTestResult = PublicCryptoCompareData(\"unknown_command\")\nTest.IsOk InStr(TestResult, \"Error\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"Response\"), \"Error\"\nTest.IsEqual JsonResult(\"Message\"), \"Path does not exist\"\nTest.IsEqual JsonResult(\"Path\"), \"\"\n\n'Error, no parameters\nTestResult = PublicCryptoCompareData(\"data/histoday\")\nTest.IsOk InStr(TestResult, \"Error\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"Response\"), \"Error\"\nTest.IsEqual JsonResult(\"Message\"), \"fsym is a required param.\"\nTest.IsEqual JsonResult(\"Path\"), \"\"\n\n'Error, create a dictionary with ONLY the parameter fsym\nDim Params As New Dictionary\nParams.Add \"fsym\", \"BTC\"\nTestResult = PublicCryptoCompareData(\"data/histoday\", Params)\nTest.IsOk InStr(TestResult, \"Error\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"Response\"), \"Error\"\nTest.IsEqual JsonResult(\"Message\"), \"tsym is a required param.\"\nTest.IsEqual JsonResult(\"Path\"), \"\"\n\n'Error, add to the same dictionary an unknown tsym\nParams.Add \"tsym\", \"BLABLA\"\nTestResult = PublicCryptoCompareData(\"data/histoday\", Params)\nTest.IsOk InStr(TestResult, \"Error\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"Response\"), \"Error\"\nTest.IsEqual JsonResult(\"Message\"), \"There is no data for the toSymbol BLABLA .\"\nTest.IsEqual JsonResult(\"Path\"), \"\"\n\n'OK, two correct parameters for histoday, make a new dictionary\nDim Params2 As New Dictionary\nParams2.Add \"fsym\", \"BTC\"\nParams2.Add \"tsym\", \"XMR\"\nTestResult = PublicCryptoCompareData(\"data/histoday\", Params2)\nTest.IsOk InStr(TestResult, \"Success\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"Response\"), \"Success\"\nTest.IsEqual JsonResult(\"Message\"), \"\"\nTest.IsEqual JsonResult(\"Path\"), \"\"\nTest.IsOk JsonResult(\"Data\")(1)(\"high\") > 0\n\n'Tests for APIkey (please get a free key at Cryptocompare.com)\n'This test fails, as API key is needed:\nTestResult = PublicCryptoCompareData(\"data/social/coin/latest\")\n'{\"Response\":\"Error\",\"Message\":\"You need a valid auth key or api key to access this endpoint\",\"HasWarning\":false,\"Type\":1,\"RateLimit\":{},\"Data\":{}}\nTest.IsOk InStr(TestResult, \"Error\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"Response\"), \"Error\"\nTest.IsEqual JsonResult(\"Message\"), \"You need a valid auth key or api key to access this endpoint\"\nTest.IsEqual JsonResult(\"Type\"), 1\n\n'Add an API key and force caching off\nDim Params3 As New Dictionary\nParams3.Add \"apikey\", Apikey\nTestResult = PublicCryptoCompareData(\"data/social/coin/latest\", Params3)\n'{\"Response\":\"Success\",\"Message\":\"\",\"HasWarning\":false,\"Type\":100,\"RateLimit\":{},\"Data\":{\"General\":{\"Points\":8212774,\"Name\":\"BTC\",\"CoinName\":\"Bitcoin\",\"Type\":\"Webpagecoinp\"},\"CryptoCompare\":{\"Points\":6898505, etc...\nTest.IsOk InStr(TestResult, \"Success\") > 0\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"Response\"), \"Success\"\nTest.IsEqual JsonResult(\"Message\"), \"\"\nTest.IsEqual JsonResult(\"Type\"), 100\nIf JsonResult(\"Type\") = 100 Then\n Test.IsEqual JsonResult(\"Data\")(\"General\")(\"Name\"), \"BTC\"\nEnd If\n\n'Rate limit WITHOUT an API key: 600/minute\nTestResult = PublicCryptoCompareData(\"stats/rate/limit\")\n'{\"Response\":\"Success\",\"Message\":\"\",\"HasWarning\":false,\"Type\":100,\"RateLimit\":{},\"Data\":{\"calls_made\":{\"second\":1,\"minute\":10,\"hour\":138,\"day\":475,\"month\":4113},\"calls_left\":{\"second\":49,\"minute\":990,\"hour\":19862,\"day\":199525,\"month\":1995887}}}\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"Response\"), \"Success\"\nIf JsonResult(\"Response\") = \"Success\" Then\n Test.IsEqual JsonResult(\"Data\")(\"calls_made\")(\"minute\") + JsonResult(\"Data\")(\"calls_left\")(\"minute\"), 300\nEnd If\n\n'Rate limit WITH an API key: 2500/minute\nTestResult = PublicCryptoCompareData(\"stats/rate/limit\", Params3)\n'{\"Response\":\"Success\",\"Message\":\"\",\"HasWarning\":false,\"Type\":100,\"RateLimit\":{},\"Data\":{\"calls_made\":{\"second\":2,\"minute\":2,\"hour\":21,\"day\":33,\"month\":33},\"calls_left\":{\"second\":48,\"minute\":2498,\"hour\":24979,\"day\":49967,\"month\":99967}}}\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"Response\"), \"Success\"\nIf JsonResult(\"Response\") = \"Success\" Then\n Test.IsEqual JsonResult(\"Data\")(\"calls_made\")(\"minute\") + JsonResult(\"Data\")(\"calls_left\")(\"minute\"), 2500\nEnd If\n\n\nSet Test = Suite.Test(\"TestC_LAST_PRICE\")\nJsonResult = C_LAST_PRICE(\"MYCOIN1\", \"BLABLA\")\nTest.IsEqual JsonResult, \"ERROR cccagg_or_exchange market does not exist for this coin pair (MYCOIN1-BLABLA)\"\n\nJsonResult = C_LAST_PRICE(\"BTC\", \"BLABLA\")\nTest.IsEqual JsonResult, \"ERROR cccagg_or_exchange market does not exist for this coin pair (BTC-BLABLA)\"\n\nJsonResult = C_LAST_PRICE(\"BTC\", \"EUR\", \"An_Unknown_Exchange\")\nTest.IsEqual JsonResult, \"ERROR an_unknown_exchange market does not exist for this coin pair (BTC-EUR)\"\n\nJsonResult = C_LAST_PRICE(\"BTC\", \"EUR\")\nTest.IsOk JsonResult > 0\n\nJsonResult = C_LAST_PRICE(\"BTC\", \"EUR\", \"Kraken\")\nTest.IsOk JsonResult > 0\n\n'Optional, add an apikey, only affects the rate limit for this function\nJsonResult = C_LAST_PRICE(\"BTC\", \"USD\", \"Bittrex\", Apikey)\nTest.IsOk JsonResult > 0\n\n\nSet Test = Suite.Test(\"TestC_HIST_PRICE\")\nJsonResult = C_HIST_PRICE(\"ETH\", \"USD\", \"2018-01-01 20:00\")\nTest.IsOk JsonResult > 0\nJsonResult = C_HIST_PRICE(\"ETH\", \"USD\", #1/1/2018#, \"Bittrex\")\nTest.IsOk JsonResult > 0\n'Optional, add an apikey, only affects the rate limit for this function\nJsonResult = C_HIST_PRICE(\"ETH\", \"USD\", #1/1/2019#, , Apikey)\nTest.IsOk JsonResult > 0\n\n\nSet Test = Suite.Test(\"TestC_DAY_AVG_PRICE\")\nJsonResult = C_DAY_AVG_PRICE(\"ETH\", \"BTC\", #1/1/2017#)\nTest.IsOk JsonResult > 0\nJsonResult = C_DAY_AVG_PRICE(\"ETH\", \"BTC\", #1/1/2017#, \"Poloniex\")\nTest.IsOk JsonResult > 0\n'Optional, add an apikey, only affects the rate limit for this function\nJsonResult = C_DAY_AVG_PRICE(\"XMR\", \"BTC\", #10/1/2018#, , Apikey)\nTest.IsOk JsonResult > 0\n\n\nSet Test = Suite.Test(\"TestC_ARR_OHLCV\")\n'Function C_ARR_OHLCV(\n'DayHour as String, CurrBuy As String, CurrSell As String, ReturnColumns As String -> ETCHLOFV, Optional NrHours As Long,\n'Optional MaxTimeDate As Date, Optional Exchange As String, Optional exchange As String, Optional ReverseData As Boolean,\n'Optional Apikey As String) As Variant()\n\n'Test for errors first\nTestArr = C_ARR_OHLCV(\"A\", \"2FA\", \"EUR\", \"ECV\")\nTest.IsEqual TestArr(1, 1), \"ERROR, DayHourMin must end with D, H or M\"\n\nTestArr = C_ARR_OHLCV(\"90M\", \"2FA\", \"EUR\", \"ECV\")\nTest.IsEqual TestArr(1, 1), \"ERROR, DayHourMin aggregation has to be from 1 to 60. Valid values are e.g. 7D, 2H or 30M\"\n\nTestArr = C_ARR_OHLCV(\"H\", \"ETH\", \"EUR\", \"\")\nTest.IsEqual TestArr(1, 1), \"ERROR ReturnColumns, use the letters ETHLCOFV\"\n\nTestArr = C_ARR_OHLCV(\"H\", \"BTC\", \"EUR\", \"ABD\")\nTest.IsEqual TestArr(1, 1), \"unknown ReturnColumn\"\nTest.IsEqual TestArr(1, 2), \"unknown ReturnColumn\"\nTest.IsEqual TestArr(1, 3), \"unknown ReturnColumn\"\n\nTestArr = C_ARR_OHLCV(\"H\", \"2FA\", \"EUR\", \"ECV\")\nTest.IsEqual TestArr(1, 1), \"ERROR There is no data for the symbol 2FA .\"\n\nTestArr = C_ARR_OHLCV(\"H\", \"BTC\", \"EUR\", \"TECV\", 48, #1/1/2018#, \"Kraken\")\nTest.IsEqual UBound(TestArr, 1), 50\nTest.IsEqual UBound(TestArr, 2), 4\nTest.IsEqual TestArr(1, 1), \"time\"\nTest.IsEqual TestArr(1, 2), \"time\"\nTest.IsEqual TestArr(1, 3), \"close\"\nTest.IsEqual TestArr(1, 4), \"volumeto\"\nTest.IsEqual TestArr(2, 1), \"1514592000\"\nTest.IsEqual TestArr(2, 2), #12/30/2017#\nTest.IsOk TestArr(2, 3) > 1\nTest.IsOk TestArr(2, 4) > 1\n\nTestArr = C_ARR_OHLCV(\"H\", \"BTC\", \"EUR\", \"EC\", 24, , \"Kraken\")\nTest.IsEqual UBound(TestArr, 1), 26\nTest.IsEqual UBound(TestArr, 2), 2\nTest.IsEqual TestArr(1, 1), \"time\"\nTest.IsEqual TestArr(1, 2), \"close\"\nTest.IsOk TestArr(2, 1) > #12/30/2019#\nTest.IsOk TestArr(2, 2) > 1\n\nTestArr = C_ARR_OHLCV(\"H\", \"XLM\", \"EUR\", \"TEOHLCFV\", 48, DateSerial(2018, 1, 1), \"Kraken\")\nTest.IsEqual UBound(TestArr, 1), 50\nTest.IsEqual UBound(TestArr, 2), 8\nTest.IsEqual TestArr(1, 1), \"time\"\nTest.IsEqual TestArr(1, 8), \"volumeto\"\nTest.IsEqual TestArr(2, 2), #12/30/2017#\nTest.IsEqual TestArr(50, 2), #1/1/2018#\nTest.IsEqual TestArr(50, 3), 0.0145\n\nTestArr = C_ARR_OHLCV(\"4H\", \"XMR\", \"BTC\", \"EC\", 48)\nTest.IsEqual UBound(TestArr, 1), 50\nTest.IsEqual UBound(TestArr, 2), 2\nTest.IsEqual TestArr(1, 1), \"time\"\nTest.IsEqual TestArr(1, 2), \"close\"\nTest.IsOk TestArr(50, 1) > #1/1/2020#\nTest.IsOk TestArr(50, 2) > 0\n\n'Flip the result (newest row on top)\nTestArr = C_ARR_OHLCV(\"H\", \"XLM\", \"EUR\", \"TEOHLCFV\", 24, DateSerial(2019, 1, 1), \"Kraken\", True, Apikey)\nTest.IsEqual UBound(TestArr, 1), 26\nTest.IsEqual UBound(TestArr, 2), 8\nTest.IsEqual TestArr(1, 1), \"time\"\nTest.IsEqual TestArr(1, 8), \"volumeto\"\nTest.IsEqual TestArr(2, 2), #1/1/2019#\nTest.IsEqual TestArr(26, 2), #12/31/2018#\nTest.IsEqual TestArr(26, 3), 0.1022\n\nEnd Sub\n\nFunction PublicCryptoCompareData(Method As String, Optional ParamDict As Dictionary) As String\n\n'For documentation, see: https://min-api.cryptocompare.com/\nDim url As String\nDim Apikey As String\nDim TempData As String\nDim Sec As Double\nDim objHeaders As New Dictionary\n\nPublicApiSite = \"https://min-api.cryptocompare.com/\"\n'Check for API key and move that to the header of the GET request.\nMethodParams = \"\"\nIf Not ParamDict Is Nothing Then\n If ParamDict.Exists(\"apikey\") Then\n 'move to the end\n tempkey = ParamDict(\"apikey\")\n ParamDict.Remove \"apikey\"\n ParamDict.Add (\"api_key\"), tempkey\n End If\n 'Change the rest of the parameters to JSON\n MethodParams = DictToString(ParamDict, \"URLENC\")\n If MethodParams <> \"\" Then MethodParams = \"?\" & MethodParams\nEnd If\n\nurlPath = Method & MethodParams\nurl = PublicApiSite & urlPath\n'Debug.Print Url\n\n'For caching, check if data already exists\nIsInDict = CCDict.Exists(urlPath)\nGetNewData = False\nIf IsInDict = True Then\n 'In dictionary, check time\n If CCDict(urlPath) + TimeSerial(0, 0, CCCacheSeconds) < Now() Or InStr((CCDict(\"DATA-\" & urlPath)), \"Error\") > 0 Then\n 'Has not been updated recently and/or forced no caching, update now\n CCDict.Remove urlPath\n CCDict.Add urlPath, Now()\n If CCDict.Exists(\"DATA-\" & urlPath) Then CCDict.Remove \"DATA-\" & urlPath\n GetNewData = True\n End If\nElse\n CCDict.Add urlPath, Now()\n GetNewData = True\nEnd If\n\nIf GetNewData = True Then\n TempData = WebRequestURL(url, \"GET\", objHeaders)\n CCDict.Add \"DATA-\" & urlPath, TempData\nElse\n TempData = CCDict(\"DATA-\" & urlPath)\nEnd If\n\nPublicCryptoCompareData = TempData\n\nEnd Function\nFunction C_LAST_PRICE(CurrBuy As String, CurrSell As String, Optional exchange As String, Optional Apikey As String)\n\nDim PrTxt As String\nDim Json As Object\nDim ParamDict As New Dictionary\nApplication.Volatile\n\nParamDict.Add (\"fsym\"), CurrBuy\nParamDict.Add (\"tsyms\"), CurrSell\nIf Len(exchange) > 2 Then\n ParamDict.Add (\"e\"), exchange\nEnd If\nIf Len(Apikey) > 0 Then\n ParamDict.Add (\"apikey\"), Apikey\nEnd If\n\nPrTxt = PublicCryptoCompareData(\"data/price\", ParamDict)\nSet Json = JsonConverter.ParseJson(PrTxt)\n\nIf Json(\"Response\") = \"Error\" Then\n 'Error\n C_LAST_PRICE = \"ERROR \" & Json(\"Message\")\nElse\n C_LAST_PRICE = Json(CurrSell)\nEnd If\n\nSet Json = Nothing\n\nEnd Function\n\nFunction C_HIST_PRICE(CurrBuy As String, CurrSell As String, DateRates As Date, Optional exchange As String, Optional Apikey As String)\n\nDim PrTxt As String\nDim Json As Object\nDim ParamDict As New Dictionary\nApplication.Volatile\n\ndt = DateToUnixTime(DateRates)\nParamDict.Add (\"fsym\"), CurrBuy\nParamDict.Add (\"tsyms\"), CurrSell\nParamDict.Add (\"ts\"), dt\nIf Len(exchange) > 2 Then\n ParamDict.Add (\"e\"), exchange\nEnd If\nIf Len(Apikey) > 0 Then\n ParamDict.Add (\"apikey\"), Apikey\nEnd If\n\nPrTxt = PublicCryptoCompareData(\"data/price\", ParamDict)\nSet Json = JsonConverter.ParseJson(PrTxt)\n\nIf Json(\"Response\") = \"Error\" Then\n 'Error\n C_HIST_PRICE = \"ERROR \" & Json(\"Message\")\nElse\n C_HIST_PRICE = Json(CurrSell)\nEnd If\n\nSet Json = Nothing\n\nEnd Function\n\nFunction C_DAY_AVG_PRICE(CurrBuy As String, CurrSell As String, DateRates As Date, Optional exchange As String, Optional Apikey As String)\n\nDim PrTxt As String\nDim Json As Object\nDim ParamDict As New Dictionary\nApplication.Volatile\n\ndt = DateToUnixTime(DateRates)\nParamDict.Add (\"fsym\"), CurrBuy\nParamDict.Add (\"tsym\"), CurrSell\nParamDict.Add (\"toTs\"), dt\nIf Len(exchange) > 2 Then\n ParamDict.Add (\"e\"), exchange\nEnd If\nIf Len(Apikey) > 0 Then\n ParamDict.Add (\"apikey\"), Apikey\nEnd If\n\nPrTxt = PublicCryptoCompareData(\"data/dayAvg\", ParamDict)\nSet Json = JsonConverter.ParseJson(PrTxt)\n\nIf Json(\"Response\") = \"Error\" Then\n 'Error\n C_DAY_AVG_PRICE = \"ERROR \" & Json(\"Message\")\nElse\n C_DAY_AVG_PRICE = Json(CurrSell)\nEnd If\n\nSet Json = Nothing\n\nEnd Function\n\nFunction C_ARR_OHLCV(DayHourMin As String, CurrBuy As String, CurrSell As String, ReturnColumns As String, Optional NrLines As Long, Optional MaxTimeDate As Date, Optional exchange As String, Optional ReverseData As Boolean, Optional Apikey As String) As Variant()\n\n'ReturnColumns: variable \"TEOHLC \" -> select columns you want back in the order you want them back, no spaces\n'T = timestamp (unixtime)\n'E = normal excel date/time\n'O = open price\n'H = high price\n'L = Low price\n'C = close price\n'F = volume From\n'V = volume to\n\nDim ExchangeTxt As String\nDim PrTxt As String\nDim AggrVal As String\nDim cmd As String\nDim utime As Long\nDim Json As Object\nDim TempArr As Variant\nDim ParamDict As New Dictionary\nDim HeadDict As New Dictionary\nColumnOptions = \"ETHLCOFV\"\nHeadDict(\"E\") = \"time\"\nHeadDict(\"T\") = \"time\"\nHeadDict(\"H\") = \"high\"\nHeadDict(\"L\") = \"low\"\nHeadDict(\"O\") = \"open\"\nHeadDict(\"C\") = \"close\"\nHeadDict(\"F\") = \"volumefrom\"\nHeadDict(\"V\") = \"volumeto\"\nApplication.Volatile\n\nIf UCase(Right(DayHourMin, 1)) = \"D\" Then\n cmd = \"data/histoday\"\nElseIf UCase(Right(DayHourMin, 1)) = \"H\" Then\n cmd = \"data/histohour\"\nElseIf UCase(Right(DayHourMin, 1)) = \"M\" Then\n cmd = \"data/histominute\"\nElse\n 'Error\n ReDim TempArr(1 To 1, 1 To 1)\n TempArr(1, 1) = \"ERROR, DayHourMin must end with D, H or M\"\n C_ARR_OHLCV = TempArr\n Exit Function\nEnd If\n\nParamDict.Add (\"fsym\"), CurrBuy\nParamDict.Add (\"tsym\"), CurrSell\nIf Len(DayHourMin) > 1 Then\n AggrVal = Left(DayHourMin, Len(DayHourMin) - 1)\n If Val(AggrVal) >= 1 And Val(AggrVal) <= 60 Then\n ParamDict.Add (\"aggregate\"), Val(AggrVal)\n Else\n 'Error\n ReDim TempArr(1 To 1, 1 To 1)\n TempArr(1, 1) = \"ERROR, DayHourMin aggregation has to be from 1 to 60. Valid values are e.g. 7D, 2H or 30M\"\n C_ARR_OHLCV = TempArr\n Exit Function\n End If\nEnd If\n\nIf MaxTimeDate > DateSerial(2000, 1, 1) Then\n dt = DateToUnixTime(MaxTimeDate)\n ParamDict.Add (\"toTs\"), dt\nEnd If\n\nIf Len(exchange) > 2 Then\n ParamDict.Add (\"e\"), exchange\nEnd If\nIf NrLines > 0 Then\n ParamDict.Add (\"limit\"), NrLines\nEnd If\nIf Len(Apikey) > 0 Then\n ParamDict.Add (\"apikey\"), Apikey\nEnd If\n\nPrTxt = PublicCryptoCompareData(cmd, ParamDict)\nSet Json = JsonConverter.ParseJson(PrTxt)\n\nIf Json(\"Response\") = \"Error\" Then\n 'Error\n ReDim TempArr(1 To 1, 1 To 1)\n TempArr(1, 1) = \"ERROR \" & Json(\"Message\")\n C_ARR_OHLCV = TempArr\nElse\n If InStr(PrTxt, \"\"\"Data\"\":[]\") > 0 Then\n 'Empty result from Cryptocompare API, show user error\n ReDim TempArr(1 To 1, 1 To 1)\n TempArr(1, 1) = \"ERROR, cryptocompare API gave back an empty result, try other settings\"\n C_ARR_OHLCV = TempArr\n Exit Function\n End If\n ResArr = JsonToArray(Json)\n ResTbl = ArrayTable(ResArr, True)\n \n ReturnColumns = UCase(Trim(ReturnColumns))\n 'Process all columns\n If Len(ReturnColumns) > 0 Then\n ReDim TempArr(1 To UBound(ResTbl, 2), 1 To Len(ReturnColumns))\n For i = 1 To Len(ReturnColumns)\n itm = Mid(ReturnColumns, i, 1)\n itmnr = 0\n For c = 1 To UBound(ResTbl, 1)\n If ResTbl(c, 1) = HeadDict(itm) Then\n itmnr = c\n Exit For\n End If\n Next c\n \n 'Checked for valid column types, move the data to the TempArr\n If itmnr > 1 Then\n For j = 1 To UBound(ResTbl, 2)\n j2 = j\n If ReverseData = True And j > 1 Then j2 = UBound(ResTbl, 2) - j + 2\n TempArr(j2, i) = ResTbl(itmnr, j)\n If itm = \"E\" Then\n 'Time from Unixtime to normal date/time\n If j > 1 Then\n utime = ResTbl(itmnr, j)\n TempArr(j2, i) = UnixTimeToDate(utime)\n Else\n TempArr(j2, i) = ResTbl(itmnr, j)\n End If\n End If\n Next j\n Else\n 'Unknown column, no data to return\n For j = 1 To UBound(ResTbl, 2)\n TempArr(j, i) = \"unknown ReturnColumn\"\n Next j\n End If\n Next i\n C_ARR_OHLCV = TempArr\n Else\n 'No returncolumns identified, return error\n ReDim TempArr(1 To 1, 1 To 1)\n TempArr(1, 1) = \"ERROR ReturnColumns, use the letters \" & ColumnOptions\n C_ARR_OHLCV = TempArr\n End If\nEnd If\n\nSet Json = Nothing\n\nEnd Function\n\n\n" }, { "path": "ModWeb.bas", "content": "Attribute VB_Name = \"ModWeb\"\n 'Source: https://github.com/krijnsent/crypto_vba\n'Remember to create a new API key for excel/VBA\n'Based on http://www.808.dk/?code-simplewinhttprequest\n\nSub TestWeb()\n\n' Create a new test suite\nDim Suite As New TestSuite\nSuite.Description = \"ModWeb\"\n\n' Create reporter and attach it to these specs\nDim Reporter As New ImmediateReporter\nReporter.ListenTo Suite\n \n' Create a new test\nDim Test As TestCase\nSet Test = Suite.Test(\"TestWebRequestURL\")\n'Testing error catching and replies\nTestResult = WebRequestURL(\"myURL\", \"myMethod\")\n'{\"error_nr\":27,\"error_txt\":\"invalid method for WebRequestURL\",\"response_txt\":0}\nTest.IsEqual Len(TestResult), 90\nTest.IsEqual TestResult, \"{\"\"error_nr\"\":27,\"\"error_txt\"\":\"\"invalid method for WebRequestURL (myMethod)\"\",\"\"response_txt\"\":0}\"\n\nSet Test = Suite.Test(\"TestWebRequestURL GET\")\nTestResult = WebRequestURL(\"myURL\", \"GET\")\n'{\"error_nr\":-2147012796,\"error_txt\":\"VBA-WinHttp.WinHttpRequest etc.\nTest.IsEqual Left(TestResult, 36), \"{\"\"error_nr\"\":-2147012795,\"\"error_txt\"\":\"\n \nTestResult = WebRequestURL(\"https://github.com/empty_url_not_there\", \"GET\")\n'{\"error_nr\":404,\"error_txt\":\"HTTP-Not Found\"}\nTest.IsEqual Len(TestResult), 62\nTest.IsEqual TestResult, \"{\"\"error_nr\"\":404,\"\"error_txt\"\":\"\"HTTP-Not Found\"\",\"\"response_txt\"\":0}\"\n\nTestResult = WebRequestURL(\"https://api.kraken.com/0/public/Time\", \"GET\")\n'{\"error\":[],\"result\":{\"unixtime\":1511954132,\"rfc1123\":\"Wed, 29 Nov 17 11:15:32 +0000\"}}\nTest.IsEqual Len(TestResult), 87\nTest.IsEqual Left(TestResult, 21), \"{\"\"error\"\":[],\"\"result\"\":\"\n\n'Test POST command\nSet Test = Suite.Test(\"TestWebRequestURL HEAD\")\n\nDim headerDict As New Dictionary\nheaderDict.Add \"Content-Type\", \"application/x-www-form-urlencoded\"\nheaderDict.Add \"Customheader\", \"MyCustomHeader\"\nTestResult = WebRequestURL(\"https://httpbin.org/get\", \"GET\", headerDict)\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"url\"), \"https://httpbin.org/get\"\nTest.IsEqual JsonResult(\"headers\").Count, 6\nTest.IsEqual JsonResult(\"headers\")(\"Content-Type\"), \"application/x-www-form-urlencoded\"\nTest.IsEqual JsonResult(\"headers\")(\"Customheader\"), \"MyCustomHeader\"\n\nSet Test = Suite.Test(\"TestWebRequestURL POST\")\n'TEST POST\nTestResult = WebRequestURL(\"https://httpbin.org/post\", \"POST\")\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"url\"), \"https://httpbin.org/post\"\nTest.IsEqual JsonResult(\"headers\").Count, 5\n\nSet headerDict = Nothing\nheaderDict.Add \"Content-Type\", \"application/x-www-form-urlencoded\"\nheaderDict.Add \"Customheader\", \"MyCustomHeader\"\nTestResult = WebRequestURL(\"https://httpbin.org/post\", \"POST\", headerDict)\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"url\"), \"https://httpbin.org/post\"\nTest.IsEqual JsonResult(\"headers\").Count, 7\nTest.IsEqual JsonResult(\"headers\")(\"Content-Type\"), \"application/x-www-form-urlencoded\"\nTest.IsEqual JsonResult(\"headers\")(\"Customheader\"), \"MyCustomHeader\"\n\nTestResult = WebRequestURL(\"https://httpbin.org/post\", \"POST\", , \"my_post_message\")\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"url\"), \"https://httpbin.org/post\"\nTest.IsEqual JsonResult(\"data\"), \"my_post_message\"\nTest.IsEqual JsonResult(\"headers\").Count, 6\n\nTestResult = WebRequestURL(\"https://httpbin.org/post\", \"POST\", headerDict, \"my_post_message_2=msg\")\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"url\"), \"https://httpbin.org/post\"\nTest.IsEqual JsonResult(\"form\")(\"my_post_message_2\"), \"msg\"\nTest.IsEqual JsonResult(\"headers\").Count, 7\nTest.IsEqual JsonResult(\"headers\")(\"Customheader\"), \"MyCustomHeader\"\n\n'DELETE -> delete action\nSet Test = Suite.Test(\"TestWebRequestURL DELETE\")\nTestResult = WebRequestURL(\"https://httpbin.org/delete\", \"DELETE\")\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"url\"), \"https://httpbin.org/delete\"\nTest.IsEqual JsonResult(\"headers\").Count, 5\n\nSet headerDict = Nothing\nheaderDict.Add \"Content-Type\", \"application/x-www-form-urlencoded\"\nheaderDict.Add \"Customheader\", \"MyCustomHeader\"\nTestResult = WebRequestURL(\"https://httpbin.org/delete\", \"DELETE\", headerDict, \"my_delete_order_nr=243\")\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"url\"), \"https://httpbin.org/delete\"\nTest.IsEqual JsonResult(\"form\")(\"my_delete_order_nr\"), \"243\"\nTest.IsEqual JsonResult(\"headers\").Count, 7\nTest.IsEqual JsonResult(\"headers\")(\"Customheader\"), \"MyCustomHeader\"\n\n\n'PUT -> is an update action\nSet Test = Suite.Test(\"TestWebRequestURL PUT\")\nTestResult = WebRequestURL(\"https://httpbin.org/put\", \"PUT\")\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"url\"), \"https://httpbin.org/put\"\nTest.IsEqual JsonResult(\"headers\").Count, 5\n\nSet headerDict = Nothing\nheaderDict.Add \"Content-Type\", \"application/x-www-form-urlencoded\"\nheaderDict.Add \"Customheader\", \"MyCustomHeader\"\nTestResult = WebRequestURL(\"https://httpbin.org/put\", \"PUT\", headerDict, \"my_update_nr=729\")\nSet JsonResult = JsonConverter.ParseJson(TestResult)\nTest.IsEqual JsonResult(\"url\"), \"https://httpbin.org/put\"\nTest.IsEqual JsonResult(\"form\")(\"my_update_nr\"), \"729\"\nTest.IsEqual JsonResult(\"headers\").Count, 7\nTest.IsEqual JsonResult(\"headers\")(\"Customheader\"), \"MyCustomHeader\"\n\n\nEnd Sub\n\n\nFunction WebRequestURL(strURL As String, strMethod As String, Optional objHeaders As Dictionary, Optional strPostMsg As String) As String\n\n' Instantiate a WinHttpRequest object and open it\nErrResp = \"{\"\"error_nr\"\":ERR_NR,\"\"error_txt\"\":\"\"ERR_TXT\"\",\"\"response_txt\"\":RESP_TXT}\"\n\n'DEFAULT: WinHttp.WinHttpRequest.5.1\nSet objHTTP = CreateObject(\"WinHttp.WinHttpRequest.5.1\")\n'HTTP options, can be outcommented if needed\n'WinHttpRequestOption_SslErrorIgnoreFlags - 13056: ignore all err, 0: accept no err\nobjHTTP.Option(4) = 13056\n'WinHttpRequestOption_SecureProtocols - 512 = TLS 1.1, 2048 for TLS 1.2\nobjHTTP.Option(9) = 2048\n\n'BACKUP (OUTCOMMENT THE 3 LINES ABOVE)\n'Set objHTTP = CreateObject(\"MSXML2.XMLHTTP\")\n\nIf strMethod = \"GET\" Then\n On Error Resume Next\n objHTTP.Open \"GET\", strURL, False\n \n If Not objHeaders Is Nothing Then\n For Each key In objHeaders.Keys()\n 'e.g. objHTTP.setRequestHeader \"User-Agent\", \"Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)\"\n objHTTP.setRequestHeader key, objHeaders(key)\n Next key\n Else\n 'No headers\n End If\n \n objHTTP.send\n If Err.Number = 0 Then\n If objHTTP.Status = \"200\" Then\n objHTTP.WaitForResponse\n WebRequestURL = objHTTP.responseText\n If Left(WebRequestURL, 1) = \"<\" Then\n WebRequestURL = Replace(Replace(Replace(ErrResp, \"ERR_NR\", objHTTP.Status), \"ERR_TXT\", \"NO JSON BUT HTML RETURNED\"), \"RESP_TXT\", 0)\n ElseIf Left(WebRequestURL, 1) <> \"{\" And Left(WebRequestURL, 1) <> \"[\" Then\n WebRequestURL = Replace(Replace(Replace(ErrResp, \"ERR_NR\", objHTTP.Status), \"ERR_TXT\", \"NO VALID JSON RETURNED\"), \"RESP_TXT\", 0)\n End If\n Else\n If Left(objHTTP.responseText, 1) = \"{\" Or Left(objHTTP.responseText, 1) = \"[\" Then\n WebRequestURL = Replace(Replace(Replace(ErrResp, \"ERR_NR\", objHTTP.Status), \"ERR_TXT\", \"HTTP-\" & objHTTP.StatusText), \"RESP_TXT\", objHTTP.responseText)\n Else\n WebRequestURL = Replace(Replace(Replace(ErrResp, \"ERR_NR\", objHTTP.Status), \"ERR_TXT\", \"HTTP-\" & objHTTP.StatusText), \"RESP_TXT\", 0)\n End If\n End If\n Else\n If IsEmpty(objHTTP.Status) Then\n WebRequestURL = Replace(Replace(Replace(ErrResp, \"ERR_NR\", Err.Number), \"ERR_TXT\", Err.Description), \"RESP_TXT\", 0)\n Else\n 'Unknown error, probably no internet connection, answer in JSON\n WebRequestURL = Replace(Replace(Replace(ErrResp, \"ERR_NR\", objHTTP.Status), \"ERR_TXT\", \"HTTP-\" & objHTTP.StatusText), \"RESP_TXT\", objHTTP.responseText)\n End If\n End If\n On Error GoTo 0\nElseIf strMethod = \"POST\" Or strMethod = \"PUT\" Or strMethod = \"DELETE\" Then\n On Error Resume Next\n objHTTP.Open strMethod, strURL, False\n \n If Not objHeaders Is Nothing Then\n For Each key In objHeaders.Keys()\n 'e.g. objHTTP.setRequestHeader \"User-Agent\", \"Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)\"\n objHTTP.setRequestHeader key, objHeaders(key)\n Next key\n Else\n 'No headers\n End If\n \n If strPostMsg = \"\" Then\n objHTTP.send\n Else\n objHTTP.send (strPostMsg)\n End If\n\n If Err.Number = 0 Then\n If objHTTP.Status = \"200\" Then\n objHTTP.WaitForResponse\n If Left(objHTTP.responseText, 1) = \"{\" Or Left(objHTTP.responseText, 1) = \"[\" Then\n WebRequestURL = objHTTP.responseText\n Else\n WebRequestURL = Replace(Replace(Replace(ErrResp, \"ERR_NR\", objHTTP.Status), \"ERR_TXT\", \"NO VALID JSON RETURNED\"), \"RESP_TXT\", objHTTP.responseText)\n End If\n Else\n If Left(objHTTP.responseText, 1) = \"{\" Or Left(objHTTP.responseText, 1) = \"[\" Then\n WebRequestURL = Replace(Replace(Replace(ErrResp, \"ERR_NR\", objHTTP.Status), \"ERR_TXT\", \"HTTP-\" & objHTTP.StatusText), \"RESP_TXT\", objHTTP.responseText)\n Else\n WebRequestURL = Replace(Replace(Replace(ErrResp, \"ERR_NR\", objHTTP.Status), \"ERR_TXT\", \"HTTP-\" & objHTTP.StatusText), \"RESP_TXT\", 0)\n End If\n End If\n Else\n 'Unknown error, probably no internet connection, answer in JSON\n If IsEmpty(objHTTP.Status) Then\n WebRequestURL = Replace(Replace(Replace(ErrResp, \"ERR_NR\", Err.Number), \"ERR_TXT\", Err.Description), \"RESP_TXT\", 0)\n Else\n 'Unknown error, probably no internet connection, answer in JSON\n WebRequestURL = Replace(Replace(Replace(ErrResp, \"ERR_NR\", objHTTP.Status), \"ERR_TXT\", \"HTTP-\" & objHTTP.StatusText), \"RESP_TXT\", objHTTP.responseText)\n End If\n End If\n On Error GoTo 0\nElse\n WebRequestURL = Replace(Replace(Replace(ErrResp, \"ERR_NR\", 27), \"ERR_TXT\", \"invalid method for WebRequestURL (\" & strMethod & \")\"), \"RESP_TXT\", \"0\")\nEnd If\nSet objHTTP = Nothing\n\nEnd Function\n\n" }, { "path": "TestCase.cls", "content": "VERSION 1.0 CLASS\nBEGIN\n MultiUse = -1 'True\nEND\nAttribute VB_Name = \"TestCase\"\nAttribute VB_GlobalNameSpace = False\nAttribute VB_Creatable = False\nAttribute VB_PredeclaredId = False\nAttribute VB_Exposed = True\n''\n' TestCase v2.0.0-beta.3\n' (c) Tim Hall - https://github.com/vba-tools/vba-test\n'\n' Verify a single test case with assertions\n'\n' @class TestCase\n' @author tim.hall.engr@gmail.com\n' @license MIT (https://opensource.org/licenses/MIT)\n' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '\nOption Explicit\n\nPrivate pFailures As VBA.Collection\n\n' --------------------------------------------- '\n' Events and Properties\n' --------------------------------------------- '\n\nPublic Name As String\nPublic Context As Dictionary\n\nPublic Planned As Long\nPublic Successes As Long\nPublic Skipped As Boolean\n\nPublic Suite As TestSuite\n\nPublic Property Get Result() As TestResultType\n If Me.Skipped Then\n Result = TestResultType.Skipped\n ElseIf Me.Successes = 0 And Me.Failures.Count = 0 Then\n Result = TestResultType.Pending\n ElseIf Me.Failures.Count > 0 Then\n Result = TestResultType.Fail\n Else\n Result = TestResultType.Pass\n End If\nEnd Property\n\nPublic Property Get Failures() As Collection\n Dim total As Long\n total = Me.Successes + pFailures.Count\n \n If Me.Planned > 0 And Me.Planned <> total Then\n Dim message As String\n Dim Failure As Variant\n \n Set Failures = New Collection\n For Each Failure In pFailures\n Failures.Add Failure\n Next Failure\n \n message = \"Total assertions, ${1}, does not equal planned, ${2}\"\n Failures.Add FormatMessage(message, total, Me.Planned)\n Else\n Set Failures = pFailures\n End If\nEnd Property\n\nPublic Property Get Self() As TestCase\n Self = Me\nEnd Property\n\n' ============================================= '\n' Public Methods\n' ============================================= '\n\n''\n' Check if two values are deep equal (including Array, Collection, and Dictionary)\n'\n' @param {Variant} A\n' @param {Variant} B\n' @param {String} [Message]\n''\nPublic Sub IsEqual(A As Variant, B As Variant, Optional message As String = _\n \"Expected ${1} to equal ${2}\")\n\n Check IsDeepEqual(A, B), message, A, B\nEnd Sub\n\n''\n' Check if two values are not deep equal (including Array, Collection, and Dictionary)\n'\n' @param {Variant} A\n' @param {Variant} B\n' @param {String} [Message]\n''\nPublic Sub NotEqual(A As Variant, B As Variant, Optional message As String = _\n \"Expected ${1} to not equal ${2}\")\n\n Check Not IsDeepEqual(A, B), message, A, B\nEnd Sub\n\n''\n' Check if a value is \"truthy\"\n'\n' From https://docs.microsoft.com/en-us/dotnet/visual-basic/language-reference/statements/if-then-else-statement\n'\n' Must evaluate to True or False, or to a data type that is implicitly convertible to Boolean.\n' If the expression is a Nullable Boolean variable that evaluates to Nothing, the condition is treated as if the expression is False.\n'\n' @param {Variant} Value\n' @param {String} [Message]\n''\nPublic Sub IsOk(Value As Variant, Optional message As String = _\n \"Expected ${1} to be ok\")\n\n Check Value, message, Value\nEnd Sub\n\n''\n' Check if a value is not \"truthy\" (See .IsOk)\n'\n' @param {Variant} Value\n' @param {String} [Message]\n''\nPublic Sub NotOk(Value As Variant, Optional message As String = _\n \"Expected ${1} to not be ok\")\n\n Check Not CBool(Value), message, Value\nEnd Sub\n\n''\n' Check if a value is \"undefined\": Nothing, Empty, Null, or Missing\n'\n' @param {Variant} Value\n' @param {String} [Message]\n''\nPublic Sub IsUndefined(Optional Value As Variant, Optional message As String = _\n \"Expected ${1} to be undefined\")\n\n Check IsNothing(Value) Or VBA.IsEmpty(Value) Or VBA.IsNull(Value) Or VBA.IsMissing(Value), message, Value\nEnd Sub\n\n''\n' Check if a value is not \"undefined\": Nothing, Empty, Null, or Missing\n'\n' @param {Variant} Value\n' @param {String} [Message]\n''\nPublic Sub NotUndefined(Value As Variant, Optional message As String = _\n \"Expected ${1} to not be undefined\")\n\n Check Not IsNothing(Value) And Not VBA.IsEmpty(Value) And Not VBA.IsNull(Value) And Not VBA.IsMissing(Value), message, Value\nEnd Sub\n\n''\n' Check if the current Err value contains an error with values (if given)\n'\n' @param {Long} [Number]\n' @param {String} [Source]\n' @param {String} [Description]\n' @param {String} [Message}\n''\nPublic Sub IsError(Optional Number As Long, Optional Source As String, Optional Description As String, Optional message As String = _\n \"Expected ${1} to be an error (with Number = ${2}, Source = ${3}, Description = ${4}\")\n \n If Err.Number = 0 Then\n pFailures.Add FormatMessage(message, \"[Error Number=0]\", Number, Source, Description)\n Exit Sub\n End If\n \n Check (Number = 0 Or Err.Number = Number) _\n And (Source = \"\" Or Err.Source = Source) _\n And (Description = \"\" Or Err.Description = Description), message, FormattedErr, Number, Source, Description\nEnd Sub\n\n''\n' Check if the current Err value does not contain an error\n''\nPublic Sub NotError(Optional message As String = \"Expected ${1} to not be an error\")\n Check Err.Number = 0, message, FormattedErr\nEnd Sub\n\n''\n' Check if a value is included in an arbitrarily nested Array or Collection\n'\n' @param {Array|Collection} Values\n' @param {Variant} Value\n' @param {String} [Message]\n''\nPublic Sub Includes(Values As Variant, Value As Variant, Optional message As String = _\n \"Expected ${2} to be included in ${1}\")\n\n If IsCollection(Values) Then\n Check CollectionIncludes(Values, Value), message, Values, Value\n ElseIf IsArray(Values) Then\n Check ArrayIncludes(Values, Value), message, Values, Value\n Else\n pFailures.Add FormatMessage(message, Values, Value) & \" (Incompatible type for Values)\"\n End If\nEnd Sub\n\n''\n' Check if a value is not included in an arbitrarily nested Array or Collection\n'\n' @param {Array|Collection} Values\n' @param {Variant} Value\n' @param {String} [Message]\n''\nPublic Sub NotIncludes(Values As Variant, Value As Variant, Optional message As String = _\n \"Expected ${2} not to be included in ${1}\")\n \n If IsCollection(Values) Then\n Check Not CollectionIncludes(Values, Value), message, Values, Value\n ElseIf IsArray(Values) Then\n Check Not ArrayIncludes(Values, Value), message, Values, Value\n Else\n pFailures.Add FormatMessage(message, Values, Value) & \" (Incompatible type for Values)\"\n End If\nEnd Sub\n\n''\n' Check if two values are approximately equal, up to the given amount of significant figures\n'\n' @example\n' ```vb\n' .IsApproximate 1.001, 1.002, 3\n'\n' ' Equivalent to .IsEqual 1.00e+0, 1.00e+0\n' ```\n' @param {Variant} A\n' @param {Variant} B\n' @param {String} [Message]\n''\nPublic Sub IsApproximate(A As Variant, B As Variant, SignificantFigures As Integer, Optional message As String = _\n \"Expected ${1} to be approximately equal to ${2} (with ${3} significant figures of precision)\")\n\n If SignificantFigures < 1 Or SignificantFigures > 15 Then\n pFailures.Add \"IsApproximate can only compare from 1 to 15 significant figures\"\n Else\n Check IsApproximatelyEqual(A, B, SignificantFigures), message, A, B, SignificantFigures\n End If\nEnd Sub\n\n''\n' Check if two values are approximately equal, up to the given amount of significant figures\n'\n' @example\n' ```vb\n' .NotApproximate 1.001, 1.009, 3\n'\n' ' Equivalent to .IsEqual 1.00e+0, 1.01e+0\n' ```\n' @param {Variant} A\n' @param {Variant} B\n' @param {String} [Message]\n''\nPublic Sub NotApproximate(A As Variant, B As Variant, SignificantFigures As Integer, Optional message As String = _\n \"Expected ${1} to not be approximately equal to ${2} (with ${3} significant figures of precision)\")\n\n If SignificantFigures < 1 Or SignificantFigures > 15 Then\n pFailures.Add \"NotApproximate can only compare from 1 to 15 significant figures\"\n Else\n Check Not IsApproximatelyEqual(A, B, SignificantFigures), message, A, B, SignificantFigures\n End If\nEnd Sub\n\n''\n' Mark the test as passing\n''\nPublic Sub Pass()\n Me.Successes = 1\n Set pFailures = New Collection\nEnd Sub\n\n''\n' Mark the test as failing\n'\n' @param {String} {Message]\n''\nPublic Sub Fail(Optional message As String = _\n \"Test failed unexpectedly\")\n \n pFailures.Add message\nEnd Sub\n\n''\n' Set the planned number of assertions for the test\n'\n' @param {Long} Count\n''\nPublic Sub Plan(Count As Long)\n Planned = Count\nEnd Sub\n\n''\n' Mark the test as skipped\n''\nPublic Sub Skip()\n Me.Skipped = True\nEnd Sub\n\n' ============================================= '\n' Private Functions\n' ============================================= '\n\nPrivate Sub Check(Assertion As Variant, message As String, ParamArray Values() As Variant)\n If Assertion Then\n Me.Successes = Me.Successes + 1\n Else\n pFailures.Add FormatMessage(message, Values)\n End If\nEnd Sub\n\nPrivate Function IsDeepEqual(A As Variant, B As Variant) As Boolean\n Dim AType As VbVarType\n Dim BType As VbVarType\n \n AType = VBA.VarType(A)\n BType = VBA.VarType(B)\n\n If VBA.IsError(A) Or VBA.IsError(B) Then\n IsDeepEqual = False\n \n ElseIf VBA.IsArray(A) And VBA.IsArray(B) Then\n IsDeepEqual = IsArrayEqual(A, B)\n \n ElseIf AType = VBA.vbObject Or BType = VBA.vbObject Then\n If AType <> BType Or VBA.TypeName(A) <> VBA.TypeName(B) Then\n IsDeepEqual = False\n ElseIf VBA.TypeName(A) = \"Collection\" Then\n IsDeepEqual = IsCollectionEqual(A, B)\n ElseIf VBA.TypeName(A) = \"Dictionary\" Then\n IsDeepEqual = IsDictionaryEqual(A, B)\n Else\n IsDeepEqual = A Is B\n End If\n \n ElseIf VBA.VarType(A) = VBA.vbDouble Or VBA.VarType(B) = VBA.vbDouble Then\n ' It is inherently difficult/almost impossible to check equality of Double\n ' http://support.microsoft.com/kb/78113\n '\n ' -> Compare up to 15 significant figures\n IsDeepEqual = IsApproximatelyEqual(A, B, 15)\n \n Else\n IsDeepEqual = A = B\n End If\nEnd Function\n\nPrivate Function IsArrayEqual(A As Variant, B As Variant) As Boolean\n If UBound(A) <> UBound(B) Then\n IsArrayEqual = False\n Exit Function\n End If\n \n Dim i As Long\n For i = LBound(A) To UBound(A)\n If Not IsDeepEqual(A(i), B(i)) Then\n IsArrayEqual = False\n Exit Function\n End If\n Next i\n \n IsArrayEqual = True\nEnd Function\n\nPrivate Function IsCollectionEqual(A As Variant, B As Variant) As Boolean\n If A.Count <> B.Count Then\n IsCollectionEqual = False\n Exit Function\n End If\n \n Dim i As Long\n For i = 1 To A.Count\n If Not IsDeepEqual(A(i), B(i)) Then\n IsCollectionEqual = False\n Exit Function\n End If\n Next i\n\n IsCollectionEqual = True\nEnd Function\n\nPrivate Function IsDictionaryEqual(A As Variant, B As Variant) As Boolean\n If UBound(A.Keys) <> UBound(B.Keys) Then\n IsDictionaryEqual = False\n Exit Function\n End If\n \n Dim AKeys As Variant\n Dim BKeys As Variant\n Dim i As Long\n \n AKeys = A.Keys\n BKeys = B.Keys\n \n For i = LBound(AKeys) To UBound(AKeys)\n If AKeys(i) <> BKeys(i) Or A.Item(AKeys(i)) <> B.Item(BKeys(i)) Then\n IsDictionaryEqual = False\n Exit Function\n End If\n Next i\n\n IsDictionaryEqual = True\nEnd Function\n\nPrivate Function IsCollection(Value As Variant) As Boolean\n IsCollection = VBA.VarType(Value) = VBA.vbObject And VBA.TypeName(Value) = \"Collection\"\nEnd Function\n\nPrivate Function IsNothing(Value As Variant) As Boolean\n If VBA.IsObject(Value) Then\n IsNothing = Value Is Nothing\n Else\n IsNothing = False\n End If\nEnd Function\n\nPrivate Function ArrayIncludes(Values As Variant, Value As Variant) As Boolean\n Dim i As Long\n For i = LBound(Values) To UBound(Values)\n If VBA.IsArray(Values(i)) Then\n If ArrayIncludes(Values(i), Value) Then\n ArrayIncludes = True\n Exit Function\n End If\n ElseIf IsCollection(Values(i)) Then\n If CollectionIncludes(Values(i), Value) Then\n ArrayIncludes = True\n Exit Function\n End If\n ElseIf IsDeepEqual(Values(i), Value) Then\n ArrayIncludes = True\n Exit Function\n End If\n Next i\n\n ArrayIncludes = False\nEnd Function\n\nPrivate Function CollectionIncludes(Values As Variant, Value As Variant) As Boolean\n Dim Item As Variant\n For Each Item In Values\n If VBA.IsArray(Item) Then\n If ArrayIncludes(Item, Value) Then\n CollectionIncludes = True\n Exit Function\n End If\n ElseIf IsCollection(Item) Then\n If CollectionIncludes(Item, Value) Then\n CollectionIncludes = True\n Exit Function\n End If\n ElseIf IsDeepEqual(Item, Value) Then\n CollectionIncludes = True\n Exit Function\n End If\n Next Item\n \n CollectionIncludes = False\nEnd Function\n\nPrivate Function IsApproximatelyEqual(A As Variant, B As Variant, SignificantFigures As Integer) As Boolean\n If SignificantFigures < 1 Or SignificantFigures > 15 Or VBA.IsError(A) Or VBA.IsError(B) Then\n IsApproximatelyEqual = False\n Exit Function\n End If\n \n Dim AValue As String\n Dim BValue As String\n \n AValue = VBA.Format$(A, VBA.Left$(\"0.00000000000000\", SignificantFigures + 1) & IIf(A > 1, \"e+0\", \"e-0\"))\n BValue = VBA.Format$(B, VBA.Left$(\"0.00000000000000\", SignificantFigures + 1) & IIf(B > 1, \"e+0\", \"e-0\"))\n \n IsApproximatelyEqual = AValue = BValue\nEnd Function\n\nPrivate Function FormatMessage(message As String, ParamArray Values() As Variant) As String\n Dim Value As Variant\n Dim Index As Long\n \n FormatMessage = message\n For Each Value In IIf(VBA.IsArray(Values(0)), Values(0), Values)\n Index = Index + 1\n FormatMessage = VBA.Replace(FormatMessage, \"${\" & Index & \"}\", PrettyPrint(Value))\n Next Value\nEnd Function\n\nPrivate Function PrettyPrint(Value As Variant, Optional Indentation As Long = 0) As String\n If VBA.IsMissing(Value) Then\n PrettyPrint = \"[Missing]\"\n Exit Function\n End If\n \n Dim i As Long\n Dim Indented As String\n Indented = VBA.String$(Indentation + 1, \" \")\n \n Select Case VBA.VarType(Value)\n Case VBA.vbObject\n ' Nothing\n If Value Is Nothing Then\n PrettyPrint = \"[Nothing]\"\n \n ' Collection\n ElseIf VBA.TypeName(Value) = \"Collection\" Then\n PrettyPrint = \"[Collection [\" & vbNewLine\n \n For i = 1 To Value.Count\n PrettyPrint = PrettyPrint & Indent(Indentation + 1) & _\n PrettyPrint(Value(i), Indentation + 1) & _\n IIf(i <> Value.Count, \",\", \"\") & vbNewLine\n Next i\n \n PrettyPrint = PrettyPrint & Indent(Indentation) & \"]\"\n \n ' Dictionary\n ElseIf VBA.TypeName(Value) = \"Dictionary\" Then\n PrettyPrint = \"[Dictionary {\" & vbNewLine\n \n For i = LBound(Value.Keys) To UBound(Value.Keys)\n PrettyPrint = PrettyPrint & Indent(Indentation + 1) & _\n Value.Keys(i) & \": \" & _\n PrettyPrint(Value.Item(Value.Keys(i)), Indentation + 1) & _\n IIf(i <> Value.Count, \",\", \"\") & vbNewLine\n Next i\n \n PrettyPrint = PrettyPrint & Indent(Indentation) & \"}]\"\n \n ' Object\n Else\n PrettyPrint = \"[\" & VBA.TypeName(Value) & \"]\"\n End If\n \n ' Array\n Case VBA.vbArray To VBA.vbArray + VBA.vbByte\n PrettyPrint = \"[\" & vbNewLine\n \n For i = LBound(Value) To UBound(Value)\n PrettyPrint = PrettyPrint & Indent(Indentation + 1) & _\n PrettyPrint(Value(i), Indentation + 1) & _\n IIf(i <> UBound(Value), \",\", \"\") & vbNewLine\n Next i\n \n PrettyPrint = PrettyPrint & Indent(Indentation) & \"]\"\n \n ' Empty\n Case VBA.vbEmpty\n PrettyPrint = \"[Empty]\"\n \n ' Null\n Case VBA.vbNull\n PrettyPrint = \"[Null]\"\n \n ' String\n Case VBA.vbString\n PrettyPrint = \"\"\"\" & Value & \"\"\"\"\n \n ' Everything else\n Case Else\n PrettyPrint = CStr(Value)\n End Select\nEnd Function\n\nPrivate Function FormattedErr() As String\n Dim ErrNumberDetails As String\n \n ErrNumberDetails = IIf(Err.Number < 0, \" (\" & (Err.Number - vbObjectError) & \" / \" & VBA.LCase$(VBA.Hex$(Err.Number)) & \")\", \"\")\n FormattedErr = \"[Error Number=\" & Err.Number & ErrNumberDetails & \", Source=\" & Err.Source & \", Description=\" & Err.Description & \"]\"\nEnd Function\n\nPrivate Function Indent(Optional Indentation As Long)\n Indent = VBA.String$(Indentation, \" \")\nEnd Function\n\nPrivate Sub Class_Initialize()\n Set Me.Context = New Dictionary\n Set pFailures = New VBA.Collection\nEnd Sub\n\nPrivate Sub Class_Terminate()\n Me.Suite.TestComplete Me\n Set Me.Context = Nothing\nEnd Sub\n" }, { "path": "TestSuite.cls", "content": "VERSION 1.0 CLASS\nBEGIN\n MultiUse = -1 'True\nEND\nAttribute VB_Name = \"TestSuite\"\nAttribute VB_GlobalNameSpace = False\nAttribute VB_Creatable = False\nAttribute VB_PredeclaredId = False\nAttribute VB_Exposed = True\n''\n' TestSuite v2.0.0-beta.3\n' (c) Tim Hall - https://github.com/vba-tools/vba-test\n'\n' A collection of tests, with events and results\n'\n' @class TestSuite\n' @author tim.hall.engr@gmail.com\n' @license MIT (https://opensource.org/licenses/MIT)\n' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '\nOption Explicit\n\n' --------------------------------------------- '\n' Types, Events, and Properties\n' --------------------------------------------- '\n\nPublic Enum TestResultType\n Pass\n Fail\n Pending\n Skipped\nEnd Enum\n\nPublic Event BeforeEach(Test As TestCase)\nPublic Event Result(Test As TestCase)\nPublic Event AfterEach(Test As TestCase)\n\n''\n' (Optional) description of suite for display in runners\n'\n' @property Description\n' @type String\n''\nPublic Description As String\n\n''\n' @property Tests\n' @type Collection\n''\nPublic Tests As VBA.Collection\n\n''\n' Compute suite result from tests\n'\n' @property Result\n' @type SpecResultType\n''\nPublic Property Get Result() As TestResultType\n Result = TestResultType.Pending\n \n Dim Test As TestCase\n For Each Test In Me.Tests\n If Test.Result = TestResultType.Pass Then\n Result = TestResultType.Pass\n ElseIf Test.Result = TestResultType.Fail Then\n Result = TestResultType.Fail\n Exit For\n End If\n Next Test\nEnd Property\n\n''\n' @property PassedTests\n' @type Collection\n''\nPublic Property Get PassedTests() As VBA.Collection\n Set PassedTests = GetTestsByType(TestResultType.Pass)\nEnd Property\n\n''\n' @property FailedTests\n' @type Collection\n''\nPublic Property Get FailedTests() As VBA.Collection\n Set FailedTests = GetTestsByType(TestResultType.Fail)\nEnd Property\n\n''\n' @property PendingTests\n' @type Collection\n''\nPublic Property Get PendingTests() As VBA.Collection\n Set PendingTests = GetTestsByType(TestResultType.Pending)\nEnd Property\n\n''\n' @property SkippedTests\n' @type Collection\n''\nPublic Property Get SkippedTests() As VBA.Collection\n Set SkippedTests = GetTestsByType(TestResultType.Skipped)\nEnd Property\n\n' ============================================= '\n' Public Methods\n' ============================================= '\n\n''\n' Create a new test case with name\n'\n' @method Test\n' @param {String} Name\n' @returns {TestCase}\n''\nPublic Function Test(Name As String) As TestCase\n Dim Instance As New TestCase\n \n Instance.Name = Name\n Set Instance.Suite = Me\n \n RaiseEvent BeforeEach(Instance)\n \n Set Test = Instance\nEnd Function\n\nPublic Sub TestComplete(Test As TestCase)\n Tests.Add Test\n\n RaiseEvent Result(Test)\n RaiseEvent AfterEach(Test)\nEnd Sub\n\n' ============================================= '\n' Private Functions\n' ============================================= '\n\nPrivate Function GetTestsByType(ResultType As TestResultType) As Collection\n Dim Test As TestCase\n Dim Filtered As New VBA.Collection\n For Each Test In Me.Tests\n If Test.Result = ResultType Then\n Filtered.Add Test\n End If\n Next Test\n\n Set GetTestsByType = Filtered\nEnd Function\n\n\nPrivate Sub Class_Initialize()\n Set Tests = New VBA.Collection\nEnd Sub\n" }, { "path": "WorkbookReporter.cls", "content": "VERSION 1.0 CLASS\nBEGIN\n MultiUse = -1 'True\nEND\nAttribute VB_Name = \"WorkbookReporter\"\nAttribute VB_GlobalNameSpace = False\nAttribute VB_Creatable = False\nAttribute VB_PredeclaredId = False\nAttribute VB_Exposed = True\n''\n' DisplayReporter v2.0.0-beta.3\n' (c) Tim Hall - https://github.com/VBA-tools/VBA-TDD\n'\n' Report results to Worksheet\n'\n' @class DisplayReporter\n' @compatibility\n' Platforms: Windows and Mac\n' Applications: Excel-only\n' @author tim.hall.engr@gmail.com\n' @license MIT (https://opensource.org/licenses/MIT)\n' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '\nOption Explicit\n\n' --------------------------------------------- '\n' Constants and Private Variables\n' --------------------------------------------- '\n\nPrivate Const ProgressWidth As Long = 128\nPrivate pSheet As Worksheet\nPrivate pCount As Long\nPrivate pTotal As Long\nPrivate pSuites As Collection\n\n' ============================================= '\n' Public Methods\n' ============================================= '\n\n''\n' Connect the display runner to a Worksheet to output results\n'\n' The given Worksheet should have names for:\n' - \"Progress\" (Shape with width)\n' - \"ProgressBorder\" (Shape)\n' - \"Result\" (Cell) - Cell to output overall result\n' - \"Output\" (Cell) - First cell to output results\n'\n' @method ConnectTo\n' @param {Worksheet} Sheet\n''\nPublic Sub ConnectTo(Sheet As Worksheet)\n Set pSheet = Sheet\nEnd Sub\n\n''\n' Call this at the beginning of a test run to reset the worksheet\n' (pass overall number of test suites that will be run to display progress)\n'\n' @method Start\n' @param {Long} [NumSuites = 0]\n''\nPublic Sub Start(Optional NumSuites As Long = 0)\n pCount = 0\n pTotal = NumSuites\n\n ClearResults\n ShowProgress\n DisplayResult \"Running\"\nEnd Sub\n\n''\n' Output the given suite\n'\n' @method Output\n' @param {TestSuite} Suite\n''\nPublic Sub Output(Suite As TestSuite)\n pCount = pCount + 1\n pSuites.Add Suite\n \n ShowProgress\n DisplayResults\nEnd Sub\n\n''\n' After outputing all suites, display overall result\n'\n' @method Done\n''\nPublic Sub Done()\n Dim Failed As Boolean\n Dim Suite As TestSuite\n For Each Suite In pSuites\n If Suite.Result = TestResultType.Fail Then\n Failed = True\n Exit For\n End If\n Next Suite\n \n DisplayResult IIf(Failed, \"FAIL\", \"PASS\")\nEnd Sub\n\n' ============================================= '\n' Private Functions\n' ============================================= '\n\nPrivate Sub ShowProgress()\n If pTotal <= 0 Then\n HideProgress\n Exit Sub\n End If\n\n Dim Percent As Double\n Percent = pCount / pTotal\n \n If Percent > 1 Then\n Debug.Print \"WARNING: DisplayRunner has output more suites than specified in Start\"\n Percent = 1\n End If\n\n pSheet.Shapes(\"Progress\").Width = ProgressWidth * Percent\n pSheet.Shapes(\"Progress\").Visible = True\n pSheet.Shapes(\"ProgressBorder\").Visible = True\nEnd Sub\n\nPrivate Sub HideProgress()\n pSheet.Shapes(\"Progress\").Visible = False\n pSheet.Shapes(\"ProgressBorder\").Visible = False\nEnd Sub\n\nPrivate Sub DisplayResult(Value As String)\n With pSheet.Range(\"Result\")\n .Font.Size = IIf(Value = \"Running\", 12, 14)\n .Value = Value\n End With\nEnd Sub\n\nPrivate Sub ClearResults()\n Dim StartRow As Long\n Dim StartColumn As Long\n StartRow = pSheet.Range(\"Output\").Row\n StartColumn = pSheet.Range(\"Output\").Column\n \n Dim lastrow As Long\n lastrow = StartRow\n Do While pSheet.Cells(lastrow + 1, StartColumn).Value <> \"\"\n lastrow = lastrow + 1\n Loop\n \n With pSheet.Range(pSheet.Cells(StartRow, StartColumn), pSheet.Cells(lastrow, StartColumn + 1))\n .Value = \"\"\n .Font.Bold = False\n .Borders(xlInsideHorizontal).LineStyle = xlNone\n End With\nEnd Sub\n\nPrivate Sub DisplayResults()\n Dim Rows As New Collection\n Dim Dividers As New Collection\n Dim Headings As New Collection\n \n Dim Suite As TestSuite\n Dim Test As TestCase\n Dim Failure As Variant\n \n For Each Suite In pSuites\n If Rows.Count > 0 Then\n Dividers.Add Rows.Count\n End If\n\n If Suite.Description <> \"\" Then\n Headings.Add Rows.Count\n Rows.Add Array(Suite.Description, ResultTypeToString(Suite.Result))\n End If\n\n For Each Test In Suite.Tests\n If Test.Result <> TestResultType.Skipped Then\n Rows.Add Array(Test.Name, ResultTypeToString(Test.Result))\n \n For Each Failure In Test.Failures\n Rows.Add Array(\" \" & Failure, \"\")\n Next Failure\n End If\n Next Test\n Next Suite\n \n Dim OutputValues() As String\n Dim Row As Variant\n Dim i As Long\n ReDim OutputValues(Rows.Count - 1, 1)\n i = 0\n For Each Row In Rows\n OutputValues(i, 0) = Row(0)\n OutputValues(i, 1) = Row(1)\n i = i + 1\n Next Row\n \n Dim StartRow As Long\n Dim StartColumn As Long\n StartRow = pSheet.Range(\"Output\").Row\n StartColumn = pSheet.Range(\"Output\").Column\n\n pSheet.Range(pSheet.Cells(StartRow, StartColumn), pSheet.Cells(StartRow + Rows.Count - 1, StartColumn + 1)).Value = OutputValues\n \n Dim Divider As Variant\n For Each Divider In Dividers\n With pSheet.Range(pSheet.Cells(StartRow + Divider, StartColumn), pSheet.Cells(StartRow + Divider, StartColumn + 1)).Borders(xlEdgeTop)\n .LineStyle = xlContinuous\n .Color = VBA.RGB(191, 191, 191)\n .Weight = xlThin\n End With\n Next Divider\n \n Dim Heading As Variant\n For Each Heading In Headings\n pSheet.Cells(StartRow + Heading, StartColumn).Font.Bold = True\n Next Heading\nEnd Sub\n\nPrivate Function ResultTypeToString(ResultType As TestResultType) As String\n Select Case ResultType\n Case TestResultType.Pass\n ResultTypeToString = \"Pass\"\n Case TestResultType.Fail\n ResultTypeToString = \"Fail\"\n Case TestResultType.Pending\n ResultTypeToString = \"Pending\"\n End Select\nEnd Function\n\nPrivate Sub Class_Initialize()\n Set pSuites = New Collection\nEnd Sub\n" }, { "path": "_config.yml", "content": "theme: jekyll-theme-leap-day" }, { "path": "readme.md", "content": "# crypto_vba\nAn Excel/VBA project to communicate with various cryptocurrency exchanges APIs. Tested on Windows 10 & Excel 365, but should work for Excel 2007+. Note: project is on hold - I'm working on other things and don't have the time & energy to jump through all the KYC hoops of exchanges to keep my accounts and test my code.\n\n# Exchanges:\nGet information from/send information to:\n- [Binance](http://binance.com/)\n- [Bitfinex](https://www.bitfinex.com/)\n- [Bitmex](https://www.bitmex.com/)\n- [Bitstamp](https://www.bitstamp.net/)\n- [Bittrex](https://www.bittrex.com/) \n- [BitVavo](https://www.bitvavo.com/) \n- [Bybit](https://www.bybit.com/) \n- [Coinbase](https://www.coinbase.com)\n- [CoinbasePro](https://pro.coinbase.com/)\n- [Coinone](https://coinone.co.kr/)\n- [Coinspot](https://www.coinspot.com.au/)\n- [HitBTC](https://hitbtc.com/)\n- [Huobi](https://www.huobi.com/)\n- [Kraken](https://www.kraken.com/)\n- [Kucoin](https://www.kucoin.com/)\n- [OKEx](https://www.okex.com/)\n- [Poloniex](https://www.poloniex.com/) \n- [Coinigy](https://www.coinigy.com/) - not an exchange, but a service where you can access multiple exchanges for a fee - not actively maintained\n- [Cryptopia] -> hacked & closed\n- [GDAX] -> see CoinbasePro\n- [Liqui] -> exchange closed\n- [WEXnz] -> exchange closed, removed\n\nMost API messages/responses are pure JSON, for which I included https://github.com/VBA-tools/VBA-JSON to process and a function to build on that.\nAs excel/VBA development is not very compatible with GIT, my pushes/forks/updates might be clunky.\nPlease consider the code I provide as simple building blocks: if you want to build a project based on this code, you will have to know (some) VBA. There are plenty of courses available online, two simple ones I send starters to are: https://www.excel-pratique.com/en/ and https://homeandlearn.org/.\n\n# How to use?\nImport the .bas files you need or simply take the sample Excel file. In the modules you'll find some examples how to use the code. Feel free to create an issue if things don't work for you. The project uses quite some Dictionaries in VBA, check out e.g. https://excelmacromastery.com/vba-dictionary/ if you want to know a bit more about them.\nYou do need some references in your VBA editor (already set up in the example file):\n- Visual Basic For Applications --- C:\\Program Files (x86)\\Common Files\\Microsoft Shared\\VBA\\VBA7.1\\VBE7.DLL\n- Microsoft Excel 16.0 Object Library --- C:\\Program Files (x86)\\Microsoft Office\\Root\\Office16\\EXCEL.EXE\n- Microsoft Forms 2.0 Object Library --- C:\\WINDOWS\\SysWOW64\\FM20.DLL\n- Microsoft Scripting Runtime C:\\Windows\\SysWOW64\\scrrun.dll\n- Microsoft Visual Basic for Applications Extensibility 5.3 --- C:\\Program Files (x86)\\Common Files\\Microsoft Shared\\VBA\\VBA6\\VBE6EXT.OLB\n- Microsoft HTML Object Library --- C:\\Windows\\SysWOW64\\mshtml.tlb\n\nAnd you do need .NET 3.5 or greater on your system, as it's used by the hashing algorithms (System.Security.Cryptography)\n\n# Virus warnings\nFrom 2021 several issues have been filed that my example file (the xlsm file) triggers a virus warning, e.g. issue #67 & #73. I have no idea what triggers this (I didn't put any virus in) and have no idea how to solve it, suggestions are very welcome. A solution if you want to use the code is to import the .bas modules & setting up the right references yourself.\nAn alternative:\n- download the Github desktop app : https://desktop.github.com/\n- clone the repository \"URL\": https://github.com/krijnsent/crypto_vba\n- all files are in your local folder and the file should open without warning\n\n# ToDo\n- Excel formulas need better caching to prevent a stalling/crashing Excel - an RTD would be a solution, but that's out of scope for me\n- Better error handling\n- Updating/adding exchanges: do create an issue if you want an exchange added/updated, as I'm not checking them.\n\n# Done\n- For historical prices, included https://www.cryptocompare.com/api/ (now https://min-api.cryptocompare.com/ )\n- Build excel functions to get the information directly to a sheet, has some caching, but - BETA STAGE - use at own risk\n- Working examples of several exchanges in the example file\n- Created a basic XLSM sample file for all provided exchanges\n- ArrayToTable improvement to handle various data types (e.g. Trade and Margin trade) in one JSON response\n- Post-process the Array to a more usable format (flat table)\n- Process the response to something you can use in Excel: an array/Range etc.\n- Build a function to transform the JSON to an Array\n- Build tests for all modules/functions\n- Integrate VBA-JSON into the project\n- Build the Binance API connector\n- Build the Bitfinex API connector\n- Build the Bitstamp API connector\n- Build the Bittrex API connector\n- Build the Bitvavo API connector\n- Build the Coinbase API connector\n- Build the CoinbasePro API connector\n- Build the Coinone API connector\n- Build the Coinspot API connector\n- Build the HitBTC API connector\n- Build the Kraken API connector\n- Build the Kucoin API connector\n- Build the OKEx API connector\n- Build the Poloniex API connector\n- Build a working and tested VBA hash function\n- Build a function to transform Dictionaries into JSON and URLencode\n- Added the UrlEncode function for e.g. Cryptopia (and Excel versions before 2016)\n- Removed inactive exchanges: Liqui, WEXnz/BTCe (nostalgia, that was the first exchange i got working in excel)\n\n# Donate\nIf this project/the Excel saves you a lot of programming time, consider sending me a coffee or a beer:
\nBTC: 1DNFF9y3dDMLNURpgdT3wXmFpmGBsQRyPa
\nETH (or ERC-20 tokens): 0x9070C5D93ADb58B8cc0b281051710CB67a40C72B
\nStellar: GCRCMHEXS4BHZQSCH4O4LHT24ZK2GTKOHML5KZ6HS5E3GV5RPVBDGDGB\nCheers!\n" } ]