form2.frm

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

VERSION 5.00
Begin VB.Form Form2 
   Caption         =   "Form2"
   ClientHeight    =   4965
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   7950
   LinkTopic       =   "Form2"
   ScaleHeight     =   4965
   ScaleWidth      =   7950
   StartUpPosition =   3  'Windows Default
   Begin VB.Timer Timer1 
      Left            =   360
      Top             =   2400
   End
   Begin VB.TextBox Text3 
      Height          =   375
      Left            =   240
      TabIndex        =   2
      Text            =   "E:\abc1.htm"
      Top             =   3600
      Width           =   6135
   End
   Begin VB.TextBox Text1 
      Height          =   1335
      Left            =   120
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   1
      Text            =   "Form2.frx":0000
      Top             =   120
      Width           =   7695
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   615
      Left            =   6000
      TabIndex        =   0
      Top             =   4320
      Width           =   1695
   End
End
Attribute VB_Name = "Form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
Timer1.Interval = 1000
Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
  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
   Dim MYARR() As String
   Dim MYARR2() As String
   Dim buytag As Integer
   Dim mystring2 As String
   '初始化变量
   Y = 0
   I = 0
   TitleMaxByte = 0
   TempStr = ""
   
   '通过XML取得网页数据内容
   Set XMLObject = CreateObject("Microsoft.XMLHTTP")
   'Set HTMLDoc = CreateObject("htmlfile")
   XMLObject.open "POST", Text3.Text, False
   'MsgBox "a"
   'XMLObject.setRequestHeader "CONTENT-TYPE", "application/x-www-form-urlencoded"
   XMLObject.Send
   'MsgBox "b"
   HTMLStr = StrConv(XMLObject.ResponseBody, vbUnicode) 'ResponseText
   'MsgBox "c"
   buytag = InStr(1, HTMLStr, "btn-buy")
   If buytag <> 0 Then
     MsgBox "己上架"
   Else
     MsgBox "没上架"
   End If
   
   S = InStr(1, HTMLStr, "skuMap")
   E = InStr(1, HTMLStr, "DivisionPanel")
   
   STRTEMP = Mid(HTMLStr, S, E - S)
   STRTEMP = Replace(STRTEMP, Chr(8), "")
   STRTEMP = Replace(STRTEMP, Chr(9), "")
   STRTEMP = Replace(STRTEMP, Chr(10), "")
   STRTEMP = Replace(STRTEMP, Chr(11), "")
   STRTEMP = Replace(STRTEMP, Chr(12), "")
   STRTEMP = Replace(STRTEMP, Chr(13), "")
   STRTEMP = Replace(STRTEMP, Chr(32), "")
   STRTEMP = Replace(STRTEMP, "</SCRIPT><DIVid=", "")
   'STRTEMP = Replace(STRTEMP, "{", "")
   'STRTEMP = Replace(STRTEMP, "}", "")
   STRTEMP = Replace(STRTEMP, """", "")
   STRTEMP = Replace(STRTEMP, ":", "")
   STRTEMP = Replace(STRTEMP, "skuMap{;", "")
   'MsgBox "d"
   MYARR = Split(STRTEMP, "},")
   'MsgBox "e"
   Text1.Text = ""
   For I = 0 To UBound(MYARR)
   Text1.Text = Text1.Text + MYARR(I) + Chr(13)
   Next
End Sub