|
Imports System.Runtime.InteropServices
Imports System
Imports System.IO
Imports System.Text
Imports System.Math
Public Class Form1
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function EnableWindow Lib "user32" (ByVal hwnd As Long, ByVal fEnable As Long) As Long
Public Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal ByValhWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Public Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Integer) As Integer
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Integer, ByVal wCmd As Integer) As Integer
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Integer, ByVal lpString As String, ByVal cch As Integer) As Integer
Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpsz1 As String, ByVal lpsz2 As String) As Integer
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Integer, ByVal lpClassName As String, ByVal nMaxCount As Integer) As Integer
Declare Auto Function SendMessage Lib "user32.dll" (ByVal hWnd As IntPtr, ByVal msg As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr
Private Const GW_CHILD = 5
Private Const GW_HWNDNEXT = 2
Private Const WM_GETTEXT As Integer = &HD
Private Const LB_GETCOUNT = &H18B
Private Const WM_close = 16
Private Const EM_GETLINECOUNT As Integer = (&H1000 + 4)
Public Function GetHandle() As Long
Dim hwnd As Long
Dim hChild As Long
Dim Handle As IntPtr = Marshal.AllocHGlobal(104)
hwnd = FindWindow(vbNullString, "刀具路径列表")
hChild = FindWindowEx(hwnd, 0, "SysListView32", vbNullString)
SendMessage(hChild, WM_GETTEXT, 50, Handle)
Dim Text As String = Marshal.PtrToStringUni(Handle) '获取内容，只有一个list1
MsgBox(Text)
Dim intCount As Integer = SendMessage(hChild, EM_GETLINECOUNT, 0, 0) '获取行数，成功
MsgBox(intCount)
Dim RetVal As Long = SendMessage(hwnd, WM_close, 0&, 0&) '关闭窗口，成功
End Function
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
GetHandle()
End Sub
End Class
上面的程序已经可以获取到窗口内容的行数，但无法获取到里面具体的内容，请高手帮忙看看哪里错了
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
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)
|
