Hi guys i need litlle help. I have some web page with this line in his html:
<h3 class="entity-title"><a name="33333" class="link" href="/xy/xy-33333">some text</a></h3>
i want VBScript which open web page and find this line and copy "/xy/xy-33333" to some string variable. name,href and some text are always random
i have this part (saving all HTML to file.txt)
Dim oXMLHTTP
Dim oStream
Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP.3.0")
oXMLHTTP.Open "GET", "http://www.yyy.com", False
oXMLHTTP.Send
If oXMLHTTP.Status = 200 Then
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write oXMLHTTP.responseBody
oStream.SaveToFile "c:\te\file.txt"
oStream.Close
End If
Try something like this:
...
If oXMLHTTP.Status = 200 Then
Set html = CreateObject("HTMLfile")
html.write oXMLHTTP.responseText
For Each h3 In html.getElementsByTagName("h3")
If h3.getAttribute("class") = "entity-title" Then
For Each a In h3.getElementsByTagName("a")
WScript.Echo a.href
Next
End If
Next
End If
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.
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
I want to create a page that can display a message "Your download is about to begin" and then after a couple seconds open a "save as" dialogue which allows the visitor to download a file. Is this possible in Classic ASP VB Script? I know how to make a page stream a file, but it doesn't show the html of the page. The file I am offering is 20Mb so the script needs to handle large files sizes.
I currently have a meta redirect in place:
<meta http-equiv="refresh" content="2; url=/downloads/brochures/ACET_Products_and_Services_Directory_2013-14.pdf" />
But this isn't really any good.
I have asppdf installed on my server, and gave this a go:
<%
Set Pdf = Server.CreateObject("Persits.Pdf")
Set Doc = Pdf.OpenDocument("d:/websites/common/downloads/brochures/ACET_Products_and_Services_Directory_2013-14.pdf")
Doc.SaveHttp "attachment;filename=ACET_Products_and_Services_Directory_2013-14.pdf"
%>
This gets around the large file, but you can't stream the file and display HTML at the same time.
I have found plenty of ways to stream the file to the browser, but I can't it to do this after the page has been displayed.
This is another one I have tried:
<%
Response.Buffer = False
Server.ScriptTimeout = 30000
Response.ContentType = "application/x-unknown" ' arbitrary
fn = "ACET_Products_and_Services_Directory_2013-14.pdf"
FPath = "d:\websites\common\downloads\brochures\" & fn
Response.AddHeader "Content-Disposition", "attachment; filename=" & fn
Set adoStream = CreateObject("ADODB.Stream")
chunk = 2048
adoStream.Open()
adoStream.Type = 1
adoStream.LoadFromFile(FPath)
iSz = adoStream.Size
Response.AddHeader "Content-Length", iSz
For i = 1 To iSz \ chunk
If Not Response.IsClientConnected Then Exit For
Response.BinaryWrite adoStream.Read(chunk)
Next
If iSz Mod chunk > 0 Then
If Response.IsClientConnected Then
Response.BinaryWrite adoStream.Read(iSz Mod chunk)
End If
End If
adoStream.Close
Set adoStream = Nothing
Response.End
%>
With this I get a Error code: ERR_INVALID_RESPONSE from Chrome.
This is one that I have tried that almost works:
<%
strFilePath = "d:/web sites/common/downloads/brochures/ACET_Products_and_Services_Directory_2013-14.pdf"
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strFilePath) Then
Set objFile = objFSO.GetFile(strFilePath)
intFileSize = objFile.Size
Set objFile = Nothing
strFileName = "ACET_Products_and_Services_Directory_2013-14.pdf"
Response.AddHeader "Content-Disposition","attachment; filename=" & strFileName
Response.ContentType = "application/x-msdownload"
Response.AddHeader "Content-Length", intFileSize
Set objStream = Server.CreateObject("ADODB.Stream")
objStream.Open
objStream.Type = 1 'adTypeBinary
objStream.LoadFromFile strFilePath
Do While Not objStream.EOS And Response.IsClientConnected
Response.BinaryWrite objStream.Read(1024)
Response.Flush()
Loop
objStream.Close
Set objStream = Nothing
Else
Response.write "Error finding file."
End if
Set objFSO = Nothing
%>
I then used <% response.redirect("download.asp") %> on the page I want it to download from, but as soon as I hit the page I get the file, but no page. Its this part I am struggling with.
SUCCESS!
<script>
window.location.replace('download.asp');
</script>
Cheers,
Steve
With a little more trial and error I discovered creating a file called download.asp and putting this code in worked:
<%#LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<%
strFilePath = "d:/websites/common/downloads/brochures/ACET_Products_and_Services_Directory_2013-14.pdf"
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strFilePath) Then
Set objFile = objFSO.GetFile(strFilePath)
intFileSize = objFile.Size
Set objFile = Nothing
strFileName = "ACET_Products_and_Services_Directory_2013-14.pdf"
Response.AddHeader "Content-Disposition","attachment; filename=" & strFileName
Response.ContentType = "application/pdf"
Response.AddHeader "Content-Length", intFileSize
Set objStream = Server.CreateObject("ADODB.Stream")
objStream.Open
objStream.Type = 1 'adTypeBinary
objStream.LoadFromFile strFilePath
Do While Not objStream.EOS And Response.IsClientConnected
Response.BinaryWrite objStream.Read(1024)
Response.Flush()
Loop
objStream.Close
Set objStream = Nothing
Else
Response.write "Error finding file."
End if
Set objFSO = Nothing
%>
I then placed this code on the page I wanted to display the instructions and then offer the automatic download:
<script>
window.location.replace('download.asp');
</script>
I hope someone else finds this useful.
Steve
When I'm trying to download an empty file with this script, I get the error:
Arguments are of the wrong type, are out of acceptable range or are in conflict with one another. How can I fix it?
Here is my script
Set objHTTP = CreateObject("WinHTTP.WinHttpRequest.5.1")
objHTTP.Open "GET", "http://localhost/file.txt", False
objHTTP.Send
Dim objStream
Set objStream = CreateObject("ADODB.Stream")
With objStream
.Type = 1
.Open
.Write objHTTP.ResponseBody
.SaveToFile "C:\file.txt"
.Close
End With
Set objStream = Nothing
I have this problem only with empty files.
For an empty file, .ResponseBody is a variant of sub-type Empty. Such a beast can't be written. As you can't create an empty Byte() in VBScript, you have to skip the .Write for an empty file. In code:
Const adSaveCreateNotExist = 1 ' Default. Creates a new file if the file does not already exist
Const adSaveCreateOverWrite = 2 ' Overwrites the file with the data from the currently open Stream
' object, if the file already exists
Set objHTTP = CreateObject("WinHTTP.WinHttpRequest.5.1")
objHTTP.Open "GET", "http://gent/empty.html", False
objHttp.Send
WScript.Echo objHttp.Status, objHttp.StatusText
Dim objStream
Set objStream = CreateObject("ADODB.Stream")
With objStream
.Type = 1
.Open
WScript.Echo TypeName(objHTTP.ResponseBody)
If Not IsEmpty(objHTTP.ResponseBody) Then .Write objHTTP.ResponseBody
.SaveToFile "file.txt", adSaveCreateOverWrite
.Close
End With
Set objStream = Nothing
output:
cscript 24512602.vbs
200 OK
Empty
...
dir
...
01.07.2014 16:54 771 24512602.vbs
01.07.2014 16:54 0 file.txt
i use this code for download a link , but if objXMLHTTP.Status not 200 then script show error that can't download or not found link &...
How can add command that if objXMLHTTP.Status not 200 , script don't show any error?
function download(sFileURL, sLocation)
'create xmlhttp object
Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")
'get the remote file
objXMLHTTP.open "GET", sFileURL, false
'send the request
objXMLHTTP.send()
'wait until the data has downloaded successfully
do until objXMLHTTP.Status = 200 : wcript.sleep(1000) : loop
'if the data has downloaded sucessfully
If objXMLHTTP.Status = 200 Then
'create binary stream object
Set objADOStream = CreateObject("ADODB.Stream")
objADOStream.Open
'adTypeBinary
objADOStream.Type = 1
objADOStream.Write objXMLHTTP.ResponseBody
'Set the stream position to the start
objADOStream.Position = 0
'create file system object to allow the script to check for an existing file
Set objFSO = Createobject("Scripting.FileSystemObject")
'check if the file exists, if it exists then delete it
If objFSO.Fileexists(sLocation) Then objFSO.DeleteFile sLocation
'destroy file system object
Set objFSO = Nothing
'save the ado stream to a file
objADOStream.SaveToFile sLocation
'close the ado stream
objADOStream.Close
'destroy the ado stream object
Set objADOStream = Nothing
'end object downloaded successfully
End if
'destroy xml http object
Set objXMLHTTP = Nothing
End function
download "http://remote-location-of-file", "C:\name-of-file-and-extension"
Your code misses the end function and you have an error at the line with wcript.sleep, without comments to be concise it should be something like
function download(sFileURL, sLocation, async)
set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")
objXMLHTTP.open "GET", sFileURL, async
on error resume next
objXMLHTTP.send()
if err.number = 0 then
if objXMLHTTP.Status = 200 Then
set objADOStream = CreateObject("ADODB.Stream")
objADOStream.Open
objADOStream.Type = 1
objADOStream.Write objXMLHTTP.ResponseBody
objADOStream.Position = 0
set objFSO = Createobject("Scripting.FileSystemObject")
if objFSO.Fileexists(sLocation) then
objFSO.DeleteFile sLocation
end if
set objFSO = Nothing
objADOStream.SaveToFile sLocation
objADOStream.Close
set objADOStream = Nothing
download = true
end if
else
download = false
end if
set objXMLHTTP = Nothing
end function
if download("http://stackoverflow.com/questions/10782976/disable-error-in-vbs", "question.html", false) then
wscript.echo "download ok"
else
wscript.echo "download nok"
end if
See my other answer about the errors in your code.
This is a more concise version using the overwrite parameter so no check with fso needed.
function download2(url, destination)
download2 = false
on error resume next
set xml = CreateObject("Microsoft.XMLHTTP")
xml.Open "GET", url, False
xml.Send
if err.number = 0 then
if xml.readystate = 4 then
if xml.status = 200 then
set oStream = createobject("Adodb.Stream")
const adTypeBinary = 1, adSaveCreateOverWrite = 2, adSaveCreateNotExist = 1
oStream.type = adTypeBinary
oStream.open
oStream.write xml.responseBody
oStream.saveToFile destination, adSaveCreateOverWrite
oStream.close
set oStream = nothing
download2 = true
end if
end if
end if
set xml = Nothing
end function
if download2("http://www.textpad.com/download/v60/txpeng600.zig", "txpeng600.zip") then
wscript.echo "download ok"
else
wscript.echo "download nok"
end if
'download nok