liunian 发表于 2005 年 2 月 11 日 21:44:51

动网论坛灌水机

我已经写了《使用VB实现邮箱自动注册（一）：表单自动提交》和《使用VB实现邮箱自动注册（二）：修改代理服务器》两篇文章（blog.csdn.net/qiyanchao），现在就以我所使用的基本方法做一个动网论坛灌水机，动网论坛是现在网上十分流行的论坛，很多论坛都使用了动网论坛。有一次，我在浏览一个英语论坛的时候想下载版主的资料，可是版猪竟将设置了发帖数超过两百才能下载，我非常生气，决定制作一个灌水机，对页面的标记元素进行研究之后，我制定出了对动网论坛进行灌水的方法。具体的源代码如下：

Dim HtmlTempText As String



Private Sub Command1_Click()

 Me.WebBrowser1.Navigate Me.Text1.Text

   'Form1.Show

' Me.WebBrowser1.SetFocus

End Sub



Private Sub Form_Load()

  'Form1.Show

  'Me.WebBrowser1.SetFocus

End Sub



Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)

  On Error Resume Next

  WebBrowser1.SetFocus

  Dim doc As Object

 

  Set doc = WebBrowser1.Document

  If InStr(doc.body.innerText, Text3.Text) > 0 Then

    doc.All.Item("FontSize").focus

    Dim objHtml As Object

    Set objHtml = doc.body.createTextRange()

    If Not IsNull(objHtml) Then

     HtmlTempText = objHtml.htmlText

     Text2.Text = HtmlTempText

    End If

    Dim tmp As String

    tmp = "fasdfasdfsfd"

    'Dim aa As Long

    'aa = PostMessage(Me.WebBrowser1.hwnd, &H100, 9, 0)

    SendKeys "{tab}"

    SendKeys tmp

   'SendKeys "{tab}"

   ' SendKeys "{tab}"

     ' 'doc.All.Item("Submit").focus

     'SendKeys "{enter}"

     Dim str As String

     str = "asdf"

     SendKeys "^{enter}"



End If

If InStr(doc.body.innerText, "fasdfasdfsfd") > 0 Then

    doc.All.Item("FontSize").focus

   

     

    tmp = "fasdfasdfsfd"

    'Dim aa As Long

    'aa = PostMessage(Me.WebBrowser1.hwnd, &H100, 9, 0)

    SendKeys "{tab}"

    SendKeys tmp

   'SendKeys "{tab}"

   ' SendKeys "{tab}"

     ' 'doc.All.Item("Submit").focus

     'SendKeys "{enter}"

     SendKeys "^{enter}"



End If

If InStr(doc.body.innerText, "错误信息") > 0 Then

  Me.WebBrowser1.Navigate Me.Text1.Text

End If





End Sub

上面的代码中有许多注释掉的语句，是我调试的时候注释掉的，你将该代码原封不动的拷到VB下就可以用了，注意Text1.Text的内容是你要灌水贴的网址如：

http://bbs.wwenglish.org/dispbbs.asp?boardID=73&ID=39431&page=1

在灌水之前，你要先登陆，取得灌水的权利。还有非常重要的一点是Text3.Text的内容是该帖子页面上典型文字，说白了就是该页面上一行或半行文字，以使程序确认该页面，比如帖子中的文字“考研翻译资料系列”之类的。

在程序页面设置完成之后，点击按钮就可以开始灌水了，呵呵，我想对一些人还是有用的。

还有一点非常注意，就是要保证这个灌水程序窗口是当前工作窗口，如果你切换到别的程序窗口就有可能不在灌水了，所以你应该在吃饭之前开始灌水，吃饭回来后关掉做别的工作。



版权声明：CSDN是本Blog托管服务提供商。如本文牵涉版权问题，CSDN不承担相关责任，请版权拥有者直接与文章作者联系解决。

幽鬼狼魂 发表于 2005 年 2 月 11 日 21:48:11

代码不错，是自己写的吗？如果是请允许我说一声“佩服”，灵活运用不错楼猪，支持你。

残花留香 发表于 2005 年 2 月 11 日 21:53:22

呵呵是你写的佩服

圣 发表于 2005 年 2 月 11 日 21:54:36

这样就算高手嘛？

圣 发表于 2005 年 2 月 11 日 21:55:12

VB的呀。

幽鬼狼魂 发表于 2005 年 2 月 11 日 21:56:19

vb怎么了哦，vb也可以写出好的程序来呀

sonic 发表于 2005 年 2 月 11 日 22:53:05

我没学好

壹生平安 发表于 2005 年 2 月 11 日 22:54:06

偶佩服

liunian 发表于 2005 年 2 月 11 日 21:44:51

动网论坛灌水机

我已经写了《使用VB实现邮箱自动注册（一）：表单自动提交》和《使用VB实现邮箱自动注册（二）：修改代理服务器》两篇文章（blog.csdn.net/qiyanchao），现在就以我所使用的基本方法做一个动网论坛灌水机，动网论坛是现在网上十分流行的论坛，很多论坛都使用了动网论坛。有一次，我在浏览一个英语论坛的时候想下载版主的资料，可是版猪竟将设置了发帖数超过两百才能下载，我非常生气，决定制作一个灌水机，对页面的标记元素进行研究之后，我制定出了对动网论坛进行灌水的方法。具体的源代码如下：

Dim HtmlTempText As String



Private Sub Command1_Click()

 Me.WebBrowser1.Navigate Me.Text1.Text

   'Form1.Show

' Me.WebBrowser1.SetFocus

End Sub



Private Sub Form_Load()

  'Form1.Show

  'Me.WebBrowser1.SetFocus

End Sub



Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)

  On Error Resume Next

  WebBrowser1.SetFocus

  Dim doc As Object

 

  Set doc = WebBrowser1.Document

  If InStr(doc.body.innerText, Text3.Text) > 0 Then

    doc.All.Item("FontSize").focus

    Dim objHtml As Object

    Set objHtml = doc.body.createTextRange()

    If Not IsNull(objHtml) Then

     HtmlTempText = objHtml.htmlText

     Text2.Text = HtmlTempText

    End If

    Dim tmp As String

    tmp = "fasdfasdfsfd"

    'Dim aa As Long

    'aa = PostMessage(Me.WebBrowser1.hwnd, &H100, 9, 0)

    SendKeys "{tab}"

    SendKeys tmp

   'SendKeys "{tab}"

   ' SendKeys "{tab}"

     ' 'doc.All.Item("Submit").focus

     'SendKeys "{enter}"

     Dim str As String

     str = "asdf"

     SendKeys "^{enter}"



End If

If InStr(doc.body.innerText, "fasdfasdfsfd") > 0 Then

    doc.All.Item("FontSize").focus

   

     

    tmp = "fasdfasdfsfd"

    'Dim aa As Long

    'aa = PostMessage(Me.WebBrowser1.hwnd, &H100, 9, 0)

    SendKeys "{tab}"

    SendKeys tmp

   'SendKeys "{tab}"

   ' SendKeys "{tab}"

     ' 'doc.All.Item("Submit").focus

     'SendKeys "{enter}"

     SendKeys "^{enter}"



End If

If InStr(doc.body.innerText, "错误信息") > 0 Then

  Me.WebBrowser1.Navigate Me.Text1.Text

End If





End Sub

上面的代码中有许多注释掉的语句，是我调试的时候注释掉的，你将该代码原封不动的拷到VB下就可以用了，注意Text1.Text的内容是你要灌水贴的网址如：

http://bbs.wwenglish.org/dispbbs.asp?boardID=73&ID=39431&page=1

在灌水之前，你要先登陆，取得灌水的权利。还有非常重要的一点是Text3.Text的内容是该帖子页面上典型文字，说白了就是该页面上一行或半行文字，以使程序确认该页面，比如帖子中的文字“考研翻译资料系列”之类的。

在程序页面设置完成之后，点击按钮就可以开始灌水了，呵呵，我想对一些人还是有用的。

还有一点非常注意，就是要保证这个灌水程序窗口是当前工作窗口，如果你切换到别的程序窗口就有可能不在灌水了，所以你应该在吃饭之前开始灌水，吃饭回来后关掉做别的工作。



版权声明：CSDN是本Blog托管服务提供商。如本文牵涉版权问题，CSDN不承担相关责任，请版权拥有者直接与文章作者联系解决。
页: [1]
查看完整版本: 动网论坛灌水机