分类： 系统运维
2010-10-04 02:28:17
不知道有没有看过我写过的（VB制作简单模拟器教程入门版）3篇文章引起了很多网友的反响，感谢各位对我长时间以来的支持和厚爱，这次的目的是将以前的基础知识运用到实践中，我们一起来完成一个注册器，新浪信箱注册器。
这个程序调试制作环境：winXp,VB6.0简体中文企业版
开始咯~
很简单，打开你的vb，新建一个标准exe工程，添加2个Microsoft Internet Controls控件，添加一个标签控件，一个按钮和一个定时器，然后我们改一下名，工程名称：SinaMail，窗体名称：frmSina，WebBrowser:webSina，WebPop，标签：labStatus，按钮：cmdGo，定时器：timWeb,然后不要忘了存盘:)
先来一起看看原理：我写程序最喜欢先研究原理了，只要原理明白了，一切都不是问题，其他的不介绍了，只介绍一下我们用到的webbrowser相关的部分
WebBrowser.Navigate "" 浏览一个网页
WebBrowser.Busy 判断是否网页全部加载完毕
WebBrowser_NewWindow2(ppDisp As Object, Cancel As Boolean) 有新新窗口请求弹出，我们要把ppDisp传一个webbrowser.object对像过去，否则就打开默认的浏览器显示弹出的窗口，或者Cancel=True就不弹出了。
WebBroswser_StatusTextChange(ByVal Text As String) 浏览状态改变，当前状态保存在Text中
正式写代码了：
Private Sub Form_Load()
webSina.Navigate ""
End Sub
这一部分为vb窗体加载时执行的部分，我们让webSina去浏览我的主页，那里可是有一个弹出窗口啊，注意咯~
Private Sub webSina_StatusTextChange(ByVal Text As String)
labStatus.Caption = Text
End Sub
如果webbrowser当前状态改变，那么更新显示
Private Sub webSina_NewWindow2(ppDisp As Object, Cancel As Boolean)
Set ppDisp = webPop(0).Object
End Sub
我们用webPop(0)来拦截这个弹出的窗口并显示，可是在webPop中要是再有弹出窗口怎么办呢？
Private Sub webPop_NewWindow2(index As Integer, ppDisp As Object, Cancel As Boolean)
If index <= PopNum Then
PopNum = PopNum + 1
Load webPop(PopNum)
End If
Set ppDisp = webPop(index + 1).Object
End Sub
我们把webPop设为一个数组，只要在设计时把它的index属性设为0就可以了，然后声明一个模块级变量PopNum，不要告诉我看不懂上面的代码什么意思啊。
Private Sub cmdGo_Click()
webSina.Navigate ""
With timWeb
.Interval = 2000
.Enabled = True
End With
End Sub
点击按钮就开始注册了至于那个网址怎么来的，到新浪主页（这个不会不知道把）右上角有个，注册新会员把这个复制下来就可以了（点右键选复制快捷方式）
Private Sub timWeb_Timer()
If webSina.Busy = True Then Exit Sub
Dim mTag As Object
With webSina
End With
End Sub
这个可是我们这次任务的重点咯~基本所有的任务都在这里完成的，一定要注意。
If webSina.Busy = True Then Exit Sub 如国网页没有完全打开，那么跳出当前过程
Dim mTag As Object定义一个变量，下次有很大的用处，今天先到这里了。
2.
第二讲 如何用VB的webbrowser提交一个含有用户名和密码的网页
第二讲 如何用VB的webbrowser提交一个含有用户名和密码的网页
上次我们知道了怎样打开一个网页，今天我们就来看看怎样迈开赚钱的第一步。
下面我们就开始迈步了：
一、先打开VB新建一个工程
二、在工具条上点右键选部件（我用的是中文版VB）或者选工程菜单，点部件
三、找到Microsoft Internet Controls，在前面打挑，然后确认就可以看到在工具条上多出来一个地球样的图标，我们以后的实现就都围绕着他来进行了。
四、添加一个WebBrowser1到Form1中，再添加一个command1到Form1中
五、在Form1中添加如下代码：（以上都是我们上一讲里说过的，应该很熟悉了吧）
'－－－－－－－－－－开始－－－－－－－－－－－
Private Sub Command1_Click()
Dim vDoc, vTag
Dim i As Integer
Set vDoc = WebBrowser1.Document
For i = 0 To vDoc.All.length - 1 '检测所有标签
If UCase(vDoc.All(i).tagName) = INPUT Then '找到input标签
Set vTag = vDoc.All(i)
If vTag.Type = text Or vTag.Type = password Then '看看是不是我们需要的
Select Case vTag.Name '按标签的名字,对号操做
Case EMAILADD
vTag.Value = '这里写入你的e-mail
Case PASSWD
vTag.Value = password '这里写入你的密码
End Select
ElseIf vTag.Type = submit And vTag.Name = SUB And vTag.Value
= 订阅 Then
'找到提交按钮
vTag.Select '也可以没有这个
vTag.Click '点击提交了，一切都OK了
End If
End If
Next i
End Sub
Private Sub Form_Load()
WebBrowser1.Navigate
End Sub
'－－－－－－－－－－结束－－－－－－－－－－－
六、当然就是测试了，点运行按钮，我们可以看到，我们的webbrowser打开了，等网页基本下载结束再点command1按钮，我们可爱的webbrowser就把我们刚刚输入的e-mail和密码都提交到网页上了，看到订阅成功了吗？那个就是胜利的标志。
好了，先写这么多，下次我们看一下怎么用webbrowser找到一个网页中的超连接，对应的就是赚钱连接啊。
附录（相关资料）：
大家也可以看出来，这次我们是拿上的那个订阅邮件列表开刀，下面就是这段网页的源代码：
里面带input的那些标签都是接受输入的，我们这讲的主要任务就是找到他们，并且对他们进行操做。
vb模拟器webbrowser实战讲解之三
这次我们要填表咯：
原理没有什么好说的了，基本都是上次的那些，如果不是很熟悉的话可以在程序里设置断点来观察个部分标签的结构和属性，下面就是代码了：
ElseIf InStr(1, .LocationURL, "") <> 0 Then
For I = 0 To .Document.All.length - 1
Set mTag = .Document.All.Item(I)
Select Case mTag.tagname
Case "INPUT" '这里注意大写
Select Case mTag.Name
Case "login" '用户名
UserName = GetRndChar(Rnd * 2 + 1, 1) & GetRndChar(Rnd * 2 + 5, 2)
mTag.Value = UserName
Case "passwd" '密码
UserPassword = GetRndChar(Rnd * 2 + 6, 2)
mTag.Value = UserPassword
Case "pass2" '从新输入密码
mTag.Value = UserPassword
Case "question" '查询密码问题
mTag.Value = GetRndChar(Rnd * 3 + 3, 1)
Case "answer" '查询密码答案
mTag.Value = GetRndChar(Rnd * 4 + 6, 1)
Case "firstname" '真实姓名
mTag.Value = GetRndChar(Rnd * 4 + 6, 1)
Case "gender" '性别
'这里是radio
If mTag.Value = "Female" Then
mTag.Checked = True '不管什么，先选一个
Else
If (Rnd * 2) / 1 = 0 Then
mTag.Click '做个随机，男女平分
End If
End If
Case "BirthYear" '出生年
mTag.Value = 1910 + (GetRndChar(2, 0) Mod 80)
Case "BirthMonth" '出生月
mTag.Value = (GetRndChar(2, 0) Mod 12) + 1
Case "BirthDay" '出生日
mTag.Value = (GetRndChar(2, 0) Mod 28) + 1
Case "hobbies" '兴趣爱好
If Int(Rnd * 3) = 1 Then
mTag.Checked = True
End If
'这里是checkbox
Case "city" '添城市
mTag.Value = GetRndChar(Rnd * 2 + 4, 1)
Case "address" '添地址
mTag.Value = GetRndChar(Rnd * 2 + 4, 1)
Case "zip" '邮编
mTag.Value = "1" & GetRndChar(5, 0)
Case "phone" '电话
mTag.Value = GetRndChar(Rnd * 2 + 7, 0)
Case "idnumber" '证件号码
mTag.Value = GetRndChar(15, 0)
Case "Write" '提交
mTag.Click
Exit For
End Select
Case "A"
If mTag.href = "" Then
If mTag.innertext = "是的，我需要一个新的新浪免费邮箱。" Then mTag.Click
ElseIf mTag.href = "" Then
mTag.Click
End If
Case "SELECT"
Dim tSelect As Long
tSelect = Int(Rnd * (mTag.All.length - 1)) + 1
mTag.All.Item(tSelect).Selected = True
End Select
Next IElseIf .LocationURL = "" Then
If InStr(1, .Document.activeelement.outertext, "新浪网祝贺您注册成功！欢迎您成为新浪会员！") <> 0 Then
SaveUser
.Navigate ""
Else
.GoBack
End IfEnd If
这次我们用到了一个函数GetRndChar，这个是我写的了，代码在下面：
Private Function GetRndChar(charLen As Integer, flag As Integer)
Dim mchar As String
Dim I As Integer
Dim tStr As String
Select Case flag
Case 0
'数字
mchar = "0123456789"
For I = 1 To charLen
tStr = tStr & Mid(mchar, Int(Rnd * 10) + 1, 1)
Next I
Case 1
'字母
mchar = "abcdefghijklmnopqrstuvwxyz"
For I = 1 To charLen
tStr = tStr & Mid(mchar, Int(Rnd * 26) + 1, 1)
Next I
Case 2
'混合
mchar = "abcdefghijklmnopqrstuvwxyz0123456789"
For I = 1 To charLen
tStr = tStr & Mid(mchar, Int(Rnd * 36) + 1, 1)
Next I
End Select
GetRndChar = tStr
Debug.Print tStrEnd Function
----------广告时间,请不要走开----------
如果你不知道什么是emailclear的话请注意了，这个软件是我写的一个工具，在我主页可以下载到
功能：清理信箱里的所有信件，完全删除。
具体情况请下载试用
---广告结束---
在最后我们注册成功了我们调用SaveUser过程来保存用户信息:
Private Sub SaveUser() Dim F As Integer Dim FileName As String F = FreeFile() FileName = App.Path & "\user.txt" Open FileName For Append As #F Print #F, UserName & ":" & UserPassword & "@pop3.sina.com.cn:110" '这里我们按emailclear的格式导出用户信息 Close #FEnd Sub
好咯~sinaMail至此全部结束，但是webbrowser得更深入的探讨我还会继续下去，请大家支持，由于本人水平有限，文章中不正确的地方还请各位高手指点
