'http://support.microsoft.com/kb/218965/ru
'http://msdn.microsoft.com/en-us/library/windows/desktop/aa446629(v=vs.85).aspx

Public Function GetSecurityOwner(ByVal pszObjName As String, _
 ByVal ObjectType As SE_OBJECT_TYPE, _
 ByRef AcctName As String, ByRef DomainName As String) As Long
  'ф-ция возвращает владельца объекта
  
  'AcctName - account name, DomainName - domain name
  Dim dwRes As Long
  Dim pSidOwner As Long 'security identifier
  Dim pSD As Long
  Dim bRtnBool As Long
  Dim dwAcctName As Long 'size of account name buffer
  Dim dwDomainName As Long 'size of domain name buffer
  Dim eUse As Integer 'SID type
 
  If (pszObjName = "") Then
    GetSecurityOwner = ERROR_INVALID_PARAMETER
    'Debug.Print "ERROR_INVALID_PARAMETER"
    Exit Function
  End If
  
  'Get a pointer to the owner SID of the file
  dwRes = GetNamedSecurityInfo(pszObjName, ObjectType, _
   OWNER_SECURITY_INFORMATION, _
   pSidOwner, 0&, 0&, 0&, pSD)
  If dwRes <> ERROR_SUCCESS Then
    'Debug.Print "GetNamedSecurityInfo Error " & CStr(dwRes)
    GoTo Cleanup
  End If
  
  'First call to LookupAccountSid to get the buffer sizes.
  bRtnBool = LookupAccountSid(vbNullString, pSidOwner, AcctName, dwAcctName, _
   DomainName, dwDomainName, eUse)
  If (bRtnBool = 0) And (Err.LastDllError <> ERROR_INSUFFICIENT_BUFFER) Then
    'Debug.Print "LookupAccountSid (1) Error " & Err.LastDllError
    dwRes = Err.LastDllError
    GoTo Cleanup
  End If
  
  'Allocate the required space in the AcctName and DomainName string
  'variables. Allocate 1 byte less to avoid the appended NULL character.
  AcctName = Space(dwAcctName - 1)
  DomainName = Space(dwDomainName - 1)
  
  'Second call to LookupAccountSid to get the account name.
  bRtnBool = LookupAccountSid(vbNullString, pSidOwner, AcctName, dwAcctName, _
   DomainName, dwDomainName, eUse)
  If bRtnBool = 0 Then
    'Debug.Print "LookupAccountSid (2) Error " & Err.LastDllError
    dwRes = Err.LastDllError
    GoTo Cleanup
  End If

Cleanup:
  If pSD <> 0 Then LocalFree pSD
  
  GetSecurityOwner = dwRes
  
End Function

'Enabling and Disabling Privileges in C++
'http://msdn.microsoft.com/en-us/library/windows/desktop/aa446619(v=vs.85).aspx
Public Function SetPrivilege( _
 ByVal hToken As Long, _
 ByVal lpszPrivilege As String, _
 ByVal bEnablePrivilege As Boolean) As Long
  ' hToken - access token handle
  ' lpszPrivilege - name of privilege to enable/disable
  ' bEnablePrivilege - to enable or disable privilege
  
  Dim bRtnBool As Long
  Dim tP As TOKEN_PRIVILEGES
  Dim New_tp As TOKEN_PRIVILEGES
  Dim mLUID As LUID
  bRtnBool = LookupPrivilegeValue("", lpszPrivilege, mLUID)
  If bRtnBool = 0 Then
    'Debug.Print "LookupPrivilegeValue Error " & Err.LastDllError
    SetPrivilege = Err.LastDllError
    Exit Function
  End If
  
  tP.PrivilegeCount = 1
  tP.Privileges(0).pLuid = mLUID
  If bEnablePrivilege Then
    tP.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
  Else
    tP.Privileges(0).Attributes = 0
  End If
  bRtnBool = AdjustTokenPrivileges(hToken, False, tP, 4 + (12 * tP.PrivilegeCount), _
   New_tp, 4 + (12 * New_tp.PrivilegeCount))
  If bRtnBool = 0 Then
    'Debug.Print "AdjustTokenPrivileges Error " & Err.LastDllError
    SetPrivilege = Err.LastDllError
    Exit Function
  End If
  
  If Err.LastDllError = ERROR_NOT_ALL_ASSIGNED Then
    'Debug.Print "AdjustTokenPrivileges Error " & Err.LastDllError
    SetPrivilege = Err.LastDllError
    Exit Function
  End If
  
  'при успехе эта ф-ция вернет 0
End Function

'Taking Object Ownership in C++
'http://msdn.microsoft.com/en-us/library/windows/desktop/aa379620(v=vs.85).aspx
Public Function SetSecurityOwnerAdmins(ByVal pszObjName As String, _
 ByVal ObjectType As SE_OBJECT_TYPE) As Long
  'назначает группу "Administrators" владельцем объекта
  
  'AcctName - account name, DomainName - domain name
  Dim dwRes As Long
  Dim hToken As Long
  Dim pSIDAdmin As Long
  Dim bRtnBool As Long
 
  If (pszObjName = "") Then
    SetSecurityOwnerAdmins = ERROR_INVALID_PARAMETER
    'Debug.Print "ERROR_INVALID_PARAMETER"
    Exit Function
  End If
  
  'Create a SID for the BUILTIN\Administrators group.
  Dim siaNtAuthority As SID_IDENTIFIER_AUTHORITY
  
  siaNtAuthority.Value(5) = SECURITY_NT_AUTHORITY
  bRtnBool = AllocateAndInitializeSid(siaNtAuthority, 2, _
   SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS, _
   0, 0, 0, 0, 0, 0, pSIDAdmin)
  If bRtnBool = 0 Then
    'Debug.Print "AllocateAndInitializeSid Error " & Err.LastDllError
    dwRes = Err.LastDllError
    GoTo Cleanup
  End If
  
  'If the preceding call failed because access was denied,
  'enable the SE_TAKE_OWNERSHIP_NAME privilege, create a SID for
  'the Administrators group, take ownership of the object, and
  'disable the privilege. Then try again to set the object's DACL.

  ' Open a handle to the access token for the calling process.
  bRtnBool = OpenProcessToken(GetCurrentProcess(), _
                          TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, _
                          hToken)
  If bRtnBool = 0 Then
    'Debug.Print "OpenProcessToken Error " & Err.LastDllError
    dwRes = Err.LastDllError
    GoTo Cleanup
  End If

  'Enable the SE_TAKE_OWNERSHIP_NAME privilege.
  dwRes = SetPrivilege(hToken, SE_TAKE_OWNERSHIP_NAME, True)
  If dwRes <> 0 Then
    'Debug.Print "SetPrivilege (1) Error " & dwRes
    GoTo Cleanup
  End If
  
  'Set the owner in the object's security descriptor.
  dwRes = SetNamedSecurityInfo(pszObjName, ObjectType, _
   OWNER_SECURITY_INFORMATION, _
   pSIDAdmin, 0&, 0&, 0&)
  If dwRes <> ERROR_SUCCESS Then
    'Debug.Print "SetNamedSecurityInfo Error " & CStr(dwRes)
    GoTo Cleanup
  End If
        
  'Disable the SE_TAKE_OWNERSHIP_NAME privilege.
  dwRes = SetPrivilege(hToken, SE_TAKE_OWNERSHIP_NAME, False)
  If dwRes <> 0 Then
    'Debug.Print "SetPrivilege (2) Error " & dwRes
    GoTo Cleanup
  End If
  
Cleanup:
  If pSIDAdmin <> 0 Then FreeSid pSIDAdmin
  If hToken <> 0 Then CloseHandle hToken

  SetSecurityOwnerAdmins = dwRes
  
End Function

'Taking Object Ownership in C++
'http://msdn.microsoft.com/en-us/library/windows/desktop/aa379620(v=vs.85).aspx
Public Function SetSecurityOwner(ByVal pszObjName As String, _
 ByVal ObjectType As SE_OBJECT_TYPE, _
 ByVal AcctName As String, Optional ByVal DomnName As String = "") As Long
  'назначает группу/аккаунт [DomnName + '\' +] AcctName владельцем объекта (по читаемому имени)
 
  'AcctName - account name, DomnName - domain name
  Dim AccountName As String 'на вход DomnName + '\' + AcctName
  
  Dim dwRes As Long
  Dim hToken As Long
  Dim p_abytSIDTarget() As Byte 'вместо pSIDTarget
  Dim dwSIDTarget As Long 'size of the Sid buffer
  Dim DomainName As String 'domain name на выходе
  Dim dwDomainName As Long 'size of domain name buffer
  Dim eUse As Integer 'SID type
  Dim bRtnBool As Long
 
  If (pszObjName = "") Then
    SetSecurityOwner = ERROR_INVALID_PARAMETER
    'Debug.Print "ERROR_INVALID_PARAMETER"
    Exit Function
  End If
  
  'Create a SID for specified account
  If Len(DomnName) > 0 Then
    AccountName = DomnName & "\" & AcctName
  Else
    AccountName = AcctName
  End If
  'Preinitialize p_abytSIDAdmin array with one element. It will be redimmed lated
  ReDim p_abytSIDTarget(1) As Byte
  'First call to LookupAccountName to get the buffer sizes.
  bRtnBool = LookupAccountName(vbNullString, AccountName, p_abytSIDTarget(0), dwSIDTarget, _
   DomainName, dwDomainName, eUse)
  If (bRtnBool = 0) And (Err.LastDllError <> ERROR_INSUFFICIENT_BUFFER) Then
    'Debug.Print "LookupAccountName (1) Error " & Err.LastDllError
    dwRes = Err.LastDllError
    GoTo Cleanup
  End If
  
  'Debug.Print "dwSIDTarget=" & dwSIDTarget & vbCrLf & "dwDomainName=" & dwDomainName
  
  'Allocate the required space in the p_abytSIDAdmin and DomainName string
  'variables. Allocate 1 byte less to avoid the appended NULL character.
  ReDim p_abytSIDTarget(dwSIDTarget) As Byte
  DomainName = Space(dwDomainName - 1)

  'Second call to LookupAccountName to get p_abytSIDAdmin.
  bRtnBool = LookupAccountName(vbNullString, AccountName, p_abytSIDTarget(0), dwSIDTarget, _
   DomainName, dwDomainName, eUse)
  If bRtnBool = 0 Then
    'Debug.Print "LookupAccountName (2) Error " & Err.LastDllError
    dwRes = Err.LastDllError
    GoTo Cleanup
  End If
  
  'Debug.Print DomainName
  
  'If the preceding call failed because access was denied,
  'enable the SE_TAKE_OWNERSHIP_NAME privilege, create a SID for
  'Target group, take ownership of the object, and
  'disable the privilege. Then try again to set the object's DACL.

  ' Open a handle to the access token for the calling process.
  bRtnBool = OpenProcessToken(GetCurrentProcess(), _
                          TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, _
                          hToken)
  If bRtnBool = 0 Then
    'Debug.Print "OpenProcessToken Error " & Err.LastDllError
    dwRes = Err.LastDllError
    GoTo Cleanup
  End If

  'Enable the SE_TAKE_OWNERSHIP_NAME privilege.
  dwRes = SetPrivilege(hToken, SE_TAKE_OWNERSHIP_NAME, True)
  If dwRes <> 0 Then
    'Debug.Print "SetPrivilege (1) Error " & dwRes
    GoTo Cleanup
  End If

  'Enable the SE_RESTORE_NAME privilege.
  dwRes = SetPrivilege(hToken, SE_RESTORE_NAME, True)
  If dwRes <> 0 Then
    'Debug.Print "SetPrivilege (2) Error " & dwRes
    GoTo Cleanup
  End If
  
  'Set the owner in the object's security descriptor.
  dwRes = SetNamedSecurityInfo(pszObjName, ObjectType, _
   OWNER_SECURITY_INFORMATION, _
   VarPtr(p_abytSIDTarget(0)), 0&, 0&, 0&)
  If dwRes <> ERROR_SUCCESS Then
    'Debug.Print "SetNamedSecurityInfo Error " & CStr(dwRes)
    GoTo Cleanup
  End If
        
  'Disable the SE_TAKE_OWNERSHIP_NAME privilege.
  dwRes = SetPrivilege(hToken, SE_TAKE_OWNERSHIP_NAME, False)
  If dwRes <> 0 Then
    'Debug.Print "SetPrivilege (3) Error " & dwRes
    GoTo Cleanup
  End If

  'Disable the SE_RESTORE_NAME privilege.
  dwRes = SetPrivilege(hToken, SE_RESTORE_NAME, False)
  If dwRes <> 0 Then
    'Debug.Print "SetPrivilege (4) Error " & dwRes
    GoTo Cleanup
  End If
  
Cleanup:
  If hToken <> 0 Then CloseHandle hToken

  SetSecurityOwner = dwRes
  
End Function

Public Function GetFileFolderOwner(ByVal FileFolderPath As String, _
 ByRef AcctName As String, ByRef DomainName As String) As Long
  'возвращает владельца папки или файла
  GetFileFolderOwner = GetSecurityOwner(FileFolderPath, _
   SE_FILE_OBJECT, _
   AcctName, _
   DomainName)
End Function

Public Function GetRegistryEntryOwner(ByVal RegistryPath As String, _
 ByRef AcctName As String, ByRef DomainName As String) As Long
  'возвращает владельца ветки реестра
  GetRegistryEntryOwner = GetSecurityOwner(RegistryPath, _
   SE_REGISTRY_KEY, _
   AcctName, _
   DomainName)
End Function

  Public Function SetRegistryEntryOwner(ByVal Key As RegistryKey, ByVal SubKey As String, _
   ByVal OwnerName As String) As Boolean
    'назначает владельца ветки реестра
    Dim hToken As IntPtr
    Dim dwRes As Integer
    Dim pSIDAdmin As IntPtr

    'Create a SID for the BUILTIN\Administrators group.
    Dim siaNtAuthority As SID_IDENTIFIER_AUTHORITY

    siaNtAuthority.Value = {0, 0, 0, 0, 0, SECURITY_NT_AUTHORITY}
    If AllocateAndInitializeSid(siaNtAuthority, 2, _
     SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS, _
     0, 0, 0, 0, 0, 0, pSIDAdmin) = False Then
      'Debug.Print "AllocateAndInitializeSid Error " & Err.LastDllError
      Return False
    End If

    'If the preceding call failed because access was denied,
    'enable the SE_TAKE_OWNERSHIP_NAME privilege, create a SID for
    'the Administrators group, take ownership of the object, and
    'disable the privilege. Then try again to set the object's DACL.

    ' Open a handle to the access token for the calling process.
    If OpenProcessToken(Process.GetCurrentProcess().Handle, _
                            TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, _
                            hToken) = False Then
      Debug.Print("OpenProcessToken Error " & Err.LastDllError)
      Return False
    End If

    'Enable the SE_TAKE_OWNERSHIP_NAME privilege.
    dwRes = SetPrivilege(hToken, SE_TAKE_OWNERSHIP_NAME, True)
    If dwRes <> 0 Then
      'Debug.Print "SetPrivilege (1) Error " & dwRes
      SetRegistryEntryOwner = False
      GoTo Cleanup
    End If

    'Set the owner in the object's security descriptor.
    dwRes = SetNamedSecurityInfo("CLASSES_ROOT\" & SubKey, SE_OBJECT_TYPE.SE_REGISTRY_KEY, _
     OWNER_SECURITY_INFORMATION, _
     pSIDAdmin, IntPtr.Zero, IntPtr.Zero, IntPtr.Zero)
    If dwRes <> ERROR_SUCCESS Then
      'Debug.Print "SetNamedSecurityInfo Error " & CStr(dwRes)
      SetRegistryEntryOwner = False
      GoTo Cleanup
    Else
      SetRegistryEntryOwner = True
    End If


    'Try
    '  Dim rk As RegistryKey = Key.OpenSubKey _
    '   (SubKey, RegistryKeyPermissionCheck.Default, Security.AccessControl.RegistryRights.TakeOwnership)
    '  Dim ac As RegistrySecurity = rk.GetAccessControl()  'New RegistrySecurity 
    '  ac.SetOwner(New NTAccount(OwnerName)) 'BUILTIN\Администраторы
    '  'ac.SetAccessRuleProtection(False,false)
    '  rk.SetAccessControl(ac)
    '  SetRegistryEntryOwner = True
    'Catch
    '  Debug.Print(Err.Description)
    '  SetRegistryEntryOwner = False
    'End Try

    'Disable the SE_TAKE_OWNERSHIP_NAME privilege.
    dwRes = SetPrivilege(hToken, SE_TAKE_OWNERSHIP_NAME, False)
    If dwRes <> 0 Then
      'Debug.Print "SetPrivilege (2) Error " & dwRes
      GoTo Cleanup
    End If

Cleanup:
    If hToken <> IntPtr.Zero Then CloseHandle(hToken)

  End Function

  'Enabling and Disabling Privileges in C++
  'http://msdn.microsoft.com/en-us/library/windows/desktop/aa446619(v=vs.85).aspx
  Public Function SetPrivilege( _
   ByVal hToken As IntPtr, _
   ByVal lpszPrivilege As String, _
   ByVal bEnablePrivilege As Boolean) As Integer
    ' hToken - access token handle
    ' lpszPrivilege - name of privilege to enable/disable
    ' bEnablePrivilege - to enable or disable privilege

    Dim tP As New TOKEN_PRIVILEGES
    Dim New_tp As New TOKEN_PRIVILEGES
    Dim mLUID As New LUID
    If LookupPrivilegeValue("", lpszPrivilege, mLUID) = False Then
      Debug.Print("LookupPrivilegeValue Error " & Err.LastDllError)
      SetPrivilege = Err.LastDllError
      Exit Function
    End If

    tP.PrivilegeCount = 1
    tP.pLuid = mLUID
    If bEnablePrivilege Then
      tP.Attributes = SE_PRIVILEGE_ENABLED
    Else
      tP.Attributes = 0
    End If
    If AdjustTokenPrivileges(hToken, False, tP, 4 + (12 * tP.PrivilegeCount), _
     New_tp, 4 + (12 * New_tp.PrivilegeCount)) = False Then
      Debug.Print("AdjustTokenPrivileges Error " & Err.LastDllError)
      SetPrivilege = Err.LastDllError
      Exit Function
    End If

    If Err.LastDllError = ERROR_NOT_ALL_ASSIGNED Then
      Debug.Print("AdjustTokenPrivileges Error " & Err.LastDllError)
      SetPrivilege = Err.LastDllError
      Exit Function
    End If

    'при успехе эта ф-ция вернет 0
    Return 0
  End Function