百度奖品兑换监视程序

积分好不容易到了7000，打算换个抱枕，听说这东西一出来就被换完了，于是就写了个小程序监视，开了两天，终于被我逮到了，哈哈。

分享下，源代码在下面
使用方法很简单，点击按钮“Start”即可，这个程序只是监视抱枕的，当有新的投放进来时会提醒，并且执行文本框中指定的文件，默认
的是播放d盘下的一个mp3文件，可以自己修改。

Option Explicit

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Dim strData$

Dim reg As Object

Dim matchs As Object, match As Object

Dim intCount%

Private Sub Command1_Click()

Timer1.Enabled = True

Command1.Enabled = False

End Sub

Private Sub Command2_Click()

Me.Hide

End Sub

Private Sub Form_Load()

Set reg = CreateObject("vbscript.regexp")

reg.Global = True

reg.IgnoreCase = True

reg.Pattern = "class=""bold"">(\d+)</span>.+?</p>"

End Sub

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

Private Sub Form_Resize()

If Me.WindowState = 1 Then Exit Sub

RichTextBox1.Width = Me.ScaleWidth - RichTextBox1.Left

RichTextBox1.Height = Me.ScaleHeight - RichTextBox1.Top

End Sub

Private Sub Timer1_Timer()

strData = getHtmlStr("http://im.baidu.com/wealth/detail.php?giftid=19")

Set matchs = reg.Execute(strData)

intCount = Val(matchs(0).SubMatches(0))

RichTextBox1.SelStart = Len(RichTextBox1.Text)

RichTextBox1.SelText = Format(Now, "yyyy-mm-dd hh:nn:ss ") & intCount & vbCrLf

If intCount > 0 Then

ShellExecute hwnd, "open", "http://im.baidu.com/wealth/detail.php?giftid=19", "", "", 1

MsgBox intCount & ", OK :)"

End If

End Sub

成功案例：