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= "
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.ReadTextBytesStream.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 p>
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
%>