写在前面:放假这段帮几个朋友写了点代码,发现一个共同的问题,就是当拿过来页面的时候看源码找对应的NAME属性来供Document.All(INDEX)语句调用时这个INDEX(或者是Document.All("NAME")的NAME)总是找不明白...其实有些时候我也找不明白,后来想想,还是写个工具,简化一下操作,不过才下火车,坐了2天多的车,累...只写了一部分,不过注释比较全,相信大家自己改改,就能写出来个不错的工具.....至少自己用方便很多。
不多说了,以下是代码,这次不同的是大家需要复制并另存为,,,
以下是IE辅助.VBP(工程文件,别略过,里面有引用)
Type=ExeReference=*/G{00020430-0000-0000-C000-000000000046}#2.0#0#C:/WINDOWS/system32/stdole2.tlb#OLE AutomationReference=*/G{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0#C:/WINDOWS/system32/ieframe.dll#Microsoft Internet ControlsForm=frmMain.frmModule=Module1; Module1.basIconForm="frmMain"Startup="frmMain"HelpFile=""Title="IE编程辅助工具"Command32=""Name="IE编程辅助工具"HelpContextID="0"CompatibleMode="0"MajorVer=1MinorVer=0RevisionVer=0AutoIncrementVer=0ServerSupportFiles=0VersionCompanyName="yy"CompilationType=-1OptimizationType=0FavorPentiumPro(tm)=0CodeViewDebugInfo=0NoAliasing=0BoundsCheck=0OverflowCheck=0FlPointCheck=0FDIVCheck=0UnroundedFP=0StartMode=0Unattended=0Retained=0ThreadPerObject=0MaxNumberOfThreads=1
[MS Transaction Server]AutoRefresh=1
'/
以下是frmMain.frm
VERSION 5.00Begin VB.Form frmMain BorderStyle = 1 'Fixed Single Caption = "IE编程辅助工具" ClientHeight = 7515 ClientLeft = 45 ClientTop = 330 ClientWidth = 9750 LinkTopic = "Form1" MaxButton = 0 'False ScaleHeight = 501 ScaleMode = 3 'Pixel ScaleWidth = 650 StartUpPosition = 2 '屏幕中心 Begin VB.CommandButton Command1 Caption = "验证" Height = 375 Left = 8520 TabIndex = 5 Top = 720 Width = 1095 End Begin VB.TextBox Text1 Height = 375 Left = 4920 TabIndex = 3 Text = "Text1" Top = 720 Width = 3495 End Begin VB.ListBox lstObj Height = 6180 Left = 120 TabIndex = 1 Top = 1200 Width = 9495 End Begin VB.PictureBox Picture1 AutoSize = -1 'True Height = 540 Left = 120 ScaleHeight = 480 ScaleWidth = 540 TabIndex = 0 ToolTipText = "http://vbboshi.126.com" Top = 120 Width = 600 End Begin VB.Label Label2 Caption = "将验证的VB代码为：" Height = 255 Left = 120 TabIndex = 4 Top = 840 Width = 4695 End Begin VB.Label Label1 Caption = "将获取页面的标题为：" Height = 255 Left = 960 TabIndex = 2 Top = 240 Width = 8535 EndEndAttribute VB_Name = "frmMain"Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = TrueAttribute VB_Exposed = FalseOption Explicit
'本工具由ZCSOR(张聪)编写于07年2月22日,测试环境:WINXP SP2,IE7.0,VB6.0 SP6'主要内容均已注释,使用方法如下:'1 打开IE页面(请等待窗口完全被打开),将所需要填写的内容填写完毕'2 将VB图标拖到要获取的IE窗口标题栏,放开鼠标,等待列表刷新完毕'3 点任意一行VB代码(型如mDocument.all(64).value = ")并在文本框内填写对应内容(本代码只提供值改写,调用事件等请自行扩充)'4 点"验证',以验证生成的代码是否正确,(注意,这里生成的代码中Document对象名称为mDocument,如果与你代码中不同,请自行修改)'5 在你的代码编辑器中按CTRL+V粘贴生成的代码.'以代码默认打开的页为例说明可能更容易明白:'1 等待页面打开,将VB图标拖到标题栏,此时窗体上显示:世纪天成会员专区 - Internet Explorer(我的是IE7,可能6的标题栏不同,但不影响代码使用,因为使用的是反向查找)'2 观察列表,发现第二组内容中,OBJNAME=USERID,很明显,这就是我们要填写的用户名了,点该行下面的代码(mDocument.all(64).value = ),在TEXT1内填写1234567,点验证'结果出来了,页面上的用户名被程序改写为1234567,说明生成的代码是正确的,此时代码已经复制到剪贴板,可以粘贴了,搞定...是不是比自己一行一行看HTML去找方便不少呢,'而且用INDEX来调用时,不会出现一些什么保留字什么的错误,省不少力气吧,,嘎嘎..'另外呢,嘿嘿,大家可以试试第3组和第4组,明显是密码,你把密码填写好,然后再拖VB图标过去看看.....555555555555,不要学坏啊Dim IsDragging As BooleanDim mTmpCode As Long '这个就是我们要的对象标志(INDEX)
Private Sub Command1_Click()If InStr(1, Label2.Caption, "mDocument.all(") ThenmDocument.All(mTmpCode).Value = Text1.Text '运行生成的代码的代码Clipboard.ClearClipboard.SetText "mDocument.all(" & mTmpCode & ").value = " & Text1.Text '将代码复制到剪贴板SetWindowPos IeHwnd, -2, 0, 0, 0, 0, 1 '将修改后的页面提前以便观看结果End IfEnd Sub
Private Sub Form_Load() IsDragging = False Picture1.Picture = Me.Icon Shell "explorer http://member.tiancity.com/Registration/AccountReg.aspx", vbMaximizedFocus DoEvents SetWindowPos Me.hwnd, -2, 0, 0, 0, 0, 1End Sub
'这个获取鼠标点所在窗体位置,标题,类名的方法没什么好说了,网上很多,我们只关心类名为IEFrame的窗口Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)If IsDragging = True Then Dim rtn As Long, curwnd As Long Dim tempstr As String Dim strlong As Long Dim point As POINTAPI point.x = x point.y = y If ClientToScreen(Me.hwnd, point) = 0 Then Exit Sub curwnd = WindowFromPoint(point.x, point.y) tempstr = Space(255) strlong = Len(tempstr) rtn = GetClassName(curwnd, tempstr, strlong) If rtn = 0 Then Exit Sub tempstr = Trim(tempstr) If InStr(1, tempstr, "IEFrame") Then tempstr = Space(255) strlong = Len(tempstr) rtn = SendMessage(curwnd, WM_GETTEXT, strlong, tempstr) tempstr = Trim(tempstr) Label1.Caption = "将获取页面的标题为：" & tempstr Else Label1.Caption = "将获取页面的标题为：" End IfEnd IfEnd Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)If IsDragging = True Then Screen.MousePointer = vbDefault IsDragging = False ReleaseCapture mGetObj lstObj, Label1.CaptionEnd IfEnd Sub'这个过程提取出我们要的对象标志Private Sub lstObj_Click()Dim tmpstr As Stringtmpstr = lstObj.List(lstObj.ListIndex)If InStr(1, tmpstr, "mDocument.all(") Then Label2.Caption = "将验证的VB代码为：" & lstObj.List(lstObj.ListIndex) tmpstr = Replace(tmpstr, "mDocument.all(", "") mTmpCode = Replace(tmpstr, ").value = ", "")End IfEnd Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)If IsDragging = False Then IsDragging = True Screen.MouseIcon = Me.Icon Screen.MousePointer = vbCustom SetCapture (Me.hwnd)End IfEnd Sub
''''''///
以下是Module1.bas
Attribute VB_Name = "Module1"Option ExplicitPublic mDocument As Object '这个是鼠标所拖到的IE窗口的Document对象Public IeHwnd As Long '这个是鼠标所拖到的IE窗口的句柄Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As LongDeclare Function SetCapture Lib "user32" (ByVal hwnd As Long) As LongDeclare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As LongDeclare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As LongDeclare Function GetLastError Lib "kernel32" () As LongDeclare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As LongDeclare Function ReleaseCapture Lib "user32" () As LongDeclare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Public Const WM_GETTEXT = &HDType POINTAPI x As Long y As LongEnd Type
'参数为网页标题Public Sub mComGetIEWindows(ByVal IETitle As String)'浏览器对象集合(包含IE也包含资源管理器)Dim mShellWindow As New SHDocVw.ShellWindows'循环变量Dim mIndex As Long'从第一个浏览器对象循环到最后一个For mIndex = 0 To mShellWindow.Count - 1 If VBA.TypeName(mShellWindow.Item(mIndex).Document) = "HTMLDocument" Then '如果是IE窗口而不是资源管理器 If InStr(1, IETitle, mShellWindow.Item(mIndex).Document.Title) Then '这个地方呢,用Document对象的TITLE属性到API取得的窗体标题上去验证,从而得到我们要的Document对象 Set mDocument = mShellWindow.Item(mIndex).Document '锁定我们要的浏览器对象 IeHwnd = mShellWindow.Item(mIndex).hwnd '保存对象窗体句柄,验证按钮那里用到这个HWND来使IE窗口前置 Exit Sub End If End IfNext mIndexEnd Sub'这个函数,需要说的比较多,首先就是那一组IF,ELSEIF,那里的TYPE=XXXX是判断的关键,大家需要根据需求自己去改,方法就是'看对应页的HTML代码里面TYPE=XXXX搬过来即可,实际上呢,这里想把POST也提取出来了,后来想想,留给大家自己写吧,不难,参照'我BLOG里面上一篇就可以了,那里已经列出了所有的FORMS,挨个调用FORMS(INDEX).SUBMIT试就能试出来,再者这个提交观察HTML'也一眼就能看出来,呵呵.....实在整不出来的把URL留给我我帮你看看.
Public Sub mGetObj(ByVal mListBox As ListBox, ByVal mTitle As String)On Error GoTo mErr:Dim mTmpStr As String, mVBCode As StringmListBox.ClearmComGetIEWindows mTitleDim mIndexEx As Long For mIndexEx = 0 To mDocument.All.length - 1 mTmpStr = "ObjIndex: " & mIndexEx & " ObjName: " & mDocument.All(mIndexEx).Name & " ObjValue: " & mDocument.All(mIndexEx).Value mVBCode = "mDocument.all(" & mIndexEx & ").value = " If mDocument.All(mIndexEx).Type = "text" Then '如果是文本框 If mTmpStr <> "" Then mListBox.AddItem "TextBox---------> " & mTmpStr mListBox.AddItem mVBCode mListBox.AddItem "======================================================================================================" End If ElseIf mDocument.All(mIndexEx).Type = "checkbox" Then '如果是选项框(实际上,这里需要调用的是mDocument.All(mIndexEx).CLICK事件,呵呵,代码开头已经说明了,大家自己写吧,我已经尽心了) If mTmpStr <> "" Then mListBox.AddItem "CheckBox--------> " & mTmpStr mListBox.AddItem mVBCode mListBox.AddItem "======================================================================================================" End If ElseIf mDocument.All(mIndexEx).Type = "select-one" Then '这个家伙是下拉列表,实际上呢,你用mDocument.All(mIndexEx).Type = "text"就能取到当前值,也能设置,提取出来也是个摆设 If mTmpStr <> "" Then mListBox.AddItem "ComboBox--------> " & mTmpStr mListBox.AddItem mVBCode mListBox.AddItem "======================================================================================================" End If ElseIf mDocument.All(mIndexEx).Type = "password" Then '密码框麻,太明显了,呵呵,这个提取出来的值可是真材实料的,不是星星,你可以填写完然后把VB图标拖过去看看,列表里是不是显示出真实值,不要拿去干坏事哦 If mTmpStr <> "" Then mListBox.AddItem "password--------> " & mTmpStr mListBox.AddItem mVBCode mListBox.AddItem "======================================================================================================" End If End If NextmErr:If Err.Number = 438 Then '这个地方啊,哈哈,实际上是偷懒了,因为没有详细的把Document里面的对象分类,所以很多没有VALUE,NAME等属性的对象是会出错的....... mTmpStr = ""End IfResume NextEnd Sub
成了,保存成三个文件以后,测试一下吧,默认是打开跑跑的注册页...呵呵.....
