Я хочу приделать к своей программе прогноз погоды и курс валют
из Рамблера, Как это можно сделать??
Вот что получилось Вдруг кому нить пригодится.
С автоматическим определением кодировки
Пример дёргает погоду с www.rambler.ru
Visual Basic:
Dim UrlDownloader
Set UrlDownloader = New UrlDownloaderClass
if UrlDownloader.UrlToDocument("http://www.rambler.ru",Document) Then
Set Tables = Document.all.tags("TABLE")
For TableIndex=1 to Tables.Length-1
if Instr(LCase(Tables(TableIndex).innertext),"погода:") Then
if LCase(Tables(TableIndex).ClassName)="gradgrey2" Then
TextBuffer = TextBuffer & Tables(TableIndex).innertext & vbCrlf
For Each TR in Tables(TableIndex+2).Rows
For Each TD in TR.Cells
if TD.innerText <> "" Then
TextBuffer = TextBuffer & " " & TD.innertext
End if
Next
TextBuffer = TextBuffer & vbCrlf
Next
End if
End if
Next
MsgBox TextBuffer
Else
MsgBox URL,vbExclamation,Err.Description
End if
Class UrlDownloaderClass
Private XmlHttp
Private Stream
Private cache
Public Status
Private Sub Class_Initialize
Set XmlHttp = CreateObject("Microsoft.XMLHTTP")
Set Stream = CreateObject("ADODB.Stream")
End Sub
Function UrlToDocument(URL,HTMLDocument)
On Error Resume Next
XmlHttp.abort
XmlHttp.Open "GET",Url,False
If Not cache then
XmlHttp.setRequestHeader "Cache-Control", "no-cache"
End if
XmlHttp.Send
Status = XmlHttp.Status
Set HTMLDocument = CreateObject("HTMLFile")
HTMLDocument.Open
HTMLDocument.write "<HTML><BODY></BODY></HTML>"
Charset = HTMLDocument.defaultcharset
If XmlHttp.Status = 200 Then
Groups = Split(XmlHttp.GetResponseHeader("Content-type"))
For Each Group in Groups
Params = Split(Group,"=")
if LCase(Params(0))="charset" then Charset = Params(1)
Next
Stream.Charset = Charset
Stream.Type = 1
Stream.Open
Stream.Write XmlHttp.ResponseBody
Stream.Position = 0
Stream.Type = 2
HTMLDocument.body.innerhtml = Stream.ReadText
Stream.Close
End if
HTMLDocument.Close
UrlToDocument = Not Cbool(Err.Number)
End Function
End Class
Сейчас этот форум просматривают: AhrefsBot и гости: 33