TM1 Forum

Code: Select all

Private Function GetCamPassport(ByVal camuri As String, ByVal servername As String, ByRef passport As String, ByVal Size As LongLong) As LongLong
    On Error GoTo ErrorHandler:
    
    Dim sResponseHeaders, sResponseText, sCamPassport, aData, sUrl, oMatch
    sUrl = StrConv(camuri, vbFromUnicode)
    
    With CreateObject("WinHttp.WinHttpRequest.5.1")
         .Open "GET", sUrl, False
         .setRequestHeader "Accept", "application/json"
         .setRequestHeader "Content-Type", "application/json; charset=utf-8"
         .SetAutoLogonPolicy (0) '(AutoLogonPolicy_Always) 'Connect using current user credentials
         .Send
         sResponseHeaders = .getAllResponseHeaders
         sResponseText = .responseText
    End With
    
    aData = Array()
    With CreateObject("VBScript.RegExp")
        .Global = True
        .MultiLine = True
        .Pattern = "^Set-Cookie: cam_passport=(\S*?);[\s\S]*?$"
        For Each oMatch In .Execute(sResponseHeaders)
            If oMatch.SubMatches.Count = 1 Then
                sCamPassport = oMatch.SubMatches(0)
            End If
        Next
    End With
    
    'passport = StrConv(sCamPassport, vbUnicode) ' This works here but results in the function returning a badly padded passport
    passport = sCamPassport
    GetCamPassport = 0

    Exit Function
    
ErrorHandler:
    GetCamPassport = 2
End Function