form1.frm

能让你实现轻松注册组建！更多联系QQ417317494 www.sfjiang.cn 姜斌

VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "注册表操作大全"
   ClientHeight    =   2760
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4905
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   2760
   ScaleWidth      =   4905
   StartUpPosition =   1  '所有者中心
   Begin VB.ListBox List4 
      Height          =   1320
      Left            =   2475
      TabIndex        =   8
      Top             =   1350
      Width           =   2340
   End
   Begin VB.ListBox List3 
      Height          =   1320
      Left            =   90
      TabIndex        =   7
      Top             =   1350
      Width           =   2325
   End
   Begin VB.ListBox List2 
      Height          =   1320
      Left            =   2310
      TabIndex        =   6
      Top             =   2775
      Visible         =   0   'False
      Width           =   2490
   End
   Begin VB.ListBox List1 
      Height          =   1320
      Left            =   75
      TabIndex        =   0
      Top             =   2775
      Visible         =   0   'False
      Width           =   2145
   End
   Begin VB.PictureBox Picture1 
      Height          =   1245
      Left            =   60
      ScaleHeight     =   1185
      ScaleWidth      =   4680
      TabIndex        =   1
      Top             =   30
      Width           =   4740
      Begin VB.CommandButton Command1 
         Caption         =   "读取键的默认值"
         Height          =   390
         Left            =   2490
         TabIndex        =   5
         Top             =   105
         Width           =   2025
      End
      Begin VB.CommandButton Command2 
         Caption         =   "列举键下面的所有子键"
         Height          =   390
         Left            =   120
         TabIndex        =   4
         Top             =   630
         Width           =   2025
      End
      Begin VB.CommandButton Command3 
         Caption         =   "删除键下面的所有子键"
         Height          =   390
         Left            =   120
         TabIndex        =   3
         Top             =   90
         Width           =   2025
      End
      Begin VB.CommandButton Command4 
         Caption         =   "读取指定键的值"
         Height          =   390
         Left            =   2490
         TabIndex        =   2
         Top             =   630
         Width           =   2025
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" (ByVal hkey As Long, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue As Long) As Long
Private Declare Function 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 RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hkey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hkey As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hkey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long         ' Note that if you declare the lpData parameter as String, you must pass it By Value.

Const HKEY_LOCAL_MACHINE = &H80000002

Private Sub Command1_Click()
    Dim ret As Long, hkey As Long, hKey2 As Long, Str_value As String, ret1 As Boolean
    ret = 1
    '取得"HKEY_LOCAL_MACHINE"底下的"SOFTWARE\Microsoft"这个SubKey Handle.
    ret = RegOpenKey(HKEY_LOCAL_MACHINE, "SOFTWARE", hkey)
    
    If ret = 0 Then 'If Success
        'MsgBox "HKLM\SOFTWARE = " & hKey
    End If
    
    'ret = RegOpenKey(hKey, "Windows\CurrentVersion", hKey2)
    'If ret = 0 Then
        'MsgBox "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion = " & hKey2
    'End If
    Dim s As String, lens As Long
    lens = 255
    s = String(lens, Chr(0))
    
    ret1 = RegQueryValue(hkey, "1111", s, lens)
    
    MsgBox s
End Sub

Private Sub Command2_Click()
    List1.Clear
    List2.Clear
    List3.Clear
    List4.Clear
    
    Dim hkey As Long, ret As Long, Name As String, Idx As Long, i, j As Integer
    
    ret = RegOpenKey(HKEY_LOCAL_MACHINE, "SOFTWARE\Classes\CLSID", hkey)
    
    j = 0
    Idx = 0
    Name = String(256, Chr(0))
    Do
        ret = RegEnumKey(hkey, Idx, Name, Len(Name))
        
        If ret = 0 Then
            List1.AddItem Left(Name, InStr(Name, Chr(0)) - 1)
            Idx = Idx + 1
        End If
    Loop Until ret <> 0
    RegCloseKey hkey
    
    For i = 0 To List1.ListCount
        List2.AddItem Func_ReadRegAndGetFileName(List1.List(i))
    Next
    
    For i = 0 To List2.ListCount
        
        'If Func_GetFileNameFormPath(List2.List(i)) = "aa.ocx" Or Func_GetFileNameFormPath(List2.List(i)) = "yes.ocx" Or Func_GetFileNameFormPath(List2.List(i)) = "winsck.ocx" Then
        If Func_GetFileNameFormPath(List2.List(i)) = "winsck.ocx" Then
            
            List3.AddItem Func_GetFileNameFormPath(List2.List(i)) + "已删除！"
            
            '查找另一个位置上的东东
            Func_ReadRegTypeLib (i)
            
            '删除程序调用ocx时必须用的信息
            Call RegOpenKey(HKEY_LOCAL_MACHINE, "SOFTWARE\Classes\CLSID\", hkey)
            DeleteSubkeyTree hkey, List1.List(i)
            
            'j = j + 1
            'If j = 4 Then
               ' MsgBox i & "\" & List1.ListCount
                'Exit Sub
            'End If
        End If
    
    Next

End Sub

'删除键下在的所有子键
 Function DeleteSubkeyTree(ByVal hkey As Long, ByVal Subkey As String) As Boolean
    Dim ret As Long, Index As Long, Name As String
    Dim hSubKey As Long
    
    ret = RegOpenKey(hkey, Subkey, hSubKey)
    
    
    If ret <> 0 Then
        DeleteSubkeyTree = False
        'MsgBox "failure!"
        Exit Function
    End If
    
    ret = RegDeleteKey(hSubKey, "")

    If ret <> 0 Then
        Name = String(256, Chr(0))
        'MsgBox "RegDeleteKey无法删除，用于Winnt下。"
        While RegEnumKey(hSubKey, 0, Name, Len(Name)) = 0 And DeleteSubkeyTree(hSubKey, Name)
            '递归删除Subkey的Subkey
        Wend
        ret = RegDeleteKey(hSubKey, "")
    End If
    
    DeleteSubkeyTree = (ret = 0)
    RegCloseKey hSubKey
End Function

Private Sub Command3_Click()
    Call RegOpenKey(HKEY_LOCAL_MACHINE, "SOFTWARE", hkey)
    DeleteSubkeyTree hkey, "1111"
End Sub

Private Sub Command4_Click()
    Dim hkey As Long, ret As Long, lenData As Long, typeData As Long, Str_value As String
    Dim Name As String
    '读取HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run的internat.exe的value.
    Name = "alpath"
    ret = RegOpenKey(HKEY_LOCAL_MACHINE, "Software\3721", hkey)
    If ret = 0 Then
        Str_value = String(255, Chr(0))
        ret = RegQueryValueEx(hkey, Name, 0, 1, ByVal Str_value, 255) '注意ByVal千万别忘了
    End If
    MsgBox Str_value
End Sub

'从路径中取出文件名
Private Function Func_GetFileNameFormPath(Str_Path As String) As String
    Dim i As Integer
    For i = 0 To Len(Str_Path)
        If i = Len(Str_Path) - 1 Then Func_GetFileNameFormPath = Str_Path
        If Left(Right(Str_Path, i), 1) = "\" Then
            Func_GetFileNameFormPath = Right(Str_Path, i - 1)
            i = Len(Str_Path)
        End If
    Next
End Function

'读键的值并取文件名
Private Function Func_ReadRegAndGetFileName(Str_filereg As String) As String
    Dim ret, hkey As Long
    Str_filereg = "SOFTWARE\Classes\CLSID\" + Str_filereg
    'MsgBox Str_FileReg
    ret = RegOpenKey(HKEY_LOCAL_MACHINE, Str_filereg, hkey)
    
    Dim s As String, lens As Long
    lens = 255
    s = String(lens, Chr(0))
    Call RegQueryValue(hkey, "InprocServer32", s, lens)
    'Call RegQueryValue(hkey, "TypeLib", y, lens)
    Func_ReadRegAndGetFileName = s
    
    
    RegCloseKey hkey
    
End Function

Private Function Func_ReadRegTypeLib(i As Integer) As String
    Dim ret, hkey As Long, Str_filereg As String
    Str_filereg = "SOFTWARE\Classes\CLSID\" + List1.List(i)
    'MsgBox Str_FileReg
    ret = RegOpenKey(HKEY_LOCAL_MACHINE, Str_filereg, hkey)
    
    Dim s As String, lens As Long
    lens = 255
    s = String(lens, Chr(0))
    Call RegQueryValue(hkey, "TypeLib", s, lens)
    'Call RegQueryValue(hkey, "TypeLib", y, lens)
    Func_ReadRegTypeLib = s
    
    '删除vb调用ocx时必须用的信息
    If s <> "" Then
        List4.AddItem "已删除！" + s
        Call RegOpenKey(HKEY_LOCAL_MACHINE, "SOFTWARE\Classes\TypeLib\", hkey)
        DeleteSubkeyTree hkey, s
    End If
    
    RegCloseKey hkey
    
End Function