tusereg.bas

提供进程监视[包括启动参数] 进程检测[包括启动参数] 网络连接检测 SSDT检测 BHO检测 IE插件检测 自启动项检测 -------程序部分[使用彩字显示] 包

Attribute VB_Name = "tusereg"
'Public Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long
Private Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Any, lpcbData As Long) As Long                                                                                 '   Note   that   if   you   declare   the   lpData   parameter   as   String,   you   must   pass   it   By   Value.
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Global Const HKEY_CLASSES_ROOT = &H80000000
Global Const HKEY_CURRENT_USER = &H80000001
Global Const HKEY_USERS = &H80000003
Global Const HKEY_PERFORMANCE_DATA = &H80000004
Global Const HKEY_CURRENT_CONFIG = &H80000005
Global Const HKEY_DYN_DATA = &H80000006

Private Const REG_NONE = 0
Private Const REG_SZ = 1
Private Const REG_EXPAND_SZ = 2
Private Const REG_BINARY = 3
Private Const REG_DWORD = 4
Private Const REG_DWORD_BIG_ENDIAN = 5
Private Const REG_MULTI_SZ = 7
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue As Long) As Long
Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long
Private Declare Function RegEnumValueAsAny Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegEnumValueAsAny2 Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, lpValueName As Any, lpcbValueName As Long, lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Public Declare Function ExpandEnvironmentStrings Lib "kernel32" Alias "ExpandEnvironmentStringsA" (ByVal lpSrc As String, ByVal lpDst As String, ByVal nSize As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long         ' Note that if you declare the lpData parameter as String, you must pass it By Value.
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

Dim prkeyEumn(0 To 500) As String
Dim pckeyEumn As Integer
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const STANDARD_RIGHTS_ALL = &H1F0000
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_SET_VALUE = &H2
Public Const KEY_CREATE_SUB_KEY = &H4
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_NOTIFY = &H10
Public Const KEY_CREATE_LINK = &H20
Public Const SYNCHRONIZE = &H100000
Public Const DELETE = &H10000
Public Const KEY_DELETE = &H2E
Public Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_DELETE Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))

Public Function DeleteValue(ByVal mainkey As Long, ByVal keyname As String, ByVal valueN As String, ByVal cType As Integer) As String

Dim hk2 As String
If RegOpenKeyEx(mainkey, keyname, 0, KEY_ALL_ACCESS, hk) <> ERROR_SUCCESS Then
RegCloseKey hk
MsgBox "权限不够 -删除操作失败!", 16
Exit Function
End If
If cType = 2 Then
   j = RegDeleteKey(hk, valueN)
   RegCloseKey hk
End If
If cType = 1 Then
   RegDeleteValue hk, valueN
   RegCloseKey hk
End If
'If uqx = True Then ChangeMetoken.CleanUp (hk2): uqx = False
End Function
    

  Public Function ReadValue(ByVal mainkey As Long, ByVal keyname As String, ByVal value As String) As String
  Dim phkResult     As Long
  Dim re     As Long
  Dim Buffer     As String
  Dim size     As Long
  On Error GoTo err
  If RegOpenKeyEx(mainkey, keyname, 0, KEY_ALL_ACCESS, phkResult) <> ERROR_SUCCESS Then
            Call RegCloseKey(phkResult)
  End If
  re = RegQueryValueEx(phkResult, value, 0, REG_SZ, 0&, size)
  If re <> ERROR_SUCCESS Then
          Call RegCloseKey(phkResult)
  End If
  Buffer = String$(size - 1, 0)
    
  re = RegQueryValueEx(phkResult, value, 0, REG_SZ, Buffer, size)
  If re <> ERROR_SUCCESS Then
          Call RegCloseKey(phkResult)
  End If
  re = RegQueryValueEx(phkResult, value, 0, REG_SZ, Buffer, size)
  ReadValue = Buffer       '返回函数值
err:
  Call RegCloseKey(phkResult)
  End Function
    
 
  Public Function ReadValuem(ByVal mainkey As Long, ByVal keyname As String, ByVal value As String) As String
  Dim phkResult     As Long
  Dim re     As Long
  Dim Buffer     As String
  Dim size     As Long
  On Error GoTo err
  If RegOpenKeyEx(mainkey, keyname, 0, KEY_ALL_ACCESS, phkResult) <> ERROR_SUCCESS Then
            Call RegCloseKey(phkResult)
  End If
  re = RegQueryValueEx(phkResult, value, 0, 7, 0&, size)
  If re <> ERROR_SUCCESS Then
          Call RegCloseKey(phkResult)
  End If
  Buffer = String$(size - 1, 0)
    
  re = RegQueryValueEx(phkResult, value, 0, 7, Buffer, size)
  If re <> ERROR_SUCCESS Then
          Call RegCloseKey(phkResult)
  End If
  re = RegQueryValueEx(phkResult, value, 0, 7, Buffer, size)
  If Len(Buffer) <> 0 Then
  Dim SArr() As String
  MultiStringToStringArray Buffer, SArr
  For i = 0 To UBound(SArr)
  o = InStr(SArr(i), " ")
  If o <> 0 Then
  swq1 = left(SArr(i), o)
  swq2 = right(SArr(i), Len(SArr(i)) - o)
  k = InStr(swq2, " ")
  If k <> 0 Then
  cs = right(swq2, Len(swq2) - k + 1)
  swq2 = left(swq2, k - 1)
  Else
  cs = ""
  End If
  fpaf = GSystemPath & "\" & swq2 & ".exe" & cs
  gui.AddTextData swq1 & " :" & fpaf, 0
  End If
  Next i
  End If
err:
  Call RegCloseKey(phkResult)
  End Function
    
 

  '进行调用
    
Function oRegOpenKey(ByVal hKey As Long, ByVal lpszSubKey As String, phkResult As Long) As Boolean
  Dim lResult As Long
  On Error GoTo 0 '关闭错误陷阱
  lResult = RegOpenKey(hKey, lpszSubKey, phkResult)
  If lResult = 0 Then
    oRegOpenKey = True
  Else: oRegOpenKey = False
  End If
End Function

Function RegSetStringValue(ByVal hKey As Long, ByVal strValueName As String, ByVal strData As String, Optional ByVal flog) As Boolean
  Dim lResult As Long
  On Error GoTo 0
  lResult = RegSetValueEx(hKey, strValueName, 0&, REG_SZ, ByVal strData, LenB(StrConv(strData, vbFromUicode)) + 1)
'StrConv是Visual Basic提供的函数，
'返回按指定类型转换的Variant(String)。
'vbFromUicode是Visual Basic的系统常数。
'在上面程序中，StrConv(strData,vbFromUnicode)的作用是：根据系统的默认码将字符串转换成Unicode。

If lResult = 0 Then
RegSetStringValue = True
Else: RegSetStringValue = False
End If
End Function

Sub MultiStringToStringArray(S As String, S2() As String)
'S为我们读取出来的多重字符串
'S2为转换后的字符串数组
Dim count As Integer, pos As Integer, pos2 As Integer, idx As Integer
pos = InStr(S, Chr(0))

While pos > 0
count = count + 1
pos = InStr(pos + 1, S, Chr(0))
Wend
'取得多重字符串中的字符串个数
count = count ' - 1
If count < 1 Then count = 1
ReDim S2(0 To count - 1)
pos = 1
For idx = 0 To count - 1
pos2 = InStr(pos, S, Chr(0))
S2(idx) = Mid(S, pos, pos2 - pos)
pos = pos2 + 1
Next
End Sub


Public Function pRegEumn(mainkey As Long, subkey As String)
Dim hKey As Long, ret As Long, lenData As Long, typeData As Long
Dim name As String
Dim lenName As Long
Dim idx As Integer, j As Integer
Dim bName(256) As Byte