本程序实现了ring3下的注册表监管工作.由VB+VC实现.功能和瑞星的注册表监视非常类似,如下图:
目前只监视了启动项.
VC DLL下载地址是:https://p-blog.csdn.net/images/p_blog_csdn_net/chenhui530/RegistryInfo.bmp
代码先公布VB部分源码,等整理后再给出VC部分的源码:
frmRegMonitor.frm
VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "comctl32.ocx"
Begin VB.Form frmRegMonitor
Caption = "注册表监视"
ClientHeight = 3585
ClientLeft = 60
ClientTop = 345
ClientWidth = 5835
ControlBox = 0 'False
LinkTopic = "Form1"
LockControls = -1 'True
ScaleHeight = 3585
ScaleWidth = 5835
StartUpPosition = 2 '屏幕中心
Begin VB.CheckBox chkAllow
Caption = "不再提示,以后都这样处理"
Height = 255
Left = 3320
TabIndex = 11
Top = 2400
Width = 2535
End
Begin VB.Timer timerCheck
Enabled = 0 'False
Interval = 1000
Left = 2880
Top = 600
End
Begin ComctlLib.ProgressBar proBar
Height = 255
Left = 120
TabIndex = 10
Top = 3240
Width = 5655
_ExtentX = 9975
_ExtentY = 450
_Version = 327682
Appearance = 1
Max = 30
End
Begin VB.OptionButton optDisaccord
Caption = "不同意修改"
Height = 255
Left = 1680
TabIndex = 4
Top = 2400
Width = 1335
End
Begin VB.OptionButton optAgree
Caption = "同意修改"
Height = 255
Left = 160
TabIndex = 3
Top = 2400
Value = -1 'True
Width = 1335
End
Begin VB.Frame frameReg
Caption = "注册表监视"
Height = 2245
Left = 120
TabIndex = 6
Top = 60
Width = 5625
Begin VB.TextBox txtProcessPath
Height = 270
Left = 1320
TabIndex = 2
Top = 1760
Width = 4095
End
Begin VB.TextBox txtType
Height = 270
Left = 1320
TabIndex = 1
Top = 1290
Width = 4095
End
Begin VB.TextBox txtRegPath
Height = 775
Left = 1320
MultiLine = -1 'True
TabIndex = 0
Top = 300
Width = 4095
End
Begin VB.Label lblProcessPath
AutoSize = -1 'True
Caption = "进程信息:"
Height = 180
Left = 240
TabIndex = 9
Top = 1800
Width = 810
End
Begin VB.Label lType
AutoSize = -1 'True
Caption = "键值/类型:"
Height = 180
Left = 240
TabIndex = 8
Top = 1320
Width = 900
End
Begin VB.Label lPath
AutoSize = -1 'True
Caption = "注册表路径:"
Height = 180
Left = 240
TabIndex = 7
Top = 360
Width = 990
End
End
Begin VB.CommandButton cmdOK
Cancel = -1 'True
Caption = "确定(&O)"
Default = -1 'True
Height = 375
Left = 4740
TabIndex = 5
Top = 2760
Width = 975
End
Begin VB.Menu mnuPopMenu
Caption = ""
Visible = 0 'False
Begin VB.Menu mnuExit
Caption = "退出程序"
End
End
End
Attribute VB_Name = "frmRegMonitor"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function InstallRegHook Lib "RegistryInfo.dll" (ByVal strCheck As String) As Long
Private Declare Function UninstallRegHook Lib "RegistryInfo.dll" () As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Sub InitCommonControls Lib "comctl32.dll" ()
Private Const HWND_TOPMOST = -1
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private mintSum As Integer
Private Sub cmdOK_Click()
timerCheck.Enabled = False '停止记时
mintSum = 0 '计数归0
Me.proBar.Value = 0 '进度条进度归0
gblnIsShow = False '设置不显示窗体标志状态
Me.Hide '隐藏窗体
End Sub
Private Sub Form_Initialize()
If App.PrevInstance Then End '重复加载就直接退出
InitCommonControls
End Sub
Private Sub Form_Load()
strIniFilePath = App.Path & "/Config.ini" '设置设置文件路径
Me.Hide '隐藏主窗体
SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE '最前端显示
StartHook Me.hwnd '消息钩子主要是获取DLL传来的消息 ,消息名是WM_COPYDATA
SendToTray '添加托盘图标
InstallRegHook "http://blog.csdn.net/chenhui530/" '安装全局API钩子
End Sub
Private Sub Form_Unload(Cancel As Integer)
If Not gblnIsEnd Then
Cancel = 1 '如果不是真的退出就不准卸载窗体
Exit Sub
End If
gblnIsShow = False '不显示窗体,防止在退出的时候还有几个消息没显示,这样的话会再次加载主窗体对象这样当次退出就无效了
DeleteSysTray '删除托盘
Unhook Me.hwnd '卸载消息钩子
UninstallRegHook '卸载API钩子
Unload Me '退出程序
End Sub
Private Sub mnuExit_Click()
Erase gstrArray '清空消息
gblnIsEnd = True '确定退出状态
cmdOK_Click '使本次生效并且关闭记时器控件等
Unload Me '卸载窗体准备退出
End Sub
Private Sub timerCheck_Timer()
If mintSum >= 30 Then '当等于30秒时就隐藏界面
timerCheck.Enabled = False
mintSum = 0
gblnIsShow = False
Me.Hide
End If
mintSum = mintSum + 1 '增加计数当大于等于30时隐藏界面
Me.proBar.Value = mintSum '显示进度
End Sub
Private Sub txtProcessPath_KeyPress(KeyAscii As Integer)
KeyAscii = 0 '不允许输入
End Sub
Private Sub txtRegPath_KeyPress(KeyAscii As Integer)
KeyAscii = 0 '不允许输入
End Sub
Private Sub txtType_KeyPress(KeyAscii As Integer)
KeyAscii = 0 '不允许输入
End Sub
modControls.bas
Attribute VB_Name = "modControls"
Option Explicit
'获取注册表子路径
Public Function GetRegistrySubPath(ByVal strRegPath As String) As String
Dim strTmp As String, blnIsMachine As Boolean, intStart As Integer
If InStr(strRegPath, "/REGISTRY/MACHINE") > 0 Then blnIsMachine = True
intStart = InStr(strRegPath, "*value:")
If intStart > 0 Then
If blnIsMachine Then
strTmp = Mid(strRegPath, Len("/REGISTRY/MACHINE") + 2, intStart - Len("/REGISTRY/MACHINE") - 1)
Else
strTmp = Mid(strRegPath, Len("/REGISTRY/USER") + 2, intStart - Len("/REGISTRY/USER") - 1)
End If
strTmp = GetPath(strTmp)
GetRegistrySubPath = Left(strTmp, Len(strTmp) - 1)
Exit Function
Else
intStart = InStr(strRegPath, "**")
If intStart > 0 Then
If blnIsMachine Then
strTmp = Mid(strRegPath, Len("/REGISTRY/MACHINE") + 2, intStart - Len("/REGISTRY/MACHINE") - 1)
Else
strTmp = Mid(strRegPath, Len("/REGISTRY/USER") + 2, intStart - Len("/REGISTRY/USER") - 1)
End If
strTmp = GetPath(strTmp)
GetRegistrySubPath = Left(strTmp, Len(strTmp) - 1)
Exit Function
End If
intStart = InStr(strRegPath, "^^")
If intStart > 0 Then
If blnIsMachine Then
strTmp = Mid(strRegPath, Len("/REGISTRY/MACHINE") + 2, intStart - Len("/REGISTRY/MACHINE") - 1)
Else
strTmp = Mid(strRegPath, Len("/REGISTRY/USER") + 2, intStart - Len("/REGISTRY/USER") - 1)
End If
strTmp = GetPath(strTmp)
GetRegistrySubPath = Left(strTmp, Len(strTmp) - 1)
Exit Function
End If
End If
End Function
'获取注册表的keyRoot
Public Function GetRoot(ByVal strRegPath As String) As keyRoot
If InStr(UCase(strRegPath), "/REGISTRY/MACHINE") > 0 Then
GetRoot = HKEY_LOCAL_MACHINE
ElseIf InStr(UCase(strRegPath), "/REGISTRY/USER") > 0 Then
GetRoot = HKEY_USERS
End If
End Function
'获取keyRoot对应的字符串
Public Function GetRootString(ByVal strRegPath As String) As String
If InStr(UCase(strRegPath), "/REGISTRY/MACHINE") > 0 Then
GetRootString = "HKEY_LOCAL_MACHINE"
ElseIf InStr(UCase(strRegPath), "/REGISTRY/USER") > 0 Then
GetRootString = "HKEY_USERS"
End If
End Function
'获取注册表路径,因为从DLL传来的是以REGISTRY开始的
Public Function GetRegistryPath(ByVal strRegPath As String) As String
Dim strTmp As String, blnIsMachine As Boolean, intStart As Integer
strTmp = GetRootString(strRegPath)
If InStr(strRegPath, "/REGISTRY/MACHINE") > 0 Then blnIsMachine = True
intStart = InStr(strRegPath, "*value:")
If intStart > 0 Then
If blnIsMachine Then
strTmp = strTmp & Mid(strRegPath, Len("/REGISTRY/MACHINE") + 1, intStart - Len("/REGISTRY/MACHINE") - 1)
Else
strTmp = strTmp & Mid(strRegPath, Len("/REGISTRY/USER") + 1, intStart - Len("/REGISTRY/USER") - 1)
End If
strTmp = GetPath(strTmp)
GetRegistryPath = Left(strTmp, Len(strTmp) - 1)
Exit Function
Else
intStart = InStr(strRegPath, "**")
If intStart > 0 Then
If blnIsMachine Then
strTmp = strTmp & Mid(strRegPath, Len("/REGISTRY/MACHINE") + 1, intStart - Len("/REGISTRY/MACHINE") - 1)
Else
strTmp = strTmp & Mid(strRegPath, Len("/REGISTRY/USER") + 1, intStart - Len("/REGISTRY/USER") - 1)
End If
strTmp = GetPath(strTmp)
GetRegistryPath = Left(strTmp, Len(strTmp) - 1)
Exit Function
End If
intStart = InStr(strRegPath, "^^")
If intStart > 0 Then
If blnIsMachine Then
strTmp = strTmp & Mid(strRegPath, Len("/REGISTRY/MACHINE") + 1, intStart - Len("/REGISTRY/MACHINE") - 1)
Else
strTmp = strTmp & Mid(strRegPath, Len("/REGISTRY/USER") + 1, intStart - Len("/REGISTRY/USER") - 1)