VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)

VB爱好者乐园(VBGood)

 找回密码
 立即注册
搜索
查看: 809|回复: 11

[求助] VB如何读取网页中鼠标右击时产生菜单选项中的文字

[复制链接]
发表于 2017-4-27 12:31:14 | 显示全部楼层 |阅读模式
        在vb运行过程中,我在任意浏览器打开的网页中,右击鼠标,得到一个菜单,然后用上下键移动光标到某一个选项上面(一般会自动加深背景色)。

         这时VB的立即窗口中要显示出这个选项中的文字。

请问代码如何写呢?听说与屏幕取词有关,但我找到的取词软件不太合适,原因是:1、它会关闭浏览器,只读取word右击菜单 ;2、如果不关闭浏览器,就读取不了。具体见附件。

屏幕取词.rar

50.87 KB, 下载次数: 16

发表于 2017-6-9 09:41:12 | 显示全部楼层
本帖最后由 mutex 于 2017-6-9 11:44 编辑

经过几天测试,问题终于解决
原来以为用GetMenuString无法返回正确的菜单项文本是由于跨进程,后来发现程序可以正常获取记事本菜单项,IE右键菜单无法获取的真正原因是它是自绘的,实际显示的菜单文本存放在MenuItemInfo结构的dwItemData所指向的内存
另外改进了右键菜单窗口的获取方式,原来通过鼠标位置确定,但右键菜单显示时鼠标不一定位于其上,现在改为通过FindWindow("#32768", vbNullString)获取
以下代码使用时需在窗口上放置一个文本框(Text1)和一个记时器(Timer1,Interval可视情况设定,比如设置为200)

  1. '****************************************************
  2. '* 程序功能:返回IE窗口右键菜单中的高亮选项文本     *
  3. '* By Mutex, http://www.vbgood.com/forum.php        *
  4. '****************************************************

  5. Option Explicit
  6. 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
  7. Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  8. Private Const MN_GETHMENU = &H1E1

  9. Private Declare Function GetModuleFileNameEx Lib "psapi.dll" Alias "GetModuleFileNameExW" (ByVal hProcess As Long, ByVal hModule As Long, ByVal lpFilename As Any, ByVal nSize As Long) As Long

  10. Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
  11. Private Declare Function GetMenuState Lib "user32" (ByVal hMenu As Long, ByVal wID As Long, ByVal wFlags As Long) As Long
  12. 'Private Declare Function GetMenuString Lib "user32" Alias "GetMenuStringA" (ByVal hMenu As Long, ByVal wIDItem As Long, ByVal lpString As Long, ByVal nMaxCount As Long, ByVal wFlag As Long) As Long
  13. Private Declare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal b As Long, lpMenuItemInfo As MENUITEMINFO) As Long

  14. Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
  15. Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
  16. Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
  17. Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long

  18. Private Const PROCESS_VM_OPERATION = &H8
  19. Private Const PROCESS_VM_READ = &H10
  20. Private Const PROCESS_VM_WRITE = &H20


  21. Private Type MENUITEMINFO
  22.     cbSize As Long
  23.     fMask As Long
  24.     fType As Long
  25.     fState As Long
  26.     wID As Long
  27.     hSubMenu As Long
  28.     hbmpChecked As Long
  29.     hbmpUnchecked As Long
  30.     dwItemData As Long
  31.     dwTypeData As Long
  32.     cch As Long
  33. End Type

  34. Private Const MIIM_FTYPE = &H100
  35. Private Const MIIM_STRING = &H40
  36. Private Const MIIM_DATA = &H20


  37. Private Const MF_BYPOSITION = &H400&
  38. Private Const MF_BYCOMMAND = &H0&
  39. Private Const MF_HILITE = &H80
  40. Private Const MFT_OWNERDRAW = &H100
  41. Private Const MAX_PATH = 260

  42. Dim hwndMenu As Long

  43. Private Sub Timer1_Timer()
  44.     Dim hMenu As Long
  45.     Dim sExeName As String
  46.     Dim lRet As Long
  47.     Dim sMenuItemString As String
  48.    
  49.     hwndMenu = 0
  50.     sMenuItemString = ""
  51.     '获取所有弹出菜单的窗口句柄
  52.     Do
  53.         hwndMenu = FindWindowEx(0, hwndMenu, "#32768", vbNullString)
  54.         
  55.         '获取菜单窗口的进程名称
  56.         sExeName = GetWindowImagePath(hwndMenu)
  57.         
  58.         '若为IE进程,则把高亮菜单项的文本显示在Text1中
  59.         '(如果注释掉下面的if判断,可以获取所有程序右键菜单的高亮选项,office、VB等程序的右键菜单并非系统菜单,不能通过此方法获取)
  60.         If Right(sExeName, 12) = "iexplore.exe" Then
  61.             '获取菜单句柄
  62.             hMenu = SendMessage(hwndMenu, MN_GETHMENU, 0, 0)
  63.             If hMenu <> 0 Then
  64.                 '获取菜单当前高亮选项文本
  65.                 sMenuItemString = GetHiliteMenuItemstring(hMenu)
  66.                 If Len(sMenuItemString) > 0 Then
  67.                     Exit Do
  68.                 End If
  69.             End If
  70.         End If
  71.     Loop While hwndMenu <> 0
  72.     Text1.Text = sMenuItemString
  73. End Sub

  74. '根据菜单句柄获取当前高亮菜单项的文本
  75. Private Function GetHiliteMenuItemstring(hSubMenu As Long) As String
  76.     Dim lItemCount As Long
  77.     Dim i As Long
  78.     Dim lRet As Long
  79.    
  80.     '获取菜单项数量
  81.     lItemCount = GetMenuItemCount(hSubMenu)
  82.     '遍历菜单项
  83.     For i = 0 To lItemCount - 1
  84.         '获取当前高亮菜单项
  85.         If GetMenuState(hSubMenu, i, MF_BYPOSITION) And MF_HILITE Then
  86.             Dim buffer() As Byte
  87.             ReDim buffer(255)
  88.             Dim mii As MENUITEMINFO
  89.             
  90.             '获取菜单项的类型、文字、数据和ID
  91.             With mii
  92.                 .cbSize = Len(mii)
  93.                 .cch = 256
  94.                 .dwTypeData = VarPtr(buffer(0))
  95.                 .fMask = MIIM_FTYPE Or MIIM_STRING Or MIIM_DATA
  96.             End With
  97.             
  98.             lRet = GetMenuItemInfo(hSubMenu, i, MF_BYPOSITION, mii)

  99.             '如果是IE的自绘菜单项,根据MenuItemData.dwItemData所指向的内存
  100.             If mii.fType And MFT_OWNERDRAW Then
  101.                 '以下代码只适用于IE右键自绘菜单,MSDN中说MenuItemData.dwItemData是程序自定义数据,不同程序可能不一样
  102.                 'IE 11.0下测试可用,其他版本未经测试
  103.                 Dim pID As Long
  104.                 Dim lpStrLen As Long
  105.                 Dim lpStr As Long
  106.                 Dim pHandle As Long
  107.                
  108.                 '获取IE进程ID
  109.                 GetWindowThreadProcessId hwndMenu, pID
  110.                 '打开IE进程的内存空间
  111.                 pHandle = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, pID)
  112.                 'MenuItemData.dwItemData是个内存指针,指向的4字节地址是个常量,之后4个字节是要绘制的文本长度n(含最后的chr(0)),之后4个字节又是个指向字符串内容的指针
  113.                 lRet = ReadProcessMemory(pHandle, mii.dwItemData + 4, lpStrLen, 4, 0)
  114.                 lRet = ReadProcessMemory(pHandle, ByVal mii.dwItemData + 8, lpStr, 4, 0)
  115.                 ReDim buffer(lpStrLen * 2)
  116.                 lRet = ReadProcessMemory(pHandle, ByVal lpStr, buffer(0), lpStrLen * 2, 0)
  117.                 GetHiliteMenuItemstring = StrConv(buffer, vbNarrow)
  118.                 CloseHandle pHandle
  119.             Else
  120.                 '非自绘菜单的菜单项文本可以从mii.dwTypeDate指针所指向的缓冲区中直接获取,用GetMenuString也可以
  121.                 ReDim Preserve buffer(mii.cch - 1)
  122.                 GetHiliteMenuItemstring = StrConv(buffer, vbUnicode)
  123.             End If

  124.             Exit For
  125.         End If
  126.     Next
  127. End Function

  128. '根据窗口句柄返回exe文件完整路径,代码来自网络
  129. Function GetWindowImagePath(ByVal hWindow As Long) As String
  130.     Dim dwProcessID As Long, hProcess As Long, hModule As Long
  131.     Dim nSize As Long
  132.     GetWindowThreadProcessId hWindow, dwProcessID
  133.     hProcess = OpenProcess(&H410, 0, dwProcessID)
  134.     hModule = 0
  135.     nSize = 256
  136.     GetWindowImagePath = Space(nSize)
  137.     nSize = GetModuleFileNameEx(hProcess, hModule, StrPtr(GetWindowImagePath), nSize)
  138.     GetWindowImagePath = Mid(GetWindowImagePath, 1, nSize)
  139.     Call CloseHandle(hProcess)
  140. End Function

复制代码


评分

参与人数 1威望 +5 人气 +1 收起 理由
bruly + 5 + 1 太给力了,非常感动~!

查看全部评分

回复 支持 1 反对 0

使用道具 举报

发表于 2017-5-22 17:01:01 | 显示全部楼层
补充说明一下,对于VB本身窗体上用PopupMenu弹出的菜单,用GetMenuString(hMenu, i, VarPtr(buffer(0)), 256, MF_BYPOSITION)或者GetMenuString(hMenu, i, sBuffer, 256, MF_BYPOSITION)可以获得正确的菜单项标题(前者的GetMenuString声明时第三个参数用ByVal lpString As Long并用Ridim buffer(255)初始化数组,后者用ByVal lpString As Long并用sBuffer=Space(256)初始化缓冲字符串),所以初步判断是跨进程的问题
之后用GetWindowThreadProcessId、OpenProcess/CloseHandel、VirtualAllocEx/VirtualFreeEx、ReadProcessMemory在获取菜单所在进程并在其中分配内存缓冲区域用于接收菜单标题,试验了一下,对于VB当前进程仍然可以用下列代码获取正确的菜单项标题,但对于其他窗口(包括IE或者记事本)的右键菜单,程序就会闪退。
  1. Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
  2. Private Type POINTAPI
  3.         X As Long
  4.         Y As Long
  5. End Type

  6. Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
  7. Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
  8. Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  9. Private Const MN_GETHMENU = &H1E1

  10. Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
  11. Private Declare Function GetMenuState Lib "user32" (ByVal hMenu As Long, ByVal wID As Long, ByVal wFlags As Long) As Long
  12. Private Declare Function GetMenuString Lib "user32" Alias "GetMenuStringA" (ByVal hMenu As Long, ByVal wIDItem As Long, ByVal lpString As Long, ByVal nMaxCount As Long, ByVal wFlag As Long) As Long
  13. Private Const MF_BYPOSITION = &H400&
  14. Private Const MF_BYCOMMAND = &H0&
  15. Private Const MF_HILITE = &H80
  16. Private Const MAX_PATH = 260


  17. Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
  18. Private Declare Function VirtualAllocEx Lib "kernel32" (ByVal hProcess As Long, ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
  19. Private Declare Function VirtualFreeEx Lib "kernel32" (ByVal hProcess As Long, ByVal lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
  20. Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, ByRef lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
  21. Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
  22. Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long

  23. Private Const PROCESS_QUERY_INFORMATION = 1024
  24. Private Const PROCESS_VM_OPERATION = &H8
  25. Private Const PROCESS_VM_READ = &H10
  26. Private Const PROCESS_VM_WRITE = &H20
  27. Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
  28. Private Const MEM_COMMIT = &H1000
  29. Private Const MEM_RELEASE = &H8000
  30. Private Const PAGE_READWRITE = &H4



  31. Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  32.     '测试代码,在窗体上添加一个名为aaa的菜单,并添加一个以上子菜单项
  33.     PopupMenu aaa
  34. End Sub

  35. Private Sub Timer1_Timer()
  36.     Dim hwnd As Long, hMenu As Long
  37.     Dim sClassName As String
  38.     Dim p As POINTAPI
  39.     Dim lItemCount As Long
  40.     Dim i As Long
  41.     Dim lRet As Long
  42.    
  43.     GetCursorPos p
  44.     hwnd = WindowFromPoint(p.X, p.Y)
  45.     sClassName = Space(255)
  46.     lRet = GetClassName(hwnd, sClassName, 255)
  47.     sClassName = Left(sClassName, lRet)
  48.     If sClassName = "#32768" Then
  49.         hMenu = SendMessage(hwnd, MN_GETHMENU, 0, 0)
  50.         lItemCount = GetMenuItemCount(hMenu)
  51.         For i = 0 To lItemCount - 1
  52.             If GetMenuState(hMenu, i, MF_BYPOSITION) And MF_HILITE Then
  53.                 Dim pID As Long
  54.                 Dim pHandle As Long
  55.                 Dim pStrBuffer As Long
  56.                 GetWindowThreadProcessId hwnd, pID
  57.                 pHandle = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, pID)
  58.                 pStrBuffer = VirtualAllocEx(pHandle, 0, MAX_PATH, MEM_COMMIT, PAGE_READWRITE)

  59.                
  60.                 lRet = GetMenuString(hMenu, i, ByVal pStrBuffer, MAX_PATH, MF_BYPOSITION)
  61.                 If lRet > 0 Then
  62.                     Dim buffer() As Byte
  63.                     ReDim buffer(lRet)
  64.                     ReadProcessMemory pHandle, ByVal pStrBuffer, buffer(0), lRet, 0
  65.                     Debug.Print StrConv(buffer, vbUnicode)
  66.                 End If
  67.                 VirtualFreeEx pHandle, pStrBuffer, MAX_PATH, MEM_RELEASE
  68.                 CloseHandle pHandle
  69.             End If
  70.         Next
  71.     End If
  72. End Sub
复制代码

评分

参与人数 1威望 +5 收起 理由
bruly + 5 很给力

查看全部评分

回复 支持 1 反对 0

使用道具 举报

发表于 2017-5-1 22:47:39 | 显示全部楼层
如果是IE浏览器应该可以通过获得IE对象来操作,如果是别的浏览器,估计要学一下JAVA写插件。
再就是以前看过一个鼠标取词的原理,就是获得迫使鼠标处的文字在屏幕上从新绘制,接管后获得文字,这样只要是显示的文本都可以捕获。不过作者只是讲了原理。也不是VB能做出来的。
还有一种就是屏幕识图,这个VB到可以,就是ocr技术,虽然VB效率不高,但确实可以做出来。如果要简单马上做出来,可以将菜单截图,保存,然后通过动态刷屏比较。或者是将字体提取作字模,然后识别,也是可行的。
当然,最简单的就是操作IE对象。如果是IE对象,在浏览器弹出一个对话框后,程序会卡住,VB也没有什么多线程,不过可以写一个针对弹窗处理的功能软件。

评分

参与人数 1威望 +5 人气 +1 收起 理由
bruly + 5 + 1 赞一个

查看全部评分

回复 支持 反对

使用道具 举报

发表于 2017-5-22 14:49:48 | 显示全部楼层
有点进展,但不成功,具体如下:
1. 在窗体上添加一个timer,设置其Interval为200毫秒;
2. 用GetCursorPos获取鼠标位置
3. 用WindowFromPoint获取鼠标所指向的窗口hwnd,用GetClassName获取类名,如果类名为"#32768",说明它是弹出菜单(整个系统的弹出菜单都是这个类名,必要的话可通过进程名称进一步判断,但这不是重点)
4. 对于弹出菜单,向这个hwnd发送一个MN_GETHMENU消息(Const MN_GETHMENU = &H1E1)得到菜单句柄hMenu,语法hMenu = SendMessage(hwnd, MN_GETHMENU, 0, 0)
5. 用GetMenuItemCount(hMenu)可以获取正确的菜单项数目
6. 用for...next遍历所有菜单项,用If GetMenuState(hMenu, i, MF_BYPOSITION) And MF_HILITE可以判断当前高亮的菜单项索引
到第6步都没有问题,但是获取菜单项文字时遇到困难,用GetMenuString和GetMenuItemInfo均告失败,希望有高手能接力完成
回复 支持 反对

使用道具 举报

 楼主| 发表于 2017-5-28 23:43:19 | 显示全部楼层
mutex 发表于 2017-5-22 17:01
补充说明一下,对于VB本身窗体上用PopupMenu弹出的菜单,用GetMenuString(hMenu, i, VarPtr(buffer(0)), 25 ...

非常感谢老师如此耐心指点和付出。老师的每一份付出对我来说都是无比让人感动的、难忘的。
上面的程序我好好调试。尽管还不是我最终想要的,但一定能对我的目标要求做一些启发。
再次感恩老师的付出,敬拜~!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2017-5-28 23:43:35 | 显示全部楼层
mutex 发表于 2017-5-22 17:01
补充说明一下,对于VB本身窗体上用PopupMenu弹出的菜单,用GetMenuString(hMenu, i, VarPtr(buffer(0)), 25 ...

非常感谢老师如此耐心指点和付出。老师的每一份付出对我来说都是无比让人感动的、难忘的。
上面的程序我好好调试。尽管还不是我最终想要的,但一定能对我的目标要求做一些启发。
再次感恩老师的付出,敬拜~!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2017-7-13 10:07:51 | 显示全部楼层
mutex 发表于 2017-6-9 09:41
经过几天测试,问题终于解决
原来以为用GetMenuString无法返回正确的菜单项文本是由于跨进程,后来发现程 ...

遗憾的是最近登陆少,回复迟了,请您谅解。
我马上尝试。
回复 支持 反对

使用道具 举报

 楼主| 发表于 2017-7-13 10:08:24 | 显示全部楼层
mutex 发表于 2017-6-9 09:41
经过几天测试,问题终于解决
原来以为用GetMenuString无法返回正确的菜单项文本是由于跨进程,后来发现程 ...

遗憾的是最近登陆少,回复迟了,请您谅解。
我马上尝试。
回复 支持 反对

使用道具 举报

 楼主| 发表于 2017-7-13 12:56:31 | 显示全部楼层
mutex 发表于 2017-6-9 09:41
经过几天测试,问题终于解决
原来以为用GetMenuString无法返回正确的菜单项文本是由于跨进程,后来发现程 ...

如果方便,我添加一下您个人号码,以方便有偿感谢~!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

文字版|手机版|小黑屋|VBGood  

GMT+8, 2017-9-26 01:12

VB爱好者乐园(VBGood)
快速回复 返回顶部 返回列表