[请教老手]如何嵌入sina新闻

还有一个办法就是用xmlhttp把这个读进来

用xmlhttp读取数据
用ASP或者正则表达式提取数据

Set objXML = CreateObject("Microsoft.XMLHTTP") '创建XMLHTTP组件；
UrlSend = "http://xxxx/"
objXML.open "GET",UrlSend,false
objXML.send()
ReturnVar = objXML.responseText
'处理返回数据做判断！'取得网页文件代码函数
function getHTTPPage(url)
dim http
set http=createobject("MSXML2.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'字节转化成字符串函数
Function bytes2BSTR(vIn)
dim strReturn
dim i,ThisCharCode,NextCharCode
strReturn = ""
For i = 1 To LenB(vIn)
ThisCharCode = AscB(MidB(vIn,i,1))
If ThisCharCode < &H80 Then
strReturn = strReturn & Chr(ThisCharCode)
Else
NextCharCode = AscB(MidB(vIn,i+1,1))
strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
i = i + 1
End If
Next
bytes2BSTR = strReturn
End Function比如你的myurl="www.163.com"
Content = getHTTPPage(myurl)
你可以response.write出content来看,然后用instr,mid,replace提炼出页面的主题2Function GetHTTPPage(url) '获取服务器生成的html代码
on error resume next
dim XmlHttp
set XmlHttp=Server.createobject("Microsoft.XMLHTTP")
XmlHttp.open "GET",url,false
XmlHttp.send()
'getHTTPPage=Http.responseText
if XmlHttp.readystate<>4 then exit function
GetHTTPPage=bytes2BSTR(XmlHttp.responseBody)
set XmlHttp=nothing
if err.number<>0 then err.Clear
End Function 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
  StringReturn =BytesStream.ReadText
  BytesStream.close
  Set BytesStream = Nothing
  Bytes2bStr = StringReturn
End Function3function GetXml(Url){
try{
var XmlHttp=Server.CreateObject("Microsoft.XMLHTTP");
XmlHttp.open("get",Url,false);
XmlHttp.send();
return XmlHttp.responseBody;
}catch(e){return null}
}
function Bytes2bStr(vin){
try{
var BytesStream,StringReturn;
BytesStream = Server.CreateObject("ADODB.Stream")
with(BytesStream){
Type =2;
Open();
WriteText(vin);
Position = 0 ;
Charset = "GB2312";
Position = 2;
StringReturn = ReadText();
close();
}
BytesStream = null
return StringReturn;
}catch(e){return ""}
}

怎样取出网页里的部分内容-----------><%
on error resume next
Private d_exsit
Dim Retrieval
Dim TakenHTML
Function GetURL(url)
    Set Retrieval = Server.CreateObject("Microsoft.XMLHTTP")
          With Retrieval
          .open "GET", url, False, "", ""
          .Send
          GetURL = .responsebody
          End With
    Set Retrieval = Nothing
End FunctionFunction bytes2BSTR(vIn)
    Dim strReturn
    Dim I, ThisCharCode, NextCharCode
    strReturn = ""
    For I = 1 To LenB(vIn)
        ThisCharCode = AscB(MidB(vIn, I, 1))
        If ThisCharCode < &H80 Then
            strReturn = strReturn & Chr(ThisCharCode)
        Else
            NextCharCode = AscB(MidB(vIn, I + 1, 1))
            strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
            I = I + 1
        End If
    Next
    bytes2BSTR = strReturn
End FunctionTakenHTML = GetURL("http://www.eyou.com")
TakenHTML=bin2str(TakenHTML)
titl=InStr(1,takenhtml,"<title>",1)
titll=InStr(1,takenhtml,"</title>",1)
title=mid(takenhtml,titl,titl1)fon=InStr(1,takenhtml,"<font class='STitle'>",1)
fonn=InStr(1,takenhtml,"</font>",1)
font=mid(takenhtml,fon,fonn)pp=InStr(1,takenhtml,"<p class=content>",1)
ppp=InStr(1,takenhtml,"</p>",1)
pppp=mid(takenhtml,pp,ppp)%>

不错，但我觉得还是用webbrowser＋ihtmlobject比较好
下面的是用VB写得，但改成asp应该也很容易双击该命令按钮，然后在事件处理器中放入下列代码，导航至文本框中命名的 Web 站点：
Private Sub Command1_Click()
    WebBrowser1.Navigate Text1.Text
End Sub保存并运行该程序。试着按浏览按钮，导航到文本框中指定的站点。您已经创建了一个基本的 Web 浏览器 — 就其本身而言没什么用，甚至没什么意义，但它却是迈向 Web 拆取技术的第一步。
回到工程中，在代码窗口中选择 WebBrowser1 对象，然后选择 DocumentComplete 的事件处理器。一旦整个 Web 页下载到此浏览器中，即触发该事件：
Private Sub WebBrowser1_DocumentComplete_
(ByVal pDisp As Object, URL As Variant)End Sub传递到该事件中的 URL 就是我们导航所至的位置，它在日后确定浏览器所在的页面时将更为有用。WebBrowser 控件有一个属性称为 Document（文档），可将其视为 IHTMLDocument 来处理：Private Sub WebBrowser1_DocumentComplete(_ ByVal pDisp As Object, URL As Variant)
    Dim Doc As IHTMLDocument2
    Set Doc = WebBrowser1.Document
    //下一步：分析该文档
End Sub较新的 IHTMLDocument2 具有 IHTMLDocument 中无法使用的特性。可对系统使用 IHTMLDocument 替代老版本的 Internet Explorer，如果您有勇气的话，甚至可以使用 IHTMLDocument3。补充说明一下，我们假设您已经导航到 Word 文档或 XML 文档，而非 HTML 文档。不要将变量 doc 声明为 IHTMLDocument2，可将其声明为 Word 的文档或 XML 的 DOMDocument。在进行下一步之前，理解 HTML 文档的结构是非常重要的。和 XML 不一样，HTML 文档的组合有一定的自由度。例如，您会遇到未关闭标记的 HTML 文档。HTML 文档确实有某种结构。结构好的 HTML 文档通常具有下列元素：<HTML>
   <HEAD>
       header information like the <TITLE>
   </HEAD>
   <BODY>
       elements like <TABLE> and <A> and <IMG>
   </BODY>
</HTML>请注意 HTML 的树状结构。标记包含标记又包含标记，如此等等。特别是，每一个标记元素都包含一个 0 到 n 个标记元素的集合。<TABLE> 标记可以包含 <TR> 标记。每个 <TR> 标记可以包含 <TD> 标记，后者又可以包含其他标记如锚或图像等。现在，分析整个 http://moneycentral.msn.com/，并在带 MSFT 符号的页填上第二个 <INPUT> 标记。然后，调用此窗体上的提交：
Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    Dim doc As IHTMLDocument2
    Set doc = WebBrowser1.Document

    If URL = _
    "http://moneycentral.msn.com/home.asp" Then
        '填充带输入标记的元素集合
        Dim Inputs As IHTMLElementCollection
        Set Inputs = doc.All.tags("INPUT")
        '选择第一个输入标记
        Dim Element As IHTMLElement
        Set Element = Inputs.Item(1, 1)

        '使用正确的界面
        Dim InputElement As IHTMLInputElement
        Set InputElement = Element
        InputElement.Value = Text1.Text

        '调用此页第一个窗体上的提交
        doc.Forms.Item(0, 0).submit
End Sub在此您会看到，标记集合如何包含可视为其特定类型的标记。每一个标记都可用 IHTMLElement 界面表示，或用指定为该标记类型的界面表示。例如，<TABLE> 标记可用 IHTMLTableElement 或 IHTMLElement 表示。标记的集合都包含下列重要的方法和属性：长度。可将其理解为计数，或集合中项目的数量。
项目。用于选择集合中的特殊元素。“项目”有两个参数，第二个参数即命名的标记。
标记。将要过滤的元素传递给标记。标记 ("A") 将返回集合内所有锚的集合。要想有效地拆取页，就需要学会使用标记集合。
现在可能您会问，“为什么不直接转到 http://moneycentral.msn.com/scripts/webquote.dll?ipage=qd&Symbol=msft？”当然是可以的，但这个例子告诉大家如何在更复杂的情况下操纵 HTML 窗体。如果您未做进一步的改动即运行该程序，就会注意到它将陷入无休止的循环，没完没了地下载同一个页面。程序不断地寻找要填充的窗体，并反复调用 DocumentComplete。要修正这个缺陷，应在 DocumentComplete 中置入一些逻辑，告诉分析器，只有在正确的页面上才提交窗体。接下来，让我们放入这个逻辑，并引入实际的股票报价。另外，我们不捕获文本框中的 URL，而是捕获股票符号：
Private Sub Command1_Click()
    WebBrowser1.Navigate _
     "http://moneycentral.msn.com/home.asp"
End Sub
Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    Dim doc As IHTMLDocument2
    Set doc = WebBrowser1.Document

    If URL = "http://moneycentral.msn.com/home.asp" Then
        '填充带输入标记的元素集合
        Dim Inputs As IHTMLElementCollection
        Set Inputs = doc.All.tags("INPUT")
        '选择第一个输入标记
        Dim Element As IHTMLElement
        Set Element = Inputs.Item(1, 1)

        '使用正确的界面
        Dim InputElement As IHTMLInputElement
        Set InputElement = Element
        InputElement.Value = Text1.Text

        '调用该页第一个窗体上的提交
        doc.Forms.Item(0, 0).submit
    ElseIf URL = _
    "http://moneycentral.msn.com/scripts/webquote.dll?ipage=qd&Symbol=" _
                 & Text1.Text Then
        Dim Tables As IHTMLElementCollection
        Set Tables = doc.All.tags("TABLE")
        '获得第 14 个表的第二个项目（基于 0）
        Dim Quote As IHTMLElement
        Set Quote = _
        Tables.Item(14, 14).All.tags("TD").Item(2, 2)
        '显示开始标记和结束标记之间的文本
        MsgBox Quote.innerText
    End If
End Sub

应该使用twebbrowser来截取，然后再生成自己的网页。否则无法变成“你自己的”网页，风格等都不一致。

调试易

[请教老手]如何嵌入sina新闻

解决方案 »