VB获取注册表SysTreeView32节点文字失败

Carlven2012 2015-08-11 01:20:07

我是win7 64位系统，代码如下，获取注册表节点文字不成功，求指教改正？！



Private Sub Command6_Click()

    Dim Wnd As Long

    Wnd = FindWindow("RegEdit_RegEdit", vbNullString)

    Wnd = FindWindowEx(Wnd, 0, "SysTreeView32", vbNullString)



    hItem = SendMessage(Wnd, TVM_GETNEXTITEM, TVGN_ROOT, ByVal 0&)      '获取根节点

    hItem = SendMessage(Wnd, TVM_GETNEXTITEM, TVGN_CHILD, ByVal hItem)  '获取第一节点

    

    Dim mhProcess As Long, dwProcessId As Long

    Dim mlpTreeItemRemote As Long, mlpTextRemote As Long

    Dim mszBuf() As Byte

    Dim mnMaxLen As Long

    Dim dwBytesRead As Long, dwBytesWrite As Long

    Dim bSuccess As Long

    Dim lvItemLocal As TVITEM

    Dim bWriteOK As Long

    mnMaxLen = 1023

    

    Call GetWindowThreadProcessId(Wnd, dwProcessId)

    mhProcess = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, 0&, dwProcessId)

    If mhProcess <> 0 Then

            '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)



            ReDim mszBuf(mnMaxLen)

            bWriteOK = WriteProcessMemory(ByVal mhProcess, ByVal mlpTextRemote, mszBuf(0), mnMaxLen + 1, dwBytesWrite)

            

            If bWriteOK = False Then Exit Sub

            'write structure

            dwBytesWrite = 0

            lvItemLocal.hItem = hItem

            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(Wnd, TVM_GETITEM, 0&, ByVal mlpTreeItemRemote)

            

            'read result

            bSuccess = ReadProcessMemory(ByVal mhProcess, ByVal mlpTextRemote, mszBuf(0), mnMaxLen + 1, dwBytesRead)

            MsgBox "节点文字为：" & StrConv(LeftB(mszBuf, InStrB(mszBuf, ChrB(0)) - 1), vbUnicode)

             

            

            'dellocate memory

            Call VirtualFreeEx(mhProcess, ByVal mlpTreeItemRemote, 0, MEM_DECOMMIT)

            Call VirtualFreeEx(mhProcess, ByVal mlpTextRemote, 0, MEM_DECOMMIT)

    End If

    CloseHandle mhProcess

End Sub

...全文

444 23 打赏收藏转发到动态举报

写回复

用AI写文章

23 条回复

切换为时间正序

请发表友善的回复…

发表回复

qq_28212669 2015-09-09

打赏
举报

用vb的msflexgrid控件读取ini文件后如何比较栅格中数之间和每个栅格中的数与textbox中数的大小。哪位高手知道附带详细代码上传下

Carlven2012 2015-08-19

打赏
举报

引用 21 楼 startbin 的回复:

提示都做到这份上了还没弄出来.......

大神，果然厉害啊！！！我就是不知道那结构怎么定义啊，你是怎么知道要那样定义的？还有，你那个地址mlpTextRemote为什么要加3000 ？获得内容必须用你那个函数GetByteW转吗（直接用strconv不行么）？

startbin 2015-08-19

打赏
举报

提示都做到这份上了还没弄出来.......

Option Explicit
'Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

Private Const PROCESS_QUERY_INFORMATION = &H400
Private Const PROCESS_VM_READ = &H10
Private Const MEM_COMMIT = 4096
Private Const MEM_RELEASE = &H8000&
Private Const PAGE_READWRITE = 4
Private Const PROCESS_VM_OPERATION = (&H8)
Private Const PROCESS_VM_WRITE = (&H20)

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

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 Declare Function SendMessageW Lib "user32" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) 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 VirtualFreeEx Lib "kernel32" (ByVal hProcess As Long, lpAddress As Any, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long

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

Private Type TVITEMW64
    mask           As Long                                                      ' UINT      mask
    mask0           As Long                                                     '64补位
    hItem          As Long                                                      ' HTREEITEM hItem
    hItem0         As Long                                                      '64补位
    state          As Long                                                      ' UINT      state
    stateMask      As Long                                                      ' UINT      stateMask
    pszText        As Long                                                      ' LPWSTR    pszText
    pszText0        As Long                                                     '64补位
    cchTextMax     As Long                                                      ' int       cchTextMax
    iImage         As Long                                                      ' int       iImage
    iSelectedImage As Long                                                      ' int       iSelectedImage
    cChildren      As Long                                                      ' int       cChildren
    lParam         As Long                                                      ' LPARAM    lParam
    lParam0         As Long                                                     '64补位
End Type

Private Const TV_FIRST = &H1100
Private Const TVM_GETITEMW = TV_FIRST + 62
Private Const TVM_GETNEXTITEM = TV_FIRST + 10
Private Const TVGN_ROOT = &H0&
Private Const TVGN_NEXT = &H1&
Private Const TVGN_PREVIOUS = &H2&
Private Const TVGN_PARENT = &H3&
Private Const TVGN_CHILD = &H4&
Private Const TVGN_FIRSTVISIBLE = &H5&
Private Const TVGN_NEXTVISIBLE = &H6&
Private Const TVGN_PREVIOUSVISIBLE = &H7&
Private Const TVGN_DROPHILITE = &H8&
Private Const TVGN_CARET = &H9&

Private Const TVIF_TEXT = &H1&
Private Const TVIF_IMAGE = &H2&
Private Const TVIF_PARAM = &H4&
Private Const TVIF_STATE = &H8&
Private Const TVIF_HANDLE = &H10&
Private Const TVIF_SELECTEDIMAGE = &H20&
Private Const TVIF_CHILDREN = &H40&
Private Const TVIF_INTEGRAL = &H80&
Private Const TVIF_STATEEX = &H100&
Private Const TVIF_EXPANDEDIMAGE = &H200&
Private Const TVIS_SELECTED = &H2&
Private Const TVIS_CUT = &H4&
Private Const TVIS_DROPHILITED = &H8&
Private Const TVIS_BOLD = &H10&
Private Const TVIS_EXPANDED = &H20&
Private Const TVIS_EXPANDEDONCE = &H40&

'Private Const WM_LBUTTONDOWN = &H201
'Private Const WM_LBUTTONUP = &H202


Private Sub Command1_Click()
    
    Dim Wnd As Long, hItem As Long, i As Long, n As Long
    Wnd = FindWindow("RegEdit_RegEdit", vbNullString)
    Wnd = FindWindowEx(Wnd, 0, "SysTreeView32", vbNullString)
    
    hItem = SendMessage(Wnd, TVM_GETNEXTITEM, TVGN_ROOT, ByVal 0&)              '获取根节点
    hItem = SendMessage(Wnd, TVM_GETNEXTITEM, TVGN_CHILD, ByVal hItem)          '获取第一节点
    
    Dim mhProcess As Long, dwProcessId As Long
    Dim mlpTreeItemRemote As Long, mlpTextRemote As Long
    Dim mszBuf() As Byte
    Dim mnMaxLen As Long
    Dim dwBytesRead As Long, dwBytesWrite As Long
    Dim bSuccess As Long
    Dim lvItemLocal As TVITEMW64
    Dim bWriteOK As Long
    mnMaxLen = 512
    
    Call GetWindowThreadProcessId(Wnd, dwProcessId)
    mhProcess = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, 0&, dwProcessId)
    If mhProcess <> 0 Then
        'allocate memory
        mlpTextRemote = VirtualAllocEx(ByVal mhProcess, ByVal 0&, 4096, MEM_COMMIT, PAGE_READWRITE)
        mlpTreeItemRemote = mlpTextRemote + 3000
        
        ReDim mszBuf(mnMaxLen)
        '        bWriteOK = WriteProcessMemory(ByVal mhProcess, ByVal mlpTextRemote, mszBuf(0), mnMaxLen + 1, dwBytesWrite)
        '
        '        If bWriteOK = False Then Exit Sub
        'write structure
        dwBytesWrite = 0
        lvItemLocal.hItem = hItem
        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 = SendMessageW(Wnd, TVM_GETITEMW, 0&, ByVal mlpTreeItemRemote)
        'read result
        bSuccess = ReadProcessMemory(ByVal mhProcess, ByVal mlpTextRemote, mszBuf(0), mnMaxLen, dwBytesRead)
        MsgBox "节点文字为：" & GetByteW(mszBuf) & "|"
        
        
        'dellocate memory
        Call VirtualFreeEx(mhProcess, ByVal mlpTreeItemRemote, 0, MEM_RELEASE)
    End If
    CloseHandle mhProcess
End Sub

Function GetByteW(b() As Byte) As String
    On Error GoTo ERR1
    Dim i As Long
    For i = 0 To UBound(b) - 1 Step 2
        If b(i) = 0 And b(i + 1) = 0 Then
            ReDim Preserve b(i - 1)
            GetByteW = b
            Exit For
        End If
    Next
ERR1:
End Function

Carlven2012 2015-08-19

打赏
举报

引用 18 楼 zhao4zhong1 的回复:

费那——事儿！

shell "reg export HKLM  HKLM.reg",vbHide
shell "reg export HKCU  HKCU.reg",vbHide
shell "reg export HKCR  HKCR.reg",vbHide
shell "reg export HKU   HKU.reg" ,vbHide
shell "reg export HKCC  HKCC.reg",vbHide

然后读对应文件

要这样，我还不如用RegEnumKeyEx呢。我只是拿注册表举个例而已。和我要获取SysTreeView32节点文字的目的都不样，要是其他比如资源管理器等里面的SysTreeView32呢，是吧。

赵4老师 2015-08-19

打赏
举报

C:\>reg export /? REG EXPORT KeyName FileName Keyname ROOTKEY[\SubKey] (只是本地机器)。 ROOTKEY [ HKLM | HKCU | HKCR | HKU | HKCC ] SubKey 所选 ROOTKEY 下的注册表项的全名。 FileName 要导出的磁盘文件名。 /y 不用提示就强行覆盖现有文件。例如: REG EXPORT HKLM\Software\MyCo\MyApp AppBkUp.reg 将注册表项 MyApp 的所有子项和值导出到文件 AppBkUp.reg

赵4老师 2015-08-19

打赏
举报

费那——事儿！

shell "reg export HKLM  HKLM.reg",vbHide
shell "reg export HKCU  HKCU.reg",vbHide
shell "reg export HKCR  HKCR.reg",vbHide
shell "reg export HKU   HKU.reg" ,vbHide
shell "reg export HKCC  HKCC.reg",vbHide

然后读对应文件

Carlven2012 2015-08-18

打赏
举报

引用 15 楼 lwl7969317 的回复:

你这是要定位注册表还是读取呢？读取打开或关闭重定向就可以解决32位程序读取64位注册表

读取，你说的“打开或关闭重定向” 是什么意思？

Carlven2012 2015-08-18

打赏
举报

引用 15 楼 lwl7969317 的回复:

你这是要定位注册表还是读取呢？读取打开或关闭重定向就可以解决32位程序读取64位注册表

读取，你说的“打开或关闭重定向” 是什么意思？

lwl7969317 2015-08-18

打赏
举报

你这是要定位注册表还是读取呢？读取打开或关闭重定向就可以解决32位程序读取64位注册表

志超机电 2015-08-18

打赏
举报

可代作WIN764环境修改注册表VB6代码

startbin 2015-08-14

打赏
举报

typedef struct tagTVITEM { UINT mask; HTREEITEM hItem; 可能是64位 UINT state; UINT stateMask; LPTSTR pszText; 64位 int cchTextMax; int iImage; int iSelectedImage; int cChildren; LPARAM lParam; 64位 } TVITEM, *LPTVITEM; 我猜测

startbin 2015-08-14

打赏
举报

其实你不知道64位的结构是怎样的也是可以的只要分配的内存足够大我相信消息是会成功的然后用16进制内存编辑器看内存块里面的数据基本就能知道TVITEM64的大小和成员

startbin 2015-08-14

打赏
举报

Dim lvItemLocal As TVITEM64

Carlven2012 2015-08-14

打赏
举报

引用 9 楼 startbin 的回复:

别误导人家了吧很简单只需要相对应的64结构就行了你现在用的是32位结构当然数据位是不对的

谁的64结构？怎么定义？求教？

startbin 2015-08-14

打赏
举报

别误导人家了吧很简单只需要相对应的64结构就行了你现在用的是32位结构当然数据位是不对的

Tiger_Zhao 2015-08-11

打赏
举报

按照下面这个文章的说法，要用 MEMORY_BASIC_INFORMATION64
ReadProcessMemory on a 64 bit proces always returns Error 299

Carlven2012 2015-08-11

打赏
举报


Private Sub Command6_Click()
    Dim Wnd As Long
    Wnd = FindWindow("RegEdit_RegEdit", vbNullString)
    Wnd = FindWindowEx(Wnd, 0, "SysTreeView32", vbNullString)

    hItem = SendMessage(Wnd, TVM_GETNEXTITEM, TVGN_ROOT, ByVal 0&)      '获取根节点
    hItem = SendMessage(Wnd, TVM_GETNEXTITEM, TVGN_CHILD, ByVal hItem)  '获取第一节点
    
    Dim mhProcess As Long, dwProcessId As Long
    Dim mlpTreeItemRemote As Long, mlpTextRemote As Long
    Dim mszBuf() As Byte
    Dim mnMaxLen As Long
    Dim dwBytesRead As Long, dwBytesWrite As Long
    Dim bSuccess As Long
    Dim lvItemLocal As TVITEM
    Dim bWriteOK As Long
    mnMaxLen = 1023
    
    Call GetWindowThreadProcessId(Wnd, dwProcessId)
    mhProcess = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, 0&, dwProcessId)
    If mhProcess <> 0 Then
            Debug.Print "OpenProcess 返回：" & mhProcess
            
            '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)

            ReDim mszBuf(mnMaxLen)
            bWriteOK = WriteProcessMemory(ByVal mhProcess, ByVal mlpTextRemote, mszBuf(0), mnMaxLen + 1, dwBytesWrite)
            If bWriteOK = False Then Exit Sub
            Debug.Print "WriteProcessMemory 返回：" & bWriteOK
            
            
            'write structure
            dwBytesWrite = 0
            lvItemLocal.hItem = hItem
            lvItemLocal.mask = TVIF_TEXT + TVIF_HANDLE
            lvItemLocal.cchTextMax = mnMaxLen
            lvItemLocal.pszText = mlpTextRemote
            bWriteOK = WriteProcessMemory(ByVal mhProcess, ByVal mlpTreeItemRemote, ByVal VarPtr(lvItemLocal), Len(lvItemLocal), dwBytesWrite)
            Debug.Print "WriteProcessMemory 返回：" & bWriteOK
            'get item
            i = SendMessage(Wnd, TVM_GETITEM, 0&, ByVal mlpTreeItemRemote)
            Debug.Print "SendMessage - TVM_GETITEM 返回：" & i
            
            
            'read result
            bSuccess = ReadProcessMemory(ByVal mhProcess, ByVal mlpTextRemote, mszBuf(0), mnMaxLen + 1, dwBytesRead)
            Debug.Print "ReadProcessMemory 返回：" & bSuccess
            Debug.Print "节点文字为：[" & StrConv(LeftB(mszBuf, InStrB(mszBuf, ChrB(0)) - 1), vbUnicode) & "]"
             
            
            'dellocate memory
            Call VirtualFreeEx(mhProcess, ByVal mlpTreeItemRemote, 0, MEM_DECOMMIT)
            Call VirtualFreeEx(mhProcess, ByVal mlpTextRemote, 0, MEM_DECOMMIT)
    End If
    CloseHandle mhProcess
End Sub

我改成这样跟踪，结果如下：


OpenProcess 返回：916
WriteProcessMemory 返回：1
WriteProcessMemory 返回：1
SendMessage - TVM_GETITEM 返回：0
ReadProcessMemory 返回：1
节点文字为：[]

Carlven2012 2015-08-11

打赏
举报

那应该怎么办呢？请指教

Tiger_Zhao 2015-08-11

打赏
举报

好吧，就算系统消息可用。
但是32位程序读64位程序的内存这不可能吧。

Carlven2012 2015-08-11

打赏
举报


    Dim r As Long
    hWin = FindWindow("RegEdit_RegEdit", vbNullString)
    hWin = FindWindowEx(hWin, 0, "SysTreeView32", vbNullString)
    SendMessage hWin, TVM_SETITEMHEIGHT, 60, 0   '设置SysTreeView32项的高度为60。默认为20

上面这个都是可以实现的！

加载更多回复（3）

易语言源码发送消息_全选插入

内容概要：本文系统梳理了计算机组成原理的完整知识体系，重点围绕冯·诺依曼体系结构、五大核心硬件（运算器、控制器、存储器、输入/输出设备）、数据表示与运算、存储层级、CPU架构、总线系统及I/O控制机制展开，深入剖析了硬件底层如何支撑Java程序的运行，特别是与JVM内存模型、多线程并发、IO操作、性能调优等关键技术的紧密关联。文章强调通过理解二进制编码、补码运算、缓存机制、指令流水线、乱序执行、中断与DMA等底层原理，帮助Java开发者从根本上解释浮点精度丢失、数值溢出、线程安全、伪共享、IO阻塞等常见问题，并提供性能优化的硬件级视角。; 适合人群：具备一定Java开发基础，工作1-3年，希望深入理解JVM、并发编程、IO模型底层原理的后端研发人员。; 使用场景及目标：① 理解Java代码从编译到执行的完整软硬件链路；② 掌握JVM内存布局、GC机制、线程上下文切换、volatile与synchronized的硬件实现原理；③ 分析并解决高并发、高性能场景下的性能瓶颈，如缓存命中率低、伪共享、总线争用、IO阻塞等问题；④ 在面试中清晰阐述Java底层与计算机硬件的关联，展现扎实的系统功底。; 阅读建议：建议按照文档提供的“八、学习顺序”分阶段学习，每学完一个硬件模块，立即结合对应的Java技术点（如学到Cache时思考伪共享和@Contended）进行复盘，将抽象硬件原理具象化到日常开发场景中，以达到学以致用的目的。

BBT0060-2025 包装容器聚对苯二甲酸乙二醇酯（PET）瓶胚_可搜索.pdf

源码链接： https://pan.quark.cn/s/044c82337b8e Teamcenter 12的中文版帮助文档中，1-1基础模块入门部分，详细介绍了产品设计、产品文档、产品结构、业务流程、客户端与集成接口、AWC、Rich client以及TC的安装与配置等内容，非常适合初学者或者希望了解Teamcenter 12的读者。Teamcenter 12是由Siemens开发的一款功能强大的产品生命周期管理（PLM）软件，它包含了产品设计、产品文档、产品结构、业务流程等多个领域，旨在帮助企业高效地管理产品开发的全过程。以下是对这些核心知识点的具体阐述： 1-1 Teamcenter简介： Teamcenter作为一个综合性的PLM解决方案，提供了一个集中化的平台来存储、管理和协同所有的产品相关信息。它支持跨部门、跨地域的合作，通过集成CAD系统、业务流程管理工具和数据管理功能，确保了数据的一致性和准确性。 1-1 产品设计： Teamcenter能够管理各种工程设计数据，包括3D模型、图纸、参数化数据等。用户可以方便地查找和组织产品设计数据，进行签出和签入操作以保证版本控制，确保在团队协作中避免数据冲突。 1-2 查找和组织产品设计：在Teamcenter中，用户可以通过高级搜索功能迅速定位所需的设计文件，同时，系统支持自定义视图和分类，使设计数据的组织更加系统化。 1-3 签出和签入产品设计：签出和签入机制是Teamcenter中防止数据冲突的重要功能。签出允许用户独占性地编辑某个设计文件，而签入则将更新后的文件版本提交回系统，供其他团队成员查看或编辑。 1-4 产品文档： Teamcenter不仅管理设计数据，还涵盖了产品相关的文档，如规格...

下载代码方式：https://pan.quark.cn/s/a4b39357ea24 TD/T 1055-2019 第三次全国国土调查技术规程.pdf