当前位置:编程学习 > VB >>

用vb取得SysTreeView32里面所有节点的名字

最近在搞VB,想做一个类似可以自动点击天翼LIVE登陆,然后得到里面所有的联系人,现在可以自动登录,登陆后联系人都在

一个SysTreeView32的类名的窗体里,已经得到他的句柄,怎样才能得到里面所有的联系人出来,最好有代码,而且解释下,

谢谢。 --------------------编程问答-------------------- 用SendMessage函数发送消息
涉及到以下:
TVM_GETITEM
TVM_GETNEXTITEM --------------------编程问答-------------------- 文字读出来怎么读 --------------------编程问答-------------------- 文字是通过TVITEM结构取出的。
楼主应该养成随手查阅MSDN的好习惯。 --------------------编程问答-------------------- 不好意思,我是菜鸟哈哈,我用这个函数怎么得不到文字呢,我已经正确选择了单个ITEM
hTVRoot = SendMessage(hBtn, TVM_GETNEXTITEM, TVGN_NEXT, ByVal hTVRoot)
Print GetTVText(hBtn, hTVRoot)


 Function   GetTVText(ByVal   hTVWnd   As   Long,   ByVal   hItem   As   Long)   As   String   
          Dim   itm   As   TVITEM   
          Dim   abBuf(1022)   As   Byte   
          With   itm   
                  .hItem   =   hItem   
                  .mask   =   TVIF_TEXT   +   TVIF_HANDLE   
                  .cchTextMax   =   1023   
                  .pszText   =   VarPtr(abBuf(0))   
          End   With   
          SendMessage   hTVWnd,   TVM_GETITEM,   0,   itm   
          GetTVText   =   StrConv(LeftB(abBuf,   InStrB(abBuf,   ChrB(0))   -   1),   vbUnicode)   
          Debug.Print   Hex(hItem)   
  End   Function   
    
--------------------编程问答-------------------- 帮顶.. --------------------编程问答-------------------- Mainfrm_hwnd = FindWindow(vbNullString, "天翼 Live | Windows Live Messenger")
exhwnd = GetWindow(Mainfrm_hwnd, GW_CHILD)
hBtn = GetWindow(exhwnd, 2)
hBtn = GetWindow(hBtn, 2)
hBtn = GetWindow(hBtn, 2)
hBtn = GetWindow(hBtn, 2)
hBtn = GetWindow(hBtn, 2)
hBtn = GetWindow(hBtn, 5)
hBtn = GetWindow(hBtn, 2)
hBtn = GetWindow(hBtn, 2)
hBtn = GetWindow(hBtn, 2)
hTVRoot = SendMessage(hBtn, TVM_GETNEXTITEM, TVGN_ROOT, ByVal 0&)
hTVRoot = SendMessage(hBtn, TVM_GETNEXTITEM, TVGN_CHILD, ByVal hTVRoot)
hTVRoot = SendMessage(hBtn, TVM_GETNEXTITEM, TVGN_NEXT, ByVal hTVRoot)
'这里已经得到电信小秘书这一项,但是用GetTVText(hBtn, hTVRoot)得不到文字
SendMessage hBtn, TVM_SELECTITEM, TVGN_Caret, ByVal hTVRoot
Print GetTVText(hBtn, hTVRoot)

请帮忙啊..... --------------------编程问答-------------------- up~ --------------------编程问答-------------------- SendMessage 的声明查一下,最后一个参数是不是 byref
Debug.Print Hex(hItem) 这种用法没见过
可以试着定义一个字串变量,把VarPtr(abBuf(0))赋给它的StrPtr,然后打印试一下。 --------------------编程问答-------------------- Soyokaze能具体点么,我菜鸟哈哈 --------------------编程问答--------------------  顶一个 --------------------编程问答--------------------
Dim s As String
s = StrConv(abBuf(), vbUnicode)
Debug.Print s
--------------------编程问答-------------------- 好像光用sendmessage不行的,要远程进程内存读取的。 --------------------编程问答-------------------- 关注中....不过我猜想应该同获取listview所有项目的鼠标位置一样,应该要进行远程进程内存操作,转载一下别人的代码应该对你有用
窗体:
Option Explicit

Private Declare Function VirtualAllocEx Lib "kernel32" (ByVal hProcess As Long, lpAddress As Any, 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

'Process操作
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 Type OSVERSIONINFO
        dwOSVersionInfoSize As Long
        dwMajorVersion As Long
        dwMinorVersion As Long
        dwBuildNumber As Long
        dwPlatformId As Long
        szCSDVersion As String * 128      '  Maintenance string for PSS usage
End Type

Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
        (lpVersionInformation As OSVERSIONINFO) As Long
Private Const VER_PLATFORM_WIN32_NT = 2
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32s = 0

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Long, ByVal Length 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 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 Declare Function UnmapViewOfFile Lib "kernel32" (lpBaseAddress As Any) As Long


Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const OPEN_ALWAYS = 4
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const SECTION_MAP_WRITE = &H2
Private Const FILE_MAP_WRITE = SECTION_MAP_WRITE
Private Const PAGE_READWRITE As Long = &H4
Private Const MEM_HANDLE As Long = &HFFFFFFFF

Private Declare Function CoCreateGuid Lib "ole32.dll" (lpGUID As Any) As Long
Private Declare Function StringFromGUID2 Lib "ole32" (lpGUID As Any, ByVal lpStr As String, ByVal lSize As Long) As Long

Private Type FileMap
    iCount As Integer
    AddressOfFileMap() As Long
    hFileMap() As Long
    tProcessID() As Long
    iIndex As Integer
End Type

Dim UseMap As FileMap
'Process参数
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const SYNCHRONIZE = &H100000
Private Const SPECIFIC_RIGHTS_ALL = &HFFFF
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const PROCESS_ALL_ACCESS = STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF
Private Const PROCESS_VM_OPERATION = &H8&
Private Const PROCESS_VM_READ = &H10&
Private Const PROCESS_VM_WRITE = &H20&
Private Const PROCESS_QUERY_INFORMATION = 1024

'记忆体形态
Private Const MEM_COMMIT = &H1000
Private Const MEM_RESERVE = &H2000
Private Const MEM_DECOMMIT = &H4000
Private Const MEM_RELEASE = &H8000
Private Const MEM_FREE = &H10000
Private Const MEM_PRIVATE = &H20000
Private Const MEM_MAPPED = &H40000
Private Const MEM_RESET = &H80000
Private Const MEM_TOP_DOWN = &H100000
Private Const MEM_4MB_PAGES = &H80000000
Private Const SEC_IMAGE = &H1000000
Private Const MEM_IMAGE = SEC_IMAGE

'记忆体保护状态
Private Const PAGE_NOACCESS = &H1
Private Const PAGE_READONLY = &H2
'Private Const PAGE_READWRITE = &H4
Private Const PAGE_WRITECOPY = &H8
Private Const PAGE_EXECUTE = &H10
Private Const PAGE_EXECUTE_READ = &H20
Private Const PAGE_EXECUTE_READWRITE = &H40
Private Const PAGE_EXECUTE_WRITECOPY = &H80
Private Const PAGE_GUARD = &H100
Private Const PAGE_NOCACHE = &H200
Public IsNt As Boolean
Private Function GetGuidID() As String
Dim pGuid(16) As Byte
Dim s As String
s = String(255, " ")
CoCreateGuid pGuid(0)
StringFromGUID2 pGuid(0), s, 255
s = Trim(s)
GetGuidID = StrConv(s, vbFromUnicode)
End Function

Public Function RemortMemoryAlloc(ByVal ProcessID As Long, Size As Long) As Long
    
UseMap.iIndex = UseMap.iIndex + 1
If UseMap.iIndex > UseMap.iCount Then
    UseMap.iCount = UseMap.iIndex
    ReDim Preserve UseMap.hFileMap(1 To UseMap.iIndex)
    ReDim Preserve UseMap.AddressOfFileMap(1 To UseMap.iIndex)
    ReDim Preserve UseMap.tProcessID(1 To UseMap.iIndex)
End If

UseMap.tProcessID(UseMap.iIndex) = ProcessID

If IsNt Then
    Dim hProcess As Long
    hProcess = OpenProcess(PROCESS_ALL_ACCESS, 0&, ProcessID)
    UseMap.hFileMap(UseMap.iIndex) = 0
    UseMap.AddressOfFileMap(UseMap.iIndex) = VirtualAllocEx(hProcess, ByVal 0, Size, MEM_COMMIT Or MEM_RESERVE, PAGE_EXECUTE_READWRITE)
    CloseHandle hProcess
Else
    UseMap.hFileMap(UseMap.iIndex) = CreateFileMapping(MEM_HANDLE, ByVal 0&, PAGE_READWRITE, 0&, Size, GetGuidID)
    UseMap.AddressOfFileMap(UseMap.iIndex) = MapViewOfFile(UseMap.hFileMap(UseMap.iCount), FILE_MAP_WRITE, 0, 0, 0)
End If

RemortMemoryAlloc = UseMap.AddressOfFileMap(UseMap.iIndex)
End Function

Public Function RemortMemoryRemove(ByVal ProcessID As Long, ByVal hAddress As Long) As Long
Dim hFileMap As Long

Dim i As Long

For i = 1 To UseMap.iIndex
    If UseMap.AddressOfFileMap(i) = hAddress Then
        Exit For
    End If
Next

If i > UseMap.iIndex Then
    MsgBox "岿粇"
    Exit Function
Else
    UseMap.AddressOfFileMap(i) = UseMap.AddressOfFileMap(UseMap.iIndex)
    hFileMap = UseMap.hFileMap(i)
    UseMap.hFileMap(i) = UseMap.hFileMap(UseMap.iIndex)
    UseMap.tProcessID(i) = UseMap.tProcessID(UseMap.iIndex)
    UseMap.iIndex = UseMap.iIndex - 1
End If

If IsNt Then
    Dim hProcess As Long
    hProcess = OpenProcess(PROCESS_ALL_ACCESS, 0&, ProcessID)
    RemortMemoryRemove = VirtualFreeEx(hProcess, hAddress, 0, MEM_RELEASE)
    CloseHandle hProcess
Else
    UnmapViewOfFile hAddress
    RemortMemoryRemove = CloseHandle(hFileMap)

End If
End Function

Private Sub Class_Initialize()
Dim OSVER As OSVERSIONINFO

OSVER.dwOSVersionInfoSize = Len(OSVER)
Call GetVersionEx(OSVER)
If OSVER.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then
    IsNt = False
ElseIf OSVER.dwPlatformId = VER_PLATFORM_WIN32_NT Then
    IsNt = True
End If
End Sub

Private Sub Class_Terminate()
Dim hFileMap As Long, i As Long

If IsNt Then
    Dim hProcess As Long
    For i = 1 To UseMap.iIndex
        hProcess = OpenProcess(PROCESS_ALL_ACCESS, 0&, UseMap.tProcessID(i))
        Call VirtualFreeEx(hProcess, UseMap.AddressOfFileMap(i), 0, MEM_RELEASE)
        CloseHandle hProcess
    Next
Else
    For i = 1 To UseMap.iIndex
        UnmapViewOfFile UseMap.AddressOfFileMap(i)
        Call CloseHandle(UseMap.hFileMap(i))
    Next
End If
Erase UseMap.AddressOfFileMap
Erase UseMap.hFileMap
Erase UseMap.tProcessID
End Sub

--------------------编程问答-------------------- 类模块:myRemoteCls
Option Explicit
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 hWndParent As Long, ByVal hWndChildAfter As Long, ByVal lpClassName As String, ByVal lpWindowName 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 Long) As Long
Private Const LVM_GETTITEMCOUNT& = (&H1000 + 4)
Private Const LVM_GETITEMPOSITION& = (&H1000 + 16)
Private Type POINTAPI
      x As Long
      y As Long
End Type
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 Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Long, ByVal Length 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 Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const SYNCHRONIZE = &H100000
Private Const SPECIFIC_RIGHTS_ALL = &HFFFF
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const PROCESS_ALL_ACCESS = STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF
Dim hdesk&, i&, iCount&, x&, y&
Private Sub Command1_Click()
Dim o As POINTAPI
Dim AddressOfFileMap As Long
Dim RmMmCls As New myRemoteCls

List1.Clear

hdesk = FindWindow("progman", vbNullString)
hdesk = FindWindowEx(hdesk, 0, "shelldll_defview", vbNullString)
hdesk = FindWindowEx(hdesk, 0, "syslistview32", vbNullString)

'获取图示数目
iCount = SendMessage(hdesk, LVM_GETTITEMCOUNT, 0, 0)

'取得listview的processID
Dim ProcessID As Long
Call GetWindowThreadProcessId(hdesk, ProcessID)

'配置外部记忆体
AddressOfFileMap = RmMmCls.RemortMemoryAlloc(ProcessID, 16&)
'Me.Caption = Hex(AddressOfFileMap)

'用sendmessage取得的坐标到记忆体中并读取(在NT中要透过ReadProcessMemory 9x系统只要用CopyMemory即可读取)
If RmMmCls.IsNt Then 'NT系统
    Dim hProcess As Long
    hProcess = OpenProcess(PROCESS_ALL_ACCESS, 0&, ProcessID)
    For i = 0 To iCount - 1
        Call SendMessage(hdesk, LVM_GETITEMPOSITION, i, ByVal AddressOfFileMap)
        ReadProcessMemory hProcess, ByVal AddressOfFileMap, o, 8&, 0
        List1.AddItem "Index " & i & ": " & "(" & o.x & "," & o.y & ")"
    Next
    CloseHandle hProcess
Else '9x系统
    For i = 0 To iCount - 1
        Call SendMessage(hdesk, LVM_GETITEMPOSITION, i, ByVal AddressOfFileMap)
        CopyMemory o, ByVal AddressOfFileMap, 8
        List1.AddItem "Index " & i & ": " & "(" & o.x & "," & o.y & ")"
    Next

End If
RmMmCls.RemortMemoryRemove ProcessID, AddressOfFileMap '释放记忆体
End Sub --------------------编程问答-------------------- 不好意思,复制反了,上面一个是类模块内容,下面一个是窗体内容 --------------------编程问答-------------------- 啊,刚意识到是跨进程读取的,呵呵。需要在对方进程开辟内存空间,然后读取。
方法楼上已经讲过了。 --------------------编程问答-------------------- GetWindowThreadProcessId hBtn, pid
hProcess = OpenProcess(&H1F0FFF, False, pid)
ptvitem = VirtualAllocEx(hProcess, 0, Len(itm), MEM_COMMIT, PAGE_READWRITE)
pItem = VirtualAllocEx(hProcess, 0, 2, MEM_COMMIT, PAGE_READWRITE)
With itm
                  .hItem = hTVRoot
                  .mask = TVIF_TEXT
                  .cchTextMax = 1023
                  .pszText = VarPtr(abBuf(0))
End With

WriteProcessMemory hProcess, ptvitem, ByVal VarPtr(itm), Len(itm), 0
 SendMessage hBtn, TVM_GETITEM, 0, ByVal itm
ReadProcessMemory hProcess, pItem, abBuf(0), 1023, vbNull
s = StrConv(LeftB(abBuf, InStrB(abBuf, ChrB(0)) - 1), vbUnicode)

这个跨进程的我昨晚测试的,但是老是错误,能帮忙看下内存WriteProcessMemory和ReadProcessMemory ,SendMessage hBtn, TVM_GETITEM, 0, ByVal itm这个要怎么写,还有分配内存,能帮忙写下么,谢谢! --------------------编程问答-------------------- 想请问下我用这个模拟数据包提交,但是得不到相应结果的网页,得到下面的提示:
HTTP/1.1 200 OK Cache-Control: private Content-Type: text/html Content-Encoding: gzip Vary: Accept-Encoding Server: Microsoft-IIS/7.5 Date: Wed, 31 Mar 2010 09:41:29 GMT Content-Length: 1259 ?
下面为数据包模拟提交,请各位大哥看下为什么会这样,谢谢!

Private Sub Command2_Click()
If Winsock1.State <> 0 Then
Winsock1.Close
End If
Winsock1.RemotePort = "8080"
Winsock1.RemoteHost = "localhost"

msg = ""
msg = msg + "POST /1024/searchdate2.asp HTTP/1.1" + vbCrLf
msg = msg + "Accept: image/jpeg, application/x-ms-application, image/gif, application/xaml+xml, image/pjpeg, application/x-ms-xbap, application/x-shockwave-flash, application/QVOD, application/QVOD, application/vnd.ms-excel, application/msword, */*" + vbCrLf
msg = msg + "Referer: http://localhost:8080/1024/searchdate2.asp" + vbCrLf
msg = msg + "Accept-Language: zh-CN" + vbCrLf
msg = msg + "User-Agent: Mozilla/4.0 (compatible; MSIE 8.0; Windows NT 6.1; Trident/4.0; Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1) ; SLCC2; .NET CLR 2.0.50727; .NET CLR 3.5.30729; .NET CLR 3.0.30729; Media Center PC 6.0)" + vbCrLf
msg = msg + "Content-Type: application/x-www-form-urlencoded" + vbCrLf
msg = msg + "Accept-Encoding: gzip, deflate" + vbCrLf
msg = msg + "Host: localhost:8080" + vbCrLf
msg = msg + "Content-Length: 102" + vbCrLf
msg = msg + "Connection: Keep-Alive" + vbCrLf
msg = msg + "Cache-Control: no-cache" + vbCrLf
msg = msg + "Cookie: ASPSESSIONIDSSATRBCA=KIGDEIHBPNJGMOFDNIFOHDBC" + vbCrLf
ACCOUNT=13360829523@189.cn; " + Right(Left(buf_Cookies, 107), 47) + " LoginCookie=IsSave=YES&LoginName=13360829523" + vbCrLf
msg = msg + vbCrLf
msg = msg + "d4311=2010-03-01+16%3A25%3A12&d4312=2010%2F3%2F31+16%3A25%3A11&cname=&cno=&uplink=&submit=%C8%B7%B6%A8" + vbCrLf
Winsock1.Connect
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim tmpstr As String
Dim s As String
Winsock1.GetData tmpstr, vbString, 8192
s = s + tmpstr
WebBrowser1.Document.open
WebBrowser1.Document.write s
End Sub
补充:VB ,  API
CopyRight © 2012 站长网 编程知识问答 www.zzzyk.com All Rights Reserved
部份技术文章来自网络,