I try to POST some data to a PHP script with VBScript, but something I do wrong...
Dim objStream
Set objStream = CreateObject("ADODB.Stream")
objStream.Type = adTypeBinary
objStream.Open()
objStream.LoadFromFile("base64.txt")
objDocElem.nodeTypedValue = objStream.Read()
Set objHTTP = CreateObject("Microsoft.XMLHTTP")
objHTTP.open "POST", "http://mysite.com/data.php", False
objHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
objHTTP.send "data=" + objDocElem.text
'MsgBox objHTTP.responseText
Set objHTTP = Nothing
Set objStream = Nothing
C:\Documents and Settings\User\Desktop\data\test.vbe(3, 1)
ADODB.Stream : Arguments are of the wrong type, are out of acceptable
range, or are in confli ct with one another.
Solved it myself.
Dim TextArea
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set TextFile = oFSO.OpenTextFile("base64.txt", 1)
TextArea = ""
Do Until TextFile.AtEndOfStream
TextArea = TextArea & TextFile.ReadLine & vbNewLine
Loop
TextFile.Close
Set objHTTP = CreateObject("Microsoft.XMLHTTP")
objHTTP.open "POST", "http://mysite.com/data.php", False
objHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
objHTTP.send "data=" + TextArea
Set oFSO = Nothing
Set TextFile = Nothing
Set objHTTP = Nothing
Related
Can someone help me? I need to extract the texts that are between tags or HTML classes using VBScript and save to a single text file. I need to save the tags or classes I define on different lines.
I've found a lot of code on the internet, but none worked as expected.
For example, I have the code below, but I can't extract classes through it, and it's not possible for more than one tag either. In many cases the code doesn't even work.
myURL = "http://rss.cnn.com/rss/edition.rss"
Set oXMLHttp = CreateObject("MSXML2.XMLHTTP")
Set ohtmlFile = CreateObject("htmlfile")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Const ForReading = 1, ForWriting = 2, ForAppending = 8
oXMLHttp.Open "GET", myURL, False
oXMLHttp.send
If oXMLHttp.Status = 200 Then
ohtmlFile.Write oXMLHttp.responseText
ohtmlFile.Close
Set oTable = ohtmlFile.getElementsByTagName("description")
sFileName = "c:\users\user\desktop\News.txt"
Set objFile = objFSO.OpenTextFile(sFileName, ForAppending, True)
For Each oTab In oTable
objFile.Write oTab.Innertext & vbCrLf
Next
objFile.Close
End If
WScript.Quit
thanks!
You could use a regular expression instead, though:
Option Explicit
Dim myURL,oXMLHttp,objFSO,Description,write2File,ws
myURL = "http://rss.cnn.com/rss/edition.rss"
set ws = CreateObject("wscript.shell")
Set oXMLHttp = CreateObject("MSXML2.XMLHTTP")
Set objFSO = CreateObject("Scripting.FileSystemObject")
oXMLHttp.Open "GET", myURL, False
oXMLHttp.send
If oXMLHttp.Status = 200 Then
Description = Extract(oXMLHttp.responseText)
Set write2File = objFSO.CreateTextFile(".\News.txt",True)
write2File.WriteLine(Description)
write2File.Close
ws.run ".\News.txt"
End If
'-------------------------------------------------------------------------
Function Extract(Data)
Dim re,Match,Matches
Set re = New RegExp
re.Global = True
re.IgnoreCase = True
re.Pattern = "<description><!\[CDATA\[([\s\S]*?)\]\]><\/description>"
Set Matches = re.Execute(Data)
For Each Match in Matches
Description = Description & Match.SubMatches(0) & vbCrlf & vbCrlf
Next
Extract = Description
End Function
'-------------------------------------------------------------------------
EDIT :
For your second request about how to get news from google :
Option Explicit
Dim myURL,oXMLHttp,objFSO,GoogleNews,write2File,ws
myURL = "https://news.google.com/?hl=en-US&gl=US&ceid=US:en"
set ws = CreateObject("wscript.shell")
Set oXMLHttp = CreateObject("MSXML2.XMLHTTP")
Set objFSO = CreateObject("Scripting.FileSystemObject")
oXMLHttp.Open "GET", myURL, False
oXMLHttp.send
If oXMLHttp.Status = 200 Then
GoogleNews = Extract(oXMLHttp.responseText)
Set write2File = objFSO.CreateTextFile(".\GoogleNews.txt",True,-1)
write2File.WriteLine(GoogleNews)
write2File.Close
ws.run ".\GoogleNews.txt"
End If
'-------------------------------------------------------------------------
Function Extract(Data)
Dim re,Match,Matches
Set re = New RegExp
re.Global = True
re.IgnoreCase = True
re.MultiLine = True
re.Pattern = "(\bclass=""DY5T1d"" >)(.+?)<\/a>"
Set Matches = re.Execute(Data)
For Each Match in Matches
GoogleNews = GoogleNews & Match.SubMatches(1) & vbCrlf & vbCrlf
Next
GoogleNews = Replace(GoogleNews,"'","'")
GoogleNews = Replace(GoogleNews,""",chr(34))
Extract = GoogleNews
End Function
'-------------------------------------------------------------------------
You are on the right track with using the getElementsByTagName Method with your ohtmlFile object. You can specify the tag types you want. For example:
Set objAnchors = ohtmlFile.getElementsByTagName("a")
This returns all <a> tags in the HTML document.
I know this has been asked and answered, it is where I found the code to start my project. But it doesn't work.
I'm stuck. I have tried and tried and the code(s) don't work.
Dim xHttp: Set xHttp = CreateObject("Microsoft.XMLHTTP")
Dim bStrm: Set bStrm = CreateObject("Adodb.Stream")
xHttp.Open "GET", "https://filexxx.exe", False
xHttp.Send
With bStrm
.Type = 1 'binary
.Open
.Write xHttp.ResponseBody 'this part removed, error, tools not yet avail
.SaveToFile "c:\temp\xxx.exe", 2 'overwrite
End With
And this one.
strFileURL = "https://filexxx.exe"
strHDLocation = "C:\temp\xxx.exe"
Set objXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP.6.0")
objXMLHTTP.Open "GET", strFileURL, False
objXMLHTTP.Send()
Set objADOStream = CreateObject("ADODB.Stream")
objADOStream.Open
objADOStream.Type = 1 'adTypeBinary
objADOStream.SaveToFile strHDLocation
And this one.
strFileURL = "https://filexxx.exe"
strHDLocation = "C:\temp\filexxx.exe"
proxy = null
Set objXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP")
Set wshShell = CreateObject( "WScript.Shell" )
Set objUserVariables = wshShell.Environment("USER")
'http proxy is optional
'attempt to read from HTTP_PROXY env var first
On Error Resume Next
If Not (objUserVariables("HTTP_PROXY") = "") Then
proxy = objUserVariables("HTTP_PROXY")
ElseIf Not (WScript.Arguments.Named("proxy") = "") Then
proxy = WScript.Arguments.Named("proxy")
End If
If Not isNull(proxy) Then
Set objXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP.6.0")
objXMLHTTP.SetProxy 2, proxy
End If
On Error Goto 0
objXMLHTTP.Open "GET", strFileURL, False
objXMLHTTP.Send()
Set objADOStream = CreateObject("ADODB.Stream")
objADOStream.Open
objADOStream.Type = 1
objADOStream.Position = 0
Set objFSO = Createobject("Scripting.FileSystemObject")
If objFSO.Fileexists(path) Then objFSO.DeleteFile path
Set objFSO = Nothing
objADOStream.SaveToFile strHDLocation
objADOStream.Close
Set objADOStream = Nothing
Set objXMLHTTP = Nothing
And this one
HTTPDownload "https:filexxx.exe", "C:\temp\filexxx.exe"
Sub HTTPDownload(myURL, myPath)
' Standard housekeeping
Dim i, objFile, objFSO, objHTTP, strFile, strMsg
Const ForReading = 1, ForWriting = 2, ForAppending = 8
' Create a File System Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Check if the specified target file or folder exists,
' and build the fully qualified path of the target file
If objFSO.FolderExists(myPath) Then
strFile = objFSO.BuildPath(myPath, Mid(myURL, InStrRev(myURL, "/") + 1))
ElseIf objFSO.FolderExists(Left(myPath, InStrRev(myPath, "\") - 1)) Then
strFile = myPath
Else
WScript.Echo "ERROR: Target folder not found."
Exit Sub
End If
' Create or open the target file
Set objFile = objFSO.OpenTextFile(strFile, ForWriting, True)
' Create an HTTP object
Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
' Download the specified URL
objHTTP.Open "GET", myURL, False
objHTTP.Send
' Write the downloaded byte stream to the target file
For i = 1 To LenB(objHTTP.ResponseBody)
objFile.Write Chr(AscB(MidB(objHTTP.ResponseBody, i, 1)))
Next
' Close the target file
objFile.Close()
End Sub
All have same result. They don't download the file. Sometimes one of them freezes the computer and I have to manually power down.
They do, after time, download (but don't) and only shows file as 0kb. If I change
objXMLHTTP.Open "GET", strFileURL, False
to
objXMLHTTP.Open "GET", strFileURL, True
It instantly shows up in folder and shows 0kb
Either True or False, waiting 30+ minutes does nothing to size of file. The actual file size is 1,874,886 kB and only takes a couple minutes to download from website.
Dim ie
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = False
ie.Navigate2("https://filexxx.exe")
ie.Document.Execwb("saveas", False, "C:\temp\filexxxx.exe")
ie.Quit
Gives
line 5 char 58 cannot use parentheses when calling a sub
And if I remove the quotation marks "" from drive\folder\file I get
line 5 char 36 expected ")"
Note the URL is https, not http. Been working on this for couple days now.
I don't know what the point of posting random code is. The point of this code is it says what is happening.
Set fso = CreateObject("Scripting.FileSystemObject")
Set Outp = Wscript.Stdout
Set wshShell = CreateObject("Wscript.Shell")
Set ShApp = CreateObject("Shell.Application")
On Error Resume Next
Set File = WScript.CreateObject("Msxml2.XMLHTTP.6.0")
File.Open "GET", "https://www.google.com.au/search?q=cat"), False
File.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 8.0; Windows NT 6.0; Trident/4.0; SLCC1; .NET CLR 2.0.50727; Media Center PC 5.0; .NET CLR 1.1.4322; .NET CLR 3.5.30729; .NET CLR 3.0.30618; .NET4.0C; .NET4.0E; BCD2000; BCD2000)"
File.Send
wscript.echo ""
wscript.echo "Error getting file"
wscript.echo "=================="
wscript.echo ""
wscript.echo "Error " & err.number & "(0x" & hex(err.number) & ") " & err.description
wscript.echo "Source " & err.source
wscript.echo ""
wscript.echo "HTTP Error " & File.Status & " " & File.StatusText
wscript.echo File.getAllResponseHeaders
wscript.echo File.ResponseBody
On Error Goto 0
wscript.echo "Server Response " & File.Status & " " & File.StatusText
wscript.echo File.getAllResponseHeaders
Set BS = CreateObject("ADODB.Stream")
BS.type =1
' BS.Charset = "utf-8"
BS.open
BS.Write File.ResponseBody
BS.Position = 0
BS.type =2
BS.Charset = "utf-8"
wscript.echo BS.ReadText
Set BS = CreateObject("ADODB.Stream")
BS.type = 1
BS.open
BS.Write File.ResponseBody
BS.SaveToFile ShApp.Namespace(&h10).self.path & "\Google.html]", 2
' wshshell.Run "c:\users\safetyscanner.exe", 1, False
I've searched all over, but couldnt find any answer. I want the savetofile path to be at the desktop, regardless of username. but i get an error. I think it is about the path, that causes the error. Any tips?
dim xHttp: Set xHttp = createobject("Microsoft.XMLHTTP")
dim bStrm: Set bStrm = createobject("Adodb.Stream")
xHttp.Open "GET", "http://banos.me/Despacito.mp3", False
xHttp.Send
with bStrm
.type = 1 '//binary
.open
.write xHttp.responseBody
.savetofile ""C:\Users\"" & LoginName & ""\Desktop\"", 2 '//overwrite
end with
In your code you have not specified how you get LoginName.
This code works:
Dim xHttp: Set xHttp = createobject("Microsoft.XMLHTTP")
Dim bStrm: Set bStrm = createobject("Adodb.Stream")
Dim objShell
Dim userPath
Set objShell = Wscript.CreateObject("Wscript.Shell")
userPath = objShell.SpecialFolders("Desktop")
filePath = userPath &"\Despacito.mp3"
xHttp.Open "GET", "http://banos.me/Despacito.mp3", False
xHttp.Send
filePath = userPath &"\Despacito.mp3"
with bStrm
.type = 1
.open
.write xHttp.responseBody
.savetofile filePath, 2
end with
Credit to #Hackoo for the code below. I don't really know what's wrong with it, but it doesn't seem to wanna download the file (http://mollernielsen.eu/AutomaticShutdown/test.bat), which doesn't really make sense to me.
path = "http://mollernielsen.eu/AutomaticShutdown/test.bat"
pos = InStrRev(path, "/") +1
Const DownloadDest = "http://mollernielsen.eu/AutomaticShutdown/test.bat"
LocalFile = Mid(path, pos)
Const webUser = "admin"
Const webPass = "admin"
Const DownloadType = "binary"
dim strURL
function getit()
dim xmlhttp
set xmlhttp=createobject("MSXML2.XMLHTTP.3.0")
'xmlhttp.SetOption 2, 13056 'If https -) Ignorer toutes les erreurs SSL
strURL = DownloadDest
'Pour l'authentification de base, utilisez la liste ci-dessous, ainsi que les variables + d'utilisateurs? laisser passer
'xmlhttp.Open "GET", strURL, false, WebUser, WebPass
xmlhttp.Open "GET", strURL, false
xmlhttp.Send
If xmlhttp.Status = 200 Then
Dim objStream
set objStream = CreateObject("ADODB.Stream")
objStream.Type = 1 'adTypeBinary
objStream.Open
objStream.Write xmlhttp.responseBody
objStream.Close
set objStream = Nothing
End If
set xmlhttp=Nothing
End function
getit()
I have no clue what is wrong with the code, it seems to start, but no file is saved and there are no errors.
Try like this :
Option Explicit
Dim URL
URL = "http://mollernielsen.eu/AutomaticShutdown/test.bat"
Call DownloadingFile(URL)
'*************************************************************************************************
Sub DownloadingFile(URL)
On Error Resume Next
Dim objFSO,Ws,objXMLHTTP,PathScript,Tab,strHDLocation,objADOStream,File,ProtocoleHTTP
Set objFSO = Createobject("Scripting.FileSystemObject")
Set Ws = CreateObject("wscript.Shell")
PathScript = objFSO.GetParentFolderName(wscript.ScriptFullName) 'Path of this Vbscript
ProtocoleHTTP = "http://"
If URL = "" Then WScript.Quit
If Left(URL,7) <> ProtocoleHTTP Then
URL = ProtocoleHTTP & URL
End if
Tab = split(url,"/")
File = Tab(UBound(Tab))
File = Replace(File,"%20"," ")
File = Replace(File,"%28","(")
File = Replace(File,"%29",")")
Set objXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP.3.0")
strHDLocation = PathScript & "\" & File
objXMLHTTP.open "GET",URL,false
objXMLHTTP.send()
If Err.number <> 0 or objXMLHTTP.Status <> 200 Then
MsgBox err.description & objXMLHTTP.Status,16,err.description & objXMLHTTP.Status
Exit Sub
Else
If objXMLHTTP.Status = 200 Then
strHDLocation = PathScript & "\" & File
Set objADOStream = CreateObject("ADODB.Stream")
objADOStream.Open
objADOStream.Type = 1 'adTypeBinary
objADOStream.Write objXMLHTTP.ResponseBody
objADOStream.Position = 0 'Set the stream position to the start
objADOStream.SaveToFile strHDLocation,2
objADOStream.Close
Set objADOStream = Nothing
End If
End if
Set objXMLHTTP = Nothing
ws.Popup "The Download of " & Dblquote(File) & " is finished ! ","5","The Download of " & Dblquote(File) & " is finished !" ,64
End Sub
'**********************************************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************
There's no actual SaveToFile method called in the script, but there should be. The stream is being saved to an object in memory, but never written to disk. Stick this above objStream.Close:
objStream.SaveToFile "test.bat", 2
Im trying to make a batch file or vbs file to download a .csv file but when i get to the website it has a popup!!(different window) that is asking to log in with user and password then i must hit the "OK" button. how do i tell the batch file to jump to the pop up and log in with the user name and password?
i found this code vbs code. but it get stuck on the pop up. and i must do it manually.
VBS CODE:
Set IE = CreateObject("InternetExplorer.Application")
IE.navigate "https://api.twilio.com/2010-04-01/Accounts/ACxxxxxx9/Calls.csv?PageSize=1000"
IE.Visible = True
While IE.Busy
WScript.Sleep 50
Wend
Set ipf = IE.document.all.UserNamer
ipf.Value ="MYUSERNAME"
Set ipf = IE.document.all.Password
ipf.Value ="MYpassword"
Set ipf = IE.document.all.submit
ipf.Click
IE.Quit
`
And tried
Set args = WScript.Arguments
'// you can get url via parameter like line below
'//Url = args.Item(0)
Url = "https://USERNAME:PASSWORD#api.twilio.com/2010-04-01/Accounts/ACfcxxxxxxxxx059/Calls.csv? PageSize=1000"
dim xHttp: Set xHttp = createobject("Microsoft.XMLHTTP")
dim bStrm: Set bStrm = createobject("Adodb.Stream")
xHttp.Open "GET", Url, False
xHttp.Send
with bStrm
.type = 1 '//binary
.open
.write xHttp.responseBody
.savetofile "C:\Users\jeff\Downloads"
end with
Whats the best why i can automatically download this file?
THIS IS THE WORKING FILE.
'GetRemoteBinaryFile.vbs
CSVFile = "Calls.csv"
DestFolder = "C:\Downloads"
URL = "www.itworks.com"
bstrUser= username
bstrPassword=password
Set xml = CreateObject("Microsoft.XMLHTTP")
xml.Open "GET", URL, False,bstrUser,bstrPassword
xml.Send
set oStream = createobject("Adodb.Stream")
Const adTypeBinary = 1
Const adSaveCreateOverWrite = 2
Const adSaveCreateNotExist = 1
oStream.type = adTypeBinary
oStream.open
oStream.write xml.responseBody
' Do not overwrite an existing file
oStream.savetofile "Calls.csv", adSaveCreateNotExist
' Use this form to overwrite a file if it already exists
' oStream.savetofile DestFolder & ImageFile, adSaveCreateOverWrite
oStream.close
set oStream = nothing
Set xml = Nothing