Option Explicit On
Imports System, System.Runtime.InteropServices
Module Module1
'----------------------
'共通変数
'----------------------
Public MyMode As String
'----------------------
' ウィンドウ関数
'----------------------
' 指定位置にあるウィンドウのハンドルを取得
Public Declare Function WindowFromPoint Lib "user32.dll" (ByVal xPoint As Integer, ByVal yPoint As Integer) As Integer
'ウィンドウのクラス名を取得
Private Declare Function GetClassName Lib "user32.dll" Alias "GetClassNameA"(ByVal hWnd As Integer, ByVal lpClassName As String, ByVal nMaxCount As Integer) As Integer
'----------------------
' ウィンドウメッセージ
'----------------------
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
ByVal hWnd As Integer, _
ByVal wMsg As Integer, _
ByVal wParam As Integer, _
ByVal lParam As Integer) As Integer
'------------------------------------
' システム関数
'------------------------------------
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Integer, ByVal bInheritHandle As Integer, ByVal dwProcessId As Integer) As Integer
Private Const PROCESS_VM_OPERATION As Integer = &H8
Private Const PROCESS_VM_READ As Integer = &H10
Private Const PROCESS_VM_WRITE As Integer = &H20
Private Const MEM_RESERVE As Integer = &H2000
Private Const MEM_DECOMMIT As Integer = &H4000
Private Const MEM_RELEASE As Integer = &H8000
Private Const MEM_COMMIT As Integer = &H1000
Private Const PAGE_READWRITE As Integer = &H4
Private Declare Function VirtualAllocEx Lib "kernel32" (ByVal hProcess As Integer, ByVal lpAddress As Integer, ByVal dwSize As Integer, ByVal flAllocationType As Integer, ByVal flProtect As Integer) As Integer
Private Declare Function VirtualFreeEx Lib "kernel32" (ByVal hProcess As Integer, ByVal lpAddress As Integer, ByVal dwSize As Integer, ByVal dwFreeType As Integer) As Integer
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Integer) As Integer
'ウィンドウのプロセスIDとスレッドIDを取得
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Integer, ByRef lpdwProcessId As Integer) As Integer
'メモリへの書込み
Private Declare Function WriteProcessMemory Lib "kernel32" ( _
ByVal hProcess As IntPtr, _
ByVal lpBaseAddress As IntPtr, _
ByRef lpBuffer As LV_ITEM, _
ByVal nSize As Integer, _
ByRef lpNumberOfBytesWritten As IntPtr) As Integer
'メモリからの読込み
Private Declare Function ReadProcessMemory Lib "kernel32" ( _
ByVal hProcess As Integer, _
ByVal lpBaseAddress As Integer, _
ByRef lpBuffer As Byte, _
ByVal nSize As Integer, ByVal lpNumberOfBytesWritten As Integer) As Integer
'------------------------------------
'リストビュー定義
'------------------------------------
Public Const WC_LISTVIEW As String = "SysListView32"
Private Const LVM_FIRST As Integer = &H1000
Private Const LVM_GETTITEMCOUNT As Integer = (LVM_FIRST + 4) 'アイテムの数を取得
Private Const LVM_GETITEMW As Integer = &H1005 'アイテムの属性を取得
Private Const LVM_GETHEADER As Integer = &H101F 'ヘッダコントロールを取得
Private Const LVM_GETITEMTEXTA As Decimal = (LVM_FIRST + 45)
Private Const HDM_GETITEMCOUNT As Integer = &H1200
Private Const LVIF_TEXT As Integer = &H1
<StructLayout(LayoutKind.Sequential, Pack:=4)> Private Structure LV_ITEM
Dim mask As Integer
Dim iItem As Integer
Dim iSubItem As Integer
Dim state As Integer
Dim stateMask As Integer
Dim lpszText As IntPtr 'LPCSTR
Dim cchTextMax As Integer
Dim iImage As Integer
Dim lParam As Integer
Dim iIndent As Integer
End Structure
'------------------------------------
' キーボード
'------------------------------------
Public Const VK_ESCAPE As Integer = &H1B 'Escape
Public Declare Function GetAsyncKeyState Lib "user32.dll" (ByVal vKey As Integer) As Integer
'-------------------------------
' リストビューボックス文字列取得
'-------------------------------
Public Function MyGetListViewItem(ByRef hWnd As Integer) As String
Dim i, p, k As Integer
Dim Dt As String
Dim pid, tid As Integer 'プロセスID,スレッドID
Dim hProc As Integer 'プロセスハンドル
Dim intRc As Integer
Dim hWndHeader As Integer 'リストビューヘッダのハンドル
Dim nCountRow, nCountCol As Integer '行列数
'----------------------
' 共有メモリアドレス
'----------------------
Dim lpShared1 As intptr 'パラメータエリア
Dim lpShared2 As Integer 'データエリア
Dim lWritten As Integer = 0 '書込済バイト数
'----------------------
' リストビューパラメータ
'----------------------
Dim li As New LV_ITEM 'パラメータ
Const TEXT_SIZE As Integer = 80
Dim strBuffer(TEXT_SIZE) As Byte
MyGetListViewItem = ""
'リストビューの項目（行）数取得
nCountRow = SendMessage(hWnd, LVM_GETTITEMCOUNT, 0, 0)
If nCountRow = 0 Then Exit Function
'リストビューの列数取得
hWndHeader = SendMessage(hWnd, LVM_GETHEADER, 0, 0)
nCountCol = SendMessage(hWndHeader, HDM_GETITEMCOUNT, 0, 0)
If (nCountCol = 0) Then Exit Function
'プロセスIDとスレッドID取得
tid = GetWindowThreadProcessId(hWnd, pid)
'共有メモリ確保
lpShared1 = GetSharedMem(pid, Marshal.SizeOf(li), hProc)
lpShared2 = GetSharedMem(pid, TEXT_SIZE, hProc)
Dt = ""
For i = 0 To nCountRow - 1 '行数分ループ
For k = 0 To nCountCol - 1 '列数分ループ
'メッセージパラメータセット
li.iItem = i '行インデックス
li.iSubItem = k '列インデックス
li.mask = LVIF_TEXT '文字情報取得
li.lpszText = lpShared2 '文字格納アドレス
li.cchTextMax = TEXT_SIZE '文字数最大値
intRc = WriteProcessMemory(hProc, lpShared1, li, Marshal.SizeOf(li), lWritten) '書込み
intRc = SendMessage(hWnd, LVM_GETITEMW, 0, lpShared1) '取得依頼
intRc = ReadProcessMemory(hProc, lpShared2, strBuffer(0), TEXT_SIZE, 0) '読込
Dim tmp As String
tmp = System.Text.Encoding.Default.GetString(strBuffer)
p = InStr(tmp, vbNullChar) - 1 '文字数
If p > 0 Then Dt = Dt & Left(tmp, p)
Dt &= vbTab 'タブ追加
Next k
Dt &= vbCrLf '改行追加
Next i
'共有メモリ開放
FreeSharedMem(hProc, lpShared1, Marshal.SizeOf(li))
FreeSharedMem(hProc, lpShared2, TEXT_SIZE)
MyGetListViewItem = Dt
End Function
'==========================================
' 共有メモリ確保と開放
'==========================================
Public Function GetSharedMem(ByVal pid As Integer, ByVal memSize As Integer, ByRef hProc As Integer) As Integer
hProc = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, pid)
GetSharedMem = VirtualAllocEx(hProc, 0, memSize, MEM_RESERVE Or MEM_COMMIT, PAGE_READWRITE)
End Function
Public Sub FreeSharedMem(ByVal hProc As Integer, ByVal MemAddress As Integer, ByVal memSize As Integer)
Call VirtualFreeEx(hProc, MemAddress, memSize, MEM_RELEASE)
CloseHandle(hProc)
End Sub
'==========================================
' ウィンドウ処理
'==========================================
Public Function MyGetClassName(ByRef hWnd As Integer) As String
'
' ウィンドウハンドルからクラス名を取得
'
Dim lngRc As Integer
Dim strWindowClassNameBuffer As New VB6.FixedLengthString(128)
' クラス名をバッファへ取得
lngRc = GetClassName(hWnd, strWindowClassNameBuffer.Value, Len(strWindowClassNameBuffer.Value))
' クラス名を取得（Null文字まで）
MyGetClassName = Left(strWindowClassNameBuffer.Value, InStr(strWindowClassNameBuffer.Value, vbNullChar) - 1)
End Function
End Module