QQ批量自动申请源码 »

« 为网站添加QQ临时会话在线图标

试试xTiNt的代码着色效果。

xTiNtGlobal UserName As String '用户名
Global Password As String '登录密码
Global Login_Page_Start As String '登录页面
Global Login_Page_Complete As String '登录完成后服务器将自动跳转的页面
Global Jump_Page As String '拟发回复贴的页面
Global Pouring_Article_ID As String '拟发回复的帖子的ID号
Global Pouring_Text As String '拟回复的内容
Global Pouring_Title As String '拟回复帖所采用的标题
Global Pouring_Times As Integer '拟回帖次数
Global Reply_Page As String '回复成功后,服务器会自动跳转的页面

Sub Read_Info()
UserName = "XXXXXX"
Password = "XXXXXX"
Login_Page_Start = "http://club.business.sohu.com/"
Login_Page_Complete = "http://club.business.sohu.com/businessmain.php"
Pouring_Article_ID = "XXXXXX"
Jump_Page = "http://club.XXXXXXX.sohu.com/read-XXXX-" & Pouring_Article_ID & "-0-0.html"
Pouring_Title = "回复机器人工作中..."
Pouring_Text = "大家好，我是XXXX的回复机器人，请多关照！" & vbCrLf
Pouring_Times = 1 '输入数字太大的话，嘿嘿，后果自负哦
Reply_Page = "http://club.XXXXXXX.sohu.com/reply_art_submit.php"
End Sub


Sub Main()
Call Read_Info
Load Form_WebBrowser1
End Sub


Private Sub brwWebBrowser_DownloadComplete()

cboAddress.Text = brwWebBrowser.LocationURL '浏览器的地址栏显示为当前页面

Select Case cboAddress.Text
Case Login_Page_Start ' 当进入登录页面时执行以下程序

' 建议从财经站点登录，因为通行证的那个登录页面比较复杂

'将浏览器内的全部文本赋值为vDoc
Dim vDoc
Set vDoc = brwWebBrowser.Document

Dim i As Integer
Dim Form_ID As Integer
Form_ID = 0 '登录输入框在第1个表单内

For i = 0 To vDoc.Forms(Form_ID).length - 1 '搜索第1表单内所有内容

'找到名称为cn和pw的输入框，自动填入
'输入框的名称可以从Html的源代码上看到，
'由程序自行分析页，得到需要输入焦点的Object名称过于复杂，
'因此，以下为简便起见，均为提前手动查找Object标志

With vDoc.Forms(Form_ID)(i)
If .Name = "cn" Then .Value = UserName ' 填入用户名
If .Name = "pw" Then .Value = Password ' 填入密码
End With
Next i

' 查找提交表单的按钮，在财经论坛登录页面是一个图片链接
' 图片的属性和前面一样也是通过html源代码看出来的

For i = 0 To vDoc.All.length - 1 '搜索全部文档
With vDoc.All(i)
If UCase$(.tagName) = "INPUT" Then ' 查找Object属性为Input的可输入项
'如是，则判断其是否是制定图片链接，并可点击
If UCase$(.Type) = "IMAGE" And .src = "http://image.club.sohu.com/businessimages/but01.gif" Then
.Select '模拟选择图片
.Click '模拟鼠标单击
End If
End If
End With
Next i

Case Login_Page_Complete '如登录页完成后

'跳转到需回复帖子的页面
brwWebBrowser.Navigate Jump_Page

Case Jump_Page '如是需回复的帖子所在的页面，则开始自动回复处理

'以下的注释掉的代码，不看也罢

Dim p As String
p = Pouring_Text

'Static Count As Integer
'Static Last_Time

' Count = Count + 1
' If Count > Pouring_Times Then Exit Sub

' If Count = 1 Then
' Last_Time = Time
' p = Pouring_Text & "Content A here..."
' Else
' p = Pouring_Text & "Content B here..."
' Last_Time = Time
' End If

Set vDoc = brwWebBrowser.Document

For i = 0 To vDoc.All.length - 1 '搜索全部文档
With vDoc.All(i)
Select Case UCase(.tagName) '根据Object属性跳转

Case "TEXTAREA" '回复帖子用的TEXTAREA
.Value = p '输入回复内容

Case "INPUT" '查找Input项
If UCase(.Name) = "TITLE" Then .Value = Pouring_Title '回帖标题
'查找回帖用图片按钮
If UCase$(.Type) = "IMAGE" And .src = "http://image.club.sohu.com/indexpic/b19.gif" Then
.Select '模拟选择图片
.Click '模拟鼠标单击
End If

End Select
End With
Next i

Case Reply_Page '服务器提示回复完成
brwWebBrowser.Navigate Jump_Page '继续跳回原贴，循环

' Case "http://stop/" '停止执行标记
' Count = Pouring_Times + 1

Case Else 'Nothing to do

End Select

Me.Caption = brwWebBrowser.LocationName
End Sub