China Naming Network - Ziwei Dou Shu - ASP weather forecast system source code, quick request

ASP weather forecast system source code, quick request

<%

Response.ContentType="text/html; charset=gb2312"

Call weather()

Sub weather( )

url="/inc/07_dc107.htm" 'Putian's weather

Call IsObjInstalled("Microsoft.XMLHTTP")

weatherStr= getHTTPPage(url )

if weatherStr="" then

response.write "Sorry, the weather forecast failed to load!"

else

set reg =new Regexp

reg.Multiline=True

reg.Global=false

reg.IgnoreCase=true

reg.Pattern= "((.|\n)*?)"

< p>Set matches = reg.execute(weatherStr)

For Each match1 in matches

weatherStr=match1.Value

Next

Set matches = Nothing

Set reg = Nothing

if InStr(weatherStr,"No match found")>0 then

response.write "Sorry, weather Forecast loading failed!"

Else

weatherStr=Replace(weatherStr,"
"," ")

%>

Today's weather:<%=weatherStr%>

<%

end if

end if

End Sub

'// Use Microsoft.XMLHTTP component to collect data

Function getHTTPPage(url)

'on error resume next

dim http

set http=Server.createobject("Microsoft.XMLHTTP")

Http.open "GET ",url,false

Http.send()

if Http.readystate<>4 then

exit function

end if

getHTTPPage=bytes2BSTR(Http.responseBody)

set http=nothing

if err.number<>0 then err.Clear

End function

'// Use ADODB.Stream to process the collected data and convert the binary file into text characters

Function Bytes2bStr(vin)

Dim BytesStream,StringReturn

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

BytesStream.Type = 2

BytesStream.Open

BytesStream.WriteText vin

BytesStream.Position = 0

BytesStream.Charset = "GB2312"

BytesStream.Position = 2

< p>StringReturn =BytesStream.ReadText

BytesStream.close

Set BytesStream = Nothing

Bytes2bStr = StringReturn

End Function

'//Check the component, use xmlhttp to crawl the web page or AspHTTP

Function IsObjInstalled(strClassString)

' On Error Resume Next

IsObjInstalled = False

Err = 0

Dim xTestObj

Set xTestObj = Server.CreateObject(strClassString)

If 0 = Err Then

If AspHttpOpen=1 Then

IsObjInstalled = True

Response.write "The system does not support the XMLHTTP component"

'Response.write "Currently Component ASPHTTP"

response.end()

Else

IsObjInstalled = False

'Response.write "Current component XMLHTTP"< /p>

End If

Else

IsObjInstalled = False

'Response.write "Current component XMLHTTP"

End If

Set xTestObj = Nothing

Err = 0

End Function

%>