vb实现网页自动填表

最新推荐文章于 2021-03-12 05:55:59 发布

wq1282

最新推荐文章于 2021-03-12 05:55:59 发布

阅读量1.2k

点赞数

分类专栏： VB源码文章标签： webbrowser vb javascript insert command integer

VB源码专栏收录该内容

45 篇文章 0 订阅

订阅专栏

http://tieba.baidu.com/f?kz=580219489

http://www.anqn.com/vb/154/8974.shtml

http://www.codefans.net/soft/5089.shtml

http://www.mndsoft.com/blog/article.asp?id=1121

http://topic.csdn.net/t/20020113/14/474848.html

选中复选框

Private Sub Command1_Click() Dim objDoc As Object Dim i As Integer Set objDoc = WebBrowser1.Document.All.tags("button") For i = 0 To objDoc.length - 1 Select Case objDoc(i).Type Case "submit" objDoc(i).Click Exit For End Select Next End Sub

http://www.vbgood.com/viewthread.php?tid=79822

http://wenwen.soso.com/z/q136444728.htm

VB 选定LIST 自动填表

'例子在这..写在command里看效果吧..加一个WebBrowser1.之后写上这些效果。。 WebBrowser1.Navigate "http://newreg.qq.com/" Do Until WebBrowser1.ReadyState = READYSTATE_COMPLETE '等装载完 DoEvents Loop WebBrowser1.Document.All.tags("select")(3).selectedIndex = 2 '改属性 WebBrowser1.Document.All.tags("select")(3).onchange '确认

直接运行网页中的JavaScript：

function alllefttab()

WebBrowser1.Document.parentwindow.execScript "insert(2)", "JavaScript"

自动选择下拉列表中的某项2

Dim s s = "javascript:document.getElementsByName(""w_type"")[0].value='2';void(0)" WebBrowser1.Document.parentwindow.execscript s

添加一个WebBrowser1

Option Explicit Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long) Dim SendLog% Private Sub Command1_Click() MsgBox WebBrowser1.LocationName & "|" & WebBrowser1.LocationURL End Sub Private Sub Form_Load() If App.PrevInstance = True Then MsgBox "你已经运行过一个喽！" End End If Me.Hide WebBrowser1.Left = 240 WebBrowser1.top = 240 WebBrowser1.Navigate "http://zhidao.baidu.com/" 'WebBrowser1.Navigate "http://zhidao.baidu.com/index.php?act=worklog:loginfo&id=" End Sub Private Sub Form_Resize() WebBrowser1.Width = Me.Width - WebBrowser1.Left - 350 WebBrowser1.Height = Me.Height - WebBrowser1.top - 750 End Sub Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant) Me.Caption = WebBrowser1.LocationName '登录并转到 Dim vDoc, vTag Dim i As Integer Dim s If WebBrowser1.LocationURL = "http://zhidao.baidu.com/" Then Set vDoc = WebBrowser1.Document For i = 0 To vDoc.All.length - 1 If UCase(vDoc.All(i).tagName) = "INPUT" Then Set vTag = vDoc.All(i) If vTag.Type = "text" Or vTag.Type = "password" Then Select Case vTag.Name Case "userid" vTag.Value = "wangquan" Case "userps" vTag.Value = "1282" End Select ElseIf vTag.Type = "submit" Then vTag.Click End If End If Next i WebBrowser1.Navigate "http://zhidao.baidu.com/index.php?act=worklog:insert" End If '是否周末 If WebBrowser1.LocationURL = "http://zhidao.baidu.com/index.php?act=worklog:insert" Then Set vDoc = WebBrowser1.Document For i = 0 To vDoc.All.length - 1 If UCase(vDoc.All(i).tagName) = "INPUT" Then Set vTag = vDoc.All(i) If vTag.Type = "text" Or vTag.Type = "hidden" Then '填写标题 If vTag.Name = "w_title" Then Dim todays todays = IIf(DateDiff("s", "07:00:00", Time) < 0, Date - 1, Date) todays = Format(todays, "yyyy年mm月dd日") vTag.Value = todays End If '选择类别 s = "javascript:document.getElementsByName(""w_type"")[0].value='" & IIf(Weekday(Now, 2) > 5, 1, 0) & "';void(0)" WebBrowser1.Document.parentwindow.execScript s End If '提交日志 If SendLog = 0 Then WebBrowser1.Document.parentwindow.execScript "insert(2)", "JavaScript" SendLog = 1 End If End If Next i Exit Sub End If '提交跳转http://zhidao.baidu.com/index.php?act=worklog:insert:sc If WebBrowser1.LocationURL = "http://zhidao.baidu.com/index.php?act=worklog:insert:sc" Then WebBrowser1.Navigate "http://zhidao.baidu.com/?act=worklog:mylogList" 'MsgBox "今天的日志已经提交，但不保证成功哦！", 64, Me.Caption End If If WebBrowser1.LocationURL = "http://zhidao.baidu.com/?act=worklog:mylogList" Then Me.Show End If End Sub

http://tieba.baidu.com/f?kz=628000186

'烟花飘飘-{百}度注册机开源 Dim S As Boolean, inf, Info Private Sub Command1_Click() S = False WebBrowser1.Navigate "https://passport.baidu.com/?reg®type=1®from=1&tpl=ik&u=http%3A//zhidao.baidu.com/regok.html%3Flogin%26t%3D1246074692593" Do While S = False DoEvents Loop Randomize For Each a In WebBrowser1.Document.getelementsbytagname("input") Select Case a.Name Case "username" a.Value = CLng(Rnd * 123456789 + 9999999) inf = "用户名:" & a.Value & vbCrLf Case "loginpass", "verifypass" a.Value = "yanhuapiaopiao" Case "email" a.Value = "yhpp.ys168.com@qq.com" Case "verifycode" Set w = WebBrowser1.Document.getelementbyid("verifypic") Set w1 = WebBrowser1.Document.BODY.createcontrolrange w1.Add (w) w1.execCommand ("Copy") Picture1.Picture = Clipboard.GetData t = InputBox("输入图片框里的验证码") If Len(t) <> 4 Then Exit Sub a.Value = t Case "submit" a.Click Info = Info & inf Text1 = Info End Select Next End Sub Private Sub Form_Load() Info = "注册的账号：（密码都是: yanhuapiaopiao ）" & vbCrLf End Sub Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant) S = True End Sub