How do I get the request to be detected - vbscript

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

Related

How to generate Pusher authentication string from VBscript?

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)

access vbs file passing parameters comes empty form

i am creating a .vbs file that should open access, and inside access a form call "Issue Details", but passing a parameter, meaning that if i have 10 issues in my "Issues" table a vbs file is created for each one and when clicked should open the right form id(would be one ID for each in the table). It is so far opening access and it is opening the form(Issue Details) but it is blank. What am i missing? Help, getting crazy here ... Check code below
Public Sub sendMRBmail(mrbid)
Dim tmprs As DAO.Recordset
Dim db As DAO.Database
Set db = CurrentDb
Set tmprs = db.OpenRecordset("select * from Issues where [ID] = " & mrbid)
If IsNull(tmprs) Then
MsgBox "Record is not yet available"
Else
DoCmd.OpenForm "Issue Details", , , "[ID] = " & mrbid
End If
Set tmprs = Nothing
End Sub
Private Sub Create_Click()
On Error GoTo Err_Command48_Click
Dim snid As Integer
snid = Me.ID
Dim filename As String
filename = "S:\Quality Control\vbs\QC" & snid & ".vbs"
Dim proc As String
proc = Chr(34) & "sendMRBmail" & Chr(34)
Dim strList As String
strList = "On Error Resume Next" & vbNewLine
strList = strList & "dim accessApp" & vbNewLine
strList = strList & "set accessApp = createObject(" & Chr(34) & "Access.Application" & Chr(34)")" & vbNewLine
strList = strList & "accessApp.OpenCurrentDataBase(" & Chr(34) & "S:\Quality Control\Quality DB\Quality Database.accdb" & Chr(34) & ")" & vbNewLine
strList = strList & "accessApp.Run " & proc & "," & Chr(34) & snid & Chr(34) & vbNewLine
strList = strList & "set accessApp = nothing" & vbNewLine
Open filename For Output As #1
Print #1, strList
Close #1
Err_Command48_Click:
If Err.Number <> 0 Then
MsgBox "Email Error #: " & Err.Number & ", " & "Description: " & Err.Description
Exit Sub
End If
End Sub
I already found the answer. I added acFormEdit at the end of my DoCmd and it worked, check below:
DoCmd.OpenForm "Issue Details", , , "[ID] = " & mrbid, acFormEdit

VB6 To send a Form Post

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

What is wrong with this code that Windows 8 doesn't like, but Windows 7 runs fine?

Have errors on Line 59, Char 1.... "The Interface is Unknown"
The intent is to popup a simple user input box and capture the results into a variable, and then into a text file, so a 3rd party application can read it. I am not very good at coding VBS but I made this work perfectly in Windows 7.
I am looking to make this (VBscript) work in Windows 8 too. But I don't want to learn how to script or code in another language. I don't want to rewrite the whole thing in Javascript or .NET or whatever.
Please let me know what Windows 8 is doing differently from Windows 7 sp1.
Thanks.
'=======================[ ASK Password ]========================================'
Option Explicit
Dim strUserID, strPassword
AskPassword
Sub AskPassword()
Dim htmlPwdCode, objCodeFile, objFileSysObj, objBrowser, strButton
Const FOR_WRITING = 2
Set objFileSysObj = CreateObject("Scripting.FileSystemObject")
htmlPwdCode = "<SCRIPT LANGUAGE=" & Chr(34) & "VBScript" & Chr(34) & ">" & Chr(13) & _
"Sub RunScript" & Chr(13) & _
" OKClicked.Value = " & Chr(34) & "OK"& Chr(34) & Chr(13) & _
"End Sub" & Chr(13) & _
"Sub CancelScript" & Chr(13) & _
" OKClicked.Value = " & Chr(34) & "Cancelled" & Chr(34) & Chr(13) & _
"End Sub" & Chr(13) & _
"Sub Default_Buttons" & Chr(13) & _
" If Window.Event.KeyCode = 13 Then" & Chr(13) & _
" btnOK.Click" & Chr(13) & _
" End If" & Chr(13) & _
"End Sub" & Chr(13) & _
"</SCRIPT>" & Chr(13) & _
"<BODY onkeypress='vbs:Default_Buttons'><center><font size=" & Chr(34) & "2" & Chr(34) & " face=" & Chr(34) & "Arial" & Chr(34) & ">" & Chr(13) & _
"User name: " & Chr(13) & _
"<input type=" & Chr(34) & "text" & Chr(34) & " name=" & Chr(34) & "UserName" & Chr(34) & " size=" & Chr(34) & "30" & Chr(34) & "><br>" & Chr(13) & _
"Password : </font><font face=" & Chr(34) & "Arial" & Chr(34) & ">" & Chr(13) & _
"<input type=" & Chr(34) & "password" & Chr(34) & " name=" & Chr(34) & "UserPassword" & Chr(34) & _
" size=" & Chr(34) & "30" & Chr(34) & "></font></p>" & Chr(13) & _
"<input type=" & Chr(34) & "hidden" & Chr(34) & " name=" & Chr(34) & "OKClicked" & Chr(34) & " size = " & Chr(34) & "20" & Chr(34) & ">" & Chr(13) & _
"<input id=" & Chr(34) & "btnOK" & Chr(34) & " class=" & Chr(34) & "button" & Chr(34) & _
" type=" & Chr(34) & "button" & Chr(34) & " value=" & Chr(34) & " OK " & Chr(34) & _
" name=" & Chr(34) & "ok_button" & Chr(34) & " onClick=" & Chr(34) & "RunScript" & Chr(34) & ">" & Chr(13) & _
"<input id=" & Chr(34) & "btnCancel" & Chr(34) & " class=" & Chr(34) & "button" & Chr(34) & _
" type=" & Chr(34) & "button" & Chr(34) & " value=" & Chr(34) & "Cancel" & Chr(34) & _
" name=" & Chr(34) & "cancel_button" & Chr(34) & " onClick=" & Chr(34) & "CancelScript" & Chr(34) & "></center></BODY>"
Set objCodeFile = objFileSysObj.CreateTextFile("LoginPrompt.html", True)
objCodeFile.Write htmlPwdCode
objCodeFile.Close
Set objCodeFile = Nothing
Set objBrowser = CreateObject("InternetExplorer.Application")
With objBrowser
.Height = 200
.Width = 400
.Top = 200
.Left = 300
.StatusBar = True
.Toolbar = False
.Resizable = False
.Navigate CreateObject("Scripting.FileSystemObject").GetParentFolderName(Wscript.ScriptFullName) & "\LoginPrompt.html"
.Visible = True
End With
Do Until objBrowser.ReadyState = 4
'wait till page loads'
Loop
Do While objBrowser.Document.Body.All.OKClicked.Value = ""
Wscript.Sleep 50
Loop
strUserID = objBrowser.Document.Body.All.UserName.Value
strPassword = objBrowser.Document.Body.All.UserPassword.Value
strButton = objBrowser.Document.Body.All.OKClicked.Value
'''''''''''''''''''''''
Dim objFSO, strFile, objFile
Const ForWriting = 2
Const OpenAsASCII = 0
Const CreateIfNotExist = True
' Specify output file.
strFile = "C:\TEMP\MEX\UN.txt"
' Open the file.
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strFile, _
ForWriting, CreateIfNotExist, OpenAsASCII)
' write to file.
objFile.WriteLine strUserID
' Clean up.
objFile.Close
'''''''''''''''''''''''''''
Dim objFSO2, strFile2, objFile2
Const ForWriting2 = 2
Const OpenAsASCII2 = 0
Const CreateIfNotExist2 = True
' Specify output file.
strFile2 = "C:\TEMP\MEX\PW.txt"
' Open the file.
Set objFSO2 = CreateObject("Scripting.FileSystemObject")
Set objFile2 = objFSO2.OpenTextFile(strFile2, _
ForWriting2, CreateIfNotExist2, OpenAsASCII2)
' write to file.
objFile2.WriteLine strPassword
' Clean up.
objFile2.Close
'''''''''''''''''''''''''''
objBrowser.Quit
If strButton = "Cancelled" Then
MsgBox "Operation cancelled, script will now exit!"
Wscript.Quit
Else
'Credentials accepted for further processing
End If
objFileSysObj.DeleteFile "LoginPrompt.html", True
Set objBrowser = Nothing
Set objFileSysObj = Nothing
End Sub
'=======================[ GOT Password ]========================================'
Line 59: Do Until objBrowser.ReadyState = 4
The problem, according to MSDN: ReadyState Property Example (VBScript), is that the "ReadyState" feature has been removed.

How to monitoring folder files by vbs

Can anyone help me where i do mistake ?
this script is for monitoring folder for create, delete or modified text files
sPath = "C:\scripts\test"
sComputer = "."
sDrive = split(sPath,":")(0)
sFolders1 = split(sPath,":")(1)
sFolders = REPLACE(sFolders1, "\", "\\") & "\\"
Set objWMIService = GetObject("winmgmts:\\" & sComputer & "\root\cimv2")
Set colMonitoredEvents = objWMIService.ExecNotificationQuery _
("SELECT * FROM __InstanceOperationEvent WITHIN 1 WHERE " _
& "TargetInstance ISA 'CIM_DataFile' AND " _
& "TargetInstance.Drive='" & sDrive & "' AND " _
& "TargetInstance.Path='" & sFolders & "' AND " _
& "TargetInstance.Extension = 'txt' ")
Wscript.Echo vbCrlf & Now & vbTab & _
"Begin Monitoring for a Folder " & sDrive & ":" & sFolders1 & " Change Event..." & vbCrlf
Do
Set objLatestEvent = colMonitoredEvents.NextEvent
Select Case objLatestEvent.Path_.Class
Case "__InstanceCreationEvent"
WScript.Echo Now & vbTab & objLatestEvent.TargetInstance.FileName & "." & objLatestEvent.TargetInstance.Extension _
& " was created" & vbCrlf
Case "__InstanceDeletionEvent"
WScript.Echo Now & vbTab & objLatestEvent.TargetInstance.FileName & "." & objLatestEvent.TargetInstance.Extension _
& " was deleted" & vbCrlf
Case "__InstanceModificationEvent"
If objLatestEvent.TargetInstance.LastModified <> _
objLatestEvent.PreviousInstance.LastModified then
WScript.Echo Now & vbTab & objLatestEvent.TargetInstance.FileName & "." & objLatestEvent.TargetInstance.Extension _
& " was modified" & vbCrlf
End If
End Select
Loop
Set objWMIService = nothing
Set colMonitoredEvents = nothing
Set objLatestEvent = nothing
This script is run perfect when i write
sPath = "\\ComputerName\C$\scripts\test"
insted of
sPath = "C:\scripts\test"
Thank you....
If you google for "WMI TargetInstance.Drive", you'll see that the drive letter needs a colon. A query like
SELECT * FROM __InstanceOperationEvent WITHIN 1 WHERE TargetInstance ISA 'CIM_DataFile' AND TargetInstance.Drive='E:' AND TargetInstance.Path='\\trials\\SoTrials\\answers\\10041057\\data\\' AND TargetInstance.Extension = 'txt'
works as expected.

Resources