怎么用VB获取网页的源代码啊

Question

我想实现以下的功能：
1、先获取网页的源代码
2、提取特定的数据
3、将数据导进数据库中（或文本文件中）求高手解答啊！！！！！！！！！

Answer 1

Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As LongSub Command1_Click()   '获取网页的源代码
    Dim r
    r = URLDownloadToFile(0, "http://www.baidu.com", "d:\1.html", 0, 0)
    If r = 0 Then
       MsgBox "下载完毕"
    Else
       MsgBox "下载失败"
    End If
End Sub

Answer 2

Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" ( _
                    ByVal sAgent As String, ByVal lAccessType As Long, _
                    ByVal sProxyName As String, ByVal sProxyBypass As String, _
                    ByVal lFlags As Long) As Long
Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" ( _
                    ByVal hInternetSession As Long, ByVal sUrl As String, _
                    ByVal sHeaders As String, ByVal lHeadersLength As Long, _
                    ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function InternetReadFile Lib "wininet.dll" ( _
                    ByVal hFile As Long, ByVal sBuffer As String, _
                    ByVal lNumBytesToRead As Long, _
                    lNumberOfBytesRead As Long) As Integer
Private Declare Function InternetCloseHandle Lib "wininet.dll" ( _
                    ByVal hInet As Long) As Integer
Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000
Dim s Private Function GetUrlFile(stUrl As String) As String
    Dim lgInternet As Long, lgSession As Long
    Dim stBuf As String * 1024
    Dim inRes As Integer
    Dim lgRet As Long
    Dim stTotal As String
    stTotal = vbNullString
    lgSession = InternetOpen("VBTagEdit", 1, vbNullString, vbNullString, 0)
    If lgSession Then
        lgInternet = InternetOpenUrl(lgSession, stUrl, vbNullString, _
                                     0, INTERNET_FLAG_NO_CACHE_WRITE, 0)
        If lgInternet Then
            Do
                inRes = InternetReadFile(lgInternet, stBuf, 1024, lgRet)
                stTotal = stTotal & Mid$(stBuf, 1, lgRet)
            Loop While (lgRet <> 0)
        End If
        inRes = InternetCloseHandle(lgInternet)
    End If
    GetUrlFile = stTotal
End FunctionPrivate Sub command1_click()
    Text1.Text = GetUrlFile("http://china.alibaba.com/?cosite=123hao&location=homepage_sy")
End SubPrivate Sub Form_Load()
WebBrowser1.Navigate "http://china.alibaba.com/?cosite=123hao&location=homepage_sy"
End Sub

Answer 3

'引用的是microsoft   vbscript   regular   expression   5.5
Function RegExpTest(patrn, strng)  'patrn:需要查找的字符 strng:被查找的字符串
  Dim regEx, Match, Matches     ' 创建变量。
  Set regEx = New RegExp            ' 创建正则表达式。
  regEx.Pattern = patrn         ' 设置模式。'"\w+([-+.]\w+)*@\w+([-.]\w+)*\.\w+([-.]\w+)*"'
  regEx.IgnoreCase = True           ' 设置是否区分大小写。
  regEx.Global = True           ' 设置全程匹配。
  Set Matches = regEx.Execute(strng)    ' 执行搜索。
  For Each Match In Matches     ' 循环遍历Matches集合。
    RetStr = RetStr & Match.Value & vbCrLf
  Next
  RegExpTest = RetStr
End Function
Private Sub Command1_Click()
Dim URLRegExp As String, MailRegExp As String, ChiniRegExp As String
Dim FileName As String, sFile As String, MuName As String, Chans As String
Dim i As Long, arr() As String, arr1() As String, arr2() As String    URLRegExp = "http://([\w-]+\.)+[\w-]+(/[\w- ./?%&=]*)?" 'URL正则表达式
    MailRegExp = "\w+([-+.]\w+)*@\w+([-.]\w+)*\.\w+([-.]\w+)*" '电子邮件正则表达式
    ChiniRegExp = "[^\x00-\xff]* "    Open "c:\temp.html" For Binary As #1
     sFile = Space(LOF(1))
     Get #1, , sFile
          Close #1
Text1.Text = RegExpTest(URLRegExp, sFile)
End Sub

Answer 4

Private Function getHtmlStr$(strUrl$) 
    Dim XmlHttp
    Set XmlHttp = CreateObject("Microsoft.XMLHTTP")
    XmlHttp.Open "GET", strUrl, False
     XmlHttp.send
    getHtmlStr = StrConv(XmlHttp.ResponseBody, vbUnicode)
    Set XmlHttp = Nothing
End Function

Answer 5

Private Sub cmd2_Click()
    Dim s As String
    Dim p As String
    Inet1.Cancel
    Inet1.protocol = icHTTP
    Inet1.url = "http://money.finance.sina.com.cn/corp/go.php/vFD_BalanceSheet/stockid/600558/ctrl/part/displaytype/4.phtml"
    s = ""
    s = Inet1.OpenURL
   'RichTextBox1.Text = s
    '(?<=货币资金\D+)\d{1,3}(?:,\d{3})*
  
End Sub我用上面的方法提取了网页源代码，但是请问怎么做才能从s中提取我要的数据啊？

Answer 6

<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312" />
<title>大西洋(600558)_资产负债表_新浪网</title>
<meta name="Keywords" content="大西洋,600558,行情" />
<meta name="Description" content="大西洋的实时行情" />
<link media="all" rel="stylesheet" href="/corp/view/css/newstyle.css" />
<link media="all" rel="stylesheet" href="/corp/view/css/tables.css" />
<link media="all" rel="stylesheet" href="/corp/view/css/style4.css" />
<style type="text/css">
body,ul,ol,li,p,h1,h2,h3,h4,h5,h6,form,fieldset,table,td,img,div{margin:0;padding:0;border:0;}
body,ul,ol,li,p,form,fieldset,table,td{font-family:"宋体";}
body{background:#fff;color:#000;}
td,p,li,select,input,textarea,div{font-size:12px;}ul{list-style-type:none;}
select,input{vertical-align:middle; padding:0; margin:0;}.f14 {font-size:14px;}
.lh20 {line-height:20px;}
.lh23{line-height:23px;}
.b1{border:1px #fcc solid;}a{text-decoration: underline;color:#009}
a:visited{color:#333333;}
a:hover这里面有你要的东西吗

Answer 7

Private Sub Command1_Click()
    Dim strTemp As String
    
    strTemp = RichTextBox1
    
    Call sub_GetData(strTemp, "货币资金", Text1)
    Call sub_GetData(strTemp, "短期投资净额", Text2)End SubPrivate Sub sub_GetData(ByVal strSource As String, ByVal strRefer As String, objTextBox As TextBox)
    Dim lngStrtT As Long
    Dim lngStart As Long
    Dim lngEnd As Long
    
    lngStartT = InStr(1, strSource, strRefer) + Len(strRefer)
    lngStart = InStr(lngStartT, strSource, "<TD>") + Len("<TD>")
    lngEnd = InStr(lngStart, strSource, "</TD>") - 1
    objTextBox = Trim(Mid(strSource, lngStart, lngEnd - lngStart + 1))
    
End Sub