Please see this post for the same issue in bash.
Here is my main code:
loadFile "md5.vbs"
wscript.echo "md5('test') = " & md5("test")
loadFile "sha256.vbs"
wscript.echo "sha256('test') = " & sha256("test")
method = "POST"
app_id = <redacted>
key = "<redacted>"
secret = "<redacted>"
tstamp = datediff("s",#1970/1/1#,dateadd("h",5,now()))
data = "{""data"":{""message"":""hello world""},""name"":""my_event"",""channel"":""test_channel""}"
path = "/apps/" & app_ID & "/events"
query = "body_md5=" & md5(data) & "&auth_version=1.0&auth_key=" & key & "&auth_timestamp=" & tstamp
sig = sha256(method & vbLf & path & vbLf & query & vbLf & secret)
url = "https://api.pusherapp.com" & path & "?" & query & "&auth_signature=" & sig
wscript.echo url
dim xmlhttp
set xmlhttp = Createobject("MSXML2.ServerXMLHTTP")
xmlhttp.Open method,url,false
xmlhttp.setRequestHeader "Content-Type", "application/json"
xmlhttp.send data
WScript.echo xmlhttp.responsetext
Set xmlhttp = nothing
md5.vbs can be found here and sha256.vbs here.
I get this error:
Invalid signature: you should have sent HmacSHA256Hex("POST\n/apps/(redacted)/events\nauth_key=(redacted)&auth_timestamp=1471291494&auth_version=1.0&body_md5=(redacted)", your_secret_key), but you sent "(redacted)"
(code edits: Added secret to sig, changed crlf to lf)
Related
I used the following code to check if a RSS url responds in 5 seconds so I can consume the RSS feed however trying to open the URL causes error when the target URL could not be resolved. What more I need rather than waitForResponse to also handle this situation?
Set http = Server.CreateObject("MSXML2.ServerXMLHTTP")
http.open "POST", "https://persiadigest.com/fa/rss/8", True
http.send
If http.waitForResponse(5) Then
body=http.responsetext
Else
response.write "Target url is not responding"
End If
Set http = Nothing
Error details:
msxml3.dll error '80072ee7' The server name or address could not be
resolved
Give a try for this example and tell me the results :
Option Explicit
Dim Title : Title = "Get RSS FEED"
Dim ArrURL : ArrURL = Array("https://persiadigest.com/fa/rss/8","http://khabarfoori.com/rss/mm")
Dim URL
For Each URL in ArrURL
If CheckURL(URL) = "200" Then
MsgBox chr(34) & URL & chr(34) & " ==> is active"& vbCrLF &_
"Status : " & CheckURL(URL),vbInformation,Title
MsgBox GetDataFromURL(URL,"GET",""),vbInformation,Title
Else
MsgBox chr(34) & URL & chr(34) & " ==> is inactive" & vbCrLF &_
"Status : " & CheckURL(URL),vbCritical,Title
End if
Next
'---------------------------------------------------------------------------
Function GetDataFromURL(strURL, strMethod, strPostData)
Dim lngTimeout
Dim strUserAgentString
Dim intSslErrorIgnoreFlags
Dim blnEnableRedirects
Dim blnEnableHttpsToHttpRedirects
Dim strHostOverride
Dim strLogin
Dim strPassword
Dim strResponseText
Dim objWinHttp
lngTimeout = 59000
strUserAgentString = "http_requester/0.1"
intSslErrorIgnoreFlags = 13056 ' 13056: ignore all err, 0: accept no err
blnEnableRedirects = True
blnEnableHttpsToHttpRedirects = True
strHostOverride = ""
strLogin = ""
strPassword = ""
Set objWinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
objWinHttp.SetTimeouts lngTimeout, lngTimeout, lngTimeout, lngTimeout
objWinHttp.Open strMethod, strURL
If strMethod = "POST" Then
objWinHttp.setRequestHeader "Content-type", _
"application/x-www-form-urlencoded"
End If
If strHostOverride <> "" Then
objWinHttp.SetRequestHeader "Host", strHostOverride
End If
objWinHttp.Option(0) = strUserAgentString
objWinHttp.Option(4) = intSslErrorIgnoreFlags
objWinHttp.Option(6) = blnEnableRedirects
objWinHttp.Option(12) = blnEnableHttpsToHttpRedirects
If (strLogin <> "") And (strPassword <> "") Then
objWinHttp.SetCredentials strLogin, strPassword, 0
End If
On Error Resume Next
objWinHttp.Send(strPostData)
If Err.Number = 0 Then
If objWinHttp.Status = "200" Then
GetDataFromURL = objWinHttp.ResponseText
Else
GetDataFromURL = "HTTP " & objWinHttp.Status & " " & _
objWinHttp.StatusText
End If
Else
GetDataFromURL = "Error " & Err.Number & " " & Err.Source & " " & _
Err.Description
End If
On Error GoTo 0
Set objWinHttp = Nothing
End Function
'---------------------------------------------------------------------------
Function CheckURL(vURL)
On Error Resume Next
Dim xhr
Set xhr = CreateObject("MSXML2.ServerXMLHTTP.3.0")
xhr.Open "HEAD", vURL, false
xhr.Send
If Err.Number = 0 Then
'MsgBox xhr.status
CheckURL = xhr.status
Else
CheckURL = Err.Description
End If
End Function
'---------------------------------------------------------------------------
A simple function that ignores errors would work.
Function WaitIgnoreError(ByRef requestObject, timeout)
On Error Resume Next
WaitIgnoreError = requestObject.WaitForResponse(timeout)
End Function
Usage:
If WaitIgnoreError(http, 5) Then
body = http.responsetext
Else
response.write "Target url is not responding"
End If
I want to send Image or pdf document in post request, the URL is working fine, but in visual basic I used the below code to send the document using url but It gives me failure response server error .
I have checked URL, it has no issue, but when I tried to implement in vb, in response I get the 500 server error
Dim strFile As String
Dim uploadDocUrl As String
Dim baBuffer() As Byte
Dim sPostData As String
Dim strFile As String
Dim strFileName As String
strFile = "C://Users/Avinashi/Desktop/1.pdf"
uploadDocUrl = "http://api.tally.messaging.bizbrain.in/api/v1/uploadFile"
strFileName = "1.pdf"
nFile = FreeFile
Open strFile For Binary Access Read As nFile
If LOF(nFile) > 0 Then
ReDim baBuffer(0 To LOF(nFile) - 1) As Byte
Get nFile, , baBuffer
sPostData = StrConv(baBuffer, vbUnicode)
End If
Close nFile
sPostData = "--" & STR_BOUNDARY & vbCrLf & _
"Content-Disposition: form-data;name=""1.pdf""; filename=""" & Mid$(strFile, InStrRev(strFile, "\") + 1) & """" & vbCrLf & _
"Content-Type:multipart/form-data" & vbCrLf & vbCrLf & _
sPostData & vbCrLf & _
"--" & STR_BOUNDARY & "--"
With CreateObject("Microsoft.XMLHTTP")
.Open "POST", uploadDocUrl, bAsync
.SetRequestHeader "Content-Type", "multipart/form-data"
.SetRequestHeader "token", "78bea912b4a5c497b85926bb471fab04"
.Send pvToByteArray(sPostData)
MsgBox (.responseText)
End With
Private Function pvToByteArray(sText As String) As Byte()
pvToByteArray = StrConv(sText, vbUnicode)
End Function
The text file exists, the web hook exists, etc. I am using a discord web hook. The response is
{"code": 50006, "message": "Cannot send an empty message"}
I have concluded that the way I formatted the request is incorrect. Probably the Set oHTTP = CreateObject("Microsoft.XMLHTTP") part.
How do I reformat the request correctly? Is it even possible to send a web hook using a .vbs file?
Dim time
user = CreateObject("WScript.Network").UserName
time = (FormatDateTime(Now, 2)& " "& FormatDateTime(Now, 4))
Set objFileToRead = CreateObject("Scripting.FileSystemObject").OpenTextFile("C:\Users\"& user& "\Desktop\state.txt",1)
state = objFileToRead.ReadAll()
objFileToRead.Close
Set objFileToRead = Nothing
url = "" 'my discord webhook
avatar = "https://discordapp.com/assets/dd4dbc0016779df1378e7812eabaa04d.png"
req1 = ("{ \" & Chr(34) & "username\" & Chr(34) & ":\" & Chr(34) & _
"Manage bot\" & Chr(34) & ", \" & Chr(34) & "avatar_url\" & Chr(34) & _
":\" & Chr(34) & avatar)
req2 = Chr(34) & ", \" & Chr(34) & "content\" & Chr(34) & ":\" & Chr(34) & _
time & " " & user & Chr(13) + Chr(10) & state & Chr(34) & " }"
Set oHTTP = CreateObject("Microsoft.XMLHTTP")
oHTTP.Open "POST", url, False
oHTTP.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
oHTTP.SetRequestHeader "Content-Length", Len(req1+req2)
oHTTP.Send req1+req2
HTTPPost = oHTTP.ResponseText
MsgBox oHTTP.ResponseText
Here is the code I am using:
Dim httpReq As New WinHttp.WinHttpRequest
Dim strLineOut As String
Dim strReturn As String
Dim strStatus As String
lblResponse1.Caption = ""
DoEvents
strLineOut = "<form name=""form1"" method=""post"" enctype=""multipart/form-data"">" & vbCrLf
strLineOut = strLineOut & " <input name=""hdntype"" type=""hidden"" id=""hnd1"" value=""1"">" & vbCrLf
strLineOut = strLineOut & " <input name=""hnd1"" type=""hidden"" id=""hnd1"" value=""Value1"">" & vbCrLf
strLineOut = strLineOut & " <input name=""hdn2"" type=""hidden"" id=""hdn2"" value=""Value2"">" & vbCrLf
strLineOut = strLineOut & " <input type=""submit"" name=""Submit"" value=""Submit"">" & vbCrLf
strLineOut = strLineOut & "</form>" & vbCrLf
httpReq.Open "POST", "http://www.XXXX.com/XMLProjects/vb6test/form_post.asp", False
httpReq.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
'text/xml
'application/x-www-form-urlencoded
'httpReq.StatusText
'httpReq.Status
'httpReq.SetRequestHeader "Content-Length", Len(strLineOut)
httpReq.Send (strLineOut)
strStatus = httpReq.StatusText
strReturn = httpReq.ResponseText
Debug.Print strReturn & vbCrLf & strStatus
lblResponse1.Caption = strReturn & vbCrLf & strStatus
Set httpReq = Nothing
The asp that catches the form cannot seem to recognize the form. It sees a form with one item.
The catch code in the asp is:
Response.Write Request.Form("hdntype")
Response.Write "the form object is " & Request.Form.Item(1) & vbCrLf
The response from the asp is:
the form object is "form1"method="post"enctype="multipart/form-data">
<inputname="hdntype"type="hidden"id="hnd1"value="1">
<inputname="hnd1"type="hidden"id="hnd1"value="Nick">
<inputname="hdn2"type="hidden"id="hdn2"value="Arnone">
<inputtype="submit"name="Submit"value="Submit"></form>
It does not see the item hdntype, or any other item within the form. It sees 1 item, the entire form.
If I do a Request.TotalBytes, I can see everythinhg in the asp.
If I add a querystring objects, I can see each object.
I cannot see form objects.
In VB6, if you send the data like this:
strIDJob = "34"
strAuthString = "supertest"
DataToPost = ""
DataToPost = DataToPost & "IDJob=" & strIDJob & "&"
DataToPost = DataToPost & "AUTH=" & strAuthString & "&"
(im sending it to an ASP page, using the CreateObject("Msxml2.XMLHTTP.6.0") component)
(sending with POST with only this header included: "application/x-www-form-urlencoded")
Then, you can retrieve each item using the code bellow (in ASP), one by one:
IDJob = Request.Form.Item(1) 'here is the core point of this post. This is the line that matters
AUTH = Request.Form.Item(2) 'here is the core point of this post. This is the line that matters
response.write "IDJob = " & IDJob & "<BR>"
response.write "AUTH = " & AUTH & "<BR>"
Response.End
this code in asp produces the following return/output:
IDJob = 34AUTH = supertest
In order to manage the errors coming from a particular client I am thinking about having the app send the current error log file to me, perhaps when it starts up.
What would the best way to achieve this in a VB6/XP environment?
Email might be easy but I imagine that could fire off all sorts of anti-virus/firewall protections.
Connecting to a webserver might be better. Would the app still have to open up the Windows firewall in this case?
I'm using XMLHTTP to upload clients error logs like this: http://wqweto.wordpress.com/2011/07/12/vb6-using-wininet-to-post-binary-file/
Private Sub pvPostFile(sUrl As String, sFileName As String, Optional ByVal bAsync As Boolean)
Const STR_BOUNDARY As String = "3fbd04f5-b1ed-4060-99b9-fca7ff59c113"
Dim nFile As Integer
Dim baBuffer() As Byte
Dim sPostData As String
'--- read file
nFile = FreeFile
Open sFileName For Binary Access Read As nFile
If LOF(nFile) > 0 Then
ReDim baBuffer(0 To LOF(nFile) - 1) As Byte
Get nFile, , baBuffer
sPostData = StrConv(baBuffer, vbUnicode)
End If
Close nFile
'--- prepare body
sPostData = "--" & STR_BOUNDARY & vbCrLf & _
"Content-Disposition: form-data; name=""uploadfile""; filename=""" & Mid$(sFileName, InStrRev(sFileName, "\") + 1) & """" & vbCrLf & _
"Content-Type: application/octet-stream" & vbCrLf & vbCrLf & _
sPostData & vbCrLf & _
"--" & STR_BOUNDARY & "--"
'--- post
With CreateObject("Microsoft.XMLHTTP")
.Open "POST", sUrl, bAsync
.SetRequestHeader "Content-Type", "multipart/form-data; boundary=" & STR_BOUNDARY
.Send pvToByteArray(sPostData)
End With
End Sub
Private Function pvToByteArray(sText As String) As Byte()
pvToByteArray = StrConv(sText, vbFromUnicode)
End Function