动网论坛灌水机

liunian

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

Dim HtmlTempText As String

- X2 E3 C( \- i% c! s

Private Sub Command1_Click()

   Me.WebBrowser1.Navigate Me.Text1.Text

; l  n# [1 ]. s# Y9 ?      'Form1.Show

" D/ r5 Q5 Q* g  ' Me.WebBrowser1.SetFocus

End Sub
( g6 a- e( i1 @& G) G- b/ @: n
: ^3 w4 J5 L% f9 M% f9 r
" ]1 ]7 l1 p% s6 L
' B# ?- o) ~& Q9 @% i5 O- P* VPrivate Sub Form_Load()
/ s( ?8 r8 D$ e6 v! q+ U
  'Form1.Show
: U0 M" z. x- p+ ~( c/ ]8 p& V- t
  'Me.WebBrowser1.SetFocus
+ W. q; d3 M4 p6 y' W; r1 V; h
End Sub
! G* \& D8 c" ]5 u4 W
! C4 W% J- G& `9 I; }9 z
, t3 W+ L4 t/ }6 ]; t
Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)

1 t) m& Q% w* d   On Error Resume Next
& e( E" z4 e, M5 w
  WebBrowser1.SetFocus

, @  r% c! g2 t- p   Dim doc As Object

: J: N! h- k( \7 R3 a* C( V3 @" p  

  Set doc = WebBrowser1.Document
/ V% c$ \# G: y. u  Q/ e
  If InStr(doc.body.innerText, Text3.Text) > 0 Then

; K! S4 z+ P+ `& j% `  W9 b         doc.All.Item("FontSize").focus
5 b" v  B( b- v+ b) s
% |8 W- y) a- K! Y& q; `0 {         Dim objHtml As Object
* P5 `3 x) D# A
        Set objHtml = doc.body.createTextRange()
/ F3 s- e: g) `  X; D# A  P
        If Not IsNull(objHtml) Then

% {) Z- {& n. T( \6 g9 w3 }8 g* r6 P            HtmlTempText = objHtml.htmlText
# G4 M1 ~0 |0 t* {% x; Q
% g$ w, `" G. l/ E: U            Text2.Text = HtmlTempText

        End If
* ^( S1 A6 n) p7 @
        Dim tmp As String

  }2 ]6 ?, I5 F0 Y3 @. Z) C7 _         tmp = "fasdfasdfsfd"

        'Dim aa As Long
2 D; U- ^* T2 V6 d
        'aa = PostMessage(Me.WebBrowser1.hwnd, &H100, 9, 0)
, M) F: w/ n, n% s
& h5 r8 J9 C( f; ^6 w         SendKeys "{tab}"

; p& w' R, c5 \( \: K         SendKeys tmp
# f3 q) N& n( }1 u3 `
  b# n7 b0 l  C$ g4 g; }$ g! x          'SendKeys "{tab}"

" y% W# H# |, E7 B' I& _          ' SendKeys "{tab}"

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

       'SendKeys "{enter}"

, x$ T/ R: Z, O- s! W( d6 l        Dim str As String

       str = "asdf"

9 V- g4 F+ H  D: d        SendKeys "^{enter}"
' P- d" g3 @3 s- I8 c
4 @+ O* Q  M. W  
0 l% _* }2 d. P' i
  End If

  If InStr(doc.body.innerText, "fasdfasdfsfd") > 0 Then
% b4 L0 F0 {! w+ v
        doc.All.Item("FontSize").focus

       

0 q$ B8 M; b( ]. Y        
1 a' E8 C4 U- Y8 p# b8 R0 B
, i3 l0 Y  t$ s         tmp = "fasdfasdfsfd"

" ^6 B, d% \+ L         'Dim aa As Long

        'aa = PostMessage(Me.WebBrowser1.hwnd, &H100, 9, 0)
: I, L# i4 D* x1 }4 W0 l4 E
        SendKeys "{tab}"
* ]* E& r& o( J# T
        SendKeys tmp
# T: F+ e: S1 U- l6 w
0 B8 ]0 l2 U& u/ }: n* X          'SendKeys "{tab}"

- \9 U( g# a  C9 e          ' SendKeys "{tab}"

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

% {7 x/ `# ~6 T% G: H* P: N5 d        'SendKeys "{enter}"
& E2 e6 P+ H. {; O
1 H' y& Z) k/ m' r% O7 Q        SendKeys "^{enter}"
# X* D/ ?9 n5 [
2 c+ ~8 G: _& x  C8 D4 e  
( b/ ]+ v* S: x3 N2 K6 N
  End If
% O6 Q) v9 v7 P8 `. h7 U5 i# P6 V& ^
; X. x/ ~4 U$ g5 z4 i8 x9 x  If InStr(doc.body.innerText, "错误信息") > 0 Then
0 a( O' `* \- _+ P) f# }
      Me.WebBrowser1.Navigate Me.Text1.Text

/ E/ Z3 N2 Z& {( \* l  End If
' X1 W4 @& G* u2 z
2 f  ?! [& s$ E, N5 S. q  e
6 N$ Z8 `+ {1 g6 A) n$ Y
4 N1 c. M" J! T  i5 c  
  o( E9 A" D' N' u/ T% N: S6 m
& v1 j1 P6 U) v/ i7 V: [End Sub
7 M% ?  y# N! ?3 e7 _* {. n" ?( l6 ~
" j! y7 Y' @0 q( k上面的代码中有许多注释掉的语句，是我调试的时候注释掉的，你将该代码原封不动的拷到VB下就可以用了，注意Text1.Text的内容是你要灌水贴的网址如：
/ D" L! z' Q* f
http://bbs.wwenglish.org/dispbbs ... ID=39431&page=1
' y/ M% P2 l) a, }, x6 ]9 U+ A
- P4 m+ f0 h) _6 c) }+ F在灌水之前，你要先登陆，取得灌水的权利。还有非常重要的一点是Text3.Text的内容是该帖子页面上典型文字，说白了就是该页面上一行或半行文字，以使程序确认该页面，比如帖子中的文字“考研翻译资料系列”之类的。

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

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


, L9 X4 a, i% u/ i
! e8 A2 J* B) ]+ [0 G5 `4 U3 F# ^版权声明：CSDN是本Blog托管服务提供商。如本文牵涉版权问题，CSDN不承担相关责任，请版权拥有者直接与文章作者联系解决。

幽鬼狼魂

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

残花留香

呵呵  是你写的  佩服

圣

这样就算高手嘛？

圣

VB的呀。

幽鬼狼魂

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

sonic

我没学好

壹生平安

偶佩服

liunian

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

Dim HtmlTempText As String
) {  x9 s& n6 `7 U5 ]

& ~/ ?, L0 z2 r: q
Private Sub Command1_Click()
& }+ Z2 y' a9 u& j6 A
$ h% e6 O/ |, D' f2 g+ u    Me.WebBrowser1.Navigate Me.Text1.Text
2 W8 c& v$ @$ n0 D8 g
9 z6 P4 V) v  Z+ v1 d1 f; B3 Z      'Form1.Show
  M- C: s% n" W: s4 l
' q& T: {: `2 Z, L1 [/ S  ' Me.WebBrowser1.SetFocus
6 u6 Y8 a- w+ u1 a$ _! D- D/ t
$ S% F! b2 D* i- c# B( `End Sub



Private Sub Form_Load()
; h9 r+ \9 u9 f, k9 k$ M
4 p0 \" @( P% j, i% o   'Form1.Show
. w1 m" Y; E  i6 l
0 `- i+ ?* U/ Q9 E$ j" q6 t) Z3 a   'Me.WebBrowser1.SetFocus
+ ]3 |8 N" n6 u7 P9 Z
+ \! h/ q" G! F# @End Sub

, _5 {5 D' H: c; a) W
& u( T1 g: s$ i7 x% ?" R$ b' }9 _
( F# {# T. }. Y) sPrivate Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
0 l3 u" ~$ B0 g0 Q, u  ?3 \! U
4 W# U0 i4 j0 r( w% C) o( N- j- x4 G   On Error Resume Next
9 W: F+ T* X2 N. v0 Y' X3 k5 b' L
  WebBrowser1.SetFocus

  Dim doc As Object
( H# S1 K' c) H: o8 A
 
; q! P) a4 e) j* u5 k( [( ]# ~2 P
  Set doc = WebBrowser1.Document
5 C( q$ G4 _- H/ S2 D  w
# K# n- U/ ^8 }9 o, A   If InStr(doc.body.innerText, Text3.Text) > 0 Then
  A2 y! I3 f. s( {
0 j" Y# F0 o* d& `. [         doc.All.Item("FontSize").focus
% C) x, _, q" t; k. {
        Dim objHtml As Object

+ H: c, Z" p6 P+ Y) Y         Set objHtml = doc.body.createTextRange()

. P* |8 C1 R. w         If Not IsNull(objHtml) Then

8 n% D# r/ Y! o' r5 `            HtmlTempText = objHtml.htmlText

           Text2.Text = HtmlTempText

        End If
' ]  R; E4 V/ I3 s8 c3 i, ]) s
" z* `: C' l8 f$ {  e0 _         Dim tmp As String
; S9 i" i+ Q5 z, p, j
        tmp = "fasdfasdfsfd"
) ?, c- @; i  i; K) h/ d
; g; R6 B& N* O2 \. {+ ~: Z         'Dim aa As Long

! V; c& d) a2 q7 o3 j1 H: x         'aa = PostMessage(Me.WebBrowser1.hwnd, &H100, 9, 0)

/ ~5 X5 f7 n5 g/ s' A, t% f         SendKeys "{tab}"
, [* n5 Z6 {- P( V1 B( c! m3 P
        SendKeys tmp
) T8 J1 j9 H$ m6 b1 s; S5 m
3 _& G" n# ]$ y: Y5 q          'SendKeys "{tab}"
  o+ s7 j! C+ [& D0 H- E8 \4 F
, g7 C! y, l+ D% l* E, A          ' SendKeys "{tab}"

, G, W" q* P6 ]" b* J        ' 'doc.All.Item("Submit").focus
- ?0 W' B3 J5 D* d$ w
       'SendKeys "{enter}"

       Dim str As String

  I! {3 |* R9 ^) y' }1 h% r. q, d5 d        str = "asdf"

       SendKeys "^{enter}"
7 s$ }  S/ O! S
  
6 o# S8 [& [+ n/ V6 F& [
  End If

) H% ~% |! N# Z4 L4 V4 Z: J1 s& w  If InStr(doc.body.innerText, "fasdfasdfsfd") > 0 Then

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

       

" I0 A/ X- i4 Z3 p: }        
% c8 v5 b5 z. \
        tmp = "fasdfasdfsfd"
  K9 }; C1 ]+ {5 U
        'Dim aa As Long

3 }6 G1 p7 A; m# U         'aa = PostMessage(Me.WebBrowser1.hwnd, &H100, 9, 0)
2 n; H0 o7 a; ~* U) f
        SendKeys "{tab}"

        SendKeys tmp
& l/ T& G6 \1 c) D% K
3 k$ f9 q% R) b          'SendKeys "{tab}"

3 p1 R; ~/ ]0 U5 P9 }. V          ' SendKeys "{tab}"
( E  w" Q' [( Q4 |$ ?
) F! V% u! N" S6 |) o2 j        ' 'doc.All.Item("Submit").focus

       'SendKeys "{enter}"
* ]% L& o9 F2 Q5 x+ Z+ s! C  a- O
8 @+ \! X3 j1 c' }" i        SendKeys "^{enter}"
/ `# q( Y9 ?4 i1 M/ o; `: ]2 {) Q
  

7 Q, @5 z9 P8 B/ E9 ]% A& Q  k& X  End If

, O! T; n+ N. J  If InStr(doc.body.innerText, "错误信息") > 0 Then
  G: L$ u# k/ D  L
: I) |/ e" S9 v+ D       Me.WebBrowser1.Navigate Me.Text1.Text
. s1 a  [+ c* O( N+ L- ?
  End If

$ ~9 R4 @1 ~$ ]  v" B& O0 P

9 Z/ O# U0 b0 C- e" [  
! N$ i: \) ]* V  I3 t4 Y
End Sub

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

4 B  v% j' p% v  e" ohttp://bbs.wwenglish.org/dispbbs ... ID=39431&page=1

在灌水之前，你要先登陆，取得灌水的权利。还有非常重要的一点是Text3.Text的内容是该帖子页面上典型文字，说白了就是该页面上一行或半行文字，以使程序确认该页面，比如帖子中的文字“考研翻译资料系列”之类的。
- G' Z5 ]- `2 l+ M- T9 @
在程序页面设置完成之后，点击按钮就可以开始灌水了，呵呵，我想对一些人还是有用的。
: a. P2 h4 C' r( X# P5 u. `
4 O- s. `$ Z: ?. e9 G" @: g. |还有一点非常注意，就是要保证这个灌水程序窗口是当前工作窗口，如果你切换到别的程序窗口就有可能不在灌水了，所以你应该在吃饭之前开始灌水，吃饭回来后关掉做别的工作。

  [  @, i1 i& R  Z/ R1 u
% V! B, p' C( j) l1 ]
* r- Z7 x2 a0 l% w& Z版权声明：CSDN是本Blog托管服务提供商。如本文牵涉版权问题，CSDN不承担相关责任，请版权拥有者直接与文章作者联系解决。