VB6.0用掲示板の過去のログ(No.2)−VBレスキュー(花ちゃん)
[記事リスト] [新規投稿] [新着記事] [ワード検索] [管理用]

投稿日: 2005/03/15(Tue) 20:04
投稿者pops
Eメール
URL
タイトルRe: リスト項目の所得

> hhttp://techtips.belution.com/ja/vc/0001/ などを参考に共有メモリを使用する方法を
> 確認していますが、VC を VB に置き換える作業もままならず全く先に進めなくなりました。

試しに、VB6に移植してみました。
Windows NT/2000 用は未確認なので、間違いがあるかもしれません。

あと、類似のVBサンプルが下記にありますよ。
Locating Desktop Icon Positions using Memory Mapped Files
hhttp://www.codeguru.com/vb/controls/vb_shell/article.php/c3055/
hhttp://www.developer.com/net/vb/article.php/634581

'------------------------------------------------------
' Windows 95/98 用の CreateFileMapping() と MapViewOfFile() を使用した、
' デスクトップのアイコンのテキストを取得するプログラム

Option Explicit

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA"
_
        (ByVal hWndParent As Long, ByVal hWndChildAfter As Long, _
        ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function CreateFileMapping Lib "kernel32" _
        Alias "CreateFileMappingA" (ByVal hFile As Long, _
        lpFileMappigAttributes As Any, ByVal flProtect As Long, _
        ByVal dwMaximumSizeHigh As Long, _
        ByVal dwMaximumSizeLow As Long, ByVal lpName As String) As Long
Private Const PAGE_READWRITE = &H4&
Private Declare Function MapViewOfFile Lib "kernel32" _
        (ByVal hFileMappingObject As Long, ByVal dwDesiredAccess As Long, _
        ByVal dwFileOffsetHigh As Long, ByVal dwFileOffsetLow As Long, _
        ByVal dwNumberOfBytesToMap As Long) As Long
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000&
Private Const SECTION_QUERY = &H1&
Private Const SECTION_MAP_WRITE = &H2&
Private Const SECTION_MAP_READ = &H4&
Private Const SECTION_MAP_EXECUTE = &H8&
Private Const SECTION_EXTEND_SIZE = &H10&
Private Const SECTION_ALL_ACCESS = STANDARD_RIGHTS_REQUIRED Or SECTION_QUERY Or _
                                   SECTION_MAP_WRITE Or SECTION_MAP_READ Or _
                                   SECTION_MAP_EXECUTE Or SECTION_EXTEND_SIZE
Private Const FILE_MAP_ALL_ACCESS = SECTION_ALL_ACCESS
Private Declare Function UnmapViewOfFile Lib "kernel32" _
        (lpBaseAddress As Any) As Long
Private Declare Function CloseHandle Lib "kernel32" _
        (ByVal hObject As Long) As Long

Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" _
        (destination As Any, source As Any, ByVal length As Long)
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
        (ByVal hWnd As Long, ByVal wMsg As Long, _
        ByVal wParam As Long, lParam As Any) As Long
Private Const LVM_FIRST = &H1000&
Private Const LVM_GETTITEMCOUNT = (LVM_FIRST + 4)
Private Const LVM_GETITEM = (LVM_FIRST + 5)

Private Const MAX_PATH = 260&
Private Const LVIF_TEXT = &H1&

Private 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 Type


Public Sub GetDesktopIconName_9x()
    Dim hSysWnd As Long       '// SysListView32 ウィンドウハンドル
    Dim nCount As Long        '// デスクトップのアイコンの数
    Dim hFileMapping As Long  '// マッピングオブジェクト のハンドル
    Dim pLocalShared As Long  '// ファイルがマップされたビューの開始アドレス
    Dim lvi As LVITEM
    Dim dwSize As Long
    Dim i As Long
    Dim sBuffer As String

    dwSize = Len(lvi) + MAX_PATH    '// 確保するサイズ

    '// SysListView32 ウィンドウハンドルを取得
    hSysWnd = FindWindowEx(0, 0, "Progman", vbNullString)
    hSysWnd = FindWindowEx(hSysWnd, 0, "SHELLDLL_DefView", vbNullString)
    hSysWnd = FindWindowEx(hSysWnd, 0, "SysListView32", vbNullString)

    '// 共有メモリをオープン
    hFileMapping = CreateFileMapping(&HFFFFFFFF, ByVal 0&, PAGE_READWRITE, 0, dwSize,

vbNullString)
    pLocalShared = MapViewOfFile(hFileMapping, FILE_MAP_ALL_ACCESS, 0, 0, 0)

    '// 共有メモリの初期化 ( LVITEM 構造体の必要な個所を埋める )
    lvi.mask = LVIF_TEXT
    lvi.iSubItem = 0
    lvi.pszText = (pLocalShared + Len(lvi))
    lvi.cchTextMax = MAX_PATH

    '// デスクトップのアイコンの数を取得
    nCount = SendMessage(hSysWnd, LVM_GETTITEMCOUNT, 0, ByVal 0&)

    '// アイコンのテキストを取得
    For i = 0 To nCount - 1
        '// テキストを取得
        lvi.iItem = i
        Call MoveMemory(ByVal pLocalShared, lvi, Len(lvi))
        Call SendMessage(hSysWnd, LVM_GETITEM, 0, ByVal pLocalShared)

        '// これで pLocalShared->pszText+1 に、アイコンのテキストが取得できた。
        '// あとはここに必要な処理を付け足す。
        sBuffer = String$(MAX_PATH, 0)
        Call MoveMemory(ByVal sBuffer, ByVal (pLocalShared + Len(lvi)), MAX_PATH)
        Debug.Print CStr(i), Left$(sBuffer, InStr(sBuffer, vbNullChar) - 1)
    Next i

    '// 共有メモリをクローズ
    Call UnmapViewOfFile(ByVal pLocalShared)  '// ビューをアンマップ
    Call CloseHandle(hFileMapping)  '// マッピングオブジェクトのハンドルをクローズ
End Sub

'------------------------------------------------------
' Windows NT/2000 用の VirtualAllocEx() と WriteProcessMemory() /
' ReadProcessMemory() を使用した、デスクトップのアイコンのテキスト
' を取得するプログラム

Option Explicit

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA"
_
        (ByVal hWndParent As Long, ByVal hWndChildAfter As Long, _
        ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function GetWindowThreadProcessId Lib "user32" _
        (ByVal hWnd As Long, lpdwProcessId 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 Const PROCESS_VM_OPERATION = &H8&
Private Const PROCESS_VM_READ = &H10&
Private Const PROCESS_VM_WRITE = &H20&
Private Declare Function CloseHandle Lib "kernel32" _
        (ByVal hObject As Long) As Long

Private Declare Function VirtualAlloc Lib "kernel32" _
        (lpAddress As Any, ByVal dwSize As Long, _
        ByVal flAllocationType As Long, _
        ByVal flProtect As Long) As Long
Private Declare Function VirtualFree Lib "kernel32" _
        (lpAddress As Any, ByVal dwSize As Long, _
        ByVal dwFreeType As Long) As Long
Private Declare Function VirtualAllocEx Lib "kernel32.dll" _
        (ByVal hProcess As Long, lpAddress As Any, _
        ByVal dwSize As Long, ByVal flAllocationType As Long, _
        ByVal flProtect As Long) As Long
Private Const MEM_RESERVE = &H2000&
Private Const MEM_COMMIT = &H1000&
Private Const PAGE_READWRITE = &H4&
Private Declare Function VirtualFreeEx Lib "kernel32.dll" _
        (ByVal hProcess As Long, lpAddress As Any, _
        ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
Private Const MEM_RELEASE = &H8000&

Private Declare Function WriteProcessMemory Lib "kernel32" _
        (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" _
        (ByVal hProcess As Long, lpBaseAddress As Any, _
        lpBuffer As Any, ByVal nSize As Long, _
        lpNumberOfBytesWritten As Long) As Long

Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" _
        (destination As Any, source As Any, ByVal length As Long)
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
        (ByVal hWnd As Long, ByVal wMsg As Long, _
        ByVal wParam As Long, lParam As Any) As Long
Private Const LVM_FIRST = &H1000&
Private Const LVM_GETTITEMCOUNT = (LVM_FIRST + 4&)
Private Const LVM_GETITEM = (LVM_FIRST + 5)

Private Const MAX_PATH = 260
Private Const LVIF_TEXT = &H1

Private 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 Type


Public Sub GetDesktopIconName_NT()
    Dim hSysWnd As Long       '// SysListView32 ウィンドウハンドル
    Dim nCount As Long        '// デスクトップのアイコンの数
    Dim pLocalShared As Long  '// ファイルがマップされた自プロセスのビューの開始アドレス
    Dim lvi As LVITEM
    Dim pSysShared As Long    '// ファイルがマップされた他のプロセスのビューの開始アドレス
    Dim hProcess As Long      '// プロセスハンドル
    Dim dwPID As Long             '// Process ID
    Dim dwNumberOfBytes As Long   '// 読み書きされたバイト数
    Dim dwSize As Long
    Dim i As Long
    Dim sBuffer As String

    dwSize = Len(lvi) + MAX_PATH   '// 確保するサイズ

    '// SysListView32 ウィンドウハンドルを取得
    hSysWnd = FindWindowEx(0, 0, "Progman", vbNullString)
    hSysWnd = FindWindowEx(hSysWnd, 0, "SHELLDLL_DefView", vbNullString)
    hSysWnd = FindWindowEx(hSysWnd, 0, "SysListView32", vbNullString)

    '// 共有メモリをオープン
    pLocalShared = VirtualAlloc(ByVal 0&, dwSize, _
                        MEM_RESERVE Or MEM_COMMIT, PAGE_READWRITE)
    Call GetWindowThreadProcessId(hSysWnd, dwPID)
    hProcess = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or _
                        PROCESS_VM_WRITE, 0, dwPID)
    pSysShared = VirtualAllocEx(hProcess, ByVal 0&, dwSize, _
                        MEM_RESERVE Or MEM_COMMIT, PAGE_READWRITE)

    '// 共有メモリの初期化 ( LVITEM 構造体の必要な個所を埋める )
    lvi.mask = LVIF_TEXT
    lvi.iSubItem = 0
    lvi.pszText = (pSysShared + Len(lvi))
    lvi.cchTextMax = MAX_PATH

    '// デスクトップのアイコンの数を取得
    nCount = SendMessage(hSysWnd, LVM_GETTITEMCOUNT, 0, ByVal 0&)

    '// アイコンのテキストを取得
    For i = 0 To nCount - 1
        '// テキストを取得
        lvi.iItem = i
        Call MoveMemory(ByVal pLocalShared, lvi, Len(lvi))
        Call WriteProcessMemory(hProcess, ByVal pSysShared, _
                        ByVal pLocalShared, dwSize, dwNumberOfBytes)
        Call SendMessage(hSysWnd, LVM_GETITEM, 0, ByVal pSysShared)
        Call ReadProcessMemory(hProcess, ByVal pSysShared, _
                        ByVal pLocalShared, dwSize, dwNumberOfBytes)

        '// これで pLocalShared+1 に、アイコンのテキストが取得できた。
        '// あとはここに必要な処理を付け足す。
        sBuffer = String$(MAX_PATH, 0)
        Call MoveMemory(ByVal sBuffer, ByVal (pLocalShared + Len(lvi)), MAX_PATH)

        Debug.Print CStr(i), Left$(sBuffer, InStr(sBuffer, vbNullChar) - 1)
    Next i

    '// 共有メモリをクローズ
    Call VirtualFree(ByVal pLocalShared, 0, MEM_RELEASE)
    Call VirtualFreeEx(hProcess, ByVal pSysShared, 0, MEM_RELEASE)
    Call CloseHandle(hProcess)
End Sub


- 関連一覧ツリー (★ をクリックするとツリー全体を一括表示します)

- 返信フォーム (この記事に返信する場合は下記フォームから投稿して下さい)

- VBレスキュー(花ちゃん) - - Web Forum -