给初学者:VB如何操作WEB页的浏览提交———九:给感觉看HTML代码去找对应对象费劲的朋友的工具

最新推荐文章于 2024-07-15 20:21:44 发布

清晨曦月

最新推荐文章于 2024-07-15 20:21:44 发布

阅读量5.2w

点赞数

分类专栏：其他文章标签： vb html web integer function string

本文链接：https://blog.csdn.net/zcsor/article/details/1512685

版权

其他专栏收录该内容

61 篇文章 0 订阅

订阅专栏

写在前面:放假这段帮几个朋友写了点代码,发现一个共同的问题,就是当拿过来页面的时候看源码找对应的NAME属性来供Document.All(INDEX)语句调用时这个INDEX(或者是Document.All("NAME")的NAME)总是找不明白...其实有些时候我也找不明白,后来想想,还是写个工具,简化一下操作,不过才下火车,坐了2天多的车,累...只写了一部分,不过注释比较全,相信大家自己改改,就能写出来个不错的工具.....至少自己用方便很多。

不多说了,以下是代码,这次不同的是大家需要复制并另存为,,,

以下是IE辅助.VBP(工程文件,别略过,里面有引用)

Type=Exe
Reference=*/G{00020430-0000-0000-C000-000000000046}#2.0#0#C:/WINDOWS/system32/stdole2.tlb#OLE Automation
Reference=*/G{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0#C:/WINDOWS/system32/ieframe.dll#Microsoft Internet Controls
Form=frmMain.frm
Module=Module1; Module1.bas
IconForm="frmMain"
Startup="frmMain"
HelpFile=""
Title="IE编程辅助工具"
Command32=""
Name="IE编程辅助工具"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="yy"
CompilationType=-1
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1

[MS Transaction Server]
AutoRefresh=1

以下是frmMain.frm

VERSION 5.00
Begin 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
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option 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 Boolean
Dim mTmpCode As Long '这个就是我们要的对象标志(INDEX)

Private Sub Command1_Click()
If InStr(1, Label2.Caption, "mDocument.all(") Then
mDocument.All(mTmpCode).Value = Text1.Text '运行生成的代码的代码
Clipboard.Clear
Clipboard.SetText "mDocument.all(" & mTmpCode & ").value = " & Text1.Text '将代码复制到剪贴板
SetWindowPos IeHwnd, -2, 0, 0, 0, 0, 1 '将修改后的页面提前以便观看结果
End If
End 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, 1
End 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 If
End If
End 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.Caption
End If
End Sub
'这个过程提取出我们要的对象标志
Private Sub lstObj_Click()
Dim tmpstr As String
tmpstr = 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 If
End 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 If
End Sub

''''''///

以下是Module1.bas

Attribute VB_Name = "Module1"
Option Explicit
Public 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 Long
Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Declare Function GetLastError Lib "kernel32" () As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Declare Function ReleaseCapture Lib "user32" () As Long
Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

Public Const WM_GETTEXT = &HD
Type POINTAPI
x As Long
y As Long
End 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 If
Next mIndex
End 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 String
mListBox.Clear
mComGetIEWindows mTitle
Dim 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
        Next
mErr:
If Err.Number = 438 Then    '这个地方啊,哈哈,实际上是偷懒了,因为没有详细的把Document里面的对象分类,所以很多没有VALUE,NAME等属性的对象是会出错的.......
    mTmpStr = ""
End If
Resume Next
End Sub