vb注册表与文件夹权限设置

【核心代码】

VERSION 5.00
Begin VB.Form frmMain 
   BorderStyle     =   0  'None
   ClientHeight    =   2784
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   6216
   LinkTopic       =   "Form1"
   ScaleHeight     =   2784
   ScaleWidth      =   6216
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'Private Const FOLDER_PATH = "MACHINE/SYSTEM/CurrentControlSet/Enum/ACPI_HAL"
Private Const SYNCHRONIZE As Long = &H100000
Private Const STANDARD_RIGHTS_READ = &H20000
Private Const STANDARD_RIGHTS_WRITE = &H20000
Private Const STANDARD_RIGHTS_EXECUTE = &H20000
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_CREATE_LINK = &H20
Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Private Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
Private Const KEY_EXECUTE = (KEY_READ)
Private Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
'Private Const STANDARD_RIGHTS_ALL As Long = &H1F0000
Private Const ERROR_SUCCESS = 0&
'Private Const READ_CONTROL = &H20000
'Private Const KEY_QUERY_VALUE = &H1
'Private Const KEY_SET_VALUE = &H2
'Private Const KEY_CREATE_SUB_KEY = &H4
'Private Const KEY_ENUMERATE_SUB_KEYS = &H8
'Private Const KEY_NOTIFY = &H10
'Private Const KEY_CREATE_LINK = &H20
'Private Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL   KEY_QUERY_VALUE   KEY_SET_VALUE   KEY_CREATE_SUB_KEY   KEY_ENUMERATE_SUB_KEYS   KEY_NOTIFY   KEY_CREATE_LINK   READ_CONTROL) And (Not SYNCHRONIZE))

Private Const DACL_SECURITY_INFORMATION = 4&
Private Const SET_ACCESS = 2&
Private Const SUB_CONTAINERS_AND_OBJECTS_INHERIT = &H3

Private Enum SE_OBJECT_TYPE
    SE_UNKNOWN_OBJECT_TYPE = 0&
    SE_FILE_OBJECT = 1&
    SE_SERVICE = 2&
    SE_PRINTER = 3&
    SE_REGISTRY_KEY = 4&
    SE_LMSHARE = 5&
    SE_KERNEL_OBJECT = 6&
    SE_WINDOW_OBJECT = 7&
End Enum

'
Private Type TRUSTEE
    pMultipleTrustee As Long
    MultipleTrusteeOperation As Long
    TrusteeForm As Long
    TrusteeType As Long
    ptstrName As String
End Type


Private Type EXPLICIT_ACCESS
    grfAccessPermissions As Long
    grfAccessMode As Long
    grfInheritance As Long
    pTRUSTEE As TRUSTEE
End Type


Private Declare Sub BuildExplicitAccessWithName Lib "Advapi32.dll" Alias _
    "BuildExplicitAccessWithNameA" _
    (ea As Any, _
    ByVal TrusteeName As String, _
    ByVal AccessPermissions As Long, _
    ByVal AccessMode As Integer, _
    ByVal Inheritance As Long)
    
Private Declare Function SetEntriesInAcl Lib "Advapi32.dll" Alias _
    "SetEntriesInAclA" _
    (ByVal CountofExplicitEntries As Long, _
    ea As Any, _
    ByVal OldAcl As Long, _
    NewAcl As Long) As Long

Private Declare Function GetNamedSecurityInfo Lib "Advapi32.dll" Alias _
    "GetNamedSecurityInfoA" _
    (ByVal ObjName As String, _
    ByVal SE_OBJECT_TYPE As Long, _
    ByVal SecInfo As Long, _
    ByVal pSid As Long, _
    ByVal pSidGroup As Long, _
    pDacl As Long, _
    ByVal pSacl As Long, _
    pSecurityDescriptor As Long) As Long
    
Private Declare Function SetNamedSecurityInfo Lib "Advapi32.dll" Alias _
    "SetNamedSecurityInfoA" _
    (ByVal ObjName As String, _
    ByVal SE_OBJECT As Long, _
    ByVal SecInfo As Long, _
    ByVal pSid As Long, _
    ByVal pSidGroup As Long, _
    ByVal pDacl As Long, _
    ByVal pSacl As Long) As Long

Private Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private commandLine As String


Private Sub Form_Load()
    MsgBox SetRegKeySecurity("CURRENT_USER/Software/Microsoft/Protected Storage System Provider/S-1-5-21-2459544509-2615247588-1385470033-500")
'    End
    SetRegKeySecurity "MACHINE/SYSTEM/CurrentControlSet/Enum/usb"
'    End
    Me.Hide
    Dim splitArr() As String
    commandLine = Command
    If commandLine = "" Then Unload Me: End

    If InStr(commandLine, "/") Then
        splitArr = Split(commandLine, "/")
        If UBound(splitArr) >= 1 Then
            If LCase(Trim(splitArr(1))) = "r" Then
                RestoreRegSecurity Trim(splitArr(2))
            Else
                If LCase(Trim(splitArr(1))) = "u" Then
                    SetRegKeySecurity Trim(splitArr(2))
                Else
                    
                    SetRegKeySecurity Trim(splitArr(1))
                End If
            End If
        End If
    ElseIf InStr(commandLine, "-") Then
        splitArr = Split(commandLine, "-")
        If UBound(splitArr) >= 1 Then
            If LCase(Trim(splitArr(1))) = "r" Then
                RestoreRegSecurity Trim(splitArr(2))
            Else
                If LCase(Trim(splitArr(1))) = "u" Then
                    SetRegKeySecurity Trim(splitArr(2))
                Else
                    SetRegKeySecurity Trim(splitArr(1))
                End If
            End If
        End If
    End If
    Unload Me: End
End Sub

Private Function SetRegKeySecurity(ByVal RegPath As String) As Boolean
    Dim result As Long
    Dim pSecDesc As Long
    Dim ea As EXPLICIT_ACCESS
    Dim pNewDACL As Long
    Dim pOldDACL As Long
    result = GetNamedSecurityInfo(RegPath, SE_REGISTRY_KEY, DACL_SECURITY_INFORMATION, 0&, 0&, pOldDACL, 0&, pSecDesc)

    If result = ERROR_SUCCESS Then
        Call BuildExplicitAccessWithName(ea, "EVERYONE", KEY_ALL_ACCESS, SET_ACCESS, SUB_CONTAINERS_AND_OBJECTS_INHERIT)
        result = SetEntriesInAcl(1, ea, pOldDACL, pNewDACL)
        If result = ERROR_SUCCESS Then
            result = SetNamedSecurityInfo(RegPath, SE_REGISTRY_KEY, DACL_SECURITY_INFORMATION, 0&, 0&, pNewDACL, 0&)
            If result = ERROR_SUCCESS Then

            Else
                SetRegKeySecurity = False
                Exit Function
            End If
            
            LocalFree pNewDACL
        Else
            SetRegKeySecurity = False
            Exit Function
        End If
        
        LocalFree pSecDesc
        SetRegKeySecurity = True
        If commandLine <> "" Then
            If InStr(LCase(commandLine), "-u") Or InStr(LCase(commandLine), "/u") Then
                Dim fn As Integer
                fn = FreeFile
                Open "_temp.txt" For Output As #fn
                Print #fn, pOldDACL
                Close #fn
            End If
        End If
    Else
        SetRegKeySecurity = False
        Exit Function
    End If
'    MsgBox SetNamedSecurityInfo(RegPath, SE_REGISTRY_KEY, DACL_SECURITY_INFORMATION, 0&, 0&, pOldDACL, 0&)
End Function

Private Function GetDacl() As Long
    Dim strDacl As String, fn As Integer
    On Error Resume Next
    If Dir(App.Path & "/_temp.txt", 1 Or 2 Or 4) <> "" Then
        fn = FreeFile
        Open App.Path & "/_temp.txt" For Input As #fn
        Line Input #fn, strDacl
        Close #fn
        strDacl = Trim(strDacl)
        If strDacl <> "" And IsNumeric(strDacl) Then
            GetDacl = CLng(strDacl)
        Else
            GetDacl = 0
        End If
    Else
        GetDacl = 0
        Exit Function
    End If
    If GetAttr(App.Path & "/_temp.txt") And vbReadOnly Then
        SetAttr App.Path & "/_temp.txt", 0
    End If
    Kill App.Path & "/_temp.txt"
End Function

Private Function RestoreRegSecurity(ByVal RegPath As String) ', ByVal dacl As Long)
    Dim dacl As Long
    dacl = GetDacl
    If dacl Then
        SetNamedSecurityInfo RegPath, SE_REGISTRY_KEY, DACL_SECURITY_INFORMATION, 0&, 0&, dacl, 0&
        LocalFree dacl
    End If
End Function