标题:论坛自动回复,现在已经到了最后一步 全部代码都在这里。。。
只看楼主
anluboy
Rank: 1
等 级:新手上路
帖 子:49
专家分:0
注 册:2007-7-19
结帖率:100%
已结贴  问题点数:20 回复次数:5 
论坛自动回复,现在已经到了最后一步 全部代码都在这里。。。
Private Sub Timer1_Timer()

Dim i As Integer

Form1.Caption = js   '提示倒计时
If js > 0 Then
    js = js - 1      '倒计时
End If

If Check1.Value > 0 Then
    If js = 0 Then           '倒计时=0
        If List1.ListCount > 0 Then       '有列表
            i = Int(Rnd() * List1.ListCount)        '产生随机位置
            WebBrowser2.Navigate List1.List(i)      '转到
            List1.RemoveItem i                      '去掉该网址
            js = 30                                '倒计时180秒
        Else
            WebBrowser2.Navigate 列表URL            '列表为空,转到列表
            js = 600                                '倒计时 600 秒
        End If

    End If
End If
End Sub



Private Sub WebBrowser2_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    js = 3
End Sub



Private Sub Command1_Click()
List1.Clear
List2.Clear
For Each ww In WebBrowser1.Document.getelementsbytagname("a")
ss = ww.href
qq = ww.innertext
If Right(ss, 5) = "shtml" Then
List1.AddItem ss
List2.AddItem qq
Label1.Caption = "共提取到:" & List1.ListCount & "条连接"
End If
Next ww
End Sub

Private Sub Command2_Click()
    List1.Clear
    List2.Clear
    Label1.Caption = "共提取到:" & List1.ListCount & "条连接"
End Sub

Private Sub MyBorwser_NavigateComplete2(ByVal pDisp As Object, URL As Variant) '忽略脚本语法错误
        Set HtmlWnd = MyBorwser.Document.parentWindow

End Sub
Private Sub Command3_Click()

            i = Int(Rnd() * List1.ListCount)        '产生随机位置
            WebBrowser2.Navigate List1.List(i)      '转到
            List1.RemoveItem i                      '去掉该网址
            js = 30
End Sub

Private Sub Form_Load()
WebBrowser1.Navigate "http://dzh.
End Sub
Private Sub Command4_Click()  '结束按钮
   End
End Sub

下面回复部分怎么写?  
我要的是自动回复。。。内容从LIST2里随机选择。
网页的代码在下面。
搜索更多相关主题的帖子: 自动回复 
2012-10-26 13:44
anluboy
Rank: 1
等 级:新手上路
帖 子:49
专家分:0
注 册:2007-7-19
得分:0 
http://dzh.
这个页面就是需要回复的页面··求大大帮忙 谢谢了··
2012-10-26 13:45
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4912
专家分:29900
注 册:2008-10-15
得分:20 
给以下三个对象 值,
irBody           回复内容
irUser           用户名
irPass           密码

调用以下 JS 函数进行提交。
MOP.DZH.loginAndReply(true,1);

你可以写成一行 JS ,然后用VB调用。
或者你去分析最后那个 回复框,然后处理 也行。

授人于鱼,不如授人于渔
早已停用QQ了
2012-10-26 15:32
anluboy
Rank: 1
等 级:新手上路
帖 子:49
专家分:0
注 册:2007-7-19
得分:0 
回复 3楼 风吹过b
谢谢大大···能帮我写一下吗?前面的代码也有你告诉我写的部分·
2012-10-26 15:40
anluboy
Rank: 1
等 级:新手上路
帖 子:49
专家分:0
注 册:2007-7-19
得分:0 
登录部分不需要的。
2012-10-26 15:42
anluboy
Rank: 1
等 级:新手上路
帖 子:49
专家分:0
注 册:2007-7-19
得分:0 
Private Sub Command1_Click()
On Error Resume Next
list1.Clear
Label2.Caption = 0
Label4.Caption = 0
Open App.Path & "\lianjie.ini" For Input As #1
Line Input #1, lianjie
Close #1
For j = 0 To 5
  WebBrowser1.Navigate lianjie & j
  
Delay 4000
  
Command4_Click '查找列出所有超链接
  
Next j

For i = 12 To list1.ListCount - 1
WebBrowser2.Navigate list1.List(i)

Delay 10000
   
k = 0
Dim o

For Each o In WebBrowser2.Document.getElementsByTagName("a")
  If InStr(o.innerText, Text1.Text) > 0 Then
    k = k + 1
  End If
Next

If k = 1 Then '如果没有的话,发帖

Dim a As String '先判断文件有多少行
Dim n As Integer
Open App.Path & "\neirong.ini" For Input As #1
  n = 0
  While Not EOF(1)
   Line Input #1, a
   n = n + 1
   Wend
Randomize '随机选一行文本进行回帖
m = Int(Rnd * n) + 1
n = Int(Rnd * 1000) + 100
neirong = Split(GetTxt(App.Path & "\neirong.ini"), vbCrLf)(m - 1) & n
Close #1
If Text1.Text = "" Then
neirong = "顶下楼主的帖"
End If

Set oDoc = WebBrowser2.Document '写入回帖内容
Set oInput = oDoc.getElementsByTagName("textarea").Item("irBody")
 oInput.Value = neirong
Delay 1000
For Each o In WebBrowser2.Document.getElementsByTagName("a") '点回复按钮
If InStr(o.onclick, "MOP.DZH.loginAndReply(false,1);") > 0 Then
    o.Click
    Exit For
  End If
 
Next
Label2.Caption = Label2.Caption + 1 '统计次数

Delay 3000

End If

Next i


 '延时30分钟
 Delay 30000: Delay 30000
 
 Delay 30000: Delay 30000
 
 Delay 30000: Delay 30000
 
 Delay 30000: Delay 30000
 
 Delay 30000: Delay 30000
 
 
 Delay 30000: Delay 30000
 
 Delay 30000: Delay 30000
 
 Delay 30000: Delay 30000
 
 Delay 30000: Delay 30000
 
 Delay 30000: Delay 30000
 
 
 Delay 30000: Delay 30000
 
 Delay 30000: Delay 30000
 
 Delay 30000: Delay 30000
 
 Delay 30000: Delay 30000
 
 Delay 30000: Delay 30000
 
 
 Delay 30000: Delay 30000
 
 Delay 30000: Delay 30000
 
 Delay 30000: Delay 30000
 
 Delay 30000: Delay 30000
 
 Delay 30000: Delay 30000
 
 
 Delay 30000: Delay 30000
 
 Delay 30000: Delay 30000
 
 Delay 30000: Delay 30000
 
 Delay 30000: Delay 30000
 
 Delay 30000: Delay 30000
 
 
 Delay 30000: Delay 30000
 
 Delay 30000: Delay 30000
 
 Delay 30000: Delay 30000
 
 Delay 30000: Delay 30000
 
 Delay 30000: Delay 30000
 

 
 
 Command1_Click

End Sub
找到一段代码
不知道怎么加进去。。。。
2012-10-26 18:11



参与讨论请移步原网站贴子:https://bbs.bccn.net/thread-384512-1-1.html




关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.756015 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved