Я работаю на местном портале, и погоду на сайте нужно обновлять каждый день. Со временем это стало довольно хлопотно, поэтому я написал плановый вор новостей. После публикации ознакомьтесь с системными требованиями: Поддержка FSO, сервера UDP TCP/IP.
Ниже приводится содержание вора.
Имя файла TianQi.asp
Написать Nioked QQ408611119
www.downcodes.com
<%
если час(сейчас)=9 и минута(сейчас)<30, то
getCategories()
конец, если
Функция getCategories()
при ошибке продолжить дальше
Dim oXMLHTTP 'как объект
Dim oCategories 'как объект
Димбодитекст
Дим Поз, Поз1
Установите oXMLHTTP = CreateObject("Microsoft.XMLHTTP")
'--- установите вызов XMLHTTP и выполните отправку (без параметра в качестве категории
'--- включен в URL
oXMLHTTP.open "GET"," http://weather.china.com.cn/travel_gntq.php?cityid=56196&cityname =Mianyang",False 'Замените это место своим адресом
oXMLHTTP.send
'--- загрузим ответ в остров данных категорий
BodyText=oXMLHTTP.responsebody
BodyText=BytesToBstr(BodyText,"gb2312")
Pos=Instr(BodyText,"<body")
pos1=Instr(BodyText,"</body>")
BodyText=mid(BodyText,pos,pos1)
BodyText=split(BodyText,"<таблица")
Pos=Instr(BodyText(4),"<tr")
pos1=Instr(BodyText(4),"</tr>")
Body=mid(BodyText(4),pos,len(BodyText(4))-pos)
body=split(body,"</table>")
body1=split(replace(replace(replace(body(0),"<br>",""),"</td>",""),"</tr>",""),"Weather" )
для i = 1 до ubound (body1)
body3=split(body1(i),"<td")
погода = погода & "document.write("""& i&"$" & "Погода" & HTMLEncode(trim(body3(0))) & """);" & vbcrlf
следующий
Weather=replace(weather,"1$","<FONT color=#ffffff>【Сегодня】</FONT>")
Weather=replace(weather,"2$","<FONT color=#ffffff>【Завтра】</FONT>")
Weather=replace(weather,"3$","<FONT color=#ffffff>【Послезавтра】</FONT>")
Set fs = CreateObject("Scripting.FileSystemObject")
Установите f = fs.CreateTextFile(request.ServerVariables("APPL_PHYSICAL_PATH")& "tq.js", True)
f.write("document.write('Прогноз погоды в Мяньяне:');" &vbcrlf & replace(weather,"<BR>",""))
е.закрыть
Установить f = ничего
Установить фс = ничего
response.write "Прогноз погоды в Мяньяне:"& погода
Установить oXMLHTTP = Ничего
если номер ошибки<>0, то
response.write "Произошла ошибка, описание ошибки:"&err.description & "<br>Источник ошибки"& err.source
ответ.Конец()
конец, если
Конечная функция
Функция BytesToBstr(body,Cset)
тусклый объектный поток
set objstream = Server.CreateObject("adodb.stream")
objstream.Type = 1
objstream.Mode =3
objstream.Открыть
objstream.Напишите тело
objstream.Position = 0
objstream.Type = 2
objstream.Charset = Cset
BytesToBstr = objstream.ReadText
objstream.Close
установить objstream = ничего
Конечная функция
Открытая функция HTMLEncode(fString)
Если Не IsNull(fString) Тогда
fString = replace(fString, ">", ">")
fString = replace(fString, "<", "<")
fString = Заменить(fString, CHR(32), " ") '
fString = Заменить(fString, CHR(9), " ") '
fString = Заменить(fString, CHR(34), """)
fString = replace(fString, CHR(39), "'") 'Фильтрация одинарных кавычек
fString = Заменить(fString, CHR(13), "")
fString = Заменить(fString, CHR(10) & CHR(10), "</P><P>")
fString = Заменить(fString, CHR(10), "<BR> ")
HTMLEncode = fString
Конец, если
Конечная функция
%>