动网论坛灌水机

liunian

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

Dim HtmlTempText As String
" m' \( e8 X' Z; C
$ S7 @  H( Q6 C* B6 J

- D1 h) Q) b- @, ?5 n, \5 gPrivate Sub Command1_Click()
1 ~3 T9 u1 @' m
# S) y5 |& `! e% ~    Me.WebBrowser1.Navigate Me.Text1.Text
" H3 Y  D* W  x' U6 v
' p5 V0 b" s5 Q      'Form1.Show
( U1 d# ~; {7 F( R3 T; i
: n, A4 T# M5 V; S  ' Me.WebBrowser1.SetFocus
6 ?( F( ~0 z# E3 G9 n) _
) a9 Z! ?7 v; P$ r: d  x' N: ?6 f+ tEnd Sub
1 e* X  Z" g4 p% I/ H- d) g& Z% n

1 U1 U4 K6 }; _' n0 j; G- z
: B; m/ d- z; v$ k5 N/ R/ PPrivate Sub Form_Load()
4 {2 ]4 `, b" F6 }( t3 {
* s& s9 l: i. s+ r- v. W$ K   'Form1.Show

  'Me.WebBrowser1.SetFocus

4 e% F* k: ~* c' ~1 `8 tEnd Sub


4 ^2 j4 _* ~; q) F3 P" n! M( ~- K( M
* d# t" J. y3 lPrivate Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)

" x- a$ W, h9 e& |3 f2 w3 v   On Error Resume Next
+ i  r7 n5 s  d& i- l3 U
  WebBrowser1.SetFocus
/ m" }3 ?! a4 @( z" u
  Dim doc As Object
1 U8 P9 e3 w0 m
 

* J* t! b( u4 r  B* O& g   Set doc = WebBrowser1.Document

- ]) Q/ z) x! M$ q) B; H3 u3 C- @   If InStr(doc.body.innerText, Text3.Text) > 0 Then
2 Q" C. o, g$ f( l
        doc.All.Item("FontSize").focus
2 H4 s, B7 C+ A  @. d
5 q) ]9 ^6 p4 i! V3 Q% W# n; f" I. h         Dim objHtml As Object
( O6 Q) V( o0 N& {
        Set objHtml = doc.body.createTextRange()

. J5 S9 g3 M- r1 H4 d4 G/ C         If Not IsNull(objHtml) Then

1 c5 n( V+ V7 C  [            HtmlTempText = objHtml.htmlText

           Text2.Text = HtmlTempText

( Y% z& s( F( v$ z" l! X         End If
% T2 v3 o0 \, A$ C5 P: I8 }9 [
        Dim tmp As String

) Q. R( P0 H& W' s6 |1 m         tmp = "fasdfasdfsfd"

9 P6 [& S) Q1 B8 E         'Dim aa As Long

4 n+ ?3 p, W$ M' H1 f         'aa = PostMessage(Me.WebBrowser1.hwnd, &H100, 9, 0)
" Q4 ^: T: d& {3 h
        SendKeys "{tab}"
; z6 f2 d  P) v2 [- ?/ r  E! ~
! T0 \& ~& b: T0 B         SendKeys tmp

         'SendKeys "{tab}"

! y% }- _- i0 o6 C          ' SendKeys "{tab}"

, S' F2 L& O5 K' P% S+ _        ' 'doc.All.Item("Submit").focus

       'SendKeys "{enter}"

       Dim str As String
& ~8 m7 ?0 c' a. |! `& M
& Y+ N' r! v4 t& L" j, [        str = "asdf"
  X- R' Y$ y8 f  Q
       SendKeys "^{enter}"
/ a; m/ V) H. E$ R! H/ a
  

  End If
* \( |7 g2 r8 _- B$ x% Z* c' u
3 T+ M' {' \* v$ Y9 X; a0 i8 ~  If InStr(doc.body.innerText, "fasdfasdfsfd") > 0 Then
& [0 Z2 F' [* K/ Y
        doc.All.Item("FontSize").focus
  U7 \. C# K! Y0 k3 L) z
       

       
, o" V+ v/ J0 M3 g
4 ]1 s7 a. c+ G) c* Y4 h! J- }- z+ ]$ J         tmp = "fasdfasdfsfd"
, a# h) K; B) y
        'Dim aa As Long

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

% ~* v6 ]0 m: l2 |" o         SendKeys "{tab}"

9 F2 {, n: s: s6 {# g- q         SendKeys tmp
( @1 T" x1 e2 \; b, G
/ m+ B& `0 K9 m          'SendKeys "{tab}"
# \2 p: C: r) W+ h/ v
         ' SendKeys "{tab}"

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

0 C9 j5 N5 _/ o1 s        'SendKeys "{enter}"
, y  n2 p0 E5 _
, z$ e, J0 u+ V) d' ~2 }        SendKeys "^{enter}"

+ z; c8 _+ N; [5 }  
# x' ~& x" b/ i
  End If
! V3 m3 @$ O9 `4 S* ^4 r
  If InStr(doc.body.innerText, "错误信息") > 0 Then

      Me.WebBrowser1.Navigate Me.Text1.Text
0 h# ]9 Z: c3 @+ x
1 A6 U5 i# R1 {$ T( s* i8 W  End If



  

$ T) I& e7 d. u5 J- F4 z( J& [3 sEnd Sub

/ x( C9 K$ q- H7 b8 v' ^上面的代码中有许多注释掉的语句，是我调试的时候注释掉的，你将该代码原封不动的拷到VB下就可以用了，注意Text1.Text的内容是你要灌水贴的网址如：
" G# X9 E, ]. V4 v5 y  G
http://bbs.wwenglish.org/dispbbs ... ID=39431&page=1

2 d, G" d) y7 a" @* ^" Z; O9 @& b- B在灌水之前，你要先登陆，取得灌水的权利。还有非常重要的一点是Text3.Text的内容是该帖子页面上典型文字，说白了就是该页面上一行或半行文字，以使程序确认该页面，比如帖子中的文字“考研翻译资料系列”之类的。
; C3 t' f( s0 A2 \( u8 l
在程序页面设置完成之后，点击按钮就可以开始灌水了，呵呵，我想对一些人还是有用的。
0 b5 v3 ?! [) ^: Y1 ]/ O) A
还有一点非常注意，就是要保证这个灌水程序窗口是当前工作窗口，如果你切换到别的程序窗口就有可能不在灌水了，所以你应该在吃饭之前开始灌水，吃饭回来后关掉做别的工作。
6 \" p0 C. x8 Y# V+ \! M1 h: B


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

幽鬼狼魂

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

残花留香

呵呵  是你写的  佩服

圣

这样就算高手嘛？

圣

VB的呀。

幽鬼狼魂

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

sonic

我没学好

壹生平安

偶佩服

liunian

  我已经写了《使用VB实现邮箱自动注册（一）：表单自动提交》和《使用VB实现邮箱自动注册（二）：修改代理服务器》两篇文章（blog.csdn.net/qiyanchao），现在就以我所使用的基本方法做一个动网论坛灌水机，动网论坛是现在网上十分流行的论坛，很多论坛都使用了动网论坛。有一次，我在浏览一个英语论坛的时候想下载版主的资料，可是版猪竟将设置了发帖数超过两百才能下载，我非常生气，决定制作一个灌水机，对页面的标记元素进行研究之后，我制定出了对动网论坛进行灌水的方法。具体的源代码如下：
0 [* [: ?6 U) e4 r2 C2 {" ?4 O2 r
Dim HtmlTempText As String
$ J# b3 w1 m, S6 T9 U3 k. X6 p% k
) w2 X( m6 J/ M% {! T  k

$ X# S2 j: F, ]2 V/ tPrivate Sub Command1_Click()
1 `7 ^. p9 o$ V
1 y/ \" U& s8 e$ r+ u( m9 i" @! b    Me.WebBrowser1.Navigate Me.Text1.Text

     'Form1.Show
" n: E' ^  G2 j! j1 g7 r
8 z4 X9 a8 e# p/ }: E  ' Me.WebBrowser1.SetFocus
. J4 B" t3 J& t& \
3 q: ^% K# O* x6 b+ r& ZEnd Sub

3 _: k1 K* x& B# C& ^* N# B' ?$ |
% b( ^; E  K. u' {. o
Private Sub Form_Load()
4 e! Y" _' X1 y9 G4 }
3 ^' v2 |, {" [5 v9 N" s   'Form1.Show
/ _- I" L* n& M" ?3 t4 i$ g# t" o
9 w& p- d: B) a  z3 t$ K   'Me.WebBrowser1.SetFocus

End Sub


+ L: z; x! U. }0 z( j3 U$ Q
Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)

. P8 V3 E8 s, Q: b/ ^  _   On Error Resume Next

  WebBrowser1.SetFocus
3 l5 n4 j4 n  z6 m4 l/ |
3 D; |' V8 e$ o6 w; [   Dim doc As Object

& F* z2 @5 }- M7 R" J  

3 Q  ?2 @) c6 a6 k6 n   Set doc = WebBrowser1.Document
! @, R9 N7 X7 G/ _
  If InStr(doc.body.innerText, Text3.Text) > 0 Then
% B* v. e6 N9 r( R/ ?! j
5 M6 ]7 M: M$ _$ `' j5 i         doc.All.Item("FontSize").focus

        Dim objHtml As Object
  F' u& A$ C2 m. V" @+ o
        Set objHtml = doc.body.createTextRange()

        If Not IsNull(objHtml) Then
7 [- Z2 t. Q9 v9 F! ~8 U
           HtmlTempText = objHtml.htmlText

           Text2.Text = HtmlTempText
, V% k7 n! S, q: F6 p) y2 k
: x" N7 C* N8 o* e         End If
$ ^- j3 A: J& t
        Dim tmp As String

        tmp = "fasdfasdfsfd"
( X# `- M; h# {( N9 {
# E" B7 ~- b, u1 Q         'Dim aa As Long
: s+ _2 n- O( i5 y8 P$ e& w; {
: H* C& f3 x, x! K# L6 F         'aa = PostMessage(Me.WebBrowser1.hwnd, &H100, 9, 0)
7 l' C( m9 g, r8 R0 j$ T) ]
8 @+ B* z; j+ ?7 a5 }# o) `4 H         SendKeys "{tab}"

        SendKeys tmp
2 o; G& U# J5 B& a& E! R! C3 Q6 A
         'SendKeys "{tab}"

         ' SendKeys "{tab}"
$ C2 {: u7 l$ ]
       ' 'doc.All.Item("Submit").focus
! J. W, D* ?+ }1 ?* s  X' R
, y- z7 u# z" S* v/ @' S! A  |        'SendKeys "{enter}"
" ^5 ?# A8 S4 p6 p6 G* ]
       Dim str As String
! H2 V: @+ [+ {6 [% ?
0 R! @9 k$ ^0 J0 L4 `' N        str = "asdf"
- L  h9 x/ w/ f+ G
       SendKeys "^{enter}"

. ~- B% b5 R, |# G  

  End If

  If InStr(doc.body.innerText, "fasdfasdfsfd") > 0 Then
1 o* `8 u4 D1 P& X7 J* Y
        doc.All.Item("FontSize").focus

3 o6 u0 @! F! E: h, h$ @        
2 i8 l) `" O1 P' r$ s: ]4 }
+ K" `- p5 Y  b5 M4 ?, S& Z0 ^        

7 i$ {9 R5 H4 _+ v. U. V- F" a         tmp = "fasdfasdfsfd"
3 A8 J8 g; U: o5 C
1 O2 Z* E5 m# I1 d9 U- c6 d9 J/ G         'Dim aa As Long

2 r+ e0 z, N* S5 r. P         'aa = PostMessage(Me.WebBrowser1.hwnd, &H100, 9, 0)

0 ]4 |- A( N0 B         SendKeys "{tab}"
/ G' a8 c/ `6 K8 v
        SendKeys tmp
: |9 k# R6 m& p" u
         'SendKeys "{tab}"
3 u) p+ g; E0 X! D
         ' SendKeys "{tab}"

% x: Z, ~5 H1 H5 w5 }* I$ M% j        ' 'doc.All.Item("Submit").focus
# m' N$ n6 Q8 G6 \# B0 v$ N! n% B( O
       'SendKeys "{enter}"

       SendKeys "^{enter}"
3 b+ s0 _# _! D' F7 n* i! F
0 `# F+ J; N( d+ i, |( p  v  

- L4 W+ Q4 U5 m1 E4 a/ u3 m  End If
8 P% V6 \3 m! ~) G/ R$ x
  If InStr(doc.body.innerText, "错误信息") > 0 Then
' |8 v; U9 I7 a7 [1 ?
' @; e. d$ `5 ~# a- m( E       Me.WebBrowser1.Navigate Me.Text1.Text

  End If
% ~* `' R* r5 c) n9 J- E# a, {, G' k

7 r5 H2 g9 @) w' o& Y; k
  
' ~1 {+ c+ v% ~' T2 y# @7 l
/ b1 ]" J( }& sEnd Sub
6 O5 ~0 N+ q, R1 _1 r
/ @+ l7 A0 @! W+ q7 _上面的代码中有许多注释掉的语句，是我调试的时候注释掉的，你将该代码原封不动的拷到VB下就可以用了，注意Text1.Text的内容是你要灌水贴的网址如：
- i0 j$ H7 K# s% ?9 u
' \+ N3 q6 p/ }0 Ehttp://bbs.wwenglish.org/dispbbs ... ID=39431&page=1

* s+ `0 h5 C8 i' P, ]7 ?在灌水之前，你要先登陆，取得灌水的权利。还有非常重要的一点是Text3.Text的内容是该帖子页面上典型文字，说白了就是该页面上一行或半行文字，以使程序确认该页面，比如帖子中的文字“考研翻译资料系列”之类的。
' }$ e. X" F3 h  O$ \* @
8 p5 ?( t, Z5 w0 A0 Q在程序页面设置完成之后，点击按钮就可以开始灌水了，呵呵，我想对一些人还是有用的。

还有一点非常注意，就是要保证这个灌水程序窗口是当前工作窗口，如果你切换到别的程序窗口就有可能不在灌水了，所以你应该在吃饭之前开始灌水，吃饭回来后关掉做别的工作。
9 h- q+ s8 ?9 H' o2 m
9 d$ p* d( @( ?/ l

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