Option Explicit '常数申明 Public Const LVM_FIRST As Long = &H1000 Public Const LVM_GETHEADER As Long = LVM_FIRST + 31 Public Const LVM_GETITEMCOUNT As Long = LVM_FIRST + 4 Public Const LVM_GETITEMTEXT As Long = LVM_FIRST + 45 Public Const HDM_FIRST As Long = &H1200 Public Const HDM_GETITEMCOUNT As Long = (HDM_FIRST + 0) Public Const PROCESS_VM_OPERATION As Long = &H8 Public Const PROCESS_VM_READ As Long = &H10 Public Const PROCESS_VM_WRITE As Long = &H20 Public Const MAX_LVMSTRING As Long = 255 Public Const MEM_COMMIT As Long = &H1000 Public Const MEM_RELEASE As Long = &H8000& Public Const PAGE_READWRITE As Long = &H4 Public Const LVIF_TEXT As Long = &H1 '类型申明 Public Type LV_ITEMA mask As Long iItem As Long iSubItem As Long State As Long stateMask As Long pszText As Long cchTextMax As Long End Type 'API申明 Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long '打开进程 Public 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 '获取内存空间 Public Declare Function VirtualFreeEx Lib "kernel32" (ByVal hProcess As Long, ByVal lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long '释放内存空间 Public Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, ByRef lpBuffer As LV_ITEMA, ByVal nSize As Long, _ lpNumberOfBytesWritten As Long) As Long '向内存写数据 Public Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, ByRef lpBuffer As Any, ByVal nSize As Long, _ lpNumberOfBytesWritten As Long) As Long '向内存读数据 Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long '发送消息 Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long '关闭进程 Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long '获得进程IDPublic Function GetListViewTextArray(ByVal hWindow As Long) As String() Dim myItem() As LV_ITEMA Dim PHandle As Long Dim ProcessId As Long Dim PStrBufferMemory As Long Dim PMyItemMemory As Long Dim StrBuffer(MAX_LVMSTRING) As Byte Dim TmpString As String Dim Ih As Long, J As Long, HCount As Long Dim StrArr() As String, ItemString As String Dim Ji As Long, MyItemLength() As Long GetWindowThreadProcessId hWindow, ProcessId HCount = SendMessage(hWindow, LVM_GETHEADER, 0, 0) '获取列数 If HCount > 0 Then HCount = SendMessage(HCount, HDM_GETITEMCOUNT, 0, 0) - 1 Else 'NOT HCOUNT... HCount = 0 End If PHandle = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, 0, ProcessId) ReDim myItem(HCount) ReDim MyItemLength(HCount) PStrBufferMemory = VirtualAllocEx(PHandle, 0, MAX_LVMSTRING, MEM_COMMIT, PAGE_READWRITE) PMyItemMemory = VirtualAllocEx(PHandle, 0, MAX_LVMSTRING, MEM_COMMIT, PAGE_READWRITE) Ji = SendMessage(hWindow, LVM_GETITEMCOUNT, 0, 0) - 1 On Error GoTo err1 ReDim StrArr(Ji)
For Ih = 0 To HCount myItem(Ih).mask = LVIF_TEXT myItem(Ih).iSubItem = Ih myItem(Ih).pszText = PStrBufferMemory myItem(Ih).cchTextMax = MAX_LVMSTRING MyItemLength(Ih) = Len(myItem(Ih)) Next Ih
For J = 0 To Ji ItemString = "" For Ih = 0 To HCount WriteProcessMemory PHandle, PMyItemMemory, myItem(Ih), MyItemLength(Ih), 0 If SendMessage(hWindow, LVM_GETITEMTEXT, J, ByVal PMyItemMemory) > 0 Then ReadProcessMemory PHandle, PStrBufferMemory, StrBuffer(0), MAX_LVMSTRING, 0 TmpString = StrConv(StrBuffer, vbUnicode) TmpString = Left(TmpString, InStr(TmpString, vbNullChar) - 1) ItemString = ItemString & TmpString & Chr(9) ' Chr$(32) End If Next Ih If ItemString <> "" Then StrArr(J) = Left(ItemString, Len(ItemString) - 1) End If Next J
Exit Function err1: MsgBox "不是Listview类吧？", vbInformation End Function上面是vb6的模块，你对照转换下
谢谢sysdzw提供的代码，我已经转成.net的了，但在执行过程中进程ID没有能获取到，还请帮我看看Public Class Form1 '常数申明 Public Const LVM_FIRST As Long = &H1000 Public Const LVM_GETHEADER As Long = LVM_FIRST + 31 Public Const LVM_GETITEMCOUNT As Long = LVM_FIRST + 4 Public Const LVM_GETITEMTEXT As Long = LVM_FIRST + 45 Public Const HDM_FIRST As Long = &H1200 Public Const HDM_GETITEMCOUNT As Long = (HDM_FIRST + 0) Public Const PROCESS_VM_OPERATION As Long = &H8 Public Const PROCESS_VM_READ As Long = &H10 Public Const PROCESS_VM_WRITE As Long = &H20 Public Const MAX_LVMSTRING As Long = 255 Public Const MEM_COMMIT As Long = &H1000 Public Const MEM_RELEASE As Long = &H8000& Public Const PAGE_READWRITE As Long = &H4 Public Const LVIF_TEXT As Long = &H1 'API申明 Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long '打开进程 Public 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 '获取内存空间 Public Declare Function VirtualFreeEx Lib "kernel32" (ByVal hProcess As Long, ByVal lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long '释放内存空间 Public Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, ByRef lpBuffer As LV_ITEMA, ByVal nSize As Long, _ ByVal lpNumberOfBytesWritten As Long) As Long '向内存写数据 Public Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, ByRef lpBuffer As Long, ByVal nSize As Long, _ ByVal lpNumberOfBytesWritten As Long) As Long '向内存读数据 Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Long) As Long '发送消息 Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long '关闭进程 Public Declare Function GetWindowThreadProcessId Lib "user32" Alias "GetWindowThreadProcessId" (ByVal hwnd As Long, ByVal lpdwProcessId As Long) As Long Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Public Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" (ByVal hWnd1 As Int32, ByVal hWnd2 As Int32, ByVal lpsz1 As String, ByVal lpsz2 As String) As Int32 Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As String) As Integer '类型申明 Public Structure LV_ITEMA Dim mask As Long Dim iItem As Long Dim iSubItem As Long Dim State As Long Dim stateMask As Long Dim pszText As Long Dim cchTextMax As Long End Structure Public Function GetListViewTextArray(ByVal hWindow As Long) As String() Dim myItem() As LV_ITEMA Dim PHandle As Long Dim ProcessId As Long Dim PStrBufferMemory As Long Dim PMyItemMemory As Long Dim StrBuffer(MAX_LVMSTRING) As Byte Dim TmpString As String Dim Ih As Long, J As Long, HCount As Long Dim StrArr() As String, ItemString As String Dim Ji As Long, MyItemLength() As Long GetWindowThreadProcessId(hWindow, ProcessId) MsgBox("ProcessId=" & ProcessId) '获取进程ID，为0，后面就什么也没有了 HCount = SendMessage(hWindow, LVM_GETHEADER, 0, 0) If HCount > 0 Then HCount = SendMessage(HCount, HDM_GETITEMCOUNT, 0, 0) - 1 Else HCount = 0 End If PHandle = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, 0, ProcessId) ReDim myItem(HCount) ReDim MyItemLength(HCount) PStrBufferMemory = VirtualAllocEx(PHandle, 0, MAX_LVMSTRING, MEM_COMMIT, PAGE_READWRITE) PMyItemMemory = VirtualAllocEx(PHandle, 0, MAX_LVMSTRING, MEM_COMMIT, PAGE_READWRITE) Ji = SendMessage(hWindow, LVM_GETITEMCOUNT, 0, 0) - 1 On Error GoTo err1 ReDim StrArr(Ji) For Ih = 0 To HCount myItem(Ih).mask = LVIF_TEXT myItem(Ih).iSubItem = Ih myItem(Ih).pszText = PStrBufferMemory myItem(Ih).cchTextMax = MAX_LVMSTRING MyItemLength(Ih) = Len(myItem(Ih)) Next For J = 0 To Ji ItemString = "" For Ih = 0 To HCount WriteProcessMemory(PHandle, PMyItemMemory, myItem(Ih), MyItemLength(Ih), 0) If SendMessage(hWindow, LVM_GETITEMTEXT, J, PMyItemMemory) > 0 Then ReadProcessMemory(PHandle, PStrBufferMemory, StrBuffer(0), MAX_LVMSTRING, 0) TmpString = System.Text.Encoding.Default.GetString(StrBuffer) MsgBox(TmpString) TmpString = Mid(TmpString, InStr(TmpString, vbNullChar) - 1) ItemString = ItemString & TmpString & Chr(9) ' Chr$(32) End If Next If ItemString <> "" Then StrArr(J) = Mid(ItemString, Len(ItemString) - 1) MsgBox(StrArr(J)) End If Next VirtualFreeEx(PHandle, PMyItemMemory, 0, MEM_RELEASE) VirtualFreeEx(PHandle, PStrBufferMemory, 0, MEM_RELEASE) CloseHandle(PHandle) ItemString = "" GetListViewTextArray = StrArr Exit Function err1: MsgBox("不是Listview类吧？", vbInformation) End Function Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click Dim hwnd0 As Long hwnd0 = FindWindow(vbNullString, "刀具路径列表") MsgBox(hwnd0) Dim hwnd1 As Long hwnd1 = FindWindowEx(hwnd0, 0&, "syslistview32", vbNullString) MsgBox(hwnd1) Call GetListViewTextArray(hwnd1) End Sub End Class补充一点，我用的是win764位的操作系统，不知道会不会有影响。
现在代码经过调试，已经可以执行到WriteProcessMemory(PHandle, PMyItemMemory, myItem(Ih), MyItemLength(Ih), 0) 但后面就会发生vshost.exe已停止工作，不知何故，我再粘贴一次代码 Public Class Form1 'Constants Private Const LVFI_PARAM = 1 Private Const LVM_FIRST = &H1000 Private Const LVM_FINDITEM = LVM_FIRST + 13 Private Const LVM_GETITEMTEXT = LVM_FIRST + 45 Private Const LVM_SORTITEMS = LVM_FIRST + 48 Private Const LVM_GETHEADER = LVM_FIRST + 31 Private Const LVM_GETITEMCOUNT = (LVM_FIRST + 4) Private Const HDM_FIRST = &H1200 '// Header messages Private Const HDM_GETITEMCOUNT = (HDM_FIRST + 0) Private Const HDM_ORDERTOINDEX = (HDM_FIRST + 15) Private Const PROCESS_QUERY_INFORMATION = 1024 Private Const PROCESS_VM_OPERATION = &H8 Private Const PROCESS_VM_READ = &H10 Private Const PROCESS_VM_WRITE = &H20 Private Const PROCESS_ALL_ACCESS As Long = &H1F0FFF Private Const STANDARD_RIGHTS_REQUIRED = &HF0000 Private Const MAX_LVMSTRING As Long = 255 '可根椐读取数据长度设置适当的数值 Private Const MEM_COMMIT = &H1000 Private Const MEM_RELEASE = &H8000 Private Const PAGE_READWRITE = &H4 Private Const LVIF_TEXT As Long = &H1 'API declarations Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, ByRef lpBuffer As Byte, ByVal nSize As Long, ByVal lpNumberOfBytesWritten As Long) As Long Private Declare Function VirtualFreeEx Lib "kernel32" (ByVal hProcess As Long, ByVal lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, ByRef lpBuffer As LV_ITEMA, ByVal nSize As Long, ByVal lpNumberOfBytesWritten As Long) As Long 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 Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, ByRef lpdwProcessId As Long) As Long Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" (ByVal hWnd1 As Int32, ByVal hWnd2 As Int32, ByVal lpsz1 As String, ByVal lpsz2 As String) As Int32 Private 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 Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As IntPtr, ByVal lpString As String, ByVal cch As Int32) As Int32 Public Structure LV_ITEMA Dim mask As Long Dim iItem As Long Dim iSubItem As Long Dim state As Long Dim stateMask As Long Dim pszText As Long Dim cchTextMax As Long Dim iImage As Long Dim lParam As Long Dim iIndent As Long End Structure Public getm As String = "" Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Dim hwnd0 As Long Dim hwnd1 As Long Dim str As String str = Space(255) '查找窗口名称为《刀具路径列表》的窗口句柄号 hwnd0 = FindWindow(vbNullString, "刀具路径列表") MsgBox("hwnd0=" & hwnd0) 'ok '查找类名为syslistview32的窗口句柄号 hwnd1 = FindWindowEx(hwnd0, 0&, "syslistview32", vbNullString) MsgBox("hwnd1=" & hwnd1) 'ok Call GetListViewTextArray(hwnd1) End Sub Public Function GetListViewTextArray(ByVal hWindow As Long) As String() Dim myItem() As LV_ITEMA Dim PHandle As Long Dim ProcessId As Long Dim PStrBufferMemory As Long Dim PMyItemMemory As Long Dim StrBuffer(MAX_LVMSTRING) As Byte Dim TmpString As String Dim Ih As Long, J As Long, HCount As Long Dim StrArr() As String, ItemString As String Dim Ji As Long, MyItemLength() As Long GetWindowThreadProcessId(hWindow, ProcessId) MsgBox("ProcessId=" & ProcessId) 'ok HCount = SendMessage(hWindow, LVM_GETHEADER, 0, 0) If HCount > 0 Then HCount = SendMessage(HCount, HDM_GETITEMCOUNT, 0, 0) - 1 MsgBox("hcount=" & HCount) 'ok Else HCount = 0 End If PHandle = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, 0, ProcessId) MsgBox("phandle=" & PHandle) 'ok ReDim myItem(HCount) ReDim MyItemLength(HCount) PStrBufferMemory = VirtualAllocEx(PHandle, 0, MAX_LVMSTRING, MEM_COMMIT, PAGE_READWRITE) PMyItemMemory = VirtualAllocEx(PHandle, 0, MAX_LVMSTRING, MEM_COMMIT, PAGE_READWRITE) Ji = SendMessage(hWindow, LVM_GETITEMCOUNT, 0, 0) - 1 On Error GoTo err1 ReDim StrArr(Ji) For Ih = 0 To HCount myItem(Ih).mask = LVIF_TEXT myItem(Ih).iSubItem = Ih myItem(Ih).pszText = PStrBufferMemory myItem(Ih).cchTextMax = MAX_LVMSTRING MyItemLength(Ih) = Len(myItem(Ih)) Next For J = 0 To Ji ItemString = "" For Ih = 0 To HCount WriteProcessMemory(PHandle, PMyItemMemory, myItem(Ih), MyItemLength(Ih), 0) If SendMessage(hWindow, LVM_GETITEMTEXT, J, PMyItemMemory) > 0 Then '程序在这里循环，然后崩溃 ReadProcessMemory(PHandle, PStrBufferMemory, StrBuffer(0), MAX_LVMSTRING, 0) TmpString = System.Text.Encoding.Default.GetString(StrBuffer) TmpString = Mid(TmpString, InStr(TmpString, vbNullChar) - 1) ItemString = ItemString & TmpString & Chr(9) ' Chr$(32) End If Next If ItemString <> "" Then StrArr(J) = Mid(ItemString, Len(ItemString) - 1) End If Next VirtualFreeEx(PHandle, PMyItemMemory, 0, MEM_RELEASE) VirtualFreeEx(PHandle, PStrBufferMemory, 0, MEM_RELEASE) CloseHandle(PHandle) ItemString = "" GetListViewTextArray = StrArr Exit Function err1: MsgBox("不是Listview类吧？", vbInformation) End Function End Class声明一下，我的分不多，因为是新手，但我是真心想解决这个问题，如果可以的话，线下付费也可以，期待真高手，那些打酱油的，让我百度、Google的就请免开尊口了，谢谢。
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Int32, ByVal wMsg As Int32, ByVal wParam As Int32, ByVal lParam As Int32) As Int32 lParam的声明改了下，下面的调用就不会出问题了 If SendMessage(hWindow, LVM_GETITEMTEXT, J, PMyItemMemory) > 0 Then '程序在这里循环，然后崩溃 我测试时FindWindowEx调用就出错了，就把所有的long型定义都改成了int32 TmpString = Mid(TmpString, InStr(TmpString, vbNullChar) - 1) 改成 TmpString = Mid(TmpString, InStr(TmpString,1, vbNullChar) - 1)
ViewWizard3.0部分代码:'mod_ReadWinTextOption ExplicitPrivate Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Function WriteProcessMemory Lib "kernel32.dll" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long Private Declare Function ReadProcessMemory Lib "kernel32.dll" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long Private Declare Function VirtualAllocEx Lib "kernel32.dll" (ByVal hProcess As Long, lpAddress As Any, ByRef dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long Private Declare Function VirtualFreeEx Lib "kernel32.dll" (ByVal hProcess As Long, lpAddress As Any, ByRef dwSize As Long, ByVal dwFreeType As Long) As Long Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As LongPrivate Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)Private Const PROCESS_VM_OPERATION As Long = (&H8) Private Const PROCESS_VM_READ As Long = (&H10) Private Const PROCESS_VM_WRITE As Long = (&H20) Private Const MEM_RESERVE As Long = &H2000 Private Const MEM_COMMIT As Long = &H1000 Private Const MEM_DECOMMIT = &H4000 Private Const MEM_RELEASE As Long = &H8000 Private Const PAGE_READWRITE As Long = &H4Private Const WM_GETTEXT = &HD Private Const WM_GETTEXTLENGTH = &HEPrivate Const EM_GETPASSWORDCHAR = &HD2 Private Const EM_SETPASSWORDCHAR = &HCCPrivate Const WM_USER = &H400Private Const LB_GETTEXT = &H189& Private Const LB_GETTEXTLEN = &H18A Private Const LB_GETCOUNT = &H18BPrivate Const CB_GETCOUNT = &H146 Private Const CB_GETLBTEXT = &H148 Private Const CB_GETLBTEXTLEN = &H149Private Const TB_BUTTONCOUNT As Long = (WM_USER + 24) Private Const TB_HIDEBUTTON As Long = (WM_USER + 4) Private Const TB_GETBUTTON As Long = (WM_USER + 23) Private Const TB_ISBUTTONHIDDEN As Long = (WM_USER + 12) Private Const TB_GETBUTTONTEXTA = (WM_USER + 45) Private Const TB_GETBUTTONTEXTW = (WM_USER + 75)Private Const TCM_FIRST = &H1300 Private Const TCM_GETITEM = (TCM_FIRST + 5) Private Const TCM_GETITEMCOUNT = &H1304 Private Const TCIF_TEXT = &H1Private Const LVM_FIRST = &H1000 Private Const LVM_GETITEMCOUNT = (LVM_FIRST + 4) Private Const LVM_GETITEM = (LVM_FIRST + 5) Private Const LVM_GETSTRINGWIDTH = (LVM_FIRST + 17) Private Const LVM_GETCOLUMN = (LVM_FIRST + 25) Private Const LVM_GETITEMTEXT = (LVM_FIRST + 45) Private Const LVM_GETHEADER = LVM_FIRST + 31 Private Const LVM_GETVIEW = (LVM_FIRST + 143) Private Const LVM_SETVIEW = (LVM_FIRST + 142) Private Const LVM_GETIMAGELIST = (LVM_FIRST + 2)Private Const HDM_FIRST = &H1200 '// Header messages Private Const HDM_GETITEMCOUNT = (HDM_FIRST + 0) Private Const HDM_ORDERTOINDEX = (HDM_FIRST + 15) Private Const HDM_GETITEMA = (HDM_FIRST + 3) Private Const HDM_GETITEMW = (HDM_FIRST + 11) Private Const HDI_TEXT = &H2Private Const WC_HEADER = "SysHeader32" Private Const LVIF_TEXT As Long = &H1 Private Const MAX_LVMSTRING As Long = 4096 '可根椐读取数据长度设置适当的数值Private Const TV_FIRST = &H1100& Private Const TVIF_TEXT = 1 Private Const TVIF_HANDLE = &H10 Private Const TVM_GETCOUNT = TV_FIRST + 5 Private Const TVM_SELECTITEM = TV_FIRST + 11 Private Const TVM_GETITEM = TV_FIRST + 12 Private Const TVM_GETNEXTITEM = TV_FIRST + 10 Private Const TVGN_ROOT = 0 Private Const TVGN_NEXT = 1 Private Const TVGN_CHILD = 4 Private Const TVGN_CARET = 9Private Const GW_CHILD = 5 Private Const GW_HWNDNEXT = 2Private Const MAX_TEXT_LENGTH = 255& '最大文本长度Private Type TCITEM mask As Long dwState As Long dwStateMask As Long pszText As Long cchTextMax As Integer iImage As Integer lParam As Long End TypePrivate Type LVITEM mask As Long iItem As Long iSubItem As Long state As Long stateMask As Long pszText As Long cchTextMax As Long iImage As Long lParam As Long iIndent As Long End TypePrivate Type HDITEM mask As Long cxy As Integer pszText As Long hbm As Long cchTextMax As Integer fmt As Integer lParam As Long iImage As Integer iOrder As Integer End TypePrivate Type TVITEM mask As Long hItem As Long state As Long stateMask As Long pszText As Long cchTextMax As Long iImage As Long iSelectedImage As Long cChildren As Long lParam As Long End TypePrivate mStackFlag As cls_Stack Private mStackNode As cls_Stack Private mhProcess As Long Private mlpTextRemote As Long Private mlpTreeItemRemote As Long Private mnMaxLen As Long Private mszBuf() As Byte '判断是否是Listbox窗口 Public Function IsListBox(hWin As Long) As Boolean IsListBox = SendMessage(hWin, LB_GETCOUNT, 0, ByVal 0&) End Function'判断是否是ComboBox窗口 Public Function IsComboBox(hWin As Long) As Boolean IsComboBox = SendMessage(hWin, CB_GETCOUNT, 0, ByVal 0&) End Function'是否工具栏 Public Function IsToolBar(hWin As Long) As Boolean IsToolBar = (WA.GetWinClassName(hWin) = "ToolbarWindow32") End Function'是否选项卡 Public Function IsTabControl(hWin As Long) As Boolean IsTabControl = SendMessage(hWin, TCM_GETITEMCOUNT, 0, ByVal 0&) 'IsTabControl = (GetWinClassName(hWin) = "SysTabControl32") End Function'是否ListView Public Function IsListView(hWin As Long) As Boolean 'IsListView = (GetWinClassName(hWin) = "SysListView32") IsListView = SendMessage(hWin, LVM_GETITEMCOUNT, 0, ByVal 0&) End Function'是否LvwHeader Public Function IsLvwHeader(hWin As Long) As Boolean 'IsLvwHeader = (GetWinClassName(hWin) = "SysHeader32") IsLvwHeader = SendMessage(hWin, HDM_GETITEMCOUNT, 0, ByVal 0&) End Function'查看方式 Public Function GetLvwViewType(hWin As Long) As Long GetLvwViewType = SendMessage(hWin, LVM_GETVIEW, 0, ByVal 0&) End Function'查看方式 Public Function SetLvwViewType(hWin As Long, nView As Long) As Long SetLvwViewType = SendMessage(hWin, LVM_SETVIEW, nView, ByVal 0&) End Function'是否ListView Public Function IsTreeView(hWin As Long) As Boolean 'IsListView = (GetWinClassName(hWin) = "SysListView32") IsTreeView = SendMessage(hWin, TVM_GETCOUNT, 0, ByVal 0&) End Function
继续： '****************************************************************************'得到窗口标题 Public Function GetWinText(ByVal hWin As Long, Optional ByVal MaxLength As Long = -1, Optional PwdChar As Long) As String On Error Resume Next
If hWin = g_hDesktop Then GetWinText = "Desktop" Exit Function End If
Dim lRet As Long Dim dwLength As Long Dim nChar As Long Dim strText As String Dim IsPwd As Boolean dwLength = GetWindowTextLength(hWin) 'Debug.Print "dwLength=", dwLength 'Debug.Print hWin If dwLength > 0 Then If MaxLength <> -1 Then If dwLength > MaxLength Then dwLength = MaxLength strText = String(dwLength, vbNullChar) lRet = GetWindowText(hWin, strText, dwLength + 1) Else If IsWinSuspend(hWin) = False Then dwLength = SendMessage(hWin, WM_GETTEXTLENGTH, 0, ByVal 0&) If MaxLength <> -1 Then If dwLength > MaxLength Then dwLength = MaxLength 'Debug.Print "Text长度=", dwLength If IsPasswordEdit(hWin) Then nChar = SendMessage(hWin, EM_GETPASSWORDCHAR, 0, ByVal 0&) PwdChar = nChar IsPwd = True End If 'Debug.Print "密码字符=", nChar If dwLength > 0 Then strText = String(dwLength, vbNullChar) If IsPwd Then PostMessage hWin, EM_SETPASSWORDCHAR, 0, 0 '设置密码 'DoEvents Sleep 10 lRet = SendMessage(hWin, WM_GETTEXT, dwLength + 1, ByVal strText) PostMessage hWin, EM_SETPASSWORDCHAR, nChar, 0 Else lRet = SendMessage(hWin, WM_GETTEXT, dwLength + 1, ByVal strText) End If End If End If End If GetWinText = strText End Function'得到Listbox内容 Public Function GetLBText(ByVal hWin As Long) As String Dim iCount As Long Dim i As Long Dim dwLength As Long Dim lRet As Long Dim ByteArray() As Byte Dim strText As String iCount = SendMessage(hWin, LB_GETCOUNT, 0, ByVal 0&) 'Debug.Print iCount For i = 0 To iCount - 1 dwLength = SendMessage(hWin, LB_GETTEXTLEN, i, ByVal 0&) 'Debug.Print dwLength If dwLength > 0 Then ReDim ByteArray(0 To dwLength - 1) lRet = SendMessage(hWin, LB_GETTEXT, i, ByteArray(0)) Else Erase ByteArray End If strText = strText & StrConv(ByteArray, vbUnicode) & vbCrLf Next i Erase ByteArray GetLBText = strText End Function'得到ComboBox内容 Public Function GetCBText(ByVal hWin As Long) As String Dim iCount As Long Dim i As Long Dim dwLength As Long Dim lRet As Long Dim ByteArray() As Byte Dim strText As String iCount = SendMessage(hWin, CB_GETCOUNT, 0, ByVal 0&) For i = 0 To iCount - 1 dwLength = SendMessage(hWin, CB_GETLBTEXTLEN, i, ByVal 0&) If dwLength > 0 Then ReDim ByteArray(0 To dwLength - 1) lRet = SendMessage(hWin, CB_GETLBTEXT, i, ByteArray(0)) Else Erase ByteArray End If strText = strText & StrConv(ByteArray, vbUnicode) & vbCrLf Next i Erase ByteArray GetCBText = strText End Function'Toolbar内容 Public Function GetToolBarText(hWin As Long) As String On Error Resume Next Dim lngPID As Long Dim hProcess As Long Dim lngAddress As Long Dim lngCount As Long Dim lngButtons As Long Dim lRet As Long Dim lngHwndAdr As Long Dim lngButtonID As Long Dim lngHwnd As Long Dim i As Long Dim strText As String Dim strInfo As String Dim ByteArray() As Byte lngPID = WA.GetWinPId(hWin) hProcess = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, 0, lngPID) If hProcess <> 0 Then lngAddress = VirtualAllocEx(hProcess, ByVal 0&, ByVal 4096&, MEM_COMMIT, PAGE_READWRITE) If lngAddress Then lngButtons = SendMessage(hWin, TB_BUTTONCOUNT, 0, ByVal 0&) 'Debug.Print lngButtons For i = 0 To lngButtons - 1 lRet = SendMessage(hWin, TB_GETBUTTON, ByVal i, ByVal lngAddress) 'Debug.Print "lngAddress=", lngAddress 'lRet = ReadProcessMemory(hProcess, ByVal lngAddress + 12, ByVal VarPtr(lngHwndAdr), ByVal 4, ByVal 0&) 'ret = ReadProcessMemory(hProcess, ByVal lngHwndAdr, ByVal VarPtr(lngHwnd), ByVal 4, ByVal 0&) lRet = ReadProcessMemory(hProcess, ByVal lngAddress + 4, ByVal VarPtr(lngButtonID), ByVal 4, ByVal 0&) 'Debug.Print "lngButtonID=", lngButtonID lRet = SendMessage(hWin, TB_ISBUTTONHIDDEN, lngButtonID, ByVal 0&) 'Debug.Print lRet If lRet = 0 Then lRet = SendMessage(hWin, TB_GETBUTTONTEXTA, lngButtonID, ByVal lngAddress) ReDim ByteArray(0 To 127) lRet = ReadProcessMemory(hProcess, ByVal lngAddress, ByVal VarPtr(ByteArray(0)), ByVal 128&, ByVal 0&) strInfo = TrimNull(StrConv(ByteArray, vbUnicode)) 'strInfo = Replace(strInfo, vbCrLf, " ") strText = strText & strInfo & vbCrLf End If Next i VirtualFreeEx hProcess, ByVal lngAddress, ByVal 4096&, MEM_RELEASE End If CloseHandle hProcess End If 'Debug.Print "strText=", strText GetToolBarText = strText End Function'TabControl内容 Public Function GetTabControlText(hWin As Long) As String On Error Resume Next Dim i As Long Dim lRet As Long Dim pszText As Long Dim tItem As TCITEM Dim lpAddress As Long Dim lpAddressItem As Long Dim hProcess As Long Dim dwProcessId As Long Dim dwItemCount As Long Dim strText As String Dim ByteArray() As Byte dwProcessId = WA.GetWinPId(hWin) hProcess = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, 0&, dwProcessId) If hProcess <> 0 Then lpAddress = VirtualAllocEx(hProcess, ByVal 0&, 256&, MEM_COMMIT, PAGE_READWRITE) lpAddressItem = VirtualAllocEx(hProcess, ByVal 0&, Len(tItem), MEM_COMMIT, PAGE_READWRITE) If lpAddressItem <> 0 Then tItem.mask = TCIF_TEXT tItem.pszText = lpAddress tItem.cchTextMax = 255 lRet = WriteProcessMemory(hProcess, ByVal lpAddressItem, tItem, Len(tItem), ByVal 0&) 'Debug.Print "lRet=", lRet dwItemCount = SendMessage(hWin, TCM_GETITEMCOUNT, 0, ByVal 0&) 'Debug.Print "dwItemCount=", dwItemCount For i = 0 To dwItemCount - 1 lRet = SendMessage(hWin, TCM_GETITEM, i, ByVal lpAddressItem) 'Debug.Print "lpAddress=", lpAddress lRet = ReadProcessMemory(hProcess, ByVal lpAddressItem, tItem, Len(tItem), ByVal 0&) 'Debug.Print tItem.pszText ReDim ByteArray(0 To 255) lRet = ReadProcessMemory(hProcess, ByVal lpAddress, ByteArray(0), 256&, ByVal 0&) strText = strText & TrimNull(StrConv(ByteArray, vbUnicode)) & vbCrLf Next i lRet = VirtualFreeEx(hProcess, ByVal lpAddressItem, ByVal 0&, MEM_RELEASE) lRet = VirtualFreeEx(hProcess, ByVal lpAddress, ByVal 0&, MEM_RELEASE) GetTabControlText = strText End If CloseHandle hProcess End If End Function
'ListView Public Function GetListViewText(ByVal lngHwnd As Long) As String
On Error Resume Next
Dim lngHeaderHwnd As Long Dim ProcessId As Long Dim lngRows As Long Dim lngCols As Long Dim lngRow As Long Dim lngCol As Long Dim strItem As String Dim nView As Long
Dim Result As Long Dim myItem As LVITEM Dim pHandle As Long Dim pStrBufferMemory As Long Dim pMyItemMemory As Long Dim strBuffer() As Byte Dim tmpString As String
'***************************************************************************************************** pHandle = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, ProcessId) If pHandle = 0 Then Exit Function
不是不能识别，是不让连续回复，后面的没发上来。'Header Public Function GetLvwHeaderText(hWin As Long) As String Dim i As Long Dim dwProcessId As Long Dim strItem As String Dim strText As String Dim myItem As HDITEM Dim hProcess As Long Dim lpAddress As Long Dim lpTextAddress As Long Dim strBuffer() As Byte Dim lRet As Long Dim dwItemCount As Long
'***************************************************************************************************** hProcess = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, dwProcessId) If hProcess = 0 Then Exit Function
GetLvwHeaderText = Trim(strText) End Function'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 'TreeView Public Function GetTreeViewText(mlhWnd As Long) As String
On Error Resume Next
Dim i As Long, s As String Dim dwProcessId As Long Dim dwBytesRead As Long, dwBytesWrite As Long Dim bSuccess As Long 'Dim lpTreeItemRemote As Long, lpTextRemote As Long Dim strText As String 'Dim nMaxLen As Long
mnMaxLen = 1023 ReDim mszBuf(mnMaxLen) Dim lvItemLocal As TVITEM
dwProcessId = WA.GetWinPId(mlhWnd) mhProcess = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, 0&, dwProcessId) If mhProcess = 0 Then Exit Function 'allocate memory mlpTextRemote = VirtualAllocEx(ByVal mhProcess, ByVal 0&, mnMaxLen + 1, MEM_COMMIT, PAGE_READWRITE) mlpTreeItemRemote = VirtualAllocEx(ByVal mhProcess, ByVal 0&, Len(lvItemLocal), MEM_COMMIT, PAGE_READWRITE)
'get content and write to file Dim hRoot As Long Set mStackNode = New cls_Stack Set mStackFlag = New cls_Stack
hChild = SendMessage(hWin, TVM_GETNEXTITEM, TVGN_CHILD, ByVal hTmpNode) If hChild <> 0 Then fChild = True mStackNode.Push hTmpNode mStackFlag.Push fChild hTmpNode = hChild lLevel = lLevel + 1 GoTo bgChild End If
bgSibling: hSibling = SendMessage(hWin, TVM_GETNEXTITEM, TVGN_NEXT, ByVal hTmpNode) If hSibling <> 0 Then If lLevel = 0 And Not fEnd Then mStackNode.Push hTmpNode mStackFlag.Push fChild End If hTmpNode = hSibling GoTo bgChild Else If lLevel = 0 Then fEnd = (lLevel = 0) GoTo ed End If End If
If mStackNode.Pop(hTmpNode) And mStackFlag.Pop(fChild) Then If Not fChild Then GoTo bgChild Else If lLevel > 0 Then lLevel = lLevel - 1 End If GoTo bgSibling End If End If ed: WalkNode1 = sText End FunctionPrivate Function GetNodeText(hWin As Long, hNode As Long) As String On Error Resume Next 'Dim mHwnd As Long Dim i As Long, s As String Dim dwBytesRead As Long, dwBytesWrite As Long Dim bSuccess As Long Dim lvItemLocal As TVITEM Dim bWriteOK As Long ReDim mszBuf(mnMaxLen)
GetNodeText = TrimNull(StrConv(mszBuf, vbUnicode)) End Function'cls_StackOption ExplicitPrivate m_colStack As CollectionPublic Function Push(v As Variant) As Boolean On Error Resume Next m_colStack.Add v Push = (Err.Number = 0) End FunctionPublic Function Pop(v As Variant) As Boolean On Error Resume Next With m_colStack v = .Item(.Count) .Remove .Count Pop = (Err.Number = 0) And (.Count > 0) End With End FunctionPrivate Sub Class_Initialize() Set m_colStack = New Collection End SubPrivate Sub Class_Terminate() Set m_colStack = Nothing End Sub
'常数申明
Public Const LVM_FIRST As Long = &H1000
Public Const LVM_GETHEADER As Long = LVM_FIRST + 31
Public Const LVM_GETITEMCOUNT As Long = LVM_FIRST + 4
Public Const LVM_GETITEMTEXT As Long = LVM_FIRST + 45
Public Const HDM_FIRST As Long = &H1200
Public Const HDM_GETITEMCOUNT As Long = (HDM_FIRST + 0)
Public Const PROCESS_VM_OPERATION As Long = &H8
Public Const PROCESS_VM_READ As Long = &H10
Public Const PROCESS_VM_WRITE As Long = &H20
Public Const MAX_LVMSTRING As Long = 255
Public Const MEM_COMMIT As Long = &H1000
Public Const MEM_RELEASE As Long = &H8000&
Public Const PAGE_READWRITE As Long = &H4
Public Const LVIF_TEXT As Long = &H1
'类型申明
Public Type LV_ITEMA
mask As Long
iItem As Long
iSubItem As Long
State As Long
stateMask As Long
pszText As Long
cchTextMax As Long
End Type
'API申明
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long '打开进程
Public 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 '获取内存空间
Public Declare Function VirtualFreeEx Lib "kernel32" (ByVal hProcess As Long, ByVal lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long '释放内存空间
Public Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, ByRef lpBuffer As LV_ITEMA, ByVal nSize As Long, _
lpNumberOfBytesWritten As Long) As Long '向内存写数据
Public Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, ByRef lpBuffer As Any, ByVal nSize As Long, _
lpNumberOfBytesWritten As Long) As Long '向内存读数据
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long '发送消息
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long '关闭进程
Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long '获得进程IDPublic Function GetListViewTextArray(ByVal hWindow As Long) As String()
Dim myItem() As LV_ITEMA
Dim PHandle As Long
Dim ProcessId As Long
Dim PStrBufferMemory As Long
Dim PMyItemMemory As Long
Dim StrBuffer(MAX_LVMSTRING) As Byte
Dim TmpString As String
Dim Ih As Long, J As Long, HCount As Long
Dim StrArr() As String, ItemString As String
Dim Ji As Long, MyItemLength() As Long GetWindowThreadProcessId hWindow, ProcessId
HCount = SendMessage(hWindow, LVM_GETHEADER, 0, 0) '获取列数
If HCount > 0 Then
HCount = SendMessage(HCount, HDM_GETITEMCOUNT, 0, 0) - 1
Else 'NOT HCOUNT...
HCount = 0
End If
PHandle = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, 0, ProcessId)
ReDim myItem(HCount)
ReDim MyItemLength(HCount)
PStrBufferMemory = VirtualAllocEx(PHandle, 0, MAX_LVMSTRING, MEM_COMMIT, PAGE_READWRITE)
PMyItemMemory = VirtualAllocEx(PHandle, 0, MAX_LVMSTRING, MEM_COMMIT, PAGE_READWRITE)
Ji = SendMessage(hWindow, LVM_GETITEMCOUNT, 0, 0) - 1
On Error GoTo err1
ReDim StrArr(Ji)
For Ih = 0 To HCount
myItem(Ih).mask = LVIF_TEXT
myItem(Ih).iSubItem = Ih
myItem(Ih).pszText = PStrBufferMemory
myItem(Ih).cchTextMax = MAX_LVMSTRING
MyItemLength(Ih) = Len(myItem(Ih))
Next Ih
For J = 0 To Ji
ItemString = ""
For Ih = 0 To HCount
WriteProcessMemory PHandle, PMyItemMemory, myItem(Ih), MyItemLength(Ih), 0
If SendMessage(hWindow, LVM_GETITEMTEXT, J, ByVal PMyItemMemory) > 0 Then
ReadProcessMemory PHandle, PStrBufferMemory, StrBuffer(0), MAX_LVMSTRING, 0
TmpString = StrConv(StrBuffer, vbUnicode)
TmpString = Left(TmpString, InStr(TmpString, vbNullChar) - 1)
ItemString = ItemString & TmpString & Chr(9) ' Chr$(32)
End If
Next Ih
If ItemString <> "" Then
StrArr(J) = Left(ItemString, Len(ItemString) - 1)
End If
Next J
VirtualFreeEx PHandle, PMyItemMemory, 0, MEM_RELEASE
VirtualFreeEx PHandle, PStrBufferMemory, 0, MEM_RELEASE
CloseHandle (PHandle)
ItemString = ""
GetListViewTextArray = StrArr
Exit Function
err1:
MsgBox "不是Listview类吧？", vbInformation
End Function上面是vb6的模块，你对照转换下
'常数申明
Public Const LVM_FIRST As Long = &H1000
Public Const LVM_GETHEADER As Long = LVM_FIRST + 31
Public Const LVM_GETITEMCOUNT As Long = LVM_FIRST + 4
Public Const LVM_GETITEMTEXT As Long = LVM_FIRST + 45
Public Const HDM_FIRST As Long = &H1200
Public Const HDM_GETITEMCOUNT As Long = (HDM_FIRST + 0)
Public Const PROCESS_VM_OPERATION As Long = &H8
Public Const PROCESS_VM_READ As Long = &H10
Public Const PROCESS_VM_WRITE As Long = &H20
Public Const MAX_LVMSTRING As Long = 255
Public Const MEM_COMMIT As Long = &H1000
Public Const MEM_RELEASE As Long = &H8000&
Public Const PAGE_READWRITE As Long = &H4
Public Const LVIF_TEXT As Long = &H1
'API申明
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long '打开进程
Public 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 '获取内存空间
Public Declare Function VirtualFreeEx Lib "kernel32" (ByVal hProcess As Long, ByVal lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long '释放内存空间
Public Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, ByRef lpBuffer As LV_ITEMA, ByVal nSize As Long, _
ByVal lpNumberOfBytesWritten As Long) As Long '向内存写数据
Public Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, ByRef lpBuffer As Long, ByVal nSize As Long, _
ByVal lpNumberOfBytesWritten As Long) As Long '向内存读数据
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Long) As Long '发送消息
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long '关闭进程
Public Declare Function GetWindowThreadProcessId Lib "user32" Alias "GetWindowThreadProcessId" (ByVal hwnd As Long, ByVal lpdwProcessId As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" (ByVal hWnd1 As Int32, ByVal hWnd2 As Int32, ByVal lpsz1 As String, ByVal lpsz2 As String) As Int32
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As String) As Integer
'类型申明
Public Structure LV_ITEMA
Dim mask As Long
Dim iItem As Long
Dim iSubItem As Long
Dim State As Long
Dim stateMask As Long
Dim pszText As Long
Dim cchTextMax As Long
End Structure Public Function GetListViewTextArray(ByVal hWindow As Long) As String() Dim myItem() As LV_ITEMA
Dim PHandle As Long
Dim ProcessId As Long
Dim PStrBufferMemory As Long
Dim PMyItemMemory As Long
Dim StrBuffer(MAX_LVMSTRING) As Byte
Dim TmpString As String
Dim Ih As Long, J As Long, HCount As Long
Dim StrArr() As String, ItemString As String
Dim Ji As Long, MyItemLength() As Long GetWindowThreadProcessId(hWindow, ProcessId)
MsgBox("ProcessId=" & ProcessId) '获取进程ID，为0，后面就什么也没有了
HCount = SendMessage(hWindow, LVM_GETHEADER, 0, 0) If HCount > 0 Then
HCount = SendMessage(HCount, HDM_GETITEMCOUNT, 0, 0) - 1 Else
HCount = 0
End If
PHandle = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, 0, ProcessId)
ReDim myItem(HCount)
ReDim MyItemLength(HCount)
PStrBufferMemory = VirtualAllocEx(PHandle, 0, MAX_LVMSTRING, MEM_COMMIT, PAGE_READWRITE)
PMyItemMemory = VirtualAllocEx(PHandle, 0, MAX_LVMSTRING, MEM_COMMIT, PAGE_READWRITE)
Ji = SendMessage(hWindow, LVM_GETITEMCOUNT, 0, 0) - 1
On Error GoTo err1
ReDim StrArr(Ji) For Ih = 0 To HCount
myItem(Ih).mask = LVIF_TEXT
myItem(Ih).iSubItem = Ih
myItem(Ih).pszText = PStrBufferMemory
myItem(Ih).cchTextMax = MAX_LVMSTRING
MyItemLength(Ih) = Len(myItem(Ih))
Next For J = 0 To Ji
ItemString = ""
For Ih = 0 To HCount
WriteProcessMemory(PHandle, PMyItemMemory, myItem(Ih), MyItemLength(Ih), 0)
If SendMessage(hWindow, LVM_GETITEMTEXT, J, PMyItemMemory) > 0 Then
ReadProcessMemory(PHandle, PStrBufferMemory, StrBuffer(0), MAX_LVMSTRING, 0)
TmpString = System.Text.Encoding.Default.GetString(StrBuffer)
MsgBox(TmpString)
TmpString = Mid(TmpString, InStr(TmpString, vbNullChar) - 1)
ItemString = ItemString & TmpString & Chr(9) ' Chr$(32)
End If
Next
If ItemString <> "" Then
StrArr(J) = Mid(ItemString, Len(ItemString) - 1)
MsgBox(StrArr(J))
End If
Next VirtualFreeEx(PHandle, PMyItemMemory, 0, MEM_RELEASE)
VirtualFreeEx(PHandle, PStrBufferMemory, 0, MEM_RELEASE)
CloseHandle(PHandle)
ItemString = ""
GetListViewTextArray = StrArr Exit Function
err1:
MsgBox("不是Listview类吧？", vbInformation)
End Function
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim hwnd0 As Long
hwnd0 = FindWindow(vbNullString, "刀具路径列表")
MsgBox(hwnd0)
Dim hwnd1 As Long
hwnd1 = FindWindowEx(hwnd0, 0&, "syslistview32", vbNullString)
MsgBox(hwnd1)
Call GetListViewTextArray(hwnd1) End Sub
End Class补充一点，我用的是win764位的操作系统，不知道会不会有影响。
但后面就会发生vshost.exe已停止工作，不知何故，我再粘贴一次代码
Public Class Form1
'Constants
Private Const LVFI_PARAM = 1
Private Const LVM_FIRST = &H1000
Private Const LVM_FINDITEM = LVM_FIRST + 13
Private Const LVM_GETITEMTEXT = LVM_FIRST + 45
Private Const LVM_SORTITEMS = LVM_FIRST + 48
Private Const LVM_GETHEADER = LVM_FIRST + 31
Private Const LVM_GETITEMCOUNT = (LVM_FIRST + 4)
Private Const HDM_FIRST = &H1200 '// Header messages
Private Const HDM_GETITEMCOUNT = (HDM_FIRST + 0)
Private Const HDM_ORDERTOINDEX = (HDM_FIRST + 15)
Private Const PROCESS_QUERY_INFORMATION = 1024
Private Const PROCESS_VM_OPERATION = &H8
Private Const PROCESS_VM_READ = &H10
Private Const PROCESS_VM_WRITE = &H20
Private Const PROCESS_ALL_ACCESS As Long = &H1F0FFF
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const MAX_LVMSTRING As Long = 255 '可根椐读取数据长度设置适当的数值
Private Const MEM_COMMIT = &H1000
Private Const MEM_RELEASE = &H8000
Private Const PAGE_READWRITE = &H4
Private Const LVIF_TEXT As Long = &H1
'API declarations
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, ByRef lpBuffer As Byte, ByVal nSize As Long, ByVal lpNumberOfBytesWritten As Long) As Long
Private Declare Function VirtualFreeEx Lib "kernel32" (ByVal hProcess As Long, ByVal lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, ByRef lpBuffer As LV_ITEMA, ByVal nSize As Long, ByVal lpNumberOfBytesWritten As Long) As Long
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
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, ByRef lpdwProcessId As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" (ByVal hWnd1 As Int32, ByVal hWnd2 As Int32, ByVal lpsz1 As String, ByVal lpsz2 As String) As Int32
Private 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
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As IntPtr, ByVal lpString As String, ByVal cch As Int32) As Int32
Public Structure LV_ITEMA
Dim mask As Long
Dim iItem As Long
Dim iSubItem As Long
Dim state As Long
Dim stateMask As Long
Dim pszText As Long
Dim cchTextMax As Long
Dim iImage As Long
Dim lParam As Long
Dim iIndent As Long
End Structure Public getm As String = ""
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Dim hwnd0 As Long
Dim hwnd1 As Long
Dim str As String
str = Space(255)
'查找窗口名称为《刀具路径列表》的窗口句柄号
hwnd0 = FindWindow(vbNullString, "刀具路径列表")
MsgBox("hwnd0=" & hwnd0) 'ok
'查找类名为syslistview32的窗口句柄号
hwnd1 = FindWindowEx(hwnd0, 0&, "syslistview32", vbNullString)
MsgBox("hwnd1=" & hwnd1) 'ok
Call GetListViewTextArray(hwnd1)
End Sub
Public Function GetListViewTextArray(ByVal hWindow As Long) As String() Dim myItem() As LV_ITEMA
Dim PHandle As Long
Dim ProcessId As Long
Dim PStrBufferMemory As Long
Dim PMyItemMemory As Long
Dim StrBuffer(MAX_LVMSTRING) As Byte
Dim TmpString As String
Dim Ih As Long, J As Long, HCount As Long
Dim StrArr() As String, ItemString As String
Dim Ji As Long, MyItemLength() As Long GetWindowThreadProcessId(hWindow, ProcessId)
MsgBox("ProcessId=" & ProcessId) 'ok
HCount = SendMessage(hWindow, LVM_GETHEADER, 0, 0) If HCount > 0 Then
HCount = SendMessage(HCount, HDM_GETITEMCOUNT, 0, 0) - 1
MsgBox("hcount=" & HCount) 'ok
Else
HCount = 0
End If
PHandle = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, 0, ProcessId) MsgBox("phandle=" & PHandle) 'ok
ReDim myItem(HCount)
ReDim MyItemLength(HCount)
PStrBufferMemory = VirtualAllocEx(PHandle, 0, MAX_LVMSTRING, MEM_COMMIT, PAGE_READWRITE)
PMyItemMemory = VirtualAllocEx(PHandle, 0, MAX_LVMSTRING, MEM_COMMIT, PAGE_READWRITE)
Ji = SendMessage(hWindow, LVM_GETITEMCOUNT, 0, 0) - 1 On Error GoTo err1
ReDim StrArr(Ji) For Ih = 0 To HCount
myItem(Ih).mask = LVIF_TEXT
myItem(Ih).iSubItem = Ih
myItem(Ih).pszText = PStrBufferMemory
myItem(Ih).cchTextMax = MAX_LVMSTRING
MyItemLength(Ih) = Len(myItem(Ih)) Next For J = 0 To Ji ItemString = ""
For Ih = 0 To HCount WriteProcessMemory(PHandle, PMyItemMemory, myItem(Ih), MyItemLength(Ih), 0) If SendMessage(hWindow, LVM_GETITEMTEXT, J, PMyItemMemory) > 0 Then '程序在这里循环，然后崩溃 ReadProcessMemory(PHandle, PStrBufferMemory, StrBuffer(0), MAX_LVMSTRING, 0) TmpString = System.Text.Encoding.Default.GetString(StrBuffer) TmpString = Mid(TmpString, InStr(TmpString, vbNullChar) - 1)
ItemString = ItemString & TmpString & Chr(9) ' Chr$(32)
End If
Next
If ItemString <> "" Then
StrArr(J) = Mid(ItemString, Len(ItemString) - 1) End If
Next VirtualFreeEx(PHandle, PMyItemMemory, 0, MEM_RELEASE)
VirtualFreeEx(PHandle, PStrBufferMemory, 0, MEM_RELEASE)
CloseHandle(PHandle)
ItemString = ""
GetListViewTextArray = StrArr Exit Function
err1:
MsgBox("不是Listview类吧？", vbInformation)
End Function
End Class声明一下，我的分不多，因为是新手，但我是真心想解决这个问题，如果可以的话，线下付费也可以，期待真高手，那些打酱油的，让我百度、Google的就请免开尊口了，谢谢。
lParam的声明改了下，下面的调用就不会出问题了
If SendMessage(hWindow, LVM_GETITEMTEXT, J, PMyItemMemory) > 0 Then '程序在这里循环，然后崩溃
我测试时FindWindowEx调用就出错了，就把所有的long型定义都改成了int32
TmpString = Mid(TmpString, InStr(TmpString, vbNullChar) - 1) 改成
TmpString = Mid(TmpString, InStr(TmpString,1, vbNullChar) - 1)
Private Declare Function WriteProcessMemory Lib "kernel32.dll" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32.dll" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function VirtualAllocEx Lib "kernel32.dll" (ByVal hProcess As Long, lpAddress As Any, ByRef dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualFreeEx Lib "kernel32.dll" (ByVal hProcess As Long, lpAddress As Any, ByRef dwSize As Long, ByVal dwFreeType As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As LongPrivate Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)Private Const PROCESS_VM_OPERATION As Long = (&H8)
Private Const PROCESS_VM_READ As Long = (&H10)
Private Const PROCESS_VM_WRITE As Long = (&H20)
Private Const MEM_RESERVE As Long = &H2000
Private Const MEM_COMMIT As Long = &H1000
Private Const MEM_DECOMMIT = &H4000
Private Const MEM_RELEASE As Long = &H8000
Private Const PAGE_READWRITE As Long = &H4Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HEPrivate Const EM_GETPASSWORDCHAR = &HD2
Private Const EM_SETPASSWORDCHAR = &HCCPrivate Const WM_USER = &H400Private Const LB_GETTEXT = &H189&
Private Const LB_GETTEXTLEN = &H18A
Private Const LB_GETCOUNT = &H18BPrivate Const CB_GETCOUNT = &H146
Private Const CB_GETLBTEXT = &H148
Private Const CB_GETLBTEXTLEN = &H149Private Const TB_BUTTONCOUNT As Long = (WM_USER + 24)
Private Const TB_HIDEBUTTON As Long = (WM_USER + 4)
Private Const TB_GETBUTTON As Long = (WM_USER + 23)
Private Const TB_ISBUTTONHIDDEN As Long = (WM_USER + 12)
Private Const TB_GETBUTTONTEXTA = (WM_USER + 45)
Private Const TB_GETBUTTONTEXTW = (WM_USER + 75)Private Const TCM_FIRST = &H1300
Private Const TCM_GETITEM = (TCM_FIRST + 5)
Private Const TCM_GETITEMCOUNT = &H1304
Private Const TCIF_TEXT = &H1Private Const LVM_FIRST = &H1000
Private Const LVM_GETITEMCOUNT = (LVM_FIRST + 4)
Private Const LVM_GETITEM = (LVM_FIRST + 5)
Private Const LVM_GETSTRINGWIDTH = (LVM_FIRST + 17)
Private Const LVM_GETCOLUMN = (LVM_FIRST + 25)
Private Const LVM_GETITEMTEXT = (LVM_FIRST + 45)
Private Const LVM_GETHEADER = LVM_FIRST + 31
Private Const LVM_GETVIEW = (LVM_FIRST + 143)
Private Const LVM_SETVIEW = (LVM_FIRST + 142)
Private Const LVM_GETIMAGELIST = (LVM_FIRST + 2)Private Const HDM_FIRST = &H1200 '// Header messages
Private Const HDM_GETITEMCOUNT = (HDM_FIRST + 0)
Private Const HDM_ORDERTOINDEX = (HDM_FIRST + 15)
Private Const HDM_GETITEMA = (HDM_FIRST + 3)
Private Const HDM_GETITEMW = (HDM_FIRST + 11)
Private Const HDI_TEXT = &H2Private Const WC_HEADER = "SysHeader32"
Private Const LVIF_TEXT As Long = &H1
Private Const MAX_LVMSTRING As Long = 4096 '可根椐读取数据长度设置适当的数值Private Const TV_FIRST = &H1100&
Private Const TVIF_TEXT = 1
Private Const TVIF_HANDLE = &H10
Private Const TVM_GETCOUNT = TV_FIRST + 5
Private Const TVM_SELECTITEM = TV_FIRST + 11
Private Const TVM_GETITEM = TV_FIRST + 12
Private Const TVM_GETNEXTITEM = TV_FIRST + 10
Private Const TVGN_ROOT = 0
Private Const TVGN_NEXT = 1
Private Const TVGN_CHILD = 4
Private Const TVGN_CARET = 9Private Const GW_CHILD = 5
Private Const GW_HWNDNEXT = 2Private Const MAX_TEXT_LENGTH = 255& '最大文本长度Private Type TCITEM
mask As Long
dwState As Long
dwStateMask As Long
pszText As Long
cchTextMax As Integer
iImage As Integer
lParam As Long
End TypePrivate Type LVITEM
mask As Long
iItem As Long
iSubItem As Long
state As Long
stateMask As Long
pszText As Long
cchTextMax As Long
iImage As Long
lParam As Long
iIndent As Long
End TypePrivate Type HDITEM
mask As Long
cxy As Integer
pszText As Long
hbm As Long
cchTextMax As Integer
fmt As Integer
lParam As Long
iImage As Integer
iOrder As Integer
End TypePrivate Type TVITEM
mask As Long
hItem As Long
state As Long
stateMask As Long
pszText As Long
cchTextMax As Long
iImage As Long
iSelectedImage As Long
cChildren As Long
lParam As Long
End TypePrivate mStackFlag As cls_Stack
Private mStackNode As cls_Stack
Private mhProcess As Long
Private mlpTextRemote As Long
Private mlpTreeItemRemote As Long
Private mnMaxLen As Long
Private mszBuf() As Byte
'判断是否是Listbox窗口
Public Function IsListBox(hWin As Long) As Boolean
IsListBox = SendMessage(hWin, LB_GETCOUNT, 0, ByVal 0&)
End Function'判断是否是ComboBox窗口
Public Function IsComboBox(hWin As Long) As Boolean
IsComboBox = SendMessage(hWin, CB_GETCOUNT, 0, ByVal 0&)
End Function'是否工具栏
Public Function IsToolBar(hWin As Long) As Boolean
IsToolBar = (WA.GetWinClassName(hWin) = "ToolbarWindow32")
End Function'是否选项卡
Public Function IsTabControl(hWin As Long) As Boolean
IsTabControl = SendMessage(hWin, TCM_GETITEMCOUNT, 0, ByVal 0&)
'IsTabControl = (GetWinClassName(hWin) = "SysTabControl32")
End Function'是否ListView
Public Function IsListView(hWin As Long) As Boolean
'IsListView = (GetWinClassName(hWin) = "SysListView32")
IsListView = SendMessage(hWin, LVM_GETITEMCOUNT, 0, ByVal 0&)
End Function'是否LvwHeader
Public Function IsLvwHeader(hWin As Long) As Boolean
'IsLvwHeader = (GetWinClassName(hWin) = "SysHeader32")
IsLvwHeader = SendMessage(hWin, HDM_GETITEMCOUNT, 0, ByVal 0&)
End Function'查看方式
Public Function GetLvwViewType(hWin As Long) As Long
GetLvwViewType = SendMessage(hWin, LVM_GETVIEW, 0, ByVal 0&)
End Function'查看方式
Public Function SetLvwViewType(hWin As Long, nView As Long) As Long
SetLvwViewType = SendMessage(hWin, LVM_SETVIEW, nView, ByVal 0&)
End Function'是否ListView
Public Function IsTreeView(hWin As Long) As Boolean
'IsListView = (GetWinClassName(hWin) = "SysListView32")
IsTreeView = SendMessage(hWin, TVM_GETCOUNT, 0, ByVal 0&)
End Function
'****************************************************************************'得到窗口标题
Public Function GetWinText(ByVal hWin As Long, Optional ByVal MaxLength As Long = -1, Optional PwdChar As Long) As String
On Error Resume Next
If hWin = g_hDesktop Then
GetWinText = "Desktop"
Exit Function
End If
Dim lRet As Long
Dim dwLength As Long
Dim nChar As Long
Dim strText As String
Dim IsPwd As Boolean
dwLength = GetWindowTextLength(hWin)
'Debug.Print "dwLength=", dwLength
'Debug.Print hWin
If dwLength > 0 Then
If MaxLength <> -1 Then If dwLength > MaxLength Then dwLength = MaxLength
strText = String(dwLength, vbNullChar)
lRet = GetWindowText(hWin, strText, dwLength + 1)
Else
If IsWinSuspend(hWin) = False Then
dwLength = SendMessage(hWin, WM_GETTEXTLENGTH, 0, ByVal 0&)
If MaxLength <> -1 Then If dwLength > MaxLength Then dwLength = MaxLength
'Debug.Print "Text长度=", dwLength
If IsPasswordEdit(hWin) Then
nChar = SendMessage(hWin, EM_GETPASSWORDCHAR, 0, ByVal 0&)
PwdChar = nChar
IsPwd = True
End If
'Debug.Print "密码字符=", nChar
If dwLength > 0 Then
strText = String(dwLength, vbNullChar)
If IsPwd Then
PostMessage hWin, EM_SETPASSWORDCHAR, 0, 0 '设置密码
'DoEvents
Sleep 10
lRet = SendMessage(hWin, WM_GETTEXT, dwLength + 1, ByVal strText)
PostMessage hWin, EM_SETPASSWORDCHAR, nChar, 0
Else
lRet = SendMessage(hWin, WM_GETTEXT, dwLength + 1, ByVal strText)
End If
End If
End If
End If
GetWinText = strText
End Function'得到Listbox内容
Public Function GetLBText(ByVal hWin As Long) As String
Dim iCount As Long
Dim i As Long
Dim dwLength As Long
Dim lRet As Long
Dim ByteArray() As Byte
Dim strText As String
iCount = SendMessage(hWin, LB_GETCOUNT, 0, ByVal 0&)
'Debug.Print iCount
For i = 0 To iCount - 1
dwLength = SendMessage(hWin, LB_GETTEXTLEN, i, ByVal 0&)
'Debug.Print dwLength
If dwLength > 0 Then
ReDim ByteArray(0 To dwLength - 1)
lRet = SendMessage(hWin, LB_GETTEXT, i, ByteArray(0))
Else
Erase ByteArray
End If
strText = strText & StrConv(ByteArray, vbUnicode) & vbCrLf
Next i
Erase ByteArray
GetLBText = strText
End Function'得到ComboBox内容
Public Function GetCBText(ByVal hWin As Long) As String
Dim iCount As Long
Dim i As Long
Dim dwLength As Long
Dim lRet As Long
Dim ByteArray() As Byte
Dim strText As String
iCount = SendMessage(hWin, CB_GETCOUNT, 0, ByVal 0&)
For i = 0 To iCount - 1
dwLength = SendMessage(hWin, CB_GETLBTEXTLEN, i, ByVal 0&)
If dwLength > 0 Then
ReDim ByteArray(0 To dwLength - 1)
lRet = SendMessage(hWin, CB_GETLBTEXT, i, ByteArray(0))
Else
Erase ByteArray
End If
strText = strText & StrConv(ByteArray, vbUnicode) & vbCrLf
Next i
Erase ByteArray
GetCBText = strText
End Function'Toolbar内容
Public Function GetToolBarText(hWin As Long) As String
On Error Resume Next
Dim lngPID As Long
Dim hProcess As Long
Dim lngAddress As Long
Dim lngCount As Long
Dim lngButtons As Long
Dim lRet As Long
Dim lngHwndAdr As Long
Dim lngButtonID As Long
Dim lngHwnd As Long
Dim i As Long
Dim strText As String
Dim strInfo As String
Dim ByteArray() As Byte
lngPID = WA.GetWinPId(hWin)
hProcess = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, 0, lngPID)
If hProcess <> 0 Then
lngAddress = VirtualAllocEx(hProcess, ByVal 0&, ByVal 4096&, MEM_COMMIT, PAGE_READWRITE)
If lngAddress Then
lngButtons = SendMessage(hWin, TB_BUTTONCOUNT, 0, ByVal 0&)
'Debug.Print lngButtons
For i = 0 To lngButtons - 1
lRet = SendMessage(hWin, TB_GETBUTTON, ByVal i, ByVal lngAddress)
'Debug.Print "lngAddress=", lngAddress
'lRet = ReadProcessMemory(hProcess, ByVal lngAddress + 12, ByVal VarPtr(lngHwndAdr), ByVal 4, ByVal 0&)
'ret = ReadProcessMemory(hProcess, ByVal lngHwndAdr, ByVal VarPtr(lngHwnd), ByVal 4, ByVal 0&)
lRet = ReadProcessMemory(hProcess, ByVal lngAddress + 4, ByVal VarPtr(lngButtonID), ByVal 4, ByVal 0&)
'Debug.Print "lngButtonID=", lngButtonID
lRet = SendMessage(hWin, TB_ISBUTTONHIDDEN, lngButtonID, ByVal 0&)
'Debug.Print lRet
If lRet = 0 Then
lRet = SendMessage(hWin, TB_GETBUTTONTEXTA, lngButtonID, ByVal lngAddress)
ReDim ByteArray(0 To 127)
lRet = ReadProcessMemory(hProcess, ByVal lngAddress, ByVal VarPtr(ByteArray(0)), ByVal 128&, ByVal 0&)
strInfo = TrimNull(StrConv(ByteArray, vbUnicode))
'strInfo = Replace(strInfo, vbCrLf, " ")
strText = strText & strInfo & vbCrLf
End If
Next i
VirtualFreeEx hProcess, ByVal lngAddress, ByVal 4096&, MEM_RELEASE
End If
CloseHandle hProcess
End If
'Debug.Print "strText=", strText
GetToolBarText = strText
End Function'TabControl内容
Public Function GetTabControlText(hWin As Long) As String
On Error Resume Next
Dim i As Long
Dim lRet As Long
Dim pszText As Long
Dim tItem As TCITEM
Dim lpAddress As Long
Dim lpAddressItem As Long
Dim hProcess As Long
Dim dwProcessId As Long
Dim dwItemCount As Long
Dim strText As String
Dim ByteArray() As Byte
dwProcessId = WA.GetWinPId(hWin)
hProcess = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, 0&, dwProcessId)
If hProcess <> 0 Then
lpAddress = VirtualAllocEx(hProcess, ByVal 0&, 256&, MEM_COMMIT, PAGE_READWRITE)
lpAddressItem = VirtualAllocEx(hProcess, ByVal 0&, Len(tItem), MEM_COMMIT, PAGE_READWRITE)
If lpAddressItem <> 0 Then
tItem.mask = TCIF_TEXT
tItem.pszText = lpAddress
tItem.cchTextMax = 255
lRet = WriteProcessMemory(hProcess, ByVal lpAddressItem, tItem, Len(tItem), ByVal 0&)
'Debug.Print "lRet=", lRet
dwItemCount = SendMessage(hWin, TCM_GETITEMCOUNT, 0, ByVal 0&)
'Debug.Print "dwItemCount=", dwItemCount
For i = 0 To dwItemCount - 1
lRet = SendMessage(hWin, TCM_GETITEM, i, ByVal lpAddressItem)
'Debug.Print "lpAddress=", lpAddress
lRet = ReadProcessMemory(hProcess, ByVal lpAddressItem, tItem, Len(tItem), ByVal 0&)
'Debug.Print tItem.pszText
ReDim ByteArray(0 To 255)
lRet = ReadProcessMemory(hProcess, ByVal lpAddress, ByteArray(0), 256&, ByVal 0&)
strText = strText & TrimNull(StrConv(ByteArray, vbUnicode)) & vbCrLf
Next i
lRet = VirtualFreeEx(hProcess, ByVal lpAddressItem, ByVal 0&, MEM_RELEASE)
lRet = VirtualFreeEx(hProcess, ByVal lpAddress, ByVal 0&, MEM_RELEASE)
GetTabControlText = strText
End If
CloseHandle hProcess
End If
End Function
Public Function GetListViewText(ByVal lngHwnd As Long) As String
On Error Resume Next
Dim lngHeaderHwnd As Long
Dim ProcessId As Long
Dim lngRows As Long
Dim lngCols As Long
Dim lngRow As Long
Dim lngCol As Long
Dim strItem As String
Dim nView As Long
Dim Result As Long
Dim myItem As LVITEM
Dim pHandle As Long
Dim pStrBufferMemory As Long
Dim pMyItemMemory As Long
Dim strBuffer() As Byte
Dim tmpString As String
ProcessId = WA.GetWinPId(lngHwnd) '获取与指定窗口关联在一起的一个进程和线程标识符
'*****************************************************************************************************
pHandle = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, ProcessId)
If pHandle = 0 Then Exit Function
'******************************
'为动态数组变量重新分配存储空间
'******************************
ReDim strBuffer(MAX_LVMSTRING)
lngHeaderHwnd = SendMessage(lngHwnd, LVM_GETHEADER, 0, ByVal 0&) '获取ListView表头句柄
'Debug.Print "lngHwnd=", lngHwnd
'Debug.Print "lngHeaderHwnd=", lngHeaderHwnd
lngRows = SendMessage(lngHwnd, LVM_GETITEMCOUNT, 0, ByVal 0&) '获取ListView项目数
'*****************************************************************************************************
'VirtualAllocEx(目标进程的句柄,0,内存区域的大小,分配类型,新分配内存的存取保护类型)返回所分配页面的基址
'*****************************************************************************************************
pStrBufferMemory = VirtualAllocEx(pHandle, ByVal 0&, ByVal MAX_LVMSTRING, MEM_COMMIT, PAGE_READWRITE)
'*************************************************
'初始化LV_ITEM 结构
'MyItem.iSubItem 列的索引号
'myItem.pszText 数据内容(此处是一个分配的内存地址)
'*************************************************
myItem.mask = LVIF_TEXT
myItem.pszText = pStrBufferMemory
myItem.cchTextMax = MAX_LVMSTRING
'***********************************************************
'把这个结构写入远程进程process's 存储量
'WriteProcessMemory(目标进程的句柄,地址,写入的数据,字节数,0)
'***********************************************************
pMyItemMemory = VirtualAllocEx(pHandle, ByVal 0&, ByVal Len(myItem), MEM_COMMIT, PAGE_READWRITE)
'Debug.Print pMyItemMemory
'Debug.Print "nView=", nView
strItem = GetLvwHeaderText(lngHeaderHwnd) & vbCrLf '列名
lngCols = SendMessage(lngHeaderHwnd, HDM_GETITEMCOUNT, 0, 0) '获取ListView表头项目数
'Debug.Print "lngCols=", lngCols
'Debug.Print lngRows, lngCols
If lngCols = 0 Then lngCols = 1
For lngRow = 0 To lngRows - 1
For lngCol = 0 To lngCols - 1
myItem.iSubItem = lngCol
Result = WriteProcessMemory(pHandle, ByVal pMyItemMemory, myItem, Len(myItem), ByVal 0&)
Result = SendMessage(lngHwnd, LVM_GETITEMTEXT, lngRow, ByVal pMyItemMemory)
'Debug.Print pMyItemMemory
'Debug.Print pStrBufferMemory
Result = ReadProcessMemory(pHandle, ByVal pStrBufferMemory, strBuffer(0), MAX_LVMSTRING, ByVal 0&)
'Result = ReadProcessMemory(pHandle, pMyItemMemory, myItem, Len(myItem), 0)
tmpString = TrimNull(StrConv(strBuffer, vbUnicode))
'Debug.Print "tmpString=", tmpString
If lstrlen(tmpString) < 20 Then
strItem = strItem & tmpString & Space(20 - lstrlen(tmpString))
Else
strItem = strItem & tmpString & " "
End If
Next
strItem = Trim(strItem) & vbCrLf
Next
'****************************
'释放分配的内存和关闭进程句柄
'****************************
Result = VirtualFreeEx(pHandle, ByVal pStrBufferMemory, ByVal 0&, MEM_RELEASE)
Result = VirtualFreeEx(pHandle, ByVal pMyItemMemory, ByVal 0&, MEM_RELEASE)
Result = CloseHandle(pHandle)
Erase strBuffer
GetListViewText = strItem
End Function
1、 Private mStackFlag As cls_Stack，类型不能识别
2、ProcessId = WA.GetWinPId(lngHwnd)，WA没有声明
3、 strItem = GetLvwHeaderText(lngHeaderHwnd) & vbCrLf，GetLvwHeaderText没有声明还是希望有高手在我的代码的基础上解决问题，一是程序执行到If SendMessage(hWindow, LVM_GETITEMTEXT, J, PMyItemMemory) > 0 Then 时值为零，二是经常性vchost。exe停止工作
Public Function GetLvwHeaderText(hWin As Long) As String
Dim i As Long
Dim dwProcessId As Long
Dim strItem As String
Dim strText As String
Dim myItem As HDITEM
Dim hProcess As Long
Dim lpAddress As Long
Dim lpTextAddress As Long
Dim strBuffer() As Byte
Dim lRet As Long
Dim dwItemCount As Long
dwProcessId = WA.GetWinPId(hWin) '获取与指定窗口关联在一起的一个进程和线程标识符
'*****************************************************************************************************
hProcess = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, dwProcessId)
If hProcess = 0 Then Exit Function
lpTextAddress = VirtualAllocEx(hProcess, ByVal 0&, ByVal 256&, MEM_COMMIT, PAGE_READWRITE)
lpAddress = VirtualAllocEx(hProcess, ByVal 0&, ByVal Len(myItem), MEM_COMMIT, PAGE_READWRITE)
If lpAddress = 0 Or lpTextAddress = 0 Then CloseHandle hProcess: Exit Function
myItem.cchTextMax = 255
myItem.mask = HDI_TEXT
myItem.pszText = lpTextAddress
dwItemCount = SendMessage(hWin, HDM_GETITEMCOUNT, 0, ByVal 0&)
ReDim strBuffer(0 To 255)
For i = 0 To dwItemCount - 1
lRet = WriteProcessMemory(hProcess, ByVal lpAddress, myItem, Len(myItem), ByVal 0&)
lRet = SendMessage(hWin, HDM_GETITEMA, i, ByVal lpAddress)
'Debug.Print "lpAddress=", lpAddress
lRet = ReadProcessMemory(hProcess, ByVal lpTextAddress, strBuffer(0), 256, ByVal 0&)
'Debug.Print lpTextAddress
strItem = TrimNull(StrConv(strBuffer, vbUnicode))
If lstrlen(strItem) < 20 Then
strText = strText & strItem & Space(20 - lstrlen(strItem))
Else
strText = strText & strItem & " "
End If
Next i
lRet = VirtualFreeEx(hProcess, ByVal lpAddress, ByVal 0&, MEM_RELEASE)
lRet = VirtualFreeEx(hProcess, ByVal lpTextAddress, ByVal 0&, MEM_RELEASE)
lRet = CloseHandle(hProcess)
Erase strBuffer
GetLvwHeaderText = Trim(strText)
End Function'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'TreeView
Public Function GetTreeViewText(mlhWnd As Long) As String
On Error Resume Next
Dim i As Long, s As String
Dim dwProcessId As Long
Dim dwBytesRead As Long, dwBytesWrite As Long
Dim bSuccess As Long
'Dim lpTreeItemRemote As Long, lpTextRemote As Long
Dim strText As String
'Dim nMaxLen As Long
mnMaxLen = 1023
ReDim mszBuf(mnMaxLen)
Dim lvItemLocal As TVITEM
dwProcessId = WA.GetWinPId(mlhWnd)
mhProcess = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, 0&, dwProcessId)
If mhProcess = 0 Then Exit Function
'allocate memory
mlpTextRemote = VirtualAllocEx(ByVal mhProcess, ByVal 0&, mnMaxLen + 1, MEM_COMMIT, PAGE_READWRITE)
mlpTreeItemRemote = VirtualAllocEx(ByVal mhProcess, ByVal 0&, Len(lvItemLocal), MEM_COMMIT, PAGE_READWRITE)
'get content and write to file
Dim hRoot As Long
Set mStackNode = New cls_Stack
Set mStackFlag = New cls_Stack
hRoot = SendMessage(mlhWnd, TVM_GETNEXTITEM, TVGN_ROOT, ByVal 0&)
'hRoot = SendMessage(mlhWnd, TVM_GETNEXTITEM, TVGN_CARET, ByVal 0&)
Do While hRoot <> 0
strText = strText & WalkNode1(mlhWnd, hRoot)
hRoot = SendMessage(mlhWnd, TVM_GETNEXTITEM, TVGN_NEXT, ByVal hRoot)
Loop
Set mStackNode = Nothing
Set mStackFlag = Nothing
Call VirtualFreeEx(mhProcess, ByVal mlpTreeItemRemote, 0, MEM_DECOMMIT)
Call VirtualFreeEx(mhProcess, ByVal mlpTextRemote, 0, MEM_DECOMMIT)
CloseHandle mhProcess
GetTreeViewText = strText
End FunctionPrivate Function WalkNode1(hWin As Long, hNode As Long) As String
On Error Resume Next
Dim lLevel As Long
Dim fChild As Boolean, fEnd As Boolean
Dim hTmpNode As Long
Dim hChild As Long, hSibling As Long
Dim sText As String, i As Long
lLevel = 0
hTmpNode = hNode
sText = ""
bgChild:
fChild = False
'对每个节点干点什么吧
'Debug.Print GetNodeText(hWin, hTmpNode)
'Debug.Print hWin, hTmpNode
sText = sText & Space(lLevel * 4) & GetNodeText(hWin, hTmpNode) & vbCrLf
i = i + 1
hChild = SendMessage(hWin, TVM_GETNEXTITEM, TVGN_CHILD, ByVal hTmpNode)
If hChild <> 0 Then
fChild = True
mStackNode.Push hTmpNode
mStackFlag.Push fChild
hTmpNode = hChild
lLevel = lLevel + 1
GoTo bgChild
End If
bgSibling:
hSibling = SendMessage(hWin, TVM_GETNEXTITEM, TVGN_NEXT, ByVal hTmpNode)
If hSibling <> 0 Then
If lLevel = 0 And Not fEnd Then
mStackNode.Push hTmpNode
mStackFlag.Push fChild
End If
hTmpNode = hSibling
GoTo bgChild
Else
If lLevel = 0 Then
fEnd = (lLevel = 0)
GoTo ed
End If
End If
If mStackNode.Pop(hTmpNode) And mStackFlag.Pop(fChild) Then
If Not fChild Then
GoTo bgChild
Else
If lLevel > 0 Then
lLevel = lLevel - 1
End If
GoTo bgSibling
End If
End If
ed:
WalkNode1 = sText
End FunctionPrivate Function GetNodeText(hWin As Long, hNode As Long) As String
On Error Resume Next
'Dim mHwnd As Long
Dim i As Long, s As String
Dim dwBytesRead As Long, dwBytesWrite As Long
Dim bSuccess As Long
Dim lvItemLocal As TVITEM
Dim bWriteOK As Long
ReDim mszBuf(mnMaxLen)
'Debug.Print "hNode=", hNode
'Debug.Print "mlpTextRemote=", mlpTextRemote
bWriteOK = WriteProcessMemory(ByVal mhProcess, ByVal mlpTextRemote, mszBuf(0), mnMaxLen + 1, dwBytesWrite)
'write structure
dwBytesWrite = 0
lvItemLocal.hItem = hNode
lvItemLocal.mask = TVIF_TEXT + TVIF_HANDLE
lvItemLocal.cchTextMax = mnMaxLen
lvItemLocal.pszText = mlpTextRemote
bWriteOK = WriteProcessMemory(ByVal mhProcess, ByVal mlpTreeItemRemote, ByVal VarPtr(lvItemLocal), Len(lvItemLocal), dwBytesWrite)
'get item
i = SendMessage(hWin, TVM_GETITEM, 0&, ByVal mlpTreeItemRemote)
'read result
'Debug.Print mlpTextRemote
bSuccess = ReadProcessMemory(ByVal mhProcess, ByVal mlpTextRemote, mszBuf(0), mnMaxLen + 1, dwBytesRead)
GetNodeText = TrimNull(StrConv(mszBuf, vbUnicode))
End Function'cls_StackOption ExplicitPrivate m_colStack As CollectionPublic Function Push(v As Variant) As Boolean
On Error Resume Next
m_colStack.Add v
Push = (Err.Number = 0)
End FunctionPublic Function Pop(v As Variant) As Boolean
On Error Resume Next
With m_colStack
v = .Item(.Count)
.Remove .Count
Pop = (Err.Number = 0) And (.Count > 0)
End With
End FunctionPrivate Sub Class_Initialize()
Set m_colStack = New Collection
End SubPrivate Sub Class_Terminate()
Set m_colStack = Nothing
End Sub