VB Script Example

Dim domain: domain = "https://app.vinsight.net"
Dim username: username= "abc@example.com"
Dim password: password = "mypassword"

Public Function login(username, password)
    Dim encodedCredentials: encodedCredentials = Replace(EncodeBase64(URLEncode(username, False) & ":" & URLEncode(password, False)), vbLf, "")

    Dim xmlHttp, URL, async: async = False
    Dim userAgent: userAgent = "Microsoft.XMLHTTP" '"Msxml2.ServerXMLHTTP"
    Set xmlHttp = CreateObject(userAgent)
    URL = domain & "/LoginContexts?$format=json"
    xmlHttp.Open "POST", URL, async
    xmlHttp.setRequestHeader "User-Agent", userAgent
    xmlHttp.setRequestHeader "Authorization", "Basic " & encodedCredentials
    xmlHttp.setRequestHeader "Host", "app.vinsight.net"
    xmlHttp.setRequestHeader "Content-Length", "0"
    xmlHttp.send
    
    If xmlHttp.Status = 200 Then
        Set Login = xmlHttp
    Else
        Throw
    End If

End Function

Function encodeBase64(text)
   
  Dim objNode, objXML: Set objXML = CreateObject("MSXML2.DOMDocument")
  Set objNode = objXML.createElement("b64")

  objNode.DataType = "bin.base64"
  objNode.nodeTypedValue = stringToBinary(text)
  EncodeBase64 = objNode.text

  Set objNode = Nothing
  Set objXML = Nothing
End Function

Public Function URLEncode(StringVal, SpaceAsPlus)
  Dim StringLen: StringLen = Len(StringVal)

  If StringLen > 0 Then
    ReDim result(StringLen)
    Dim i, CharCode
    Dim Char, Space

    If SpaceAsPlus Then Space = "+" Else Space = "%20"

    For i = 1 To StringLen
      Char = Mid(StringVal, i, 1)
      CharCode = Asc(Char)
      If (CharCode >= 97 And CharCode <= 122) _
        Or (CharCode >= 65 And CharCode <= 90) _
        Or (CharCode >= 48 And CharCode <= 57) _
        Or CharCode = 45 Or CharCode = 46 Or CharCode = 95 Or CharCode = 126 Then
          result(i) = Char
        ElseIf CharCode = 32 Then
          result(i) = Space
        ElseIf CharCode >= 0 And CharCode <= 15 Then
          result(i) = "%0" & Hex(CharCode)
         Else
          result(i) = "%" & Hex(CharCode)
      End If
    Next
    URLEncode = Join(result, "")
  End If
End Function

Function stringToBinary(Text)
  Const adTypeText = 2
  Const adTypeBinary = 1

  'Create Stream object
  Dim BinaryStream 'As New Stream
  Set BinaryStream = CreateObject("ADODB.Stream")

  'Specify stream type - we want To save text/string data.
  BinaryStream.Type = adTypeText

  'Specify charset For the source text (unicode) data.
  BinaryStream.CharSet = "us-ascii"

  'Open the stream And write text/string data To the object
  BinaryStream.Open
  BinaryStream.WriteText Text

  'Change stream type To binary
  BinaryStream.Position = 0
  BinaryStream.Type = adTypeBinary

  'Ignore first two bytes - sign of
  BinaryStream.Position = 0

  'Open the stream And get binary data from the object
  stringToBinary = BinaryStream.Read

  Set BinaryStream = Nothing
End Function

Function getHeaders(xmlHttp, headerName)
    headerName = Trim(headerName) & ":"
    Dim tArr: tArr = Split(xmlHttp.getAllResponseHeaders(), vbCrLf)
    tArr = Filter(tArr, headerName, True, vbTextCompare)
    Dim i
    For i = 0 To UBound(tArr)
        tArr(i) = Trim(Mid(tArr(i), Len(headerName) + 1, Len(tArr(i))))
    Next
    getHeaders = tArr
End Function

Public Function getCookies(xmlHttp)
    Dim headers: headers = getHeaders(xmlHttp, "Set-Cookie")
    Dim cookies: Set cookies = CreateObject("Scripting.Dictionary")
    
    Dim i, name, value, delimiterPos
    For i = 0 To UBound(headers)
        delimiterPos = InStr(headers(i), "=")
        name = Left(headers(i), delimiterPos - 1)
        value = Split(Mid(headers(i), delimiterPos + 1), ";")(0)
        cookies.Add name, value
    Next
    Set getCookies = cookies

End Function

Public Function getJson(URL, cookies)
    Set getJson = getAs(URL, cookies, "application/json")
End Function

Public Function getAs(URL, cookies, acceptType)
    Dim authCookieNames(1)
    authCookieNames(0) = "ASP.NET_SessionId"
    authCookieNames(1) = ".ASPXAUTH"
        
    Dim userAgent: userAgent = "Microsoft.XMLHTTP" '"Msxml2.ServerXMLHTTP"
    Dim xmlHttp: Set xmlHttp = CreateObject(userAgent)

    Dim async: async = False
    
    xmlHttp.Open "GET", domain & URL, async
    xmlHttp.setRequestHeader "User-Agent", userAgent
    xmlHttp.setRequestHeader "Accept", acceptType
    xmlHttp.setRequestHeader "Host", "app.vinsight.net"
    xmlHttp.setRequestHeader "Content-Length", "0"
    
    Dim i, cookie
    For i = 0 To UBound(authCookieNames)
        cookie = authCookieNames(i) & "=" & cookies(authCookieNames(i)) & "; "
    Next
    xmlHttp.setRequestHeader "Cookie", cookie

    xmlHttp.send

    Set getAs = xmlHttp

End Function

Function test(URL)
    Dim loginRequest: Set loginRequest = login(username, password)
    Dim cookies: Set cookies = getCookies(loginRequest)

    Dim resp: Set resp = getAs(URL, cookies, "text/csv")

    'Print output
    Set fso = CreateObject ("Scripting.FileSystemObject")
    Set stdout = fso.GetStandardStream (1)
    'Set stderr = fso.GetStandardStream (2)
    stdout.WriteLine "Status: " & resp.Status
    stdout.WriteLine "ResponseText: " & resp.responseText
    'stderr.WriteLine "This will go to error output."
End Function

test "/Vessels?$select=VesselCode,Volume,BatchCode,BatchStatus&$top=999"