diff --git a/authenticators/DigestAuthenticator.cls b/authenticators/DigestAuthenticator.cls index d1e8e4c8..10ec98c8 100644 --- a/authenticators/DigestAuthenticator.cls +++ b/authenticators/DigestAuthenticator.cls @@ -162,7 +162,8 @@ Public Sub ExtractAuthenticateInformation(Response As WebResponse) Dim web_CrLf As String auth_Header = WebHelpers.FindInKeyValues(Response.Headers, "WWW-Authenticate") - web_CrLf = VBA.Chr$(13) & VBA.Chr$(10) + 'web_CrLf = VBA.Chr$(13) & VBA.Chr$(10) 'original code(cr)(lf) + web_CrLf = VBA.Chr$(44) 'new code (,) If auth_Header <> "" And VBA.Left$(auth_Header, 6) = "Digest" Then Dim auth_Lines As Variant diff --git a/examples/httpbin/Httpbin.bas b/examples/httpbin/Httpbin.bas new file mode 100644 index 00000000..379d88c7 --- /dev/null +++ b/examples/httpbin/Httpbin.bas @@ -0,0 +1,99 @@ +Option Explicit + +Public Function HttpbinLookup(RequestUrl As String, Post_data As String) As WebResponse + + '------------------ build webclient ------------------ + Dim HttpbinClient As New WebClient + HttpbinClient.BaseUrl = "https://httpbin.org/" + + + '------------------ http basic authentication ------------------ + If Left(RequestUrl, 10) = "basic-auth" Then + Dim HttpbinAuth1 As New HttpBasicAuthenticator 'calls setup sub inside class module HttpBasicAuthenticator + 'enter your username and password below + HttpbinAuth1.Setup _ + Username:="user", _ + Password:="passwd" + 'add the info from the authenticator to the webclient we just created + Set HttpbinClient.Authenticator = HttpbinAuth1 + + + '------------------ http digest authentication ------------------ + ElseIf Left(RequestUrl, 11) = "digest-auth" Then + Dim HttpbinAuth2 As New DigestAuthenticator 'calls setup sub inside class module DigestAuthenticator + 'enter your username and password below + HttpbinAuth2.Setup _ + Username:="user", _ + Password:="passwd" + 'add the info from the authenticator to the webclient we just created + Set HttpbinClient.Authenticator = HttpbinAuth2 + 'httpbin digest auth will not work without a cookie! + End If + + + '------------------ build query url request (->) ------------------ + Dim request As New WebRequest + request.Resource = RequestUrl 'adds request onto end of the baseurl + 'Request.AddQuerystringParam "key", Credentials.Values("Google")("api_key") 'looks in credentials text file + 'Request.AddQuerystringParam "Request", Post_data 'outputs ?Request=Post_data Post_data is value from cell B2 + + + '------------------ set formatting ------------------ + 'Simple - send and receive in the same format + 'Request.Format = WebFormat.Json 'Request.Format sets four things: Content-Type header Accept header + 'Request Body conversion Response Data conversion + 'Medium - send and receive in two different formats + request.RequestFormat = WebFormat.JSON 'Set Content-Type and request converter + request.ResponseFormat = WebFormat.JSON 'Set Accept and response converter + 'request.ResponseFormat = WebFormat.FormUrlEncoded + + 'Advanced: Set separate everything + 'Request.RequestFormat = WebFormat.Json + 'Request.ContentType = "application/json" + 'Request.ResponseFormat = WebFormat.Json + 'Request.Accept = "application/json" + + + '------------------ set method ------------------ + If RequestUrl = "post" Then + request.Method = WebMethod.HttpPost 'POST - form data appears within the message body of the HTTP request, not in the URL + 'Request.Body = "{""a"":123,""b"":[456, 789]}" 'same as below just all in one line + 'Request.AddBodyParameter "a", 123 + 'Request.AddBodyParameter "b", Array(456, 789) + Dim system_time As String + system_time = Now() + request.AddBodyParameter "systemtime", system_time 'send current system time + request.AddBodyParameter "postdata", Post_data 'Post_data is value passed from cell B2 + Else + request.Method = WebMethod.HttpGet 'GET - all form data is encoded into the URL - less flexible, less secure + End If + + + '------------------ set contents ------------------ + 'Add other things common to all Requests + request.AddCookie "cookie", "testCookie" 'httpbin digest auth will not work without a cookie! + request.AddHeader "header", "testHeader" + + + '------------------ send request and receive response ------------------ + 'this takes the HttpbinClient webclient we built at the top and executes the Request webrequest we made + 'then it sets the function to return the data from the server (<-) + Set HttpbinLookup = HttpbinClient.Execute(request) 'goes to WebClient(Execute) + +End Function + + +'this is just for testing in debug window and bypasses using an excel worksheet +Public Sub Test() + + WebHelpers.EnableLogging = True 'extended debug info + + Dim Response As WebResponse + Set Response = HttpbinLookup("ip", "") 'this calls function HttpbinLookup above + + If Response.StatusCode = WebStatusCode.OK Then + Debug.Print "Result: " & Response.Data("origin") 'ip address + Else + Debug.Print Response.Content + End If +End Sub diff --git a/examples/httpbin/HttpbinSheet.cls b/examples/httpbin/HttpbinSheet.cls new file mode 100644 index 00000000..d21cf357 --- /dev/null +++ b/examples/httpbin/HttpbinSheet.cls @@ -0,0 +1,93 @@ +Option Explicit + +Private Const HttpbinResultsFirstRow As Integer = 3 'Row 3 +Private Const HttpbinResultsCol As Integer = 2 'Column B +Private Const HttpbinResultsCount As Integer = 6 + + +Public Sub SearchHttpBin() + Dim Response As WebResponse + Dim RequestUrl As String, Post_data As String 'declared variables for readability + RequestUrl = LCase(Range("B1")) + Post_data = Range("B2") + + ClearResults 'calls ClearResults() + WebHelpers.EnableLogging = True 'extended debug info + + If RequestUrl = "post" Then 'if posting, make sure there is post data in RequestURL + If Post_data = "" Then + MsgBox ("Post Data input is empty") + Exit Sub + End If + End If + + If RequestUrl <> "" Then 'make sure cell B1 has data + Set Response = HttpbinLookup(RequestUrl, Post_data) 'call HttpbinLookup in Module Httpbin + Else + MsgBox ("Request input is empty") 'when the program comes back to here it is finished running + Exit Sub + End If + + ProcessResults Response 'calls ProcessResults() below with Response, the webresponse we received +End Sub + + +Public Sub ProcessResults(Results As WebResponse) + If Results.StatusCode < 400 Then + OutputResults Results 'calls OutputResults() + Else + OutputError Results.StatusCode, Results.Content 'calls OutputError() + End If +End Sub + + +Private Sub OutputResults(Results As WebResponse) + Dim request As String + request = LCase(Range("B1")) + If request = "get?show_env=1" Then + Range("B3") = "url: " & Results.Data("url") + Range("B4") = "user-agent: " & Results.Data("headers")("User-Agent") + Range("B5") = "origin: " & Results.Data("origin") + Range("B6") = "protocol: " & Results.Data("headers")("X-Forwarded-Proto") + Range("B7") = "port: " & Results.Data("headers")("X-Forwarded-Port") + ElseIf request = "get" Then + Range("B3") = "url: " & Results.Data("url") + Range("B4") = "user-agent: " & Results.Data("headers")("User-Agent") + Range("B5") = "origin: " & Results.Data("origin") + ElseIf Left(request, 10) = "basic-auth" Then + Range("B3") = "authenticated: " & Results.Data("authenticated") + Range("B4") = "user: " & Results.Data("user") + ElseIf Left(request, 11) = "digest-auth" Then + Range("B3") = "authenticated: " & Results.Data("authenticated") + Range("B4") = "user: " & Results.Data("user") + ElseIf request = "post" Then + 'these will give you an error if they are not returned in the response (because you requested something different) + Range("B3") = Results.Data("data") 'outputs all data in one line, probably not what you want + Range("B4") = "url: " & Results.Data("url") + Range("B5") = "user-agent: " & Results.Data("headers")("User-Agent") + Range("B6") = "origin: " & Results.Data("origin") + 'don't try reading individual entries out of ("data") + 'for it to work they all need to be on separate lines in the debug window, like how "headers" or "json" are + Range("B7") = "systemtime: " & Results.Data("json")("systemtime") + Range("B8") = "postdata: " & Results.Data("json")("postdata") + End If +End Sub + + +Private Sub OutputError(Code As Integer, Message As String) + Me.Cells(HttpbinResultsFirstRow, HttpbinResultsCol) = "Error " & Code & ": " & Message +End Sub + + +Private Sub ClearResults() + Dim PrevUpdating As Boolean + PrevUpdating = Application.ScreenUpdating + Application.ScreenUpdating = False + + Dim LastRow As Integer + LastRow = HttpbinResultsFirstRow + HttpbinResultsCount - 1 + 'Me.Rows(HttpbinResultsFirstRow & ":" & LastRow).ClearContents 'clear entire row + Me.Range(Me.Cells(HttpbinResultsFirstRow, HttpbinResultsCol), Me.Cells(LastRow, HttpbinResultsCol)).ClearContents 'clear selected part of column + + Application.ScreenUpdating = PrevUpdating +End Sub diff --git a/examples/requestbin/Requestbin.bas b/examples/requestbin/Requestbin.bas new file mode 100644 index 00000000..51169b52 --- /dev/null +++ b/examples/requestbin/Requestbin.bas @@ -0,0 +1,77 @@ +Option Explicit + +Public Function RequestbinLookup(Tempurl As String, Post_data As String) As WebResponse + + '------------------ build webclient ------------------ + Dim RequestbinClient As New WebClient + RequestbinClient.BaseUrl = "https://requestb.in/" + + + '------------------ build query url request (->) ------------------ + Dim request As New WebRequest + request.Resource = Tempurl 'adds request onto end of the baseurl + 'Request.AddQuerystringParam "key", Credentials.Values("Google")("api_key") 'looks in credentials text file + 'Request.AddQuerystringParam "Request", Post_data 'outputs ?Request=Post_data Post_data is value from cell B1 + + + '------------------ set formatting ------------------ + 'Simple - send and receive in the same format + 'Request.Format = WebFormat.Json 'Request.Format sets four things: Content-Type header Accept header + 'Request Body conversion Response Data conversion + 'Medium - send and receive in two different formats + request.RequestFormat = WebFormat.JSON 'Set Content-Type and request converter + 'request.ResponseFormat = WebFormat.JSON 'Set Accept and response converter + request.ResponseFormat = WebFormat.FormUrlEncoded + + 'Advanced: Set separate everything + 'Request.RequestFormat = WebFormat.Json + 'Request.ContentType = "application/json" + 'Request.ResponseFormat = WebFormat.Json + 'Request.Accept = "application/json" + + + '------------------ set method ------------------ + request.Method = WebMethod.HttpPost 'POST - form data appears within the message body of the HTTP request, not in the URL + 'Request.Method = WebMethod.HttpGet 'GET - all form data is encoded into the URL - less flexible, less secure + + + '------------------ set contents ------------------ + 'Request.Body = "{""a"":123,""b"":[456, 789]}" 'same as below just all in one line + 'Request.AddBodyParameter "a", 123 + 'Request.AddBodyParameter "b", Array(456, 789) + Dim system_time As String + system_time = Now() + request.AddBodyParameter "system time", system_time 'send current system time + request.AddBodyParameter "spreadsheet input", Post_data 'Post_data is value passed from cell B1 + + + ' Add other things common to all Requests + request.AddCookie "cookie", "testCookie" + request.AddHeader "header", "testHeader" + + + '------------------ send request and receive response ------------------ + 'this takes the RequestbinClient webclient we built at the top and executes the Request webrequest we made + 'then it sets the function to return the data from the server (<-) + Set RequestbinLookup = RequestbinClient.Execute(request) 'now it goes to WebClient(Execute) + +End Function + + +'this is just for testing in debug window and bypasses using an excel worksheet +Public Sub Test() + + Dim Tempurl As String + Dim Post_data As String + Tempurl = "1klwlzq1" 'enter your bin + Post_data = "Test12345" 'enter your post data + + Dim Response As WebResponse + Set Response = RequestbinLookup(Tempurl, Post_data) 'this calls function RequestbinLookup above + + If Response.StatusCode = WebStatusCode.OK Then + Debug.Print "Result: " & Response.Content 'server response + Else + Debug.Print Response.Content + End If +End Sub diff --git a/examples/requestbin/RequestbinSheet.cls b/examples/requestbin/RequestbinSheet.cls new file mode 100644 index 00000000..94626a7e --- /dev/null +++ b/examples/requestbin/RequestbinSheet.cls @@ -0,0 +1,59 @@ +Option Explicit + +Private Const RequestbinResultsFirstRow As Integer = 2 'Row 2 +Private Const RequestbinResultsCol As Integer = 2 'Column B +Private Const RequestbinResultsCount As Integer = 1 + +Public Sub SearchRequestbin() + Dim Response As WebResponse + Dim Tempurl As String, Post_data As String 'declared variables for readability + Tempurl = Range("E5") + Post_data = Range("B1") + + ClearResults 'calls ClearResults() + WebHelpers.EnableLogging = True 'extended debug info + + If IsEmpty(Tempurl) = True Then 'user must enter their personal requestbin url + MsgBox ("Please enter your request bin url") + Exit Sub + End If + + If IsEmpty(Post_data) = False Then 'don't submit a blank post data + Set Response = RequestbinLookup(Tempurl, Post_data) 'this line goes out and does everything + Else 'when the program comes back to here it is already finished running + MsgBox ("Input is empty") + Exit Sub + End If + + ProcessResults Response 'calls ProcessResults() below with Response, the webresponse we received +End Sub + +Public Sub ProcessResults(Results As WebResponse) + If Results.StatusCode < 400 Then + OutputResults Results 'calls OutputResults() + Else + OutputError Results.StatusCode, Results.Content 'calls OutputError() + End If +End Sub + +Private Sub OutputResults(Results As WebResponse) + 'requestbin just lets you post data, it only returns a server response 'ok' + Me.Cells(RequestbinResultsFirstRow, RequestbinResultsCol) = Results.Content +End Sub + +Private Sub OutputError(Code As Integer, Message As String) + Me.Cells(RequestbinResultsFirstRow, RequestbinResultsCol) = "Error " & Code & ": " & Message +End Sub + +Private Sub ClearResults() + Dim PrevUpdating As Boolean + PrevUpdating = Application.ScreenUpdating + Application.ScreenUpdating = False + + Dim LastRow As Integer + LastRow = RequestbinResultsFirstRow + RequestbinResultsCount - 1 + 'Me.Rows(RequestbinResultsFirstRow & ":" & LastRow).ClearContents 'clear entire row + Me.Range(Me.Cells(RequestbinResultsFirstRow, RequestbinResultsCol), Me.Cells(LastRow, RequestbinResultsCol)).ClearContents 'clear selected part of column + + Application.ScreenUpdating = PrevUpdating +End Sub