东莞天气预报一周7天10天15天vv_东莞天气预报一周7天10天15天一览表

一个command,一个?text（设为多行）?

Private?Sub?Command1_Click()

x?=?GetCode(?://.weather.cn/weather/101020100.shtml)

X1?=?InStr(1,?x,?"风力</th>",?1)?+?2

X2?=?InStr(X1,?x,?"<!--?Live?start-->",?1)

x?=?Mid(x,?X1,?X2?-?X1)

X1?=?InStr(1,?x,?"未来4-7天天气预报",?1)

X2?=?InStr(X1,?x,?"<",?1)

x?=?Replace(x,?Mid(x,?X1,?X2?-?X1),?"")

x?=?ZZtihuan(x,?"\<[^>]*>",?"")

x?=?Replace(x,?vbCrLf,?"")

x?=?Replace(x,?"?",?"")

x?=?Replace(x,?Chr(9),?"")

x?=?Replace(x,?"?",?"")

Y1?=?CInt(Mid(x,?1,?InStr(1,?x,?"日",?1)?-?1))?'第一天日子

s1?=?1:?ccv?=?True:?vv?=?1?-?Len(Y1?-?1)?-?1

For?i?=?1?To?3

?Y1?=?Y1?+?1

?Y2?=?InStr(vv?+?Len(Y1?-?1)?+?1,?x,?Y1?&?"日",?1)

?If?Y2?<>?0?Then

?vv?=?Y2

?xx?=?Mid(x,?s1,?Y2?-?s1)

?xx?=?Replace(xx,?"星期",?vbTab?&?"星期",?1,?1)

?xx?=?Replace(xx,?"白天",?vbCrLf?&?" 白天--",?1,?1)

?xx?=?Replace(xx,?"夜间",?vbCrLf?&?" 夜间--",?1,?1)

?s?=?s?&?xx?&?vbCrLf?&?vbCrLf

?Else

?If?ccv?=?True?Then

?Y1?=?0:?ccv?=?False

?Else

?xx?=?Mid(x,?s1)

?xx?=?Replace(xx,?"星期",?vbTab?&?"星期",?1,?1)

?xx?=?Replace(xx,?"白天",?vbCrLf?&?" 白天--",?1,?1)

?xx?=?Replace(xx,?"夜间",?vbCrLf?&?" 夜间--",?1,?1)

?s?=?s?&?xx

?End?If

?End?If

?If?ccv?=?True?Then?s1?=?Y2?Else?s1?=?vv

Next

Text1?=?s?

End?Sub

Public?Function?GetCode(?Url)?

Dim?XmlHttp

Randomize

Url?=?Url?&?"?rNum="?&?Int((9999)?*?Rnd(Now())?+?1)

Dim?xmlHTTP1

Set?xmlHTTP1?=?CreateObject("Microsoft.XMLHTTP")

xmlHTTP1.Open?"get",?Url,?False

xmlHTTP1.send

GetCode?=?xmlHTTP1.responseText

Set?xmlHTTP1?=?Nothing

End?Function

Function?ZZtihuan(ZZword,?ZZguize,?ZZhuan)

Dim?objRegExp?As?Object

Set?objRegExp?=?CreateObject("vbscript.regexp")

objRegExp.Pattern?=?ZZguize

objRegExp.IgnoreCase?=?True

objRegExp.Global?=?True

ZZtihuan?=?objRegExp.Replace(ZZword,?ZZhuan)

End?Function?