<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>  
<%        
url="http://sports.sina.com.cn/k/2008-09-15/04593948756.shtml"    
str=getHTTPPage(url)    
title=strcut(str,"<h1 id=""artibodyTitle"" style=""color:#03005C;"">","</h1>",2)    
content=strcut(str,"<!-- 正文内容 begin -->","<!-- 正文内容 end -->",2)    
response.write "新闻标题<br><b>"&title&"</b><br><br><br>新闻内容:<br>"&content    
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=bytesToBSTR(Http.responseBody,"GB2312")    
set http=nothing    
    If Err.number<>0 then    
    Response.Write "<p align=’center’><font color=’red’><b>服务器获取文件内容出错</b></font></p>"    
    Err.Clear    
    End If    
End Function    
 
Function BytesToBstr(body,Cset)    
dim objstream    
set objstream = Server.CreateObject("adodb.stream")    
objstream.Type = 1    
objstream.Mode =3    
objstream.Open    
objstream.Write body    
objstream.Position = 0    
objstream.Type = 2    
objstream.Charset = Cset    
BytesToBstr = objstream.ReadText    
objstream.Close    
set objstream = nothing    
End Function    
 
'截取字符串,1.包括起始和终止字符，2.不包括    
Function strCut(strContent,StartStr,EndStr,CutType)    
Dim strHtml,S1,S2    
strHtml = strContent    
On Error Resume Next    
    Select Case CutType    
    Case 1    
    S1 = InStr(strHtml,StartStr)    
    S2 = InStr(S1,strHtml,EndStr)+Len(EndStr)    
    Case 2    
    S1 = InStr(strHtml,StartStr)+Len(StartStr)    
    S2 = InStr(S1,strHtml,EndStr)    
    End Select    
    If Err Then    
    strCute = "<p align=’center’>没有找到需要的内容。</p>"    
    Err.Clear    
    Exit Function    
    Else    
    strCut = Mid(strHtml,S1,S2-S1)    
    End If    
End Function    
%> 

来源：展洋科技 www.35544216.com