Integer = &H20000狗带是什么意思思
点击联系发帖人
时间：2015-09-17 07:04
QQ直播是.NET 编的吗？_百度知道
QQ直播是.NET 编的吗？
QQ直播.NET
做东西能插播放器
我有更好的答案
给你我的程序，自己研究一下吧，我也不是很明白。
Public Class Form1
Private Declare Auto Function PlaySound Lib &winmm.dll& (ByVal lpszSoundName As String, ByVal hModule As Integer, ByVal dwFlags As Integer) As Integer
Const SND_filename As Integer = &H20000
Const SND_alias As Integer = &H10000
Const SND_sync As Integer = &H0
Declare Auto Function waveOutGetNumDevs Lib &winmm.dll& Alias &waveOutGetNumDevs& () As Integer
Declare Auto Function sndPlaySound Lib &winmm.dll& (ByVal filename As String, ByVal options As Integer) As Integer
Private Const SND_memory As Integer = &H4
Private Const SND_async As Integer = &H1
Private Const pr...
QQ直播不是.NET编的.net做的东东能插播放器
Microsoft?? Visual Studio?? 2005 visual c++ 8.0
可以播放哦
其他类似问题
为您推荐：
qq直播的相关知识
等待您来回答
下载知道APP
随时随地咨询
出门在外也不愁反病毒工具之注册表监视器 - CSDN博客
本程序实现了ring3下的注册表监管工作.由VB+VC实现.功能和瑞星的注册表监视非常类似,如下图:
目前只监视了启动项.
VC DLL下载地址是:
代码先公布VB部分源码,等整理后再给出VC部分的源码:
frmRegMonitor.frm
VERSION 5.00Object = &{6B7E1B-AFC0-DA7}#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&& mandButton 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&& EndEndAttribute VB_Name = &frmRegMonitor&Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = TrueAttribute VB_Exposed = FalseOption ExplicitPrivate Declare Function InstallRegHook Lib &RegistryInfo.dll& (ByVal strCheck As String) As LongPrivate Declare Function UninstallRegHook Lib &RegistryInfo.dll& () As LongPrivate 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 LongPrivate Declare Sub InitCommonControls Lib &comctl32.dll& ()Private Const HWND_TOPMOST = -1Private Const SWP_NOSIZE = &H1Private Const SWP_NOMOVE = &H2Private 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 '重复加载就直接退出&&& InitCommonControlsEnd 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 && '安装全局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
'获取注册表的keyRootPublic 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 IfEnd 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 IfEnd 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)&&&&&&&&&&& End If&&&&&&&&&&& strTmp = GetPath(strTmp)&&&&&&&&&&& GetRegistryPath = Left(strTmp, Len(strTmp) - 1)&&&&&&&&&&& Exit Function&&&&&&& End If&&& End IfEnd Function
'获取DLL传来的完整信息Public Function GetFullPath(ByVal strPath As String)&&& Dim strTmp As String, intStart As Integer&&& intStart = InStr(strPath, &:&)&&& If intStart & 0 Then&&&&&&& strTmp = Mid(strPath, intStart + 1, Len(strPath) - intStart)&&& End If&&& GetFullPath = strTmpEnd Function
'获取注册表键名Public Function GetRegValueName(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 = GetFileName(strTmp)&&&&&&& GetRegValueName = strTmp&&&&&&& 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 = GetFileName(strTmp)&&&&&&&&&&& GetRegValueName = strTmp&&&&&&&&&&& 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)&&&&&&&&&&& End If&&&&&&&&&&& strTmp = GetFileName(strTmp)&&&&&&&&&&& GetRegValueName = strTmp&&&&&&&&&&& Exit Function&&&&&&& End If&&& End IfEnd Function
'获取注册表键值Public Function GetRegValue(ByVal strRegPath As String) As String&&& Dim strTmp As String, intStart As Integer, intStart1 As Integer&&& intStart = InStr(strRegPath, &*value:&)&&& If intStart & 0 Then&&&&&&& intStart1 = InStr(strRegPath, &**&)&&&&&&& If intStart1 & 0 Then&&&&&&&&&&& strTmp = Mid(strRegPath, intStart + Len(&*value:&), intStart1 - intStart - Len(&*value:&))&&&&&&&&&&& GetRegValue = strTmp&&&&&&& Else&&&&&&&&&&& intStart1 = InStr(strRegPath, &^^&)&&&&&&&&&&& If intStart1 & 0 Then&&&&&&&&&&&&&&& strTmp = Mid(strRegPath, intStart + Len(&*value:&), intStart1 - intStart - Len(&*value:&))&&&&&&&&&&&&&&& GetRegValue = strTmp&&&&&&&&&&& Else&&&&&&&&&&&&&&& GetRegValue = &&&&&&&&&&&&& End If&&&&&&& End If&&& Else&&&&&&& GetRegValue = &&&&& End IfEnd Function
'获取操作类型Public Function GetRegistryType(ByVal strRegPath As String) As String&&& Dim strTmp As String, intStart As Integer, intStart1 As Integer&&& intStart = InStr(strRegPath, &**&)&&& If intStart & 0 Then&&&&&&& intStart1 = InStr(strRegPath, &^^&)&&&&&&& If intStart1 & 0 Then&&&&&&&&&&& strTmp = Mid(strRegPath, intStart + Len(&**&), intStart1 - intStart - Len(&**&))&&&&&&&&&&& GetRegistryType = strTmp&&&&&&& Else&&&&&&&&&&& GetRegistryType = &&&&&&&&& End If&&& Else&&&&&&& GetRegistryType = &&&&& End If&&& GetRegistryType = GetRegType(GetRegistryType)End Function
'把注册表类型的字符串类型转换成ValueTypePublic Function GetRegType(ByVal strRegType As String) As ValueType&&& Select Case strRegType&&&&&&& Case &1&&&&&&&&&&&& GetRegType = REG_SZ&&&&&&& Case &2&&&&&&&&&&&& GetRegType = REG_EXPAND_SZ&&&&&&& Case &3&&&&&&&&&&&& GetRegType = REG_BINARY&&&&&&& Case &4&&&&&&&&&&&& GetRegType = REG_DWORD&&&&&&& Case &7&&&&&&&&&&&& GetRegType = REG_MULTI_SZ&&&&&&& Case Else&&&&&&&&&&& GetRegType = REG_SZ&&& End SelectEnd Function
'注册表类型的字符串型转换成LONG型Public Function GetRegTypeLng(ByVal strRegType As String) As ValueType&&& Select Case strRegType&&&&&&& Case &1&&&&&&&&&&&& GetRegTypeLng = 1&&&&&&& Case &2&&&&&&&&&&&& GetRegTypeLng = 2&&&&&&& Case &3&&&&&&&&&&&& GetRegTypeLng = 3&&&&&&& Case &4&&&&&&&&&&&& GetRegTypeLng = 4&&&&&&& Case &7&&&&&&&&&&&& GetRegTypeLng = 7&&&&&&& Case Else&&&&&&&&&&& GetRegTypeLng = 1&&& End SelectEnd Function
'获取指定注册表类型对应的类型Public Function GetRegTypeString(ByVal strRegType As String) As String&&& Select Case strRegType&&&&&&& Case &1&&&&&&&&&&&& GetRegTypeString = ®_SZ&&&&&&&& Case &2&&&&&&&&&&&& GetRegTypeString = ®_EXPAND_SZ&&&&&&&& Case &3&&&&&&&&&&&& GetRegTypeString = ®_BINARY&&&&&&&& Case &4&&&&&&&&&&&& GetRegTypeString = ®_DWORD&&&&&&&& Case &7&&&&&&&&&&&& GetRegTypeString = ®_MULTI_SZ&&&&&&&& Case Else&&&&&&&&&&& GetRegTypeString = ®_SZ&&&& End SelectEnd Function
'获取进程路径信息包括没分离的PID信息Public Function GetRegProcessPath(ByVal strRegPath As String) As String&&& Dim strTmp As String, intStart As Integer&&& intStart = InStr(strRegPath, &^^&)&&& If intStart & 0 Then&&&&&&& strTmp = Mid(strRegPath, intStart + 2, Len(strRegPath) - intStart)&&& End If&&& GetRegProcessPath = strTmpEnd Function
'获取进程路径信息Public Function GetRegProcessPathEx(ByVal strRegPath As String) As String&&& Dim strTmp As String, intStart As Integer&&& intStart = InStr(strRegPath, &^^&)&&& If intStart & 0 Then&&&&&&& strTmp = Mid(strRegPath, intStart + 2, InStr(strRegPath, &进程ID&&) - 2 - intStart)&&& End If&&& GetRegProcessPathEx = strTmpEnd Function
'此函数从字符串中分离出路径Public Function GetPath(ByVal strPathIn As String) As String&&& Dim i As Integer&&& For i = Len(strPathIn) To 1 Step -1&&&&&&& If InStr(&:/&, Mid$(strPathIn, i, 1)) Then Exit For&&& Next&&& GetPath = Left$(strPathIn, i)End Function
'此函数从字符串中分离出文件名Public Function GetFileName(ByVal strFileIn As String) As String&&& Dim i As Integer&&& For i = Len(strFileIn) To 1 Step -1&&&&&&& If InStr(&/&, Mid$(strFileIn, i, 1)) Then Exit For&&& Next&&& GetFileName = Mid$(strFileIn, i + 1, Len(strFileIn) - i)End Function
modIni.bas
Attribute VB_Name = &modIni&Option Explicit''''''''''''''''''''''''''读写INI文件模块'''''''''''''''''''''''''Private Declare Function GetPrivateProfileSection Lib &KERNEL32& Alias &GetPrivateProfileSectionA& (ByVal lpAppName As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As LongPrivate Declare Function GetPrivateProfileString Lib &KERNEL32& Alias &GetPrivateProfileStringA& (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As LongPrivate Declare Function WritePrivateProfileString Lib &KERNEL32& Alias &WritePrivateProfileStringA& (ByVal lpApplicationName As String, ByVal lpKeyName As Any, lpString As Any, ByVal lpFileName As String) As LongPublic strIniFilePath As String '设置文件路径
'读取指定节点下对应名称的值Public Function GetiniValue(ByVal lpKeyName As String, ByVal strName As String, ByVal strIniFile As String) As String&&& Dim strTmp As String * 32767&&& Call GetPrivateProfileString(lpKeyName, strName, &&, strTmp, Len(strTmp), strIniFile)&&& GetiniValue = Left$(strTmp, InStr(strTmp, vbNullChar) - 1)End Function
'给指定节点下对名称赋值Public Function WriteIniStr(ByVal strSection As String, ByVal strKey As String, ByVal strData As String, ByVal strIniFile As String) As Boolean&&& On Error GoTo WriteIniStrErr&&& WriteIniStr = True&&& If strData = &0& Then&&&&&&& WritePrivateProfileString strSection, strKey, ByVal 0, strIniFile&&& Else&&&&&&& WritePrivateProfileString strSection, strKey, ByVal strData, strIniFile&&& End If&&& Exit FunctionWriteIniStrErr:&&& err.Clear&&& WriteIniStr = FalseEnd Function
'获取指定节电下的最大索引Public Function GetMaxIndex(ByVal strSection As String, strIniFile As String) As String&&& Dim strReturn As String * 32767&&& Dim strTmp As String&&& Dim lngReturn As Integer, i As Integer, strTmpArray() As String, sum As Integer&&& lngReturn = GetPrivateProfileSection(strSection, strReturn, Len(strReturn), strIniFile)&&& strTmp = Left(strReturn, lngReturn)&&& strTmpArray = Split(strTmp, Chr(0))&&& For i = 0 To UBound(strTmpArray)&&&&&&& If strTmpArray(i) && && And strTmpArray(i) && Chr(0) Then&&&&&&&&&&& strTmp = Left(strTmpArray(i), InStr(strTmpArray(i), &=&) - 1)&&&&&&&&&&& If Val(strTmp) & sum Then sum = Val(strTmp)&&&&&&& End If&&& Next&&& GetMaxIndex = sum + 1End Function
'判断数据是否已经添加过了Public Function IsIniDataExist(ByVal strSection As String, ByVal strData As String, ByVal strIniFile As String) As String&&& Dim strReturn As String * 32767&&& Dim strTmp As String&&& Dim lngReturn As Integer, i As Integer, strTmpArray() As String, sum As Integer&&& lngReturn = GetPrivateProfileSection(strSection, strReturn, Len(strReturn), strIniFile)&&& strTmp = Left(strReturn, lngReturn)&&& strTmpArray = Split(strTmp, Chr(0))&&& For i = 0 To UBound(strTmpArray)&&&&&&& If strTmpArray(i) && && And strTmpArray(i) && Chr(0) Then&&&&&&&&&&& strTmp = Trim(Mid(strTmpArray(i), InStr(strTmpArray(i), &=&) + 1, Len(strTmpArray(i)) - InStr(strTmpArray(i), &=&)))&&&&&&&&&&& If strTmp && && Then&&&&&&&&&&&&&&& If LCase(strTmp) = LCase(strData) Then&&&&&&&&&&&&&&&&&&& IsIniDataExist = Left(strTmpArray(i), InStr(strTmpArray(i), &=&) - 1)&&&&&&&&&&&&&&&&&&& Exit Function&&&&&&&&&&&&&&& End If&&&&&&&&&&& End If&&&&&&& End If&&& NextEnd Function
modRegistry.bas
Attribute VB_Name = &modRegistry&Option Explicit
'---------------------------------------------------------------'- 注册表 API 声明...'---------------------------------------------------------------Private Declare Function RegCloseKey Lib &advapi32.dll& (ByVal hKey As Long) As LongPrivate Declare Function RegCreateKeyEx Lib &advapi32.dll& Alias &RegCreateKeyExA& (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition As Long) As LongPrivate Declare Function RegDeleteKey Lib &advapi32.dll& Alias &RegDeleteKeyA& (ByVal hKey As Long, ByVal lpSubKey As String) As LongPrivate Declare Function RegDeleteValue Lib &advapi32.dll& Alias &RegDeleteValueA& (ByVal hKey As Long, ByVal lpValueName As String) As LongPrivate 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 LongPrivate Declare Function RegQueryValueEx Lib &advapi32.dll& Alias &RegQueryValueExA& (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As LongPrivate Declare Function RegRestoreKey Lib &advapi32.dll& Alias &RegRestoreKeyA& (ByVal hKey As Long, ByVal lpFile As String, ByVal dwFlags As Long) As LongPrivate Declare Function RegSaveKey Lib &advapi32.dll& Alias &RegSaveKeyA& (ByVal hKey As Long, ByVal lpFile As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As LongPrivate 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 LongPrivate Declare Function RegQueryInfoKey Lib &advapi32.dll& Alias &RegQueryInfoKeyA& (ByVal hKey As Long, ByVal lpClass As String, lpcbClass As Long, ByVal lpReserved As Long, lpcSubKeys As Long, lpcbMaxSubKeyLen As Long, lpcbMaxClassLen As Long, lpcValues As Long, lpcbMaxValueNameLen As Long, lpcbMaxValueLen As Long, lpcbSecurityDescriptor As Long, lpftLastWriteTime As FILETIME) As LongPrivate Declare Function RegEnumValue Lib &advapi32.dll& Alias &RegEnumValueA& (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As LongPrivate 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 LongPrivate Declare Function RegOpenKey Lib &advapi32.dll& Alias &RegOpenKeyA& (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As LongPrivate 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
Private Declare Function AdjustTokenPrivileges Lib &advapi32.dll& (ByVal TokenHandle As Long, ByVal DisableAllPriv As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long&&&&&&&&&&&&&&& 'Used to adjust your program's security privileges, can't restore without it!Private Declare Function LookupPrivilegeValue Lib &advapi32.dll& Alias &LookupPrivilegeValueA& (ByVal lpSystemName As Any, ByVal lpName As String, lpLuid As LUID) As Long&&&&&&&&& 'Returns a valid LUID which is important when making security changes in NT.Private Declare Function OpenProcessToken Lib &advapi32.dll& (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As LongPrivate Declare Function GetCurrentProcess Lib &kernel32& () As Long
'---------------------------------------------------------------'- 注册表 Api 常数...'---------------------------------------------------------------' 注册表创建类型值...Const REG_OPTION_NON_VOLATILE = 0&&&&&&& ' 当系统重新启动时，关键字被保留
' 注册表关键字安全选项...Const READ_CONTROL = &H20000Const KEY_QUERY_VALUE = &H1Const KEY_SET_VALUE = &H2Const KEY_CREATE_SUB_KEY = &H4Const KEY_ENUMERATE_SUB_KEYS = &H8Const KEY_NOTIFY = &H10Const KEY_CREATE_LINK = &H20Const KEY_READ = KEY_QUERY_VALUE + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + READ_CONTROLConst KEY_WRITE = KEY_SET_VALUE + KEY_CREATE_SUB_KEY + READ_CONTROLConst KEY_EXECUTE = KEY_READConst KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL&&&&&&&&&&&&&&&&&&&& ' 返回值...Const ERROR_NONE = 0Const ERROR_BADKEY = 2Const ERROR_ACCESS_DENIED = 8Const ERROR_SUCCESS = 0
' 有关导入/导出的常量Const REG_FORCE_RESTORE As Long = 8&Const TOKEN_QUERY As Long = &H8&Const TOKEN_ADJUST_PRIVILEGES As Long = &H20&Const SE_PRIVILEGE_ENABLED As Long = &H2Const SE_RESTORE_NAME = &SeRestorePrivilege&Const SE_BACKUP_NAME = &SeBackupPrivilege&
'---------------------------------------------------------------'- 注册表类型...'---------------------------------------------------------------Private Type SECURITY_ATTRIBUTES&&& nLength As Long&&& lpSecurityDescriptor As Long&&& bInheritHandle As BooleanEnd Type
Private Type FILETIME&&& dwLowDateTime As Long&&& dwHighDateTime As LongEnd Type
Private Type LUID&&& lowpart As Long&&& highpart As LongEnd Type
Private Type LUID_AND_ATTRIBUTES&&& pLuid As LUID&&& Attributes As LongEnd Type
Private Type TOKEN_PRIVILEGES&&& PrivilegeCount As Long&&& Privileges As LUID_AND_ATTRIBUTESEnd Type
'---------------------------------------------------------------'- 自定义枚举类型...'---------------------------------------------------------------' 注册表数据类型...Public Enum ValueType&&& REG_SZ = 1&&&&&&&&&&&&&&&&&&&&&&&& ' 字符串值&&& REG_EXPAND_SZ = 2&&&&&&&&&&&&&&&&& ' 可扩充字符串值&&& REG_BINARY = 3&&&&&&&&&&&&&&&&&&&& ' 二进制值&&& REG_DWORD = 4&&&&&&&&&&&&&&&&&&&&& ' DWORD值&&& REG_MULTI_SZ = 7&&&&&&&&&&&&&&&&&& ' 多字符串值End Enum
' 注册表关键字根类型...Public Enum keyRoot&&& HKEY_CLASSES_ROOT = &H&&& HKEY_CURRENT_USER = &H&&& HKEY_LOCAL_MACHINE = &H&&& HKEY_USERS = &H&&& HKEY_PERFORMANCE_DATA = &H&&& HKEY_CURRENT_CONFIG = &H&&& HKEY_DYN_DATA = &HEnd Enum
Public strstring As StringPrivate hKey As Long&&&&&&&&&&&&&&&&&& ' 注册表打开项的句柄Private i As Long, j As Long&&&&&&&&&& ' 循环变量Private Success As Long&&&&&&&&&&&&&&& ' API函数的返回值, 判断函数调用是否成功
'-------------------------------------------------------------------------------------------------------------'- 新建注册表关键字并设置注册表关键字的值...'- 如果 ValueName 和 Value 都缺省, 则只新建 KeyName 空项, 无子键...'- 如果只缺省 ValueName 则将设置指定 KeyName 的默认值'- 参数说明: KeyRoot--根类型, KeyName--子项名称, ValueName--值项名称, Value--值项数据, ValueType--值项类型'-------------------------------------------------------------------------------------------------------------Public Function SetKeyValue(keyRoot As keyRoot, KeyName As String, Optional ValueName As String, Optional Value As Variant = &&, Optional ValueType As ValueType = REG_SZ) As Boolean&&& Dim lpAttr As SECURITY_ATTRIBUTES&&&&&&&&&&&&&&&&&& ' 注册表安全类型&&& lpAttr.nLength = 50&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ' 设置安全属性为缺省值...&&& lpAttr.lpSecurityDescriptor = 0&&&&&&&&&&&&&&&&&&&& ' ...&&& lpAttr.bInheritHandle = True&&&&&&&&&&&&&&&&&&&&&&& ' ...&&& &&& ' 新建注册表关键字...&&& Success = RegCreateKeyEx(keyRoot, KeyName, 0, ValueType, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, lpAttr, hKey, 0)&&& If Success && ERROR_SUCCESS Then SetKeyValue = False: RegCloseKey hKey: Exit Function&&& &&& ' 设置注册表关键字的值...&&& If IsMissing(ValueName) = False Then&&&&&&& Select Case ValueType&&&&&&&&&&& Case REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ&&&&&&&&&&&&&&& Success = RegSetValueEx(hKey, ValueName, 0, ValueType, ByVal CStr(Value), LenB(StrConv(Value, vbFromUnicode)) + 1)&&&&&&&&&&& Case REG_DWORD&&&&&&&&&&&&&&& If CDbl(Value) &= # And CDbl(Value) &= 0 Then&&&&&&&&&&&&&&&&&&& Dim sValue As String&&&&&&&&&&&&&&&&&&& sValue = DoubleToHex(Value)&&&&&&&&&&&&&&&&&&& Dim dValue(3) As Byte&&&&&&&&&&&&&&&&&&& dValue(0) = Format(&&h& & Mid(sValue, 7, 2))&&&&&&&&&&&&&&&&&&& dValue(1) = Format(&&h& & Mid(sValue, 5, 2))&&&&&&&&&&&&&&&&&&& dValue(2) = Format(&&h& & Mid(sValue, 3, 2))&&&&&&&&&&&&&&&&&&& dValue(3) = Format(&&h& & Mid(sValue, 1, 2))&&&&&&&&&&&&&&&&&&& Success = RegSetValueEx(hKey, ValueName, 0, ValueType, dValue(0), 4)&&&&&&&&&&&&&&& Else&&&&&&&&&&&&&&&&&&& Success = ERROR_BADKEY&&&&&&&&&&&&&&& End If&&&&&&&&&&& Case REG_BINARY&&&&&&&&&&&&&&& On Error Resume Next&&&&&&&&&&&&&&& Success = 1&&&&&&&&&&&&&&&&&&&&&&&&&&&& ' 假设调用API不成功(成功返回0)&&&&&&&&&&&&&&& ReDim tmpValue(UBound(Value)) As Byte&&&&&&&&&&&&&&& For i = 0 To UBound(tmpValue)&&&&&&&&&&&&&&&&&&& tmpValue(i) = Value(i)&&&&&&&&&&&&&&& Next i&&&&&&&&&&&&&&& Success = RegSetValueEx(hKey, ValueName, 0, ValueType, tmpValue(0), UBound(Value) + 1)&&&&&&& End Select&&& End If&&& If Success && ERROR_SUCCESS Then SetKeyValue = False: RegCloseKey hKey: Exit Function&&& &&& ' 关闭注册表关键字...&&& RegCloseKey hKey&&& SetKeyValue = True&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ' 返回函数值End Function
'-------------------------------------------------------------------------------------------------------------'- 获得已存在的注册表关键字的值...'- 如果 ValueName=&& 则返回 KeyName 项的默认值...'- 如果指定的注册表关键字不存在, 则返回空串...'- 参数说明: KeyRoot--根类型, KeyName--子项名称, ValueName--值项名称, ValueType--值项类型'-------------------------------------------------------------------------------------------------------------Public Function GetKeyValue(ByVal keyRoot As keyRoot, ByVal KeyName As String, ByVal ValueName As String, Optional ByVal ValueType As Long) As String&&& Dim TempValue As String&&&&&&&&&&&&&&&&&&&&&&&&&&&& ' 注册表关键字的临时值&&& Dim Value As String&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ' 注册表关键字的值&&& Dim ValueSize As Long&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ' 注册表关键字的值的实际长度&&& TempValue = Space(1024)&&&&&&&&&&&&&&&&&&&&&&&&&&&& ' 存储注册表关键字的临时值的缓冲区&&& ValueSize = 1024&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ' 设置注册表关键字的值的默认长度
&&& ' 打开一个已存在的注册表关键字...&&& RegOpenKeyEx keyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey&&& If hKey = 0 Then&&&&&&& GetKeyValue = &^_*_*_^&&&&&&&& Exit Function&&& End If&&& Dim x As Integer&&& x = RegQueryValueEx(hKey, ValueName, 0, ValueType, ByVal TempValue, ValueSize)&&& ' 获得已打开的注册表关键字的值...&&& If x && 0 Then&&&&&&& If x = 2 And ValueSize = 1024 Then&&&&&&&&&&& GetKeyValue = &^_*_*_^&&&&&&&&&&&& Exit Function&&&&&&& End If&&& End If&&& ' 返回注册表关键字的的值...&&& Select Case ValueType&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ' 通过判断关键字的类型, 进行处理&&&&&&& Case REG_SZ, REG_MULTI_SZ, REG_EXPAND_SZ&&&&&&&&&&& If ValueSize & 0 Then TempValue = Left$(TempValue, ValueSize - 1)&&&&&&&&&&&&&&&&&&&&&& ' 去掉TempValue尾部空格&&&&&&&&&&& Value = TempValue&&&&&&& Case REG_DWORD&&&&&&&&&&& ReDim dValue(3) As Byte&&&&&&&&&&& RegQueryValueEx hKey, ValueName, 0, REG_DWORD, dValue(0), ValueSize&&&&&&&&&&& For i = 3 To 0 Step -1&&&&&&&&&&&&&&& Value = Value + String(2 - Len(Hex(dValue(i))), &0&) + Hex(dValue(i))&& ' 生成长度为8的十六进制字符串&&&&&&&&&&& Next i&&&&&&&&&&& If CDbl(&&H& & Value) & 0 Then&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ' 将十六进制的 Value 转换为十进制&&&&&&&&&&&&&&& Value = 2 ^ 32 + CDbl(&&H& & Value)&&&&&&&&&&& Else&&&&&&&&&&&&&&& Value = CDbl(&&H& & Value)&&&&&&&&&&& End If&&&&&&& Case REG_BINARY&&&&&&&&&&& If ValueSize & 0 Then&&&&&&&&&&&&&&& ReDim bValue(ValueSize - 1) As Byte&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ' 存储 REG_BINARY 值的临时数组&&&&&&&&&&&&&&& RegQueryValueEx hKey, ValueName, 0, REG_BINARY, bValue(0), ValueSize&&&&&&&&&&&&&&& For i = 0 To ValueSize - 1&&&&&&&&&&&&&&&&&&& Value = Value + String(2 - Len(Hex(bValue(i))), &0&) + Hex(bValue(i)) + & && ' 将数组转换成字符串&&&&&&&&&&&&&&& Next i&&&&&&&&&&& End If&&& End Select&&& &&& ' 关闭注册表关键字...&&& RegCloseKey hKey&&& Value = Trim(Value)&&& If InStr(Value, Chr(0)) Then&&&&&&& GetKeyValue = Left(Value, InStr(Value, Chr(0)) - 1)&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ' 返回函数值&&& Else&&&&&&& GetKeyValue = Value&&& End IfEnd Function
Public Function RegDeleteKeyName(mhKey As keyRoot, SubKey As String, hKeyName As String) As Boolean&&& '删除子键数据&&& 'mhKey是指主键的名称，SubKey是指路径，hKeyName是指键名&&& Dim hKey As Long, ret As Long&&& ret = RegOpenKey(mhKey, SubKey, hKey)&&& RegDeleteKeyName = False&&& If ret = 0 Then&&&&&&& If RegDeleteValue(hKey, hKeyName) = 0 Then RegDeleteKeyName = True&&& End If&&& RegCloseKey hKey '删除打开的键值，释放内存End Function
'-------------------------------------------------------------------------------------------------------------'- 将 Double 型( 限制在 0--2^32-1 )的数字转换为十六进制并在前面补零'- 参数说明: Number--要转换的 Double 型数字'-------------------------------------------------------------------------------------------------------------Private Function DoubleToHex(ByVal Number As Double) As String&&& Dim strHex As String&&& strHex = Space(8)&&& For i = 1 To 8&&&&&&& Select Case Number - Int(Number / 16) * 16&&&&&&&&&&& Case 10&&&&&&&&&&&&&&& Mid(strHex, 9 - i, 1) = &A&&&&&&&&&&&& Case 11&&&&&&&&&&&&&&& Mid(strHex, 9 - i, 1) = &B&&&&&&&&&&&& Case 12&&&&&&&&&&&&&&& Mid(strHex, 9 - i, 1) = &C&&&&&&&&&&&& Case 13&&&&&&&&&&&&&&& Mid(strHex, 9 - i, 1) = &D&&&&&&&&&&&& Case 14&&&&&&&&&&&&&&& Mid(strHex, 9 - i, 1) = &E&&&&&&&&&&&& Case 15&&&&&&&&&&&&&&& Mid(strHex, 9 - i, 1) = &F&&&&&&&&&&&& Case Else&&&&&&&&&&&&&&& Mid(strHex, 9 - i, 1) = CStr(Number - Int(Number / 16) * 16)&&&&&&& End Select&&&&&&& Number = Int(Number / 16)&&& Next i&&& DoubleToHex = strHexEnd Function
Public Function GetKeyValueType(ByVal keyRoot As keyRoot, ByVal KeyName As String, ByVal checkValueName As String) As ValueType&&& Dim f As FILETIME, CountKey As Long, CountValue As Long, MaxLenKey As Long, MaxLenValue As Long&&& Dim l As Long, s As String, strTmp As String, intTmp As Long, ValueName() As String, ValueType() As ValueType&&& &&& ' 打开一个已存在的注册表关键字...&&& Success = RegOpenKeyEx(keyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey)&&& If Success && ERROR_SUCCESS Then GetKeyValueType = 0: RegCloseKey hKey: Exit Function&&& &&& ' 获得一个已打开的注册表关键字的信息...&&& Success = RegQueryInfoKey(hKey, vbNullString, ByVal 0&, ByVal 0&, CountKey, MaxLenKey, ByVal 0&, CountValue, MaxLenValue, ByVal 0&, ByVal 0&, f)&&& &&& If Success && ERROR_SUCCESS Then GetKeyValueType = 0: RegCloseKey hKey: Exit Function
&&& If CountValue && 0 Then&&&&&&& ReDim ValueName(CountValue - 1) As String&&&&&&&&&& ' 重新定义数组, 使用数组大小与注册表关键字的子键数量匹配&&&&&&& ReDim ValueType(CountValue - 1) 'As Long&&&&&&&&&&&& ' 重新定义数组, 使用数组大小与注册表关键字的子键数量匹配&&&&&&& For i = 0 To CountValue - 1&&&&&&&&&&& strTmp = String(255, vbNullChar) 'Space(255)&&&&&&&&&&& l = 255&&&&&&&&&&& RegEnumValue hKey, i, ByVal strTmp, l, 0, intTmp, ByVal 0&, ByVal 0&&&&&&&&&&&& ValueType(i) = intTmp&&&&&&&&&&& ValueName(i) = Left(strTmp, l)&&&&&&&&&&& If InStr(ValueName(i), vbNullChar) - 1 && -1 Then&&&&&&&&&&&&&&& ValueName(i) = Left$(ValueName(i), InStr(ValueName(i), vbNullChar) - 1)&&&&&&&&&&& End If&&&&&&&&&&& If ValueName(i) = checkValueName Then&&&&&&&&&&&&&&& GetKeyValueType = ValueType(i)&&&&&&&&&&&&&&& Exit Function&&&&&&&&&&& End If&&&&&&& Next i&&& End If&&& &&& ' 关闭注册表关键字...&&& RegCloseKey hKeyEnd Function
Public Function GetKeyInfo(keyRoot As keyRoot, KeyName As String, SubKeyName() As String, ValueName() As String, ValueType() As ValueType, Optional CountKey As Long, Optional CountValue As Long, Optional MaxLenKey As Long, Optional MaxLenValue As Long) As Boolean&&& Dim f As FILETIME&&& Dim l As Long, s As String, strTmp As String, intTmp As Long&&& &&& ' 打开一个已存在的注册表关键字...&&& Success = RegOpenKeyEx(keyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey)&&& If Success && ERROR_SUCCESS Then GetKeyInfo = False: RegCloseKey hKey: Exit Function&&& &&& ' 获得一个已打开的注册表关键字的信息...&&& Success = RegQueryInfoKey(hKey, vbNullString, ByVal 0&, ByVal 0&, CountKey, MaxLenKey, ByVal 0&, CountValue, MaxLenValue, ByVal 0&, ByVal 0&, f)&&& &&& If Success && ERROR_SUCCESS Then GetKeyInfo = False: RegCloseKey hKey: Exit Function&&& &&& If CountKey && 0 Then&&&&&&& ReDim SubKeyName(CountKey - 1) As String&&&&&&&&&&& ' 重新定义数组, 使用数组大小与注册表关键字的子项数量匹配&&&&&&& For i = 0 To CountKey - 1&&&&&&&&&&& strTmp = String(255, vbNullChar) 'Space(255)&&&&&&&&&&& l = 255&&&&&&&&&&& RegEnumKeyEx hKey, i, ByVal strTmp, l, 0, vbNullString, ByVal 0&, f&&&&&&&&&&& SubKeyName(i) = Left(strTmp, l)&&&&&&&&&&& If InStr(SubKeyName(i), vbNullChar) - 1 && -1 Then&&&&&&&&&&&&&&& SubKeyName(i) = Left$(SubKeyName(i), InStr(SubKeyName(i), vbNullChar) - 1)&&&&&&&&&&& End If&&&&&&& Next i&&&&&&& &&&&&&& ' 下面的二重循环对字符串数组进行冒泡排序&&&&&&& For i = 0 To UBound(SubKeyName)&&&&&&&&&&& For j = i + 1 To UBound(SubKeyName)&&&&&&&&&&&&&&& If SubKeyName(i) & SubKeyName(j) Then&&&&&&&&&&&&&&&&&&& s = SubKeyName(i)&&&&&&&&&&&&&&&&&&& SubKeyName(i) = SubKeyName(j)&&&&&&&&&&&&&&&&&&& SubKeyName(j) = s&&&&&&&&&&&&&&& End If&&&&&&&&&&& Next j&&&&&&& Next i&&& End If
&&& If CountValue && 0 Then&&&&&&& ReDim ValueName(CountValue - 1) As String&&&&&&&&&& ' 重新定义数组, 使用数组大小与注册表关键字的子键数量匹配&&&&&&& ReDim ValueType(CountValue - 1) 'As Long&&&&&&&&&&&& ' 重新定义数组, 使用数组大小与注册表关键字的子键数量匹配&&&&&&& For i = 0 To CountValue - 1&&&&&&&&&&& strTmp = String(255, vbNullChar) 'Space(255)&&&&&&&&&&& &&&&&&&&&&& l = 255&&&&&&&&&&& RegEnumValue hKey, i, ByVal strTmp, l, 0, intTmp, ByVal 0&, ByVal 0&&&&&&&&&&&& ValueType(i) = intTmp&&&&&&&&&&& ValueName(i) = Left(strTmp, l)&&&&&&&&&&& If InStr(ValueName(i), vbNullChar) - 1 && -1 Then&&&&&&&&&&&&&&& ValueName(i) = Left$(ValueName(i), InStr(ValueName(i), vbNullChar) - 1)&&&&&&&&&&& End If&&&&&&& Next i&&&&&&& &&&&&&& ' 下面的二重循环对字符串数组进行冒泡排序&&&&&&& For i = 0 To UBound(ValueName)&&&&&&&&&&& For j = i + 1 To UBound(ValueName)&&&&&&&&&&&&&&& If ValueName(i) & ValueName(j) Then&&&&&&&&&&&&&&&&&&& s = ValueName(i)&&&&&&&&&&&&&&&&&&& ValueName(i) = ValueName(j)&&&&&&&&&&&&&&&&&&& ValueName(j) = s&&&&&&&&&&&&&&& End If&&&&&&&&&&& Next j&&&&&&& Next i&&& End If&&& &&& ' 关闭注册表关键字...&&& RegCloseKey hKey&&& GetKeyInfo = True&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ' 返回函数值End Function
Public Function RegDeleteSubkey(hKey As keyRoot, SubKey As String) As Boolean&&& '删除目录&&& 'mhKey是指主键的名称，SubKey是指路径&&& Dim ret As Long, Index As Long, hName As String&&& Dim hSubkey As Long&&& ret = RegOpenKey(hKey, SubKey, hSubkey)&&& If ret && 0 Then&&&&&&& RegDeleteSubkey = False&&&&&&& Exit Function&&& End If&&& ret = RegDeleteKey(hSubkey, &&)&&& If ret && 0 Then '如果删除失败则认为是NT则用递归方法删除目录&&&&&&& hName = String(256, Chr(0))&&&&&&& While RegEnumKey(hSubkey, 0, hName, Len(hName)) = 0 And _&&&&&&&&&&&&& RegDeleteSubkey(hSubkey, hName)&&&&&&& Wend&&&&&&& ret = RegDeleteKey(hSubkey, &&)&&& End If&&& RegDeleteSubkey = (ret = 0)&&& RegCloseKey hSubkey '删除打开的键值，释放内存End Function
Public Sub GetRegRootPath(ByVal RegPath As String, regRoot As keyRoot)&&& If InStr(UCase(RegPath), &HKEY_CLASSES_ROOT&) & 0 Then&&&&&&& regRoot = HKEY_CLASSES_ROOT&&& ElseIf InStr(UCase(RegPath), &HKEY_CURRENT_CONFIG&) & 0 Then&&&&&&& regRoot = HKEY_CURRENT_CONFIG&&& ElseIf InStr(UCase(RegPath), &HKEY_CURRENT_USER&) & 0 Then&&&&&&& regRoot = HKEY_CURRENT_USER&&& ElseIf InStr(UCase(RegPath), &HKEY_DYN_DATA&) & 0 Then&&&&&&& regRoot = HKEY_DYN_DATA&&& ElseIf InStr(UCase(RegPath), &HKEY_LOCAL_MACHINE&) & 0 Then&&&&&&& regRoot = HKEY_LOCAL_MACHINE&&& ElseIf InStr(UCase(RegPath), &HKEY_PERFORMANCE_DATA&) & 0 Then&&&&&&& regRoot = HKEY_PERFORMANCE_DATA&&& Else&&&&&&& regRoot = HKEY_USERS&&& End IfEnd Sub
Public Function GetRegSubPath(ByVal RegPath As String) As String&&& If InStr(UCase(RegPath), &HKEY_CLASSES_ROOT&) & 0 Then&&&&&&& GetRegSubPath = Mid(RegPath, Len(&HKEY_CLASSES_ROOT&) + 2, Len(RegPath) - Len(&HKEY_CLASSES_ROOT&) + 1)&&& ElseIf InStr(UCase(RegPath), &HKEY_CURRENT_CONFIG&) & 0 Then&&&&&&& GetRegSubPath = Mid(RegPath, Len(&HKEY_CURRENT_CONFIG&) + 2, Len(RegPath) - Len(&HKEY_CURRENT_CONFIG&) + 1)&&& ElseIf InStr(UCase(RegPath), &HKEY_CURRENT_USER&) & 0 Then&&&&&&& GetRegSubPath = Mid(RegPath, Len(&HKEY_CURRENT_USER&) + 2, Len(RegPath) - Len(&HKEY_CURRENT_USER&) + 1)&&& ElseIf InStr(UCase(RegPath), &HKEY_DYN_DATA&) & 0 Then&&&&&&& GetRegSubPath = Mid(RegPath, Len(&HKEY_DYN_DATA&) + 2, Len(RegPath) - Len(&HKEY_DYN_DATA&) + 1)&&& ElseIf InStr(UCase(RegPath), &HKEY_LOCAL_MACHINE&) & 0 Then&&&&&&& GetRegSubPath = Mid(RegPath, Len(&HKEY_LOCAL_MACHINE&) + 2, Len(RegPath) - Len(&HKEY_LOCAL_MACHINE&) + 1)&&& ElseIf InStr(UCase(RegPath), &HKEY_PERFORMANCE_DATA&) & 0 Then&&&&&&& GetRegSubPath = Mid(RegPath, Len(&HKEY_PERFORMANCE_DATA&) + 2, Len(RegPath) - Len(&HKEY_PERFORMANCE_DATA&) + 1)&&& Else&&&&&&& GetRegSubPath = Mid(RegPath, Len(&HKEY_USERS&) + 2, Len(RegPath) - Len(&HKEY_USERS&) + 1)&&& End IfEnd Function
'Public Sub GetRegType(ByVal RegType As String, valueTypes As ValueType)'&&& Select Case RegType'&&&&&&& Case &1&'&&&&&&&&&&& valueTypes = REG_SZ'&&&&&&& Case &2&'&&&&&&&&&&& valueTypes = REG_EXPAND_SZ'&&&&&&& Case &3&'&&&&&&&&&&& valueTypes = REG_BINARY'&&&&&&& Case &4&'&&&&&&&&&&& valueTypes = REG_DWORD'&&&&&&& Case &7&'&&&&&&&&&&& valueTypes = REG_MULTI_SZ'&&&&&&& Case Else'&&&&&&&&&&& valueTypes = REG_SZ'&&& End Select'End Sub
Public Function RegRootPathIsTrue(ByVal RegPath As String) As Boolean&&& If InStr(UCase(RegPath), &HKEY_CLASSES_ROOT&) & 0 Then&&&&&&& RegRootPathIsTrue = True&&& ElseIf InStr(UCase(RegPath), &HKEY_CURRENT_CONFIG&) & 0 Then&&&&&&& RegRootPathIsTrue = True&&& ElseIf InStr(UCase(RegPath), &HKEY_CURRENT_USER&) & 0 Then&&&&&&& RegRootPathIsTrue = True&&& ElseIf InStr(UCase(RegPath), &HKEY_DYN_DATA&) & 0 Then&&&&&&& RegRootPathIsTrue = True&&& ElseIf InStr(UCase(RegPath), &HKEY_LOCAL_MACHINE&) & 0 Then&&&&&&& RegRootPathIsTrue = True&&& ElseIf InStr(UCase(RegPath), &HKEY_PERFORMANCE_DATA&) & 0 Then&&&&&&& RegRootPathIsTrue = True&&& Else&&&&&&& RegRootPathIsTrue = False&&& End IfEnd Function
Public Function GetRegRoot(regRoot As keyRoot) As String&&& Select Case regRoot&&&&&&& Case &H&&&&&&&&&&& GetRegRoot = &HKEY_CLASSES_ROOT&&&&&&&& Case &H&&&&&&&&&&& GetRegRoot = &HKEY_CURRENT_USER&&&&&&&& Case &H&&&&&&&&&&& GetRegRoot = &HKEY_LOCAL_MACHINE&&&&&&&& Case &H&&&&&&&&&&& GetRegRoot = &HKEY_USERS&&&&&&&& Case &H&&&&&&&&&&& GetRegRoot = &HKEY_PERFORMANCE_DATA&&&&&&&& Case &H&&&&&&&&&&& GetRegRoot = &HKEY_CURRENT_CONFIG&&&&&&&& Case &H&&&&&&&&&&& GetRegRoot = &HKEY_DYN_DATA&&&& End Select&&&&&&& End Function
modSubClass.bas
Attribute VB_Name = &modSubClass&'REG_SZ = 1'REG_BINARY = 3'REG_DOWRD = 4'REG_MULTI_SZ = 7'REG_EXPAND_SZ = 2''/REGISTRY/MACHINE'/REGISTRY/USER
Option Explicit&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& Private Type POINTAPI&&& x As Long&&& y As LongEnd Type
Private Type MINMAXINFO&&& ptReserved As POINTAPI&&& ptMaxSize As POINTAPI&&& ptMaxPosition As POINTAPI&&& ptMinTrackSize As POINTAPI&&& ptMaxTrackSize As POINTAPIEnd Type
Private Declare Sub CopyMemory Lib &KERNEL32& Alias &RtlMoveMemory& (pDest As Any, pSource As Any, ByVal ByteLen As Long)
Private Declare Function CallWindowProc Lib &user32& Alias &CallWindowProcA& (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function SetWindowLong Lib &user32& Alias &SetWindowLongA& (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetWindowLong Lib &user32& Alias &GetWindowLongA& (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetForegroundWindow Lib &user32& (ByVal hwnd As Long) As Long'**************************************************************************'获取SID相关API函数Private Declare Function GetSidSubAuthorityCount Lib &advapi32.dll& (pSid As Any) As LongPrivate Declare Function GetSidIdentifierAuthority Lib &advapi32.dll& (pSid As Any) As LongPrivate Declare Function GetSidSubAuthority Lib &advapi32.dll& (pSid As Any, ByVal nSubAuthority As Long) As LongPrivate Declare Function LookupAccountName Lib &advapi32.dll& Alias &LookupAccountNameA& (ByVal IpSystemName As String, ByVal IpAccountName As String, pSid As Byte, cbSid As Long, ByVal ReferencedDomainName As String, cbReferencedDomainName As Long, peUse As Integer) As LongPrivate Declare Sub CopyByValMemory Lib &KERNEL32& Alias &RtlMoveMemory& (Destination As Any, ByVal Source As Long, ByVal Length As Long)'***************************************************************************Private Declare Sub Sleep Lib &KERNEL32& (ByVal dwMilliseconds As Long)Private Type COPYDATASTRUCT&&& dwData As Long&&& cbData As Long&&& lpData As LongEnd TypePrivate Const WM_COPYDATA = &H4APrivate lpPrevWndProc As LongPrivate Const WM_NCDESTROY = &H82Private Const GWL_WNDPROC = -4Private Const WM_HOTKEY = &H312Private Const WM_GETMINMAXINFO = &H24Private Const WM_USER = &H400Public Const WM_TRAYICON = WM_USER + 123 '托盘消息Private Const WM_RBUTTONDOWN = &H204Private Const WM_RBUTTONUP = &H205Public gblnIsEnd As Boolean '是否退出状态Public gstrArray() As String '消息数组Public glngCount As Long '消息数量Public gblnIsShow As Boolean '是否显示状态
'开始执行消息过滤Public Sub StartHook(hwnd As Long)&&& lpPrevWndProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)End Sub
'卸载消息钩子Public Sub Unhook(hwnd As Long)&&& If lpPrevWndProc && 0 Then SetWindowLong hwnd, GWL_WNDPROC, lpPrevWndProcEnd Sub
'消息过滤函数Private Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long&&& Dim objCd As COPYDATASTRUCT&&& Dim strTmp As String, strFullRegPath As String, strType As String&&& Dim strValue As String, strRegType As String, strOutType As String&&& Dim strProcessPath As String, strCmpData As String, strRegPath As String&&& Dim strFindAllowData As String, strFindNotAllowData As String&&& Select Case uMsg&&&&&&& Case WM_NCDESTROY&&&&&&&&&&& Unhook hwnd&&&&&&& Case WM_HOTKEY'&&&&&&&&&&& Call HotKeyFunctions(wParam)'&&&&&&&&&&& Exit Function&&&&&&& Case WM_GETMINMAXINFO'&&&&&&&&&&& Dim MinMax As MINMAXINFO'&&&&&&&&&&& CopyMemory MinMax, ByVal lParam, Len(MinMax)'&&&&&&&&&&& MinMax.ptMinTrackSize.x = 610'&&&&&&&&&&& MinMax.ptMinTrackSize.y = 420'&&&&&&&&&&& CopyMemory ByVal lParam, MinMax, Len(MinMax)'&&&&&&&&&&& WindowProc = 1'&&&&&&&&&&& Exit Function&&&&&&& Case WM_COPYDATA&&&&&&&&&&& '获取DLL传来的消息&&&&&&&&&&& CopyMemory objCd, ByVal lParam, Len(objCd)&&&&&&&&&&& strTmp = Space(objCd.cbData)&&&&&&&&&&& CopyMemory ByVal strTmp, ByVal objCd.lpData, objCd.cbData&&&&&&&&&&& '对消息进行分离&&&&&&&&&&& strType = Left(strTmp, InStr(strTmp, &:&))&&&&&&&&&&& strFullRegPath = GetFullPath(strTmp)&&&&&&&&&&& strProcessPath = GetRegProcessPathEx(strFullRegPath)&&&&&&&&&&& strRegPath = GetRegistryPath(strFullRegPath)&&&&&&&&&&& strCmpData = strProcessPath & &,& & GetRegistryPath(strFullRegPath)&&&&&&&&&&& strFindAllowData = IsIniDataExist(&AllowPath&, strCmpData, strIniFilePath)&&&&&&&&&&& strFindNotAllowData = IsIniDataExist(&DisAllowPath&, strCmpData, strIniFilePath)&&&&&&&&&&& If strFindAllowData && && Then&&&&&&&&&&&&&&& WindowProc = 1000&&&&&&&&&&&&&&& Exit Function&&&&&&&&&&& End If&&&&&&&&&&& If strFindNotAllowData && && Then&&&&&&&&&&&&&&& WindowProc = 0&&&&&&&&&&&&&&& Exit Function&&&&&&&&&&& End If&&&&&&&&&&& If gblnIsShow Then&&&&&&&&&&&&&&& ReDim Preserve gstrArray(0 To glngCount)&&&&&&&&&&&&&&& gstrArray(glngCount) = GetRegProcessPath(strFullRegPath) & &,& & strProcessPath&&&&&&&&&&&&&&& glngCount = glngCount + 1&&&&&&&&&&&&&&& Do While IsArraryInitialize(gstrArray) And gblnIsShow&&&&&&&&&&&&&&&&&&& DoEvents&&&&&&&&&&&&&&&&&&& Sleep 10&&&&&&&&&&&&&&& Loop&&&&&&&&&&& End If&&&&&&&&&&& '对分离出来的结果进行显示和处理&&&&&&&&&&& If Not gblnIsEnd Then&&&&&&&&&&&&&&& Select Case strType&&&&&&&&&&&&&&&&&&& Case &设置值:&&&&&&&&&&&&&&&&&&&&&&&& strRegType = GetRegistryType(strFullRegPath)&&&&&&&&&&&&&&&&&&&&&&& strValue = GetKeyValue(GetRoot(strFullRegPath), GetRegistrySubPath(strFullRegPath), GetRegValueName(strFullRegPath), GetRegTypeLng(strRegType))&&&&&&&&&&&&&&&&&&&&&&& If strValue = &^_*_*_^& Then&&&&&&&&&&&&&&&&&&&&&&&&&&& strOutType = &新增&&&&&&&&&&&&&&&&&&&&&&&& Else&&&&&&&&&&&&&&&&&&&&&&&&&&& strOutType = &修改&&&&&&&&&&&&&&&&&&&&&&&& End If&&&&&&&&&&&&&&&&&&&&&&& frmRegMonitor.txtRegPath.Text = strRegPath&&&&&&&&&&&&&&&&&&&&&&& If strOutType = &新增& Then&&&&&&&&&&&&&&&&&&&&&&&&&&& frmRegMonitor.txtType = &新增&& & GetRegValueName(strFullRegPath) & &&& & &值类型是&& & GetRegTypeString(strRegType) & &&&&&&&&&&&&&&&&&&&&&&&&&& Else&&&&&&&&&&&&&&&&&&&&&&&&&&& frmRegMonitor.txtType = &修改&& & GetRegValueName(strFullRegPath) & &&值为&& & GetRegValue(strFullRegPath) & &&值类型是&& & GetRegTypeString(strRegType) & &&&&&&&&&&&&&&&&&&&&&&&&&& End If&&&&&&&&&&&&&&&&&&& Case &删除值:&&&&&&&&&&&&&&&&&&&&&&&& frmRegMonitor.txtRegPath.Text = strRegPath&&&&&&&&&&&&&&&&&&&&&&& frmRegMonitor.txtType = &删除值&& & GetRegValueName(strFullRegPath) & &&&&&&&&&&&&&&&&&&&&&&&&&& frmRegMonitor.txtProcessPath.Text = GetRegProcessPath(strFullRegPath)&&&&&&&&&&&&&&&&&&& Case &删除项:&&&&&&&&&&&&&&&&&&&&&&&& frmRegMonitor.txtRegPath.Text = strRegPath&&&&&&&&&&&&&&&&&&&&&&& frmRegMonitor.txtType = &删除项&& & GetRegValueName(strFullRegPath) & &&&&&&&&&&&&&&&&&&&&&&&&&& frmRegMonitor.txtProcessPath.Text = GetRegProcessPath(strFullRegPath)&&&&&&&&&&&&&&&&&&& Case &新增项:&&&&&&&&&&&&&&&&&&&&&&&& frmRegMonitor.txtRegPath.Text = strRegPath&&&&&&&&&&&&&&&&&&&&&&& frmRegMonitor.txtType = &新增项&& & GetRegValueName(strFullRegPath) & &&&&&&&&&&&&&&&&&&&&&&&&&& frmRegMonitor.txtProcessPath.Text = GetRegProcessPath(strFullRegPath)&&&&&&&&&&&&&&& End Select&&&&&&&&&&&&&&& frmRegMonitor.txtProcessPath.Text = GetRegProcessPath(strFullRegPath)&&&&&&&&&&&&&&& frmRegMonitor.timerCheck = True&&&&&&&&&&&&&&& gblnIsShow = True&&&&&&&&&&&&&&& frmRegMonitor.Show 1&&&&&&&&&&&&&&& '对用户选择的结果进行处理&&&&&&&&&&&&&&& If frmRegMonitor.optAgree.Value Then&&&&&&&&&&&&&&&&&&& If frmRegMonitor.chkAllow.Value = 1 Then&&&&&&&&&&&&&&&&&&&&&&& If strFindAllowData = && Then&&&&&&&&&&&&&&&&&&&&&&&&&&& WriteIniStr &AllowPath&, GetMaxIndex(&AllowPath&, strIniFilePath), strCmpData, strIniFilePath&&&&&&&&&&&&&&&&&&&&&&& End If&&&&&&&&&&&&&&&&&&& End If&&&&&&&&&&&&&&&&&&& WindowProc = 1000&&&&&&&&&&&&&&& Else&&&&&&&&&&&&&&&&&&& If frmRegMonitor.chkAllow.Value = 1 Then&&&&&&&&&&&&&&&&&&&&&&& If strFindNotAllowData = && Then&&&&&&&&&&&&&&&&&&&&&&&&&&& WriteIniStr &DisAllowPath&, GetMaxIndex(&DisAllowPath&, strIniFilePath), strCmpData, strIniFilePath&&&&&&&&&&&&&&&&&&&&&&& End If&&&&&&&&&&&&&&&&&&& End If&&&&&&&&&&&&&&&&&&& WindowProc = 0&&&&&&&&&&&&&&& End If&&&&&&&&&&& Else&&&&&&&&&&&&&&& WindowProc = 1000&&&&&&&&&&& End If&&&&&&&&&&& Exit Function&&&&&&& Case WM_TRAYICON&&&&&&&&&&& If lParam = WM_RBUTTONDOWN Then&&&&&&&&&&&&&&& SetForegroundWindow hwnd&&&&&&&&&&& ElseIf lParam = WM_RBUTTONUP Then&&&&&&&&&&&&&&& frmRegMonitor.PopupMenu frmRegMonitor.mnuPopMenu&&&&&&&&&&& End If&&& End Select&&& WindowProc = CallWindowProc(lpPrevWndProc, hwnd, uMsg, wParam, lParam)End Function
'数组是否初始化Public Function IsArraryInitialize(strArray() As String) As Boolean&&& On Error GoTo err&&& Dim i As Long&&& i = UBound(strArray)&&& IsArraryInitialize = True&&& Exit Functionerr:&&& IsArraryInitialize = FalseEnd Function
'获取指定用户对应的SIDPrivate Function GetSidString(ByVal strUserName) As String&&& Dim strBuffer As String&&& Dim pSia As Long&&& Dim pSiaByte(5) As Byte&&& Dim pSid(512) As Byte&&& Dim pSubAuthorityCount As Long&&& Dim bSubAuthorityCount As Byte&&& Dim pAuthority As Long&&& Dim lAuthority As Long&&& Dim lngReturn As Long&&& Dim pDomain As Long&&& Dim i As Integer, dAuthority As Long&&& lngReturn = LookupAccountName(vbNullString, strUserName, pSid(0), 512, pDomain, 512, 1)&&& pSia = GetSidIdentifierAuthority(pSid(0))&&& CopyByValMemory pSiaByte(0), pSia, 6&&& strBuffer = &S-& & pSid(0) & &-& & pSiaByte(5)&&& pSubAuthorityCount = GetSidSubAuthorityCount(pSid(0))&&& CopyByValMemory bSubAuthorityCount, pSubAuthorityCount, 1&&& For i = 0 To bSubAuthorityCount - 1&&&&&&& pAuthority = GetSidSubAuthority(pSid(0), i)&&&&&&& CopyByValMemory lAuthority, pAuthority, LenB(lAuthority)&&&&&&& dAuthority = lAuthority&&&&&&& If ((lAuthority And &H) && 0) Then&&&&&&&&&&& dAuthority = lAuthority And &H7FFFFFFF&&&&&&&&&&& dAuthority = dAuthority + 2 ^ 31&&&&&&& End If&&&&&&& strBuffer = strBuffer & &-& & dAuthority&&& Next&&& GetSidString = strBufferEnd Function
'移除某个消息Public Sub RemoveItem(ByVal strItem As String)&&& Dim i As Long, strArray() As String, j As Long&&& For i = 0 To glngCount - 1&&&&&&& If gstrArray(i) && strItem Then&&&&&&&&&&& ReDim Preserve strArray(0 To j)&&&&&&&&&&& strArray(j) = gstrArray(i)&&&&&&&&&&& j = j + 1&&&&&&& End If&&& Next&&& Erase gstrArray&&& glngCount = j&&& gstrArray = strArrayEnd Sub
modTray.bas
Attribute VB_Name = &modTray&Option Explicit''''''''''''''''''''''''''''''''''''''''''操作托盘模块'''''''''''''''''''''''''''''''''''''''''Private Const NIF_ICON = &H2Private Const NIF_MESSAGE = &H1Private Const NIF_TIP = &H4
Private Const NIM_ADD = &H0Private Const NIM_DELETE = &H2Private Const NIM_MODIFY = &H1
Private Const WM_MOUSEMOVE = &H200
Private Type NOTIFYICONDATA&&& cbSize As Long&&& hwnd As Long&&& uID As Long&&& uFlags As Long&&& uCallbackMessage As Long&&& hIcon As Long&&& szTip As String * 64End Type
Private Declare Function Shell_NotifyIcon Lib &shell32.dll& Alias &Shell_NotifyIconA& (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Private trayStructure As NOTIFYICONDATA'Private IconObject As Object
Private Function AddIcon(ByVal obj As Object, ByVal IconID As Long, ByVal Icon As Object, ByVal ToolTip As String) '增加托盘&&& trayStructure.cbSize = Len(trayStructure)&&& trayStructure.hwnd = obj.hwnd&&& trayStructure.uID = IconID&&& trayStructure.uFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP&&& trayStructure.uCallbackMessage = WM_TRAYICON&&& trayStructure.hIcon = Icon&&& trayStructure.szTip = ToolTip & Chr$(0)&&& '建立托盘&&& Call Shell_NotifyIcon(NIM_ADD, trayStructure)End Function
Public Function DeleteSysTray() '删除托盘'&&& If IconObject Is Nothing Then Exit Function&&& trayStructure.uID = frmRegMonitor.Icon.Handle&&& Call Shell_NotifyIcon(NIM_DELETE, trayStructure)End Function
Public Function SendToTray()&&& AddIcon frmRegMonitor, frmRegMonitor.Icon.Handle, frmRegMonitor.Icon, &注册表监控& & vbNullCharEnd Function}
QQ直播是.NET 编的吗？
QQ直播.NET
做东西能插播放器
我有更好的答案
给你我的程序，自己研究一下吧，我也不是很明白。
Public Class Form1
Private Declare Auto Function PlaySound Lib &winmm.dll& (ByVal lpszSoundName As String, ByVal hModule As Integer, ByVal dwFlags As Integer) As Integer
Const SND_filename As Integer = &H20000
Const SND_alias As Integer = &H10000
Const SND_sync As Integer = &H0
Declare Auto Function waveOutGetNumDevs Lib &winmm.dll& Alias &waveOutGetNumDevs& () As Integer
Declare Auto Function sndPlaySound Lib &winmm.dll& (ByVal filename As String, ByVal options As Integer) As Integer
Private Const SND_memory As Integer = &H4
Private Const SND_async As Integer = &H1
Private Const pr...
QQ直播不是.NET编的.net做的东东能插播放器
Microsoft?? Visual Studio?? 2005 visual c++ 8.0
可以播放哦
其他类似问题
为您推荐：
qq直播的相关知识
等待您来回答
下载知道APP
随时随地咨询
出门在外也不愁反病毒工具之注册表监视器 - CSDN博客
本程序实现了ring3下的注册表监管工作.由VB+VC实现.功能和瑞星的注册表监视非常类似,如下图:
目前只监视了启动项.
VC DLL下载地址是:
代码先公布VB部分源码,等整理后再给出VC部分的源码:
frmRegMonitor.frm
VERSION 5.00Object = &{6B7E1B-AFC0-DA7}#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&& mandButton 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&& EndEndAttribute VB_Name = &frmRegMonitor&Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = TrueAttribute VB_Exposed = FalseOption ExplicitPrivate Declare Function InstallRegHook Lib &RegistryInfo.dll& (ByVal strCheck As String) As LongPrivate Declare Function UninstallRegHook Lib &RegistryInfo.dll& () As LongPrivate 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 LongPrivate Declare Sub InitCommonControls Lib &comctl32.dll& ()Private Const HWND_TOPMOST = -1Private Const SWP_NOSIZE = &H1Private Const SWP_NOMOVE = &H2Private 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 '重复加载就直接退出&&& InitCommonControlsEnd 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 && '安装全局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
'获取注册表的keyRootPublic 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 IfEnd 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 IfEnd 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)&&&&&&&&&&& End If&&&&&&&&&&& strTmp = GetPath(strTmp)&&&&&&&&&&& GetRegistryPath = Left(strTmp, Len(strTmp) - 1)&&&&&&&&&&& Exit Function&&&&&&& End If&&& End IfEnd Function
'获取DLL传来的完整信息Public Function GetFullPath(ByVal strPath As String)&&& Dim strTmp As String, intStart As Integer&&& intStart = InStr(strPath, &:&)&&& If intStart & 0 Then&&&&&&& strTmp = Mid(strPath, intStart + 1, Len(strPath) - intStart)&&& End If&&& GetFullPath = strTmpEnd Function
'获取注册表键名Public Function GetRegValueName(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 = GetFileName(strTmp)&&&&&&& GetRegValueName = strTmp&&&&&&& 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 = GetFileName(strTmp)&&&&&&&&&&& GetRegValueName = strTmp&&&&&&&&&&& 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)&&&&&&&&&&& End If&&&&&&&&&&& strTmp = GetFileName(strTmp)&&&&&&&&&&& GetRegValueName = strTmp&&&&&&&&&&& Exit Function&&&&&&& End If&&& End IfEnd Function
'获取注册表键值Public Function GetRegValue(ByVal strRegPath As String) As String&&& Dim strTmp As String, intStart As Integer, intStart1 As Integer&&& intStart = InStr(strRegPath, &*value:&)&&& If intStart & 0 Then&&&&&&& intStart1 = InStr(strRegPath, &**&)&&&&&&& If intStart1 & 0 Then&&&&&&&&&&& strTmp = Mid(strRegPath, intStart + Len(&*value:&), intStart1 - intStart - Len(&*value:&))&&&&&&&&&&& GetRegValue = strTmp&&&&&&& Else&&&&&&&&&&& intStart1 = InStr(strRegPath, &^^&)&&&&&&&&&&& If intStart1 & 0 Then&&&&&&&&&&&&&&& strTmp = Mid(strRegPath, intStart + Len(&*value:&), intStart1 - intStart - Len(&*value:&))&&&&&&&&&&&&&&& GetRegValue = strTmp&&&&&&&&&&& Else&&&&&&&&&&&&&&& GetRegValue = &&&&&&&&&&&&& End If&&&&&&& End If&&& Else&&&&&&& GetRegValue = &&&&& End IfEnd Function
'获取操作类型Public Function GetRegistryType(ByVal strRegPath As String) As String&&& Dim strTmp As String, intStart As Integer, intStart1 As Integer&&& intStart = InStr(strRegPath, &**&)&&& If intStart & 0 Then&&&&&&& intStart1 = InStr(strRegPath, &^^&)&&&&&&& If intStart1 & 0 Then&&&&&&&&&&& strTmp = Mid(strRegPath, intStart + Len(&**&), intStart1 - intStart - Len(&**&))&&&&&&&&&&& GetRegistryType = strTmp&&&&&&& Else&&&&&&&&&&& GetRegistryType = &&&&&&&&& End If&&& Else&&&&&&& GetRegistryType = &&&&& End If&&& GetRegistryType = GetRegType(GetRegistryType)End Function
'把注册表类型的字符串类型转换成ValueTypePublic Function GetRegType(ByVal strRegType As String) As ValueType&&& Select Case strRegType&&&&&&& Case &1&&&&&&&&&&&& GetRegType = REG_SZ&&&&&&& Case &2&&&&&&&&&&&& GetRegType = REG_EXPAND_SZ&&&&&&& Case &3&&&&&&&&&&&& GetRegType = REG_BINARY&&&&&&& Case &4&&&&&&&&&&&& GetRegType = REG_DWORD&&&&&&& Case &7&&&&&&&&&&&& GetRegType = REG_MULTI_SZ&&&&&&& Case Else&&&&&&&&&&& GetRegType = REG_SZ&&& End SelectEnd Function
'注册表类型的字符串型转换成LONG型Public Function GetRegTypeLng(ByVal strRegType As String) As ValueType&&& Select Case strRegType&&&&&&& Case &1&&&&&&&&&&&& GetRegTypeLng = 1&&&&&&& Case &2&&&&&&&&&&&& GetRegTypeLng = 2&&&&&&& Case &3&&&&&&&&&&&& GetRegTypeLng = 3&&&&&&& Case &4&&&&&&&&&&&& GetRegTypeLng = 4&&&&&&& Case &7&&&&&&&&&&&& GetRegTypeLng = 7&&&&&&& Case Else&&&&&&&&&&& GetRegTypeLng = 1&&& End SelectEnd Function
'获取指定注册表类型对应的类型Public Function GetRegTypeString(ByVal strRegType As String) As String&&& Select Case strRegType&&&&&&& Case &1&&&&&&&&&&&& GetRegTypeString = ®_SZ&&&&&&&& Case &2&&&&&&&&&&&& GetRegTypeString = ®_EXPAND_SZ&&&&&&&& Case &3&&&&&&&&&&&& GetRegTypeString = ®_BINARY&&&&&&&& Case &4&&&&&&&&&&&& GetRegTypeString = ®_DWORD&&&&&&&& Case &7&&&&&&&&&&&& GetRegTypeString = ®_MULTI_SZ&&&&&&&& Case Else&&&&&&&&&&& GetRegTypeString = ®_SZ&&&& End SelectEnd Function
'获取进程路径信息包括没分离的PID信息Public Function GetRegProcessPath(ByVal strRegPath As String) As String&&& Dim strTmp As String, intStart As Integer&&& intStart = InStr(strRegPath, &^^&)&&& If intStart & 0 Then&&&&&&& strTmp = Mid(strRegPath, intStart + 2, Len(strRegPath) - intStart)&&& End If&&& GetRegProcessPath = strTmpEnd Function
'获取进程路径信息Public Function GetRegProcessPathEx(ByVal strRegPath As String) As String&&& Dim strTmp As String, intStart As Integer&&& intStart = InStr(strRegPath, &^^&)&&& If intStart & 0 Then&&&&&&& strTmp = Mid(strRegPath, intStart + 2, InStr(strRegPath, &进程ID&&) - 2 - intStart)&&& End If&&& GetRegProcessPathEx = strTmpEnd Function
'此函数从字符串中分离出路径Public Function GetPath(ByVal strPathIn As String) As String&&& Dim i As Integer&&& For i = Len(strPathIn) To 1 Step -1&&&&&&& If InStr(&:/&, Mid$(strPathIn, i, 1)) Then Exit For&&& Next&&& GetPath = Left$(strPathIn, i)End Function
'此函数从字符串中分离出文件名Public Function GetFileName(ByVal strFileIn As String) As String&&& Dim i As Integer&&& For i = Len(strFileIn) To 1 Step -1&&&&&&& If InStr(&/&, Mid$(strFileIn, i, 1)) Then Exit For&&& Next&&& GetFileName = Mid$(strFileIn, i + 1, Len(strFileIn) - i)End Function
modIni.bas
Attribute VB_Name = &modIni&Option Explicit''''''''''''''''''''''''''读写INI文件模块'''''''''''''''''''''''''Private Declare Function GetPrivateProfileSection Lib &KERNEL32& Alias &GetPrivateProfileSectionA& (ByVal lpAppName As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As LongPrivate Declare Function GetPrivateProfileString Lib &KERNEL32& Alias &GetPrivateProfileStringA& (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As LongPrivate Declare Function WritePrivateProfileString Lib &KERNEL32& Alias &WritePrivateProfileStringA& (ByVal lpApplicationName As String, ByVal lpKeyName As Any, lpString As Any, ByVal lpFileName As String) As LongPublic strIniFilePath As String '设置文件路径
'读取指定节点下对应名称的值Public Function GetiniValue(ByVal lpKeyName As String, ByVal strName As String, ByVal strIniFile As String) As String&&& Dim strTmp As String * 32767&&& Call GetPrivateProfileString(lpKeyName, strName, &&, strTmp, Len(strTmp), strIniFile)&&& GetiniValue = Left$(strTmp, InStr(strTmp, vbNullChar) - 1)End Function
'给指定节点下对名称赋值Public Function WriteIniStr(ByVal strSection As String, ByVal strKey As String, ByVal strData As String, ByVal strIniFile As String) As Boolean&&& On Error GoTo WriteIniStrErr&&& WriteIniStr = True&&& If strData = &0& Then&&&&&&& WritePrivateProfileString strSection, strKey, ByVal 0, strIniFile&&& Else&&&&&&& WritePrivateProfileString strSection, strKey, ByVal strData, strIniFile&&& End If&&& Exit FunctionWriteIniStrErr:&&& err.Clear&&& WriteIniStr = FalseEnd Function
'获取指定节电下的最大索引Public Function GetMaxIndex(ByVal strSection As String, strIniFile As String) As String&&& Dim strReturn As String * 32767&&& Dim strTmp As String&&& Dim lngReturn As Integer, i As Integer, strTmpArray() As String, sum As Integer&&& lngReturn = GetPrivateProfileSection(strSection, strReturn, Len(strReturn), strIniFile)&&& strTmp = Left(strReturn, lngReturn)&&& strTmpArray = Split(strTmp, Chr(0))&&& For i = 0 To UBound(strTmpArray)&&&&&&& If strTmpArray(i) && && And strTmpArray(i) && Chr(0) Then&&&&&&&&&&& strTmp = Left(strTmpArray(i), InStr(strTmpArray(i), &=&) - 1)&&&&&&&&&&& If Val(strTmp) & sum Then sum = Val(strTmp)&&&&&&& End If&&& Next&&& GetMaxIndex = sum + 1End Function
'判断数据是否已经添加过了Public Function IsIniDataExist(ByVal strSection As String, ByVal strData As String, ByVal strIniFile As String) As String&&& Dim strReturn As String * 32767&&& Dim strTmp As String&&& Dim lngReturn As Integer, i As Integer, strTmpArray() As String, sum As Integer&&& lngReturn = GetPrivateProfileSection(strSection, strReturn, Len(strReturn), strIniFile)&&& strTmp = Left(strReturn, lngReturn)&&& strTmpArray = Split(strTmp, Chr(0))&&& For i = 0 To UBound(strTmpArray)&&&&&&& If strTmpArray(i) && && And strTmpArray(i) && Chr(0) Then&&&&&&&&&&& strTmp = Trim(Mid(strTmpArray(i), InStr(strTmpArray(i), &=&) + 1, Len(strTmpArray(i)) - InStr(strTmpArray(i), &=&)))&&&&&&&&&&& If strTmp && && Then&&&&&&&&&&&&&&& If LCase(strTmp) = LCase(strData) Then&&&&&&&&&&&&&&&&&&& IsIniDataExist = Left(strTmpArray(i), InStr(strTmpArray(i), &=&) - 1)&&&&&&&&&&&&&&&&&&& Exit Function&&&&&&&&&&&&&&& End If&&&&&&&&&&& End If&&&&&&& End If&&& NextEnd Function
modRegistry.bas
Attribute VB_Name = &modRegistry&Option Explicit
'---------------------------------------------------------------'- 注册表 API 声明...'---------------------------------------------------------------Private Declare Function RegCloseKey Lib &advapi32.dll& (ByVal hKey As Long) As LongPrivate Declare Function RegCreateKeyEx Lib &advapi32.dll& Alias &RegCreateKeyExA& (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition As Long) As LongPrivate Declare Function RegDeleteKey Lib &advapi32.dll& Alias &RegDeleteKeyA& (ByVal hKey As Long, ByVal lpSubKey As String) As LongPrivate Declare Function RegDeleteValue Lib &advapi32.dll& Alias &RegDeleteValueA& (ByVal hKey As Long, ByVal lpValueName As String) As LongPrivate 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 LongPrivate Declare Function RegQueryValueEx Lib &advapi32.dll& Alias &RegQueryValueExA& (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As LongPrivate Declare Function RegRestoreKey Lib &advapi32.dll& Alias &RegRestoreKeyA& (ByVal hKey As Long, ByVal lpFile As String, ByVal dwFlags As Long) As LongPrivate Declare Function RegSaveKey Lib &advapi32.dll& Alias &RegSaveKeyA& (ByVal hKey As Long, ByVal lpFile As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As LongPrivate 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 LongPrivate Declare Function RegQueryInfoKey Lib &advapi32.dll& Alias &RegQueryInfoKeyA& (ByVal hKey As Long, ByVal lpClass As String, lpcbClass As Long, ByVal lpReserved As Long, lpcSubKeys As Long, lpcbMaxSubKeyLen As Long, lpcbMaxClassLen As Long, lpcValues As Long, lpcbMaxValueNameLen As Long, lpcbMaxValueLen As Long, lpcbSecurityDescriptor As Long, lpftLastWriteTime As FILETIME) As LongPrivate Declare Function RegEnumValue Lib &advapi32.dll& Alias &RegEnumValueA& (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As LongPrivate 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 LongPrivate Declare Function RegOpenKey Lib &advapi32.dll& Alias &RegOpenKeyA& (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As LongPrivate 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
Private Declare Function AdjustTokenPrivileges Lib &advapi32.dll& (ByVal TokenHandle As Long, ByVal DisableAllPriv As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long&&&&&&&&&&&&&&& 'Used to adjust your program's security privileges, can't restore without it!Private Declare Function LookupPrivilegeValue Lib &advapi32.dll& Alias &LookupPrivilegeValueA& (ByVal lpSystemName As Any, ByVal lpName As String, lpLuid As LUID) As Long&&&&&&&&& 'Returns a valid LUID which is important when making security changes in NT.Private Declare Function OpenProcessToken Lib &advapi32.dll& (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As LongPrivate Declare Function GetCurrentProcess Lib &kernel32& () As Long
'---------------------------------------------------------------'- 注册表 Api 常数...'---------------------------------------------------------------' 注册表创建类型值...Const REG_OPTION_NON_VOLATILE = 0&&&&&&& ' 当系统重新启动时，关键字被保留
' 注册表关键字安全选项...Const READ_CONTROL = &H20000Const KEY_QUERY_VALUE = &H1Const KEY_SET_VALUE = &H2Const KEY_CREATE_SUB_KEY = &H4Const KEY_ENUMERATE_SUB_KEYS = &H8Const KEY_NOTIFY = &H10Const KEY_CREATE_LINK = &H20Const KEY_READ = KEY_QUERY_VALUE + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + READ_CONTROLConst KEY_WRITE = KEY_SET_VALUE + KEY_CREATE_SUB_KEY + READ_CONTROLConst KEY_EXECUTE = KEY_READConst KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL&&&&&&&&&&&&&&&&&&&& ' 返回值...Const ERROR_NONE = 0Const ERROR_BADKEY = 2Const ERROR_ACCESS_DENIED = 8Const ERROR_SUCCESS = 0
' 有关导入/导出的常量Const REG_FORCE_RESTORE As Long = 8&Const TOKEN_QUERY As Long = &H8&Const TOKEN_ADJUST_PRIVILEGES As Long = &H20&Const SE_PRIVILEGE_ENABLED As Long = &H2Const SE_RESTORE_NAME = &SeRestorePrivilege&Const SE_BACKUP_NAME = &SeBackupPrivilege&
'---------------------------------------------------------------'- 注册表类型...'---------------------------------------------------------------Private Type SECURITY_ATTRIBUTES&&& nLength As Long&&& lpSecurityDescriptor As Long&&& bInheritHandle As BooleanEnd Type
Private Type FILETIME&&& dwLowDateTime As Long&&& dwHighDateTime As LongEnd Type
Private Type LUID&&& lowpart As Long&&& highpart As LongEnd Type
Private Type LUID_AND_ATTRIBUTES&&& pLuid As LUID&&& Attributes As LongEnd Type
Private Type TOKEN_PRIVILEGES&&& PrivilegeCount As Long&&& Privileges As LUID_AND_ATTRIBUTESEnd Type
'---------------------------------------------------------------'- 自定义枚举类型...'---------------------------------------------------------------' 注册表数据类型...Public Enum ValueType&&& REG_SZ = 1&&&&&&&&&&&&&&&&&&&&&&&& ' 字符串值&&& REG_EXPAND_SZ = 2&&&&&&&&&&&&&&&&& ' 可扩充字符串值&&& REG_BINARY = 3&&&&&&&&&&&&&&&&&&&& ' 二进制值&&& REG_DWORD = 4&&&&&&&&&&&&&&&&&&&&& ' DWORD值&&& REG_MULTI_SZ = 7&&&&&&&&&&&&&&&&&& ' 多字符串值End Enum
' 注册表关键字根类型...Public Enum keyRoot&&& HKEY_CLASSES_ROOT = &H&&& HKEY_CURRENT_USER = &H&&& HKEY_LOCAL_MACHINE = &H&&& HKEY_USERS = &H&&& HKEY_PERFORMANCE_DATA = &H&&& HKEY_CURRENT_CONFIG = &H&&& HKEY_DYN_DATA = &HEnd Enum
Public strstring As StringPrivate hKey As Long&&&&&&&&&&&&&&&&&& ' 注册表打开项的句柄Private i As Long, j As Long&&&&&&&&&& ' 循环变量Private Success As Long&&&&&&&&&&&&&&& ' API函数的返回值, 判断函数调用是否成功
'-------------------------------------------------------------------------------------------------------------'- 新建注册表关键字并设置注册表关键字的值...'- 如果 ValueName 和 Value 都缺省, 则只新建 KeyName 空项, 无子键...'- 如果只缺省 ValueName 则将设置指定 KeyName 的默认值'- 参数说明: KeyRoot--根类型, KeyName--子项名称, ValueName--值项名称, Value--值项数据, ValueType--值项类型'-------------------------------------------------------------------------------------------------------------Public Function SetKeyValue(keyRoot As keyRoot, KeyName As String, Optional ValueName As String, Optional Value As Variant = &&, Optional ValueType As ValueType = REG_SZ) As Boolean&&& Dim lpAttr As SECURITY_ATTRIBUTES&&&&&&&&&&&&&&&&&& ' 注册表安全类型&&& lpAttr.nLength = 50&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ' 设置安全属性为缺省值...&&& lpAttr.lpSecurityDescriptor = 0&&&&&&&&&&&&&&&&&&&& ' ...&&& lpAttr.bInheritHandle = True&&&&&&&&&&&&&&&&&&&&&&& ' ...&&& &&& ' 新建注册表关键字...&&& Success = RegCreateKeyEx(keyRoot, KeyName, 0, ValueType, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, lpAttr, hKey, 0)&&& If Success && ERROR_SUCCESS Then SetKeyValue = False: RegCloseKey hKey: Exit Function&&& &&& ' 设置注册表关键字的值...&&& If IsMissing(ValueName) = False Then&&&&&&& Select Case ValueType&&&&&&&&&&& Case REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ&&&&&&&&&&&&&&& Success = RegSetValueEx(hKey, ValueName, 0, ValueType, ByVal CStr(Value), LenB(StrConv(Value, vbFromUnicode)) + 1)&&&&&&&&&&& Case REG_DWORD&&&&&&&&&&&&&&& If CDbl(Value) &= # And CDbl(Value) &= 0 Then&&&&&&&&&&&&&&&&&&& Dim sValue As String&&&&&&&&&&&&&&&&&&& sValue = DoubleToHex(Value)&&&&&&&&&&&&&&&&&&& Dim dValue(3) As Byte&&&&&&&&&&&&&&&&&&& dValue(0) = Format(&&h& & Mid(sValue, 7, 2))&&&&&&&&&&&&&&&&&&& dValue(1) = Format(&&h& & Mid(sValue, 5, 2))&&&&&&&&&&&&&&&&&&& dValue(2) = Format(&&h& & Mid(sValue, 3, 2))&&&&&&&&&&&&&&&&&&& dValue(3) = Format(&&h& & Mid(sValue, 1, 2))&&&&&&&&&&&&&&&&&&& Success = RegSetValueEx(hKey, ValueName, 0, ValueType, dValue(0), 4)&&&&&&&&&&&&&&& Else&&&&&&&&&&&&&&&&&&& Success = ERROR_BADKEY&&&&&&&&&&&&&&& End If&&&&&&&&&&& Case REG_BINARY&&&&&&&&&&&&&&& On Error Resume Next&&&&&&&&&&&&&&& Success = 1&&&&&&&&&&&&&&&&&&&&&&&&&&&& ' 假设调用API不成功(成功返回0)&&&&&&&&&&&&&&& ReDim tmpValue(UBound(Value)) As Byte&&&&&&&&&&&&&&& For i = 0 To UBound(tmpValue)&&&&&&&&&&&&&&&&&&& tmpValue(i) = Value(i)&&&&&&&&&&&&&&& Next i&&&&&&&&&&&&&&& Success = RegSetValueEx(hKey, ValueName, 0, ValueType, tmpValue(0), UBound(Value) + 1)&&&&&&& End Select&&& End If&&& If Success && ERROR_SUCCESS Then SetKeyValue = False: RegCloseKey hKey: Exit Function&&& &&& ' 关闭注册表关键字...&&& RegCloseKey hKey&&& SetKeyValue = True&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ' 返回函数值End Function
'-------------------------------------------------------------------------------------------------------------'- 获得已存在的注册表关键字的值...'- 如果 ValueName=&& 则返回 KeyName 项的默认值...'- 如果指定的注册表关键字不存在, 则返回空串...'- 参数说明: KeyRoot--根类型, KeyName--子项名称, ValueName--值项名称, ValueType--值项类型'-------------------------------------------------------------------------------------------------------------Public Function GetKeyValue(ByVal keyRoot As keyRoot, ByVal KeyName As String, ByVal ValueName As String, Optional ByVal ValueType As Long) As String&&& Dim TempValue As String&&&&&&&&&&&&&&&&&&&&&&&&&&&& ' 注册表关键字的临时值&&& Dim Value As String&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ' 注册表关键字的值&&& Dim ValueSize As Long&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ' 注册表关键字的值的实际长度&&& TempValue = Space(1024)&&&&&&&&&&&&&&&&&&&&&&&&&&&& ' 存储注册表关键字的临时值的缓冲区&&& ValueSize = 1024&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ' 设置注册表关键字的值的默认长度
&&& ' 打开一个已存在的注册表关键字...&&& RegOpenKeyEx keyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey&&& If hKey = 0 Then&&&&&&& GetKeyValue = &^_*_*_^&&&&&&&& Exit Function&&& End If&&& Dim x As Integer&&& x = RegQueryValueEx(hKey, ValueName, 0, ValueType, ByVal TempValue, ValueSize)&&& ' 获得已打开的注册表关键字的值...&&& If x && 0 Then&&&&&&& If x = 2 And ValueSize = 1024 Then&&&&&&&&&&& GetKeyValue = &^_*_*_^&&&&&&&&&&&& Exit Function&&&&&&& End If&&& End If&&& ' 返回注册表关键字的的值...&&& Select Case ValueType&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ' 通过判断关键字的类型, 进行处理&&&&&&& Case REG_SZ, REG_MULTI_SZ, REG_EXPAND_SZ&&&&&&&&&&& If ValueSize & 0 Then TempValue = Left$(TempValue, ValueSize - 1)&&&&&&&&&&&&&&&&&&&&&& ' 去掉TempValue尾部空格&&&&&&&&&&& Value = TempValue&&&&&&& Case REG_DWORD&&&&&&&&&&& ReDim dValue(3) As Byte&&&&&&&&&&& RegQueryValueEx hKey, ValueName, 0, REG_DWORD, dValue(0), ValueSize&&&&&&&&&&& For i = 3 To 0 Step -1&&&&&&&&&&&&&&& Value = Value + String(2 - Len(Hex(dValue(i))), &0&) + Hex(dValue(i))&& ' 生成长度为8的十六进制字符串&&&&&&&&&&& Next i&&&&&&&&&&& If CDbl(&&H& & Value) & 0 Then&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ' 将十六进制的 Value 转换为十进制&&&&&&&&&&&&&&& Value = 2 ^ 32 + CDbl(&&H& & Value)&&&&&&&&&&& Else&&&&&&&&&&&&&&& Value = CDbl(&&H& & Value)&&&&&&&&&&& End If&&&&&&& Case REG_BINARY&&&&&&&&&&& If ValueSize & 0 Then&&&&&&&&&&&&&&& ReDim bValue(ValueSize - 1) As Byte&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ' 存储 REG_BINARY 值的临时数组&&&&&&&&&&&&&&& RegQueryValueEx hKey, ValueName, 0, REG_BINARY, bValue(0), ValueSize&&&&&&&&&&&&&&& For i = 0 To ValueSize - 1&&&&&&&&&&&&&&&&&&& Value = Value + String(2 - Len(Hex(bValue(i))), &0&) + Hex(bValue(i)) + & && ' 将数组转换成字符串&&&&&&&&&&&&&&& Next i&&&&&&&&&&& End If&&& End Select&&& &&& ' 关闭注册表关键字...&&& RegCloseKey hKey&&& Value = Trim(Value)&&& If InStr(Value, Chr(0)) Then&&&&&&& GetKeyValue = Left(Value, InStr(Value, Chr(0)) - 1)&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ' 返回函数值&&& Else&&&&&&& GetKeyValue = Value&&& End IfEnd Function
Public Function RegDeleteKeyName(mhKey As keyRoot, SubKey As String, hKeyName As String) As Boolean&&& '删除子键数据&&& 'mhKey是指主键的名称，SubKey是指路径，hKeyName是指键名&&& Dim hKey As Long, ret As Long&&& ret = RegOpenKey(mhKey, SubKey, hKey)&&& RegDeleteKeyName = False&&& If ret = 0 Then&&&&&&& If RegDeleteValue(hKey, hKeyName) = 0 Then RegDeleteKeyName = True&&& End If&&& RegCloseKey hKey '删除打开的键值，释放内存End Function
'-------------------------------------------------------------------------------------------------------------'- 将 Double 型( 限制在 0--2^32-1 )的数字转换为十六进制并在前面补零'- 参数说明: Number--要转换的 Double 型数字'-------------------------------------------------------------------------------------------------------------Private Function DoubleToHex(ByVal Number As Double) As String&&& Dim strHex As String&&& strHex = Space(8)&&& For i = 1 To 8&&&&&&& Select Case Number - Int(Number / 16) * 16&&&&&&&&&&& Case 10&&&&&&&&&&&&&&& Mid(strHex, 9 - i, 1) = &A&&&&&&&&&&&& Case 11&&&&&&&&&&&&&&& Mid(strHex, 9 - i, 1) = &B&&&&&&&&&&&& Case 12&&&&&&&&&&&&&&& Mid(strHex, 9 - i, 1) = &C&&&&&&&&&&&& Case 13&&&&&&&&&&&&&&& Mid(strHex, 9 - i, 1) = &D&&&&&&&&&&&& Case 14&&&&&&&&&&&&&&& Mid(strHex, 9 - i, 1) = &E&&&&&&&&&&&& Case 15&&&&&&&&&&&&&&& Mid(strHex, 9 - i, 1) = &F&&&&&&&&&&&& Case Else&&&&&&&&&&&&&&& Mid(strHex, 9 - i, 1) = CStr(Number - Int(Number / 16) * 16)&&&&&&& End Select&&&&&&& Number = Int(Number / 16)&&& Next i&&& DoubleToHex = strHexEnd Function
Public Function GetKeyValueType(ByVal keyRoot As keyRoot, ByVal KeyName As String, ByVal checkValueName As String) As ValueType&&& Dim f As FILETIME, CountKey As Long, CountValue As Long, MaxLenKey As Long, MaxLenValue As Long&&& Dim l As Long, s As String, strTmp As String, intTmp As Long, ValueName() As String, ValueType() As ValueType&&& &&& ' 打开一个已存在的注册表关键字...&&& Success = RegOpenKeyEx(keyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey)&&& If Success && ERROR_SUCCESS Then GetKeyValueType = 0: RegCloseKey hKey: Exit Function&&& &&& ' 获得一个已打开的注册表关键字的信息...&&& Success = RegQueryInfoKey(hKey, vbNullString, ByVal 0&, ByVal 0&, CountKey, MaxLenKey, ByVal 0&, CountValue, MaxLenValue, ByVal 0&, ByVal 0&, f)&&& &&& If Success && ERROR_SUCCESS Then GetKeyValueType = 0: RegCloseKey hKey: Exit Function
&&& If CountValue && 0 Then&&&&&&& ReDim ValueName(CountValue - 1) As String&&&&&&&&&& ' 重新定义数组, 使用数组大小与注册表关键字的子键数量匹配&&&&&&& ReDim ValueType(CountValue - 1) 'As Long&&&&&&&&&&&& ' 重新定义数组, 使用数组大小与注册表关键字的子键数量匹配&&&&&&& For i = 0 To CountValue - 1&&&&&&&&&&& strTmp = String(255, vbNullChar) 'Space(255)&&&&&&&&&&& l = 255&&&&&&&&&&& RegEnumValue hKey, i, ByVal strTmp, l, 0, intTmp, ByVal 0&, ByVal 0&&&&&&&&&&&& ValueType(i) = intTmp&&&&&&&&&&& ValueName(i) = Left(strTmp, l)&&&&&&&&&&& If InStr(ValueName(i), vbNullChar) - 1 && -1 Then&&&&&&&&&&&&&&& ValueName(i) = Left$(ValueName(i), InStr(ValueName(i), vbNullChar) - 1)&&&&&&&&&&& End If&&&&&&&&&&& If ValueName(i) = checkValueName Then&&&&&&&&&&&&&&& GetKeyValueType = ValueType(i)&&&&&&&&&&&&&&& Exit Function&&&&&&&&&&& End If&&&&&&& Next i&&& End If&&& &&& ' 关闭注册表关键字...&&& RegCloseKey hKeyEnd Function
Public Function GetKeyInfo(keyRoot As keyRoot, KeyName As String, SubKeyName() As String, ValueName() As String, ValueType() As ValueType, Optional CountKey As Long, Optional CountValue As Long, Optional MaxLenKey As Long, Optional MaxLenValue As Long) As Boolean&&& Dim f As FILETIME&&& Dim l As Long, s As String, strTmp As String, intTmp As Long&&& &&& ' 打开一个已存在的注册表关键字...&&& Success = RegOpenKeyEx(keyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey)&&& If Success && ERROR_SUCCESS Then GetKeyInfo = False: RegCloseKey hKey: Exit Function&&& &&& ' 获得一个已打开的注册表关键字的信息...&&& Success = RegQueryInfoKey(hKey, vbNullString, ByVal 0&, ByVal 0&, CountKey, MaxLenKey, ByVal 0&, CountValue, MaxLenValue, ByVal 0&, ByVal 0&, f)&&& &&& If Success && ERROR_SUCCESS Then GetKeyInfo = False: RegCloseKey hKey: Exit Function&&& &&& If CountKey && 0 Then&&&&&&& ReDim SubKeyName(CountKey - 1) As String&&&&&&&&&&& ' 重新定义数组, 使用数组大小与注册表关键字的子项数量匹配&&&&&&& For i = 0 To CountKey - 1&&&&&&&&&&& strTmp = String(255, vbNullChar) 'Space(255)&&&&&&&&&&& l = 255&&&&&&&&&&& RegEnumKeyEx hKey, i, ByVal strTmp, l, 0, vbNullString, ByVal 0&, f&&&&&&&&&&& SubKeyName(i) = Left(strTmp, l)&&&&&&&&&&& If InStr(SubKeyName(i), vbNullChar) - 1 && -1 Then&&&&&&&&&&&&&&& SubKeyName(i) = Left$(SubKeyName(i), InStr(SubKeyName(i), vbNullChar) - 1)&&&&&&&&&&& End If&&&&&&& Next i&&&&&&& &&&&&&& ' 下面的二重循环对字符串数组进行冒泡排序&&&&&&& For i = 0 To UBound(SubKeyName)&&&&&&&&&&& For j = i + 1 To UBound(SubKeyName)&&&&&&&&&&&&&&& If SubKeyName(i) & SubKeyName(j) Then&&&&&&&&&&&&&&&&&&& s = SubKeyName(i)&&&&&&&&&&&&&&&&&&& SubKeyName(i) = SubKeyName(j)&&&&&&&&&&&&&&&&&&& SubKeyName(j) = s&&&&&&&&&&&&&&& End If&&&&&&&&&&& Next j&&&&&&& Next i&&& End If
&&& If CountValue && 0 Then&&&&&&& ReDim ValueName(CountValue - 1) As String&&&&&&&&&& ' 重新定义数组, 使用数组大小与注册表关键字的子键数量匹配&&&&&&& ReDim ValueType(CountValue - 1) 'As Long&&&&&&&&&&&& ' 重新定义数组, 使用数组大小与注册表关键字的子键数量匹配&&&&&&& For i = 0 To CountValue - 1&&&&&&&&&&& strTmp = String(255, vbNullChar) 'Space(255)&&&&&&&&&&& &&&&&&&&&&& l = 255&&&&&&&&&&& RegEnumValue hKey, i, ByVal strTmp, l, 0, intTmp, ByVal 0&, ByVal 0&&&&&&&&&&&& ValueType(i) = intTmp&&&&&&&&&&& ValueName(i) = Left(strTmp, l)&&&&&&&&&&& If InStr(ValueName(i), vbNullChar) - 1 && -1 Then&&&&&&&&&&&&&&& ValueName(i) = Left$(ValueName(i), InStr(ValueName(i), vbNullChar) - 1)&&&&&&&&&&& End If&&&&&&& Next i&&&&&&& &&&&&&& ' 下面的二重循环对字符串数组进行冒泡排序&&&&&&& For i = 0 To UBound(ValueName)&&&&&&&&&&& For j = i + 1 To UBound(ValueName)&&&&&&&&&&&&&&& If ValueName(i) & ValueName(j) Then&&&&&&&&&&&&&&&&&&& s = ValueName(i)&&&&&&&&&&&&&&&&&&& ValueName(i) = ValueName(j)&&&&&&&&&&&&&&&&&&& ValueName(j) = s&&&&&&&&&&&&&&& End If&&&&&&&&&&& Next j&&&&&&& Next i&&& End If&&& &&& ' 关闭注册表关键字...&&& RegCloseKey hKey&&& GetKeyInfo = True&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ' 返回函数值End Function
Public Function RegDeleteSubkey(hKey As keyRoot, SubKey As String) As Boolean&&& '删除目录&&& 'mhKey是指主键的名称，SubKey是指路径&&& Dim ret As Long, Index As Long, hName As String&&& Dim hSubkey As Long&&& ret = RegOpenKey(hKey, SubKey, hSubkey)&&& If ret && 0 Then&&&&&&& RegDeleteSubkey = False&&&&&&& Exit Function&&& End If&&& ret = RegDeleteKey(hSubkey, &&)&&& If ret && 0 Then '如果删除失败则认为是NT则用递归方法删除目录&&&&&&& hName = String(256, Chr(0))&&&&&&& While RegEnumKey(hSubkey, 0, hName, Len(hName)) = 0 And _&&&&&&&&&&&&& RegDeleteSubkey(hSubkey, hName)&&&&&&& Wend&&&&&&& ret = RegDeleteKey(hSubkey, &&)&&& End If&&& RegDeleteSubkey = (ret = 0)&&& RegCloseKey hSubkey '删除打开的键值，释放内存End Function
Public Sub GetRegRootPath(ByVal RegPath As String, regRoot As keyRoot)&&& If InStr(UCase(RegPath), &HKEY_CLASSES_ROOT&) & 0 Then&&&&&&& regRoot = HKEY_CLASSES_ROOT&&& ElseIf InStr(UCase(RegPath), &HKEY_CURRENT_CONFIG&) & 0 Then&&&&&&& regRoot = HKEY_CURRENT_CONFIG&&& ElseIf InStr(UCase(RegPath), &HKEY_CURRENT_USER&) & 0 Then&&&&&&& regRoot = HKEY_CURRENT_USER&&& ElseIf InStr(UCase(RegPath), &HKEY_DYN_DATA&) & 0 Then&&&&&&& regRoot = HKEY_DYN_DATA&&& ElseIf InStr(UCase(RegPath), &HKEY_LOCAL_MACHINE&) & 0 Then&&&&&&& regRoot = HKEY_LOCAL_MACHINE&&& ElseIf InStr(UCase(RegPath), &HKEY_PERFORMANCE_DATA&) & 0 Then&&&&&&& regRoot = HKEY_PERFORMANCE_DATA&&& Else&&&&&&& regRoot = HKEY_USERS&&& End IfEnd Sub
Public Function GetRegSubPath(ByVal RegPath As String) As String&&& If InStr(UCase(RegPath), &HKEY_CLASSES_ROOT&) & 0 Then&&&&&&& GetRegSubPath = Mid(RegPath, Len(&HKEY_CLASSES_ROOT&) + 2, Len(RegPath) - Len(&HKEY_CLASSES_ROOT&) + 1)&&& ElseIf InStr(UCase(RegPath), &HKEY_CURRENT_CONFIG&) & 0 Then&&&&&&& GetRegSubPath = Mid(RegPath, Len(&HKEY_CURRENT_CONFIG&) + 2, Len(RegPath) - Len(&HKEY_CURRENT_CONFIG&) + 1)&&& ElseIf InStr(UCase(RegPath), &HKEY_CURRENT_USER&) & 0 Then&&&&&&& GetRegSubPath = Mid(RegPath, Len(&HKEY_CURRENT_USER&) + 2, Len(RegPath) - Len(&HKEY_CURRENT_USER&) + 1)&&& ElseIf InStr(UCase(RegPath), &HKEY_DYN_DATA&) & 0 Then&&&&&&& GetRegSubPath = Mid(RegPath, Len(&HKEY_DYN_DATA&) + 2, Len(RegPath) - Len(&HKEY_DYN_DATA&) + 1)&&& ElseIf InStr(UCase(RegPath), &HKEY_LOCAL_MACHINE&) & 0 Then&&&&&&& GetRegSubPath = Mid(RegPath, Len(&HKEY_LOCAL_MACHINE&) + 2, Len(RegPath) - Len(&HKEY_LOCAL_MACHINE&) + 1)&&& ElseIf InStr(UCase(RegPath), &HKEY_PERFORMANCE_DATA&) & 0 Then&&&&&&& GetRegSubPath = Mid(RegPath, Len(&HKEY_PERFORMANCE_DATA&) + 2, Len(RegPath) - Len(&HKEY_PERFORMANCE_DATA&) + 1)&&& Else&&&&&&& GetRegSubPath = Mid(RegPath, Len(&HKEY_USERS&) + 2, Len(RegPath) - Len(&HKEY_USERS&) + 1)&&& End IfEnd Function
'Public Sub GetRegType(ByVal RegType As String, valueTypes As ValueType)'&&& Select Case RegType'&&&&&&& Case &1&'&&&&&&&&&&& valueTypes = REG_SZ'&&&&&&& Case &2&'&&&&&&&&&&& valueTypes = REG_EXPAND_SZ'&&&&&&& Case &3&'&&&&&&&&&&& valueTypes = REG_BINARY'&&&&&&& Case &4&'&&&&&&&&&&& valueTypes = REG_DWORD'&&&&&&& Case &7&'&&&&&&&&&&& valueTypes = REG_MULTI_SZ'&&&&&&& Case Else'&&&&&&&&&&& valueTypes = REG_SZ'&&& End Select'End Sub
Public Function RegRootPathIsTrue(ByVal RegPath As String) As Boolean&&& If InStr(UCase(RegPath), &HKEY_CLASSES_ROOT&) & 0 Then&&&&&&& RegRootPathIsTrue = True&&& ElseIf InStr(UCase(RegPath), &HKEY_CURRENT_CONFIG&) & 0 Then&&&&&&& RegRootPathIsTrue = True&&& ElseIf InStr(UCase(RegPath), &HKEY_CURRENT_USER&) & 0 Then&&&&&&& RegRootPathIsTrue = True&&& ElseIf InStr(UCase(RegPath), &HKEY_DYN_DATA&) & 0 Then&&&&&&& RegRootPathIsTrue = True&&& ElseIf InStr(UCase(RegPath), &HKEY_LOCAL_MACHINE&) & 0 Then&&&&&&& RegRootPathIsTrue = True&&& ElseIf InStr(UCase(RegPath), &HKEY_PERFORMANCE_DATA&) & 0 Then&&&&&&& RegRootPathIsTrue = True&&& Else&&&&&&& RegRootPathIsTrue = False&&& End IfEnd Function
Public Function GetRegRoot(regRoot As keyRoot) As String&&& Select Case regRoot&&&&&&& Case &H&&&&&&&&&&& GetRegRoot = &HKEY_CLASSES_ROOT&&&&&&&& Case &H&&&&&&&&&&& GetRegRoot = &HKEY_CURRENT_USER&&&&&&&& Case &H&&&&&&&&&&& GetRegRoot = &HKEY_LOCAL_MACHINE&&&&&&&& Case &H&&&&&&&&&&& GetRegRoot = &HKEY_USERS&&&&&&&& Case &H&&&&&&&&&&& GetRegRoot = &HKEY_PERFORMANCE_DATA&&&&&&&& Case &H&&&&&&&&&&& GetRegRoot = &HKEY_CURRENT_CONFIG&&&&&&&& Case &H&&&&&&&&&&& GetRegRoot = &HKEY_DYN_DATA&&&& End Select&&&&&&& End Function
modSubClass.bas
Attribute VB_Name = &modSubClass&'REG_SZ = 1'REG_BINARY = 3'REG_DOWRD = 4'REG_MULTI_SZ = 7'REG_EXPAND_SZ = 2''/REGISTRY/MACHINE'/REGISTRY/USER
Option Explicit&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& Private Type POINTAPI&&& x As Long&&& y As LongEnd Type
Private Type MINMAXINFO&&& ptReserved As POINTAPI&&& ptMaxSize As POINTAPI&&& ptMaxPosition As POINTAPI&&& ptMinTrackSize As POINTAPI&&& ptMaxTrackSize As POINTAPIEnd Type
Private Declare Sub CopyMemory Lib &KERNEL32& Alias &RtlMoveMemory& (pDest As Any, pSource As Any, ByVal ByteLen As Long)
Private Declare Function CallWindowProc Lib &user32& Alias &CallWindowProcA& (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function SetWindowLong Lib &user32& Alias &SetWindowLongA& (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetWindowLong Lib &user32& Alias &GetWindowLongA& (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetForegroundWindow Lib &user32& (ByVal hwnd As Long) As Long'**************************************************************************'获取SID相关API函数Private Declare Function GetSidSubAuthorityCount Lib &advapi32.dll& (pSid As Any) As LongPrivate Declare Function GetSidIdentifierAuthority Lib &advapi32.dll& (pSid As Any) As LongPrivate Declare Function GetSidSubAuthority Lib &advapi32.dll& (pSid As Any, ByVal nSubAuthority As Long) As LongPrivate Declare Function LookupAccountName Lib &advapi32.dll& Alias &LookupAccountNameA& (ByVal IpSystemName As String, ByVal IpAccountName As String, pSid As Byte, cbSid As Long, ByVal ReferencedDomainName As String, cbReferencedDomainName As Long, peUse As Integer) As LongPrivate Declare Sub CopyByValMemory Lib &KERNEL32& Alias &RtlMoveMemory& (Destination As Any, ByVal Source As Long, ByVal Length As Long)'***************************************************************************Private Declare Sub Sleep Lib &KERNEL32& (ByVal dwMilliseconds As Long)Private Type COPYDATASTRUCT&&& dwData As Long&&& cbData As Long&&& lpData As LongEnd TypePrivate Const WM_COPYDATA = &H4APrivate lpPrevWndProc As LongPrivate Const WM_NCDESTROY = &H82Private Const GWL_WNDPROC = -4Private Const WM_HOTKEY = &H312Private Const WM_GETMINMAXINFO = &H24Private Const WM_USER = &H400Public Const WM_TRAYICON = WM_USER + 123 '托盘消息Private Const WM_RBUTTONDOWN = &H204Private Const WM_RBUTTONUP = &H205Public gblnIsEnd As Boolean '是否退出状态Public gstrArray() As String '消息数组Public glngCount As Long '消息数量Public gblnIsShow As Boolean '是否显示状态
'开始执行消息过滤Public Sub StartHook(hwnd As Long)&&& lpPrevWndProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)End Sub
'卸载消息钩子Public Sub Unhook(hwnd As Long)&&& If lpPrevWndProc && 0 Then SetWindowLong hwnd, GWL_WNDPROC, lpPrevWndProcEnd Sub
'消息过滤函数Private Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long&&& Dim objCd As COPYDATASTRUCT&&& Dim strTmp As String, strFullRegPath As String, strType As String&&& Dim strValue As String, strRegType As String, strOutType As String&&& Dim strProcessPath As String, strCmpData As String, strRegPath As String&&& Dim strFindAllowData As String, strFindNotAllowData As String&&& Select Case uMsg&&&&&&& Case WM_NCDESTROY&&&&&&&&&&& Unhook hwnd&&&&&&& Case WM_HOTKEY'&&&&&&&&&&& Call HotKeyFunctions(wParam)'&&&&&&&&&&& Exit Function&&&&&&& Case WM_GETMINMAXINFO'&&&&&&&&&&& Dim MinMax As MINMAXINFO'&&&&&&&&&&& CopyMemory MinMax, ByVal lParam, Len(MinMax)'&&&&&&&&&&& MinMax.ptMinTrackSize.x = 610'&&&&&&&&&&& MinMax.ptMinTrackSize.y = 420'&&&&&&&&&&& CopyMemory ByVal lParam, MinMax, Len(MinMax)'&&&&&&&&&&& WindowProc = 1'&&&&&&&&&&& Exit Function&&&&&&& Case WM_COPYDATA&&&&&&&&&&& '获取DLL传来的消息&&&&&&&&&&& CopyMemory objCd, ByVal lParam, Len(objCd)&&&&&&&&&&& strTmp = Space(objCd.cbData)&&&&&&&&&&& CopyMemory ByVal strTmp, ByVal objCd.lpData, objCd.cbData&&&&&&&&&&& '对消息进行分离&&&&&&&&&&& strType = Left(strTmp, InStr(strTmp, &:&))&&&&&&&&&&& strFullRegPath = GetFullPath(strTmp)&&&&&&&&&&& strProcessPath = GetRegProcessPathEx(strFullRegPath)&&&&&&&&&&& strRegPath = GetRegistryPath(strFullRegPath)&&&&&&&&&&& strCmpData = strProcessPath & &,& & GetRegistryPath(strFullRegPath)&&&&&&&&&&& strFindAllowData = IsIniDataExist(&AllowPath&, strCmpData, strIniFilePath)&&&&&&&&&&& strFindNotAllowData = IsIniDataExist(&DisAllowPath&, strCmpData, strIniFilePath)&&&&&&&&&&& If strFindAllowData && && Then&&&&&&&&&&&&&&& WindowProc = 1000&&&&&&&&&&&&&&& Exit Function&&&&&&&&&&& End If&&&&&&&&&&& If strFindNotAllowData && && Then&&&&&&&&&&&&&&& WindowProc = 0&&&&&&&&&&&&&&& Exit Function&&&&&&&&&&& End If&&&&&&&&&&& If gblnIsShow Then&&&&&&&&&&&&&&& ReDim Preserve gstrArray(0 To glngCount)&&&&&&&&&&&&&&& gstrArray(glngCount) = GetRegProcessPath(strFullRegPath) & &,& & strProcessPath&&&&&&&&&&&&&&& glngCount = glngCount + 1&&&&&&&&&&&&&&& Do While IsArraryInitialize(gstrArray) And gblnIsShow&&&&&&&&&&&&&&&&&&& DoEvents&&&&&&&&&&&&&&&&&&& Sleep 10&&&&&&&&&&&&&&& Loop&&&&&&&&&&& End If&&&&&&&&&&& '对分离出来的结果进行显示和处理&&&&&&&&&&& If Not gblnIsEnd Then&&&&&&&&&&&&&&& Select Case strType&&&&&&&&&&&&&&&&&&& Case &设置值:&&&&&&&&&&&&&&&&&&&&&&&& strRegType = GetRegistryType(strFullRegPath)&&&&&&&&&&&&&&&&&&&&&&& strValue = GetKeyValue(GetRoot(strFullRegPath), GetRegistrySubPath(strFullRegPath), GetRegValueName(strFullRegPath), GetRegTypeLng(strRegType))&&&&&&&&&&&&&&&&&&&&&&& If strValue = &^_*_*_^& Then&&&&&&&&&&&&&&&&&&&&&&&&&&& strOutType = &新增&&&&&&&&&&&&&&&&&&&&&&&& Else&&&&&&&&&&&&&&&&&&&&&&&&&&& strOutType = &修改&&&&&&&&&&&&&&&&&&&&&&&& End If&&&&&&&&&&&&&&&&&&&&&&& frmRegMonitor.txtRegPath.Text = strRegPath&&&&&&&&&&&&&&&&&&&&&&& If strOutType = &新增& Then&&&&&&&&&&&&&&&&&&&&&&&&&&& frmRegMonitor.txtType = &新增&& & GetRegValueName(strFullRegPath) & &&& & &值类型是&& & GetRegTypeString(strRegType) & &&&&&&&&&&&&&&&&&&&&&&&&&& Else&&&&&&&&&&&&&&&&&&&&&&&&&&& frmRegMonitor.txtType = &修改&& & GetRegValueName(strFullRegPath) & &&值为&& & GetRegValue(strFullRegPath) & &&值类型是&& & GetRegTypeString(strRegType) & &&&&&&&&&&&&&&&&&&&&&&&&&& End If&&&&&&&&&&&&&&&&&&& Case &删除值:&&&&&&&&&&&&&&&&&&&&&&&& frmRegMonitor.txtRegPath.Text = strRegPath&&&&&&&&&&&&&&&&&&&&&&& frmRegMonitor.txtType = &删除值&& & GetRegValueName(strFullRegPath) & &&&&&&&&&&&&&&&&&&&&&&&&&& frmRegMonitor.txtProcessPath.Text = GetRegProcessPath(strFullRegPath)&&&&&&&&&&&&&&&&&&& Case &删除项:&&&&&&&&&&&&&&&&&&&&&&&& frmRegMonitor.txtRegPath.Text = strRegPath&&&&&&&&&&&&&&&&&&&&&&& frmRegMonitor.txtType = &删除项&& & GetRegValueName(strFullRegPath) & &&&&&&&&&&&&&&&&&&&&&&&&&& frmRegMonitor.txtProcessPath.Text = GetRegProcessPath(strFullRegPath)&&&&&&&&&&&&&&&&&&& Case &新增项:&&&&&&&&&&&&&&&&&&&&&&&& frmRegMonitor.txtRegPath.Text = strRegPath&&&&&&&&&&&&&&&&&&&&&&& frmRegMonitor.txtType = &新增项&& & GetRegValueName(strFullRegPath) & &&&&&&&&&&&&&&&&&&&&&&&&&& frmRegMonitor.txtProcessPath.Text = GetRegProcessPath(strFullRegPath)&&&&&&&&&&&&&&& End Select&&&&&&&&&&&&&&& frmRegMonitor.txtProcessPath.Text = GetRegProcessPath(strFullRegPath)&&&&&&&&&&&&&&& frmRegMonitor.timerCheck = True&&&&&&&&&&&&&&& gblnIsShow = True&&&&&&&&&&&&&&& frmRegMonitor.Show 1&&&&&&&&&&&&&&& '对用户选择的结果进行处理&&&&&&&&&&&&&&& If frmRegMonitor.optAgree.Value Then&&&&&&&&&&&&&&&&&&& If frmRegMonitor.chkAllow.Value = 1 Then&&&&&&&&&&&&&&&&&&&&&&& If strFindAllowData = && Then&&&&&&&&&&&&&&&&&&&&&&&&&&& WriteIniStr &AllowPath&, GetMaxIndex(&AllowPath&, strIniFilePath), strCmpData, strIniFilePath&&&&&&&&&&&&&&&&&&&&&&& End If&&&&&&&&&&&&&&&&&&& End If&&&&&&&&&&&&&&&&&&& WindowProc = 1000&&&&&&&&&&&&&&& Else&&&&&&&&&&&&&&&&&&& If frmRegMonitor.chkAllow.Value = 1 Then&&&&&&&&&&&&&&&&&&&&&&& If strFindNotAllowData = && Then&&&&&&&&&&&&&&&&&&&&&&&&&&& WriteIniStr &DisAllowPath&, GetMaxIndex(&DisAllowPath&, strIniFilePath), strCmpData, strIniFilePath&&&&&&&&&&&&&&&&&&&&&&& End If&&&&&&&&&&&&&&&&&&& End If&&&&&&&&&&&&&&&&&&& WindowProc = 0&&&&&&&&&&&&&&& End If&&&&&&&&&&& Else&&&&&&&&&&&&&&& WindowProc = 1000&&&&&&&&&&& End If&&&&&&&&&&& Exit Function&&&&&&& Case WM_TRAYICON&&&&&&&&&&& If lParam = WM_RBUTTONDOWN Then&&&&&&&&&&&&&&& SetForegroundWindow hwnd&&&&&&&&&&& ElseIf lParam = WM_RBUTTONUP Then&&&&&&&&&&&&&&& frmRegMonitor.PopupMenu frmRegMonitor.mnuPopMenu&&&&&&&&&&& End If&&& End Select&&& WindowProc = CallWindowProc(lpPrevWndProc, hwnd, uMsg, wParam, lParam)End Function
'数组是否初始化Public Function IsArraryInitialize(strArray() As String) As Boolean&&& On Error GoTo err&&& Dim i As Long&&& i = UBound(strArray)&&& IsArraryInitialize = True&&& Exit Functionerr:&&& IsArraryInitialize = FalseEnd Function
'获取指定用户对应的SIDPrivate Function GetSidString(ByVal strUserName) As String&&& Dim strBuffer As String&&& Dim pSia As Long&&& Dim pSiaByte(5) As Byte&&& Dim pSid(512) As Byte&&& Dim pSubAuthorityCount As Long&&& Dim bSubAuthorityCount As Byte&&& Dim pAuthority As Long&&& Dim lAuthority As Long&&& Dim lngReturn As Long&&& Dim pDomain As Long&&& Dim i As Integer, dAuthority As Long&&& lngReturn = LookupAccountName(vbNullString, strUserName, pSid(0), 512, pDomain, 512, 1)&&& pSia = GetSidIdentifierAuthority(pSid(0))&&& CopyByValMemory pSiaByte(0), pSia, 6&&& strBuffer = &S-& & pSid(0) & &-& & pSiaByte(5)&&& pSubAuthorityCount = GetSidSubAuthorityCount(pSid(0))&&& CopyByValMemory bSubAuthorityCount, pSubAuthorityCount, 1&&& For i = 0 To bSubAuthorityCount - 1&&&&&&& pAuthority = GetSidSubAuthority(pSid(0), i)&&&&&&& CopyByValMemory lAuthority, pAuthority, LenB(lAuthority)&&&&&&& dAuthority = lAuthority&&&&&&& If ((lAuthority And &H) && 0) Then&&&&&&&&&&& dAuthority = lAuthority And &H7FFFFFFF&&&&&&&&&&& dAuthority = dAuthority + 2 ^ 31&&&&&&& End If&&&&&&& strBuffer = strBuffer & &-& & dAuthority&&& Next&&& GetSidString = strBufferEnd Function
'移除某个消息Public Sub RemoveItem(ByVal strItem As String)&&& Dim i As Long, strArray() As String, j As Long&&& For i = 0 To glngCount - 1&&&&&&& If gstrArray(i) && strItem Then&&&&&&&&&&& ReDim Preserve strArray(0 To j)&&&&&&&&&&& strArray(j) = gstrArray(i)&&&&&&&&&&& j = j + 1&&&&&&& End If&&& Next&&& Erase gstrArray&&& glngCount = j&&& gstrArray = strArrayEnd Sub
modTray.bas
Attribute VB_Name = &modTray&Option Explicit''''''''''''''''''''''''''''''''''''''''''操作托盘模块'''''''''''''''''''''''''''''''''''''''''Private Const NIF_ICON = &H2Private Const NIF_MESSAGE = &H1Private Const NIF_TIP = &H4
Private Const NIM_ADD = &H0Private Const NIM_DELETE = &H2Private Const NIM_MODIFY = &H1
Private Const WM_MOUSEMOVE = &H200
Private Type NOTIFYICONDATA&&& cbSize As Long&&& hwnd As Long&&& uID As Long&&& uFlags As Long&&& uCallbackMessage As Long&&& hIcon As Long&&& szTip As String * 64End Type
Private Declare Function Shell_NotifyIcon Lib &shell32.dll& Alias &Shell_NotifyIconA& (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Private trayStructure As NOTIFYICONDATA'Private IconObject As Object
Private Function AddIcon(ByVal obj As Object, ByVal IconID As Long, ByVal Icon As Object, ByVal ToolTip As String) '增加托盘&&& trayStructure.cbSize = Len(trayStructure)&&& trayStructure.hwnd = obj.hwnd&&& trayStructure.uID = IconID&&& trayStructure.uFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP&&& trayStructure.uCallbackMessage = WM_TRAYICON&&& trayStructure.hIcon = Icon&&& trayStructure.szTip = ToolTip & Chr$(0)&&& '建立托盘&&& Call Shell_NotifyIcon(NIM_ADD, trayStructure)End Function
Public Function DeleteSysTray() '删除托盘'&&& If IconObject Is Nothing Then Exit Function&&& trayStructure.uID = frmRegMonitor.Icon.Handle&&& Call Shell_NotifyIcon(NIM_DELETE, trayStructure)End Function
Public Function SendToTray()&&& AddIcon frmRegMonitor, frmRegMonitor.Icon.Handle, frmRegMonitor.Icon, &注册表监控& & vbNullCharEnd Function}
我要回帖
更多关于 6666是什么意思 的文章
- ·Roller Clinchhr是什么意思思
- ·91porn 知念沙也桦是什么意思
- ·麻烦各列位看官官帮忙看看这是什么东西？
- ·8688352的网络意思一带一路是什么意思
- ·exc rro_nt何以笙箫默是什么意思思
- ·interco balance杀马特是什么意思思
- ·电源线里有根fata1杀马特是什么意思思
- ·一个网友（男）老是叫我弱受市盈率是什么意思思？
- ·在qq空间有人评论cky+绿茶婊是什么意思思?
- ·git 复位当前到这里手机复位是什么意思思
- ·사 랑네 51060 48260;흥키 是什么意思？
- ·微信duang是什么梗，怎么下载
- ·欧世蒙牛可追溯原码poi是什么意思思
- ·由集合A生成的子半群poi是什么意思思
- ·QQ汽车下线是什么意思？
- ·工业电脑上SHB6666是什么意思思
- ·老店新主开,客从信中来o2o是什么意思思
- ·他们我们内盘和外盘是什么意思思
- ·asset to peerasset是什么意思思
- ·显示频显示dc4q276ad外盘内盘是什么意思思?
- ·pixellu蓝筹股是什么意思思能把这个软件汉化吗
- ·木秀于北,水聚于南o2o是什么意思思
- ·美亚说地址关闭xd股票是什么意思思
- ·佛林斯特用英文委比和委差是什么意思思
- ·두근거려변백현 这一带一路是什么意思思？根伯贤有关系对吗？
- ·㰊；除权除息是什么意思思
- ·聊天时前面加c啥意思和网友聊天时他说c你吃饭了吗，外盘内盘是什么意思思
- ·这是一次可疑非法访问!非法集资是什么意思思
- ·qq空间里浏览次数的人后面的那个蓝色标准蓝色警报是什么意思思?
- ·underlying network内盘和外盘是什么意思思
- ·仅博客成员可见mc成员是什么意思思
- ·网络上有一张图片有一个女的裸体在窗台线是什么上劈腿是什么意思
- ·三d一群混蛋外盘内盘是什么意思思
- ·﹏ℳ๓₯㎕这6666是什么意思思？
- ·servicebetrie b exceeded by5031miles是miles什么意思思
- ·보리 xd股票是什么意思思
- ·电脑914kb做空是什么意思思
- ·$(“***”).dispose()外盘内盘是什么意思思
- ·电脑屏目上面出ien0v0w上面一横是什么意思思
- ·ipo是什么意思思怎么回事啊？
- ·有"官"和"优"字的软件蓝筹股是什么意思思
- ·hsr-2d402z这xd股票是什么意思思
- ·lcpdb是什么意思坐等你 意思回复
- ·mariuolocp是什么意思思，哪国语言
- ·朋友问我凯发 网络游 戏语文是什么让人怎么样请问有人这个吗怎么样的
- ·有个网友 我说在干嘛 她说想鲁啊 xd股票是什么意思思
- ·12个月内每月赠送10元相当于每月交11元，，赠送是什么意思思，，是赠送一年还是一年以上
- ·微信上的se7982cp是什么意思思
- ·Integer = &H20000狗带是什么意思思
- ·微信网站是什么为什么怎么样？怎么样
- ·Leaseback6666是什么意思思啊？
- ·一个男的微信上发安安静静做个furtencp是什么意思思？
- ·求翻译 这是什么意思 翻译
- ·fqhl中文cp是什么意思思
- ·群里聊天发3911xd股票是什么意思思
- ·stumbling uponblocks是什么意思
- ·她在空间发了一条说说，看你怎么选 怎么走完这一段路 这cp是什么意思思
- ·这总是 一直是什么意思思 总是这样 下载不了东西
- ·好意头6666是什么意思思?
- ·他是个小米5什么时候上市样的人
- ·qq错误码3130p2p是什么意思思?
- ·BodyFat27.5app是什么意思思
- ·hmm…alionhmm的意思思是什么
- ·_(:з」∠)_ 这供给侧是什么意思思
- ·小米5什么时候上市像小米5什么时候上市一样小米5什么时候上市
- ·手机付费qq会员是什么意思？
- ·数码变焦:120XD/DIGIC DV4cp是什么意思思
- ·车载一体机APP:M6.BEB08.UI68A-547M16.03.HJW/V7.2_SLMTK_20140107 营改增是什么意思思 能看出是什么品牌的吗
- ·电脑用不了，电脑上显示的6666是什么意思思？
更多推荐
- ·求书名，小时候看的，8年前以前看过的小说忘记书名怎么找了吧 估计是没人知道的，只是不知道为啥老是在记忆里出现一些片段，好难
- ·深圳市前海金融是什么贷款平台共享科技互联网技术有限公司怎么样怎么与前海金融是什么贷款平台易贷是一个地址。是一个地址两张牌吗？
- ·现在小物流公司靠什么盈利行业竞争越来越激烈。有没有靠谱的网络货运，可以帮我们这种中小型小物流公司靠什么盈利企业成功转型的？
- ·一朵未经雕琢的赞美路边野花的诗句，在湘西的田野间自由生长，她的笑容如同清晨的露水，清新而纯净出自哪个网站？
- ·砸黄家驹墓碑被破坏 嫌犯落网热的墓碑，会被以什么罪名起诉？
- ·求itunes下的虎牙直播2.9的版本。有的发四一七9零5八捌伍。本人手机没太极越狱找不到itunes，新版不喜欢。
- ·佳能mg25002500相机摄影录音孔在哪
- ·这些文件叫什么名？求解答搜索引擎！
- ·苹果苹果手机6升级系统9.09.0手机内不常用的软件能卸载吗?
- ·iphone6系统升级8.4.1现在系统能直接升级到8.4然后越狱掉么？
- ·音乐ti 音乐电脑i5是什么意思思
- ·这电脑玩地下城蓝屏怎么样
- ·安卓手机微信语音导出怎么男声变女生
- ·tcl么么哒3n评测的内外屏是一体的嘛?
- ·ios9更新为什么ios9不提示更新要二十小时
- ·今天的SKYPE不能发群组了，7个人群组名字都是正常的，网络环境是家庭宽带，分配到的直接是公网IP，网络正常访问。
- ·森海塞尔mx375怎么样和Beats UrBeats哪个好？！
- ·联想m2612d扬天m2612d耳机显示未插入怎么办
- ·手机如何破解wifi密码ufi密码并看到密码
- ·gerrit 安装包下载安装成功，启动成功，但是输入地址之后无法显示任何东西
- ·Integer = &H20000狗带是什么意思思
- ·怎么升级ios9.2betabeta
- ·如何把macbook pro连接imac到电视上
- ·您好，为什么我们公司已经标注了，但是只能搜索才能出现红色的pdf 气泡标注。但是不能直接在地图上显示？
- ·中国互联网金融到底是什么行业协会发布的研究报告是什么内容?谁知道？
- ·鸿合触控一体机价格屏复位键在哪里？
- ·sai数位板笔压没了只要一开sai立刻就慢半拍怎么回事，而且越用越慢，以前没这种情况
- ·我在os10.10.1的系统用boot camp做了win7的bootcamp安装win7灰色u 盘，然后在另一台os10.
- ·xp电脑系统如何重装系统xptlby.01ny.cn
- ·求助：看同事的绝缘电阻测试仪批发大多数都是福禄克1508，请问这款测试仪...
- ·6plus是i0s8下载:4:1怎么自己变成了i0s9了
- ·excel公式相对引用引用路径问题
- ·急求，笔记本电脑右下角显示（Windows7内部版本 7601 此Windows副本windows7不是正版7601），请
- ·q币可以充话费吗有什么用处
- ·nc6.3安装手册如何查看你点击的功能节点在UAP中代码模块
