Weather source code network

Response. content type = " text/html； charset=gb23 12 "

Call to ask about the weather ()

Sub-weather ()

Url="/inc/07_dc 107.htm "'The weather in Putian.

Call IsObjInstalled ("Microsoft. XMLHTTP”)

weatherStr= getHTTPPage(url)

If weatherStr= ""then

Response. Write "Sorry, the weather forecast failed to load!"

other

set reg=new Regexp

Register. Multiline=True

Register. Global = false

Register. IgnoreCase=true

Register. Pattern = " & ltTD height = " " 57 " " align = " " center " " bgcolor = " " # eef3f 8 " " & gt； ((.|\n)*？ )& lt/TD & gt； & lt/tr >；

set matches = reg . execute(weatherStr)

Every game 1 game

weatherStr=match 1。 value

then

Set Match = None

Set reg = Nothing.

If InStr(weatherStr, "and not found") > 0, then

Response. Write "Sorry, the weather forecast failed to load!"

other

weatherStr=Replace(weatherStr，" & ltbr >； ," ")

% & gt

& lt font color = "# cc0000" style = "font-size: 9pt" > Today's weather:

& lt%

If ... it will be over.

If ... it will be over.

End joint

//Adopt Microsoft. XMLHTTP component to collect data.

Function getHTTPPage(url)

Continue to the next step when an error occurs.

dim http

set http = server . createobject(" Microsoft。 XMLHTTP”)

http . open“GET”，url，false

Http.send()

If http. readystate < > then 4.

Exit function

If ... it will be over.

getHTTPPage = bytes 2 bstr(http . response body)

Set http = none.

If err.number & lt& gt0 and then an error occurs. clear

End function

//adopt ADODB. Stream to process the collected data and convert binary files into text characters.

Function byte 2bStr(vin)

Dim BytesStream，StringReturn

Set BytesStream = Server。 CreateObject("ADODB。 Stream ")

Byte stream. Type = 2

Byte stream. open

Byte stream. WriteText vin

Byte stream. Location = 0

Byte stream. Charset = "GB23 12 "

Byte stream. Position = 2

StringReturn =BytesStream。 Read the text

BytesStream.close

Set byte stream = none

Bytes2bStr = StringReturn

End function

//Check the component, and use xmlhttp to grab the web page or AspHTTP.

Function IsObjInstalled(strClassString)

Continue to the next step when an error occurs.

IsObjInstalled = False

Err = 0

Dim xTestObj

Set xTestObj = Server. CreateObject(strClassString)

If 0 = Err, then

If AspHttpOpen= 1

IsObjInstalled = True

Response.write "XMLHTTP component is not supported by the system"

"Response.write" current component ASPHTTP "

response.end()

other

IsObjInstalled = False

"Response.write" current component XMLHTTP "

If ... it will be over.

other

IsObjInstalled = False

"Response.write" current component XMLHTTP "

If ... it will be over.

Set xTestObj = Nothing

Err = 0

End function

% & gt