form1.frm

可用于解析网页数据～～～～～～～～～～～

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   8700
   ClientLeft      =   60
   ClientTop       =   375
   ClientWidth     =   12795
   LinkTopic       =   "Form1"
   ScaleHeight     =   8700
   ScaleWidth      =   12795
   StartUpPosition =   3  'Windows Default
   Begin VB.TextBox Text1 
      Height          =   7845
      Left            =   225
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   1
      Text            =   "Form1.frx":0000
      Top             =   270
      Width           =   10320
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   525
      Left            =   10935
      TabIndex        =   0
      Top             =   210
      Width           =   1305
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
   Dim XMLObject As Object, HTMLDoc As Object
   Dim SendStr As String, HTMLStr As String
   Dim DataInfo As String, S As Long, E As Long
   Dim Info(66) As String, TempArray() As String
   Dim X As Long, Y As Long, I As Long, TempStr As String
   Dim TitleMaxByte As Long, TitleByte As Long
   
   '初始化变量
   Y = 0
   I = 0
   TitleMaxByte = 0
   TempStr = ""
   
   '通过XML取得网页数据内容
   Set XMLObject = CreateObject("Microsoft.XMLHTTP")
   Set HTMLDoc = CreateObject("htmlfile")
   XMLObject.open "GET", "http://quotes.money.163.com/corp/1034/code=600221.html", False
   XMLObject.setRequestHeader "CONTENT-TYPE", "application/x-www-form-urlencoded"
   XMLObject.Send SendStr
   HTMLStr = StrConv(XMLObject.ResponseBody, vbUnicode)
   '通过HTMLDocument对象分析出网页内包含的文本
   HTMLDoc.body.innerHTML = HTMLStr
   DataInfo = HTMLDoc.body.innerText   '从网页中取得全部文本信息
   
   '取得相关的资料位置
   S = InStr(1, DataInfo, "报表日期")
   E = InStr(S, DataInfo, "主编信箱")
   '提取资料文本
   DataInfo = Mid(DataInfo, S, E - S - 4)
   
   
   '将文本分割成以行为单位的数组
   TempArray = Split(DataInfo, vbCrLf)
   
   '为了让最后输出的文本在格式上比较好看，所以就取出信息字段的最大字节数作为格式化标准
   For X = 0 To 66
      Info(X) = RTrim(TempArray(X))          '将右边的空格符去掉
      TitleByte = LenB(StrConv(Info(X), vbFromUnicode))  '取字段标题字节数
      If TitleByte > TitleMaxByte Then TitleMaxByte = TitleByte   '纪录最大字节数
   Next X
   
   '将标题内容统一格式化为最大字节数，以空格填充
   For X = 0 To 66
      '判断如果是大类标题就不处理
      If Right(Info(X), 1) <> "：" Then
         TitleByte = LenB(StrConv(Info(X), vbFromUnicode))  '取当前处理的字段标题字节数
         Info(X) = Info(X) & String(TitleMaxByte - TitleByte, " ") & vbTab '用空格填充标题内容
      End If
   Next X
   
   '将数据放入字段行数组中
   For X = 67 To UBound(TempArray)
      If Y >= 67 Then Y = 0: I = I + 1
      '判断如果是大类标题就不处理
      If Right(Info(Y), 1) <> "：" Then
         If I = 0 Then
            Info(Y) = Info(Y) & TempArray(X)
         Else
            Info(Y) = Info(Y) & "," & TempArray(X)
         End If
      End If
      Y = Y + 1
   Next X
   
   '将处理好的行文本集合到一个文本变量中
   For X = 0 To UBound(Info)
      If Len(TempStr) = 0 Then
         TempStr = Info(X)
      Else
         TempStr = TempStr & vbCrLf & Info(X)
      End If
   Next X

   '输出文本
   Text1.Text = TempStr
End Sub