[原创] 带头开源 - CsrWalker_VB(源码) CsrWalker, 源码, 开源

suanzi

'版权声明: suanzi , iceboy(因为是ICY同学教我做的,也写上他名字)
'直接把ProcessView里的一个枚举进程模块copy出来 随便写的代码 很乱 不过我加了比较详细的注释了
'代码中我加了一处手脚 原因.. 有垃圾.. 垃圾在哪?
'提示一下 某行代码的传址传值我修改了 会的人一调试就知
'带上广告,附上我的ProcessView

1. Option Explicit
   
2. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
   
3. Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
   
4. Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
   
5. Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
   
6. 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
   
7. Private Declare Function CsrGetProcessId Lib "ntdll" () As Long '这是csrss的Pid
   
8. 
   
9. Private Type CSR_PROCESS_PARTIAL
   
10.     UniqueProcess As Long
    
11.     UniqueThread As Long
    
12.     Flink As Long
    
13.     Blink As Long
    
14. End Type
    
15. 
    
16. 
    
17. Public Function EnumByCsrWalk() As Long()
    
18.     Dim hprocess As Long, hModule As Long, addr As Long
    
19.     Dim buff(0 To &H2F) As Byte, AddrCRP As Long, addr2 As Long
    
20.     Dim cpp As CSR_PROCESS_PARTIAL, FirstFlink As Long
    
21.     Dim Pids() As Long, I As Long
    
22. 
    
23.     hprocess = IszOpenProcess(&H400 Or &H10, CsrGetProcessId()) '打开csrss需要SE_DEBUG
    
24.     hModule = LoadLibrary("csrsrv.dll")
    
25.     addr = GetProcAddress(hModule, "CsrLockProcessByClientId")  'CsrLockProcessByClientId的地址
    
26. 
    
27.     CopyMemory buff(0), ByVal CLng(addr + &H8), &H30
    
28.    
    
29.     For I = 0 To UBound(buff) - 1   '搜索并定位CsrRootProcess
    
30.         If buff(I) = &H8B And buff(I + 1) = &H35 Then  'CsrRootProcess在XP反汇编得的特征码是8B 35
    
31.             CopyMemory AddrCRP, ByVal buff(I + 2), 4
    
32.         End If
    
33.     Next
    
34. 
    
35.     ReadProcessMemory hprocess, ByVal AddrCRP, addr2, 4, ByVal 0& '读取AddrCRP指向的地址，这个地址指向一个结构
    
36.     ReadProcessMemory hprocess, ByVal addr2, cpp, 16, ByVal 0&  '这里已经读取第1个了
    
37.     FirstFlink = cpp.Flink '记录一下第1个 因为这是一个双向链表
    
38.     ReDim Pids(0)
    
39.     Do
    
40.         ReadProcessMemory hprocess, ByVal cpp.Flink - 8, cpp, 16, ByVal 0& '下一个是Flink - 8
    
41.         AddItemToArray cpp.UniqueProcess, Pids
    
42.     Loop While cpp.Flink <> FirstFlink
    
43.    
    
44.     If (UBound(Pids) = 0) Then MsgBox "错误发生在_EnumByCsrWalk"
    
45.     IcyClose hprocess
    
46.     FreeLibrary hModule
    
47. 
    
48.     EnumByCsrWalk = Pids
    
49. End Function

复制代码

[ 本帖最后由 suanzi 于 2008-7-27 14:16 编辑 ]

iceboy

cpp 这个变量名有意思

--

注释应该改一下:'记录下第一个, 因为这是一个循环链表'

[ 本帖最后由 icesboy 于 2008-7-27 14:44 编辑 ]

iceboy

在 suanzi 同学的带头作用下, 丢一点儿代码:

psnull2\m_dos_device_trie.bas

1. Option Explicit
   
2. 
   
3. Private Const DataMask As Integer = 31744
   
4. Private Const PointerMask As Integer = 1023
   
5. 
   
6. Dim Trie(0 To 65535) As Integer, BlockCount As Long
   
7. 
   
8. Private Sub ClearTrie()
   
9.     BlockCount = 1
   
10.     IcyZeroMemory VarPtr(Trie(0)), 64
    
11. End Sub
    
12. 
    
13. Private Function AddTrie(ByVal Parent As Integer, ByVal Index As Byte, ByVal Data As Byte) As Integer
    
14.     Dim ParentOffset As Long, SubBlock As Integer
    
15.     If Parent < BlockCount Then
    
16.         Index = Index And CByte(31)
    
17.         Data = Data And CByte(31)
    
18.         ParentOffset = CLng(Parent) * 32 + CLng(Index)
    
19.         If Data = 0 Then
    
20.             SubBlock = Trie(ParentOffset) And PointerMask
    
21.             If SubBlock = 0 Then
    
22.                 IcyZeroMemory VarPtr(Trie(BlockCount * 32)), 64
    
23.                 SubBlock = BlockCount
    
24.                 Trie(ParentOffset) = Trie(ParentOffset) Or SubBlock
    
25.                 BlockCount = BlockCount + 1
    
26.                 If BlockCount >= 2048 Then
    
27.                     MsgBox "Sorry, there are too many devices on your computer.", vbCritical
    
28.                     End
    
29.                 End If
    
30.             End If
    
31.             AddTrie = SubBlock
    
32.         Else
    
33.             Trie(ParentOffset) = Trie(ParentOffset) Or (Data * 1024)
    
34.         End If
    
35.     End If
    
36. End Function
    
37. 
    
38. Private Function QueryTrie(ByVal Parent As Integer, ByVal Index As Byte) As Integer
    
39.     If Parent < BlockCount Then QueryTrie = Trie(CLng(Parent) * 32 + CLng(Index And 31))
    
40. End Function
    
41. 
    
42. Private Function SearchTrie(ByRef Buffer() As Byte) As Long
    
43.     Dim pBlock As Integer, i As Long
    
44.     Do While Buffer(i) <> 0
    
45.         pBlock = QueryTrie(pBlock, Buffer(i))
    
46.         If i > 1 Then
    
47.             If (pBlock And DataMask) <> 0 Then
    
48.                 Buffer(i - 2) = (pBlock \ 1024) Or 64
    
49.                 Buffer(i - 1) = 58
    
50.                 Buffer(i) = 92
    
51.                 SearchTrie = i - 1
    
52.                 Exit Function
    
53.             End If
    
54.         End If
    
55.         i = i + 1
    
56.         If i > UBound(Buffer) Then Exit Do
    
57.     Loop
    
58. End Function
    
59. 
    
60. Public Function NtPathNameToDosName(ByVal NtName As String) As String
    
61.     Dim NtNameAnsi() As Byte, i As Long
    
62.     If NtName = Empty Then Exit Function
    
63.     NtNameAnsi = StrConv(NtName, vbFromUnicode)
    
64.     i = SearchTrie(NtNameAnsi)
    
65.     If i = 0 Then
    
66.         NtPathNameToDosName = NtName
    
67.     Else
    
68.         NtPathNameToDosName = Mid(StrConv(NtNameAnsi, vbUnicode), i)
    
69.     End If
    
70. End Function
    
71. 
    
72. Public Sub RefreshDosDeviceNames()
    
73.     Dim DriveInfo(0 To 8) As Long, DosName(0 To 2) As Byte, NtName(0 To 255) As Byte
    
74.     Dim pDosName As Long, pNtName As Long, pBlock As Integer, i As Long
    
75.     ClearTrie
    
76.     IcyQueryInformationProcess -1, &H17, VarPtr(DriveInfo(0)), 36, 0
    
77.     DosName(0) = 65
    
78.     DosName(1) = 58
    
79.     pDosName = VarPtr(DosName(0))
    
80.     pNtName = VarPtr(NtName(0))
    
81.     Do While DriveInfo(0) > 0
    
82.         If (DriveInfo(0) And 1) = 1 Then
    
83.             QueryDosDeviceA pDosName, pNtName, 1024
    
84.             i = 0
    
85.             pBlock = 0
    
86.             Do While NtName(i) <> 0
    
87.                 pBlock = AddTrie(pBlock, NtName(i), 0)
    
88.                 i = i + 1
    
89.             Loop
    
90.             AddTrie pBlock, 92, DosName(0)
    
91.         End If
    
92.         DriveInfo(0) = DriveInfo(0) \ 2
    
93.         DosName(0) = DosName(0) + 1
    
94.     Loop
    
95. End Sub

复制代码

[ 本帖最后由 icesboy 于 2008-7-27 14:53 编辑 ]

suanzi

叫圆圈链表吧 ^-^
dim cpp as CSR_PROCESS_PARTIAL
....懒人的变量名

suanzi

看贴看回复的人就是好人
把楼顶的代码 code = replace(code, "ByVal buff(I + 2)", "buff(I + 2)")
因为这里是直接传址

over,over ...

329510010

iceboy同学发下声明可以吗？

ggystudio

- -
全都发了你还要声明

iceboy

我在想, 肯定有人想要利用楼主的代码, 来证明自己能检测到 phide_ex 了

hehao_00

哎~能详细点吗 太菜了 不会用

suanzi

全部代码贴出来了 还要多详细