APPLIQUER LES DROITS FULL SUR UN REPERTOIRE

Private Sub Command1_Click()


test = Dir1.path

Call rights(Dir1.path, user.Text, "full")
MsgBox ("réussi!!")
End Sub

Private Sub SetACL1_MessageEvent(ByVal sMessage As String)

   sMessage = Replace(sMessage, vbLf, vbCrLf)

   

End Sub

Private Sub rights(path As String, user, droit)

   Dim nError As Integer
   Set objSetACLs = CreateObject("SetACL.SetACLCtrl.1")
   
   With objSetACLs
      nError = .SetObject(path, SE_FILE_OBJECT)
      
      If nError <> RTN_OK Then
         MsgBox "SetObject failed: " & .GetResourceString(nError) & vbCrLf & "OS error: " & .GetLastAPIErrorMessage()
         Exit Sub
      End If
      
        nError = .SetAction(ACTN_ADDACE)
      
      If nError <> RTN_OK Then
         MsgBox "SetAction failed: " & .GetResourceString(nError) & vbCrLf & "OS error: " & .GetLastAPIErrorMessage()
         Exit Sub
      End If
      If creation.Value = True Then
         nError = .AddACE(user, False, droit, INHPARNOCHANGE, False, GRANT_ACCESS, ACL_DACL)
         nError = .SetRecursion(RECURSE_CONT_OBJ)
     ElseIf suppression.Value = True Then
      nError = .AddACE(user, False, droit, INHPARNOCHANGE, False, REVOKE_ACCESS, ACL_DACL)
      nError = .SetRecursion(RECURSE_CONT_OBJ)
     Else
        MsgBox ("erreur vous n'avez pas selectionner création ou supression ... ")
        Exit Sub
     End If
      
      If nError <> RTN_OK Then
         MsgBox "AddAce failed: " & .GetResourceString(nError) & vbCrLf & "OS error: " & .GetLastAPIErrorMessage()
         Exit Sub
      End If
      
      nError = .Run
      
      If nError <> RTN_OK Then
         MsgBox "Run failed: " & .GetResourceString(nError) & vbCrLf & "OS error: " & .GetLastAPIErrorMessage()
         Exit Sub
      End If
   End With
    
    Set objSetACLs = Nothing

End Sub