VB做论坛自动发贴软件

两种方式：

1.用AxWebBrowser控件做论坛自动发贴软件

2.用HttpWebRequest类做论坛快速发帖器

[@more@]

1。用AxWebBrowser控件做论坛自动发贴软件

　
　　 AxWebBrowser控件即VB6中的WebBrowser控件。
　　 用AxWebBrowser做论坛批量发贴软件，使用时先添加对AxWebBrowser控件和MSHTML的引用。
　　 先Navigate到指定网址。然后用以下代码等待网页加载完毕：

Do While brow.Busy
　　Application.DoEvents()
Loop

　　然后调用发帖过程。


Public Sub fill()
　　On Error Resume Next
　　Do While brow.Busy
　　　　Application.DoEvents()
　　Loop

　　Dim webDoc As Object = brow.Document.all
　　Dim webTag As Object
　　Dim lengthTag As Integer = webDoc.length - 1

　　For countTag As Integer= 0 To lengthTag
　　　　webTag = webDoc.item(countTag)
　　　　Select Case Strings.LCase(webDoc.item(countTag).tagname)
　　　　　　Case "textarea"　　　　　'网页中的文本框
　　　　　　　　Select Case webTag.name
　　　　　　　　　　Case "body"　　　'"body"来自网页源代码，不同网站很可能不同，你根据实际修改。下同。
　　　　　　　　　　　　webTag.value = strBody 　　'这是预先定义的值,下同。
　　　　　　　 　End Select

　　　　　　Case "select"　　　　　　　'网页中的下拉选择框
　　　　　　　　Select Case webTag.name
　　　　　　　　　　Case "month"　　　'选择月份，这里略去年、日的选择，因为原理相同。
　　　　　　　　　　　　webTag.all.item(1).selected = True　　'选择第一个值
　　　　　　　　 End Select

　　　　　　 Case "input"　　'网页中的输入框
　　　　　　　　Select Case Strings.LCase(webTag.type)
　　　　　　　　　　Case "text"　　　　　'文本
　　　　　　　　　　　　Select Case webTag.name
　　　　　　　　　　　　　　Case "name", "userid", "nickname" '用户名
　　　　　　　　　　　　　　　　webTag.value = strName
　　　　　　　　　　　　　 Case "subject" '标题
　　　　　　　　　　　　　　　　webTag.value = strSubject
　　　　　　　　　　　　　　Case "regid" '注册码
　　　　　　　　　　　　　　　　webTag.value = strRegid
　　　　　　　　　　　　　　Case "username", "realname"
　　　　　　　　　　　　　　　　webTag.value = strUsername
　　　　　　　　　　　　　　Case "cardnumber"
　　　　　　　　　　　　　　　　webTag.value = strCardNumber
　　　　　　　　　　　　　　Case "homephone"
　　　　　　　　　　　　　　　　webTag.value = strHomephone '电话号
　　　　　　　　　　　　　　Case "url_title" '链接名称
　　　　　　　　　　　　　　　　webTag.value = urlTitle
　　　　　　　　　　　　　　Case "url"　　'链接
　　　　　　　　　　　　　　　　webTag.value = url
　　　　　　　　　　　　　　Case "email"　'email地址
　　　　　　　　　　　　　　　　webTag.value = email
　　　　　　　　　　　　　　Case "img" 　'图片　　
　　　　　　　　　　　　　　　　webTag.value = img
　　　　　　　　　　　　　　Case "midi"　　'音乐
　　　　　　　　　　　　　　　　webTag.value = midi
　　　　　　　　　　　　　　Case "year"　　'年
　　　　　　　　　　　　　　　　webTag.value = strYear
　　　　　　　　　　　　　　Case "prompt" '找回密码提示问题
　　　　　　　　　　　　　　　　webTag.value = strPrompt
　　　　　　　　　　　　　　Case "answer" '找回密码答案
　　　　　　　　　　　　　　　　webTag.value = strAnswer
　　　　　　　　　　　　End Select
　　　　　　　　　　Case "password"　　'密码
　　　　　　　　　　　　Select Case webTag.name
　　　　　　　　　　　　　　Case "passwd", "password", "confirm", "repasswd" '密码，确认密码
　　　　　　　　　　　　　　　　webTag.value = strPass
　　　　　　　　　　　　End Select
　　　　　　　　　 Case "checkbox"　　'单选框
　　　　　　　　　　　　Select Case webTag.name
　　　　　　　　　　　　　　Case "emailme"　　'email通知tuenhai
　　　　　　　　　　　　　　　　webTag.checked = True　　
　　　　　　　　　　　　End Select

　　　　　　　　End Select

　　　　 End Select
　　 Next

　　brow.Document.forms(0).submit()　　'许多网页表单，这一句简单代码即实现自动提交

End Sub


于是，主过程是这样：

Public Sub autoAdd()
　　brow.Silent = True '不弹出窗口
　　brow.Navigate("http://www.Tuenhai.com";) '　tuenhai的小站为例
　　Do While formBrowNetsh.brow.Busy　　'等待网页加载完毕
　　　　Application.DoEvents()
　　Loop
　　Call fill()
End Sub

　　以上代码可实现可视化自动注册和论坛自动发帖工具。
　　 还有几个问题有待解决：
　　 一. 有的网站要填上识别码数字才能注册或发言，如何用程序来实现自动识别识别码图片上的数字？
　　 二. 有的网站一进去就会跳出一个欢迎对话框，程序的运行就被暂停。
　　 三. 对于自动注册和发言来说，加载较慢的图片、Flash、音乐等并不是必需的。

　　

2。用HttpWebRequest类做论坛快速发帖器

　　用HttpWebRequest类做论坛发贴机就简单多了。
　　我们始终不能忘记，最好的教程是MSDN，在Microsoft Visual Studio .NET 2003“搜索”中敲入HttpWebRequest，抄来一些东东（事实上许多教程书籍都是从MSDN上抄的)：
　　 命名空间: System.Net
　　 HttpWebRequest 类对 WebRequest 中定义的属性和方法提供支持，也对使用户能够直接与使用 HTTP 的服务器交互的附加属性和方法提供支持。
　　 不要使用 HttpWebRequest 构造函数。使用 WebRequest.Create 方法初始化 HttpWebRequest 的一个新实例。如果 URI 的方案是 http:// 或 https:// ，则 Create 将返回 HttpWebRequest 实例。
　　 GetResponse 方法向 RequestUri 属性中指定的 Internet 资源发出同步请求并返回包含该响应的 HttpWebResponse 实例。可以使用 BeginGetResponse 和 EndGetResponse 方法对 Internet 资源发出异步请求。
　　 当要向 Internet 资源发送数据时， GetRequestStream 方法返回用于发送数据的 Stream 实例。　　BeginGetRequestStream 和 EndGetRequestStream 方法提供对发送数据流的异步访问。　　
　　 如果在访问 Internet 资源时发生错误，则 HttpWebRequest 类将引发 WebException 。 WebException.Status 属性是 WebExceptionStatus 值之一，它指示错误源。当 WebException.Status 为 WebExceptionStatus.ProtocolError 时， Response 属性包含从 Internet 资源接收的 HttpWebResponse 。
　　

Shared Sub postData()
　　Dim httpUrl As New System.Uri("http://www.Tuenhai.com?"; & "name=yourName&pass=yourPass&cardnumber=yourCardNumber")
　　Dim req As HttpWebRequest
　　'req.Timeout = 10000 '设置超时值10秒
　　req = CType(WebRequest.Create(httpUrl2), HttpWebRequest)
　　req.Method = "POST"
　　req.ContentType = "application/x-www-form-urlencoded"
　　Dim bytesData() As Byte = 　　System.Text.Encoding.ASCII.GetBytes(""name=yourName&pass=yourPass&cardnumber=yourCardNumber")
　　req.ContentLength = bytesData.Length
　　Dim postStream As Stream = req.GetRequestStream()
　　postStream.Write(bytesData, 0, bytesData.Length) 　　'以上向服务器post信息。
　　Dim res As HttpWebResponse = CType(req.GetResponse(), HttpWebResponse)　'以下获取服务器返回信息
　　Dim reader As StreamReader = _
　　New StreamReader(res.GetResponseStream, System.Text.Encoding.GetEncoding("GB2312"))
　　Dim respHTML As String = reader.ReadToEnd()
　　　　MsgBox(respHTML) 　'这就是向网络服务器post后返回的信息
　　　　MsgBox(res.StatusCode.ToString)　　'向网络服务器post后返回的状态码
　　res.Close()　'关闭

End Sub


　　用AxWebBrowser控件做论坛发贴机留有三个问题，用HttpWebRequest类来实现，后二个问题都不复存在。而且，用HttpWebRequest类来实现论坛发帖器的速度要快得多。但是，同样的？
　　有的网站要填上识别码数字才能注册或发言，如何用“论坛自动发贴机”来实现自动识别识别码图片上的数字？

　　我们在主过程里加上线程，因为我们以后要用多线程做自动发帖机啊。用多线程做论坛自动发贴器在VB6中不好实现，在VB.NET中做自动发帖工具却不难。
　

Dim threadAdd As System.Threading.Thread '定义线程　
Public Sub threadAutoAdd()
　　threadAdd= New System.Threading.Thread(AddressOf postData)　　'创建线程实例
　　threadNetsh.Start()　　'开始线程
　　'别忘了在Sub postData()的最后加上threadAutoAdd.Abort()来关闭线程
　　'或者在这里加上判断Sub postData()完毕的代码，如果完毕就关闭线程
End Sub

3。获取 IE 当前 URL 的代码,网上有许多类似代码，但在WINDOWSXP 下不能运行。查了一些资料，发现由于Win2000，WINXP 是基于Unicode代码的操作系统，所以没有WorkerA类，而以WorkerW类取而代之（XXXXA should be used on not unicode compliant windows oses likes Windows 95,98 etc and on unicode enabled oses replace A with W. Remember WorkerA or WorkerW doesn't have something related to IE version. To obtain all of the opened IEs URL use EnumWindows callback function and cheers. ）。


Option Explicit


Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long 'Findwindow函数的功能是找到当前运行的IE窗口的url地址的句柄


Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long 'FindwindowEx函数的功能是找到子窗体的句柄


Private Declare Function SendMessageByString Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long


Private Const WM_GETTEXT = &HD


Private Sub Command1_Click()

getcurrenturl

End Sub

Sub getcurrenturl(Optional ByRef URL As String)

Dim hwnd As Long '设定一个长整形变量用来接收函数返回值

hwnd = 0 '初始化

hwnd = FindWindowEx(hwnd, 0, "IEFrame", vbNullString) 'IE窗口句柄

hwnd = FindWindowEx(hwnd, 0, "Workerw", vbNullString) 'IE窗口的工作区句柄

hwnd = FindWindowEx(hwnd, 0, "ReBarWindow32", vbNullString) 'IE窗口的菜单栏句柄

hwnd = FindWindowEx(hwnd, 0, "ComboBoxEx32", vbNullString) 'IE窗口下拉菜单句柄

hwnd = FindWindowEx(hwnd, 0, "ComboBox", vbNullString) 'IE窗口下拉菜单当前项句柄

hwnd = FindWindowEx(hwnd, 0, "Edit", vbNullString) ''IE窗口下拉菜单编辑框句柄

URL = String(1024, Chr(0)) '初始化字符串

SendMessageByString hwnd, WM_GETTEXT, 1025, URL '向系统发送获得IE窗体地址栏中的字符串命令

URL = Split(URL, Chr(0))(0) '根据 URL 长度得到 URL 值

MsgBox URL '显示IE当前网址

End Sub

来自 “ ITPUB博客 ” ，链接：http://blog.itpub.net/82387/viewspace-902982/，如需转载，请注明出处，否则将追究法律责任。

转载于:http://blog.itpub.net/82387/viewspace-902982/