Appliquer les droits full sur un repertoire

Soyez le premier à donner votre avis sur cette source.

Vue 7 056 fois - Téléchargée 530 fois

Description

Bonjour, Voici un code réaliser avec l'activeX setacl. Il permet d'ajouter une permission sur un repertoire et sous tous ces repertoire et fichier fils, sans changer les droits des objets fils du repertoire. Si certains ne voient pas trop l'intéret d'un tel programme, les admins de gros réseaux avec beaucoup d'utilisateurs tel que les université par exemple le verront :)!
Ce programme est un programme de base. Je suis tout à fait prêt à l'améliorer (gérer les différentes permissions, récurence ou pas récurence, etc ... ), si certains en ont le besoin. En cas de soucis n'hésiter pas à me contacter : opsi85@hotmail.com.
merci pour m'avoir lus ... :] !

Source / Exemple :


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

Conclusion :


Je remercie les devellopeurs de l'active X setacl, qui font du super boulot !!!!
Attention lors de l'utilisation du programme sur de gros repertoire l'ajout des droits peut etre long et l'affichage instable.... =)

Le fichier ocx se trouve dans le fichier zip ...

Codes Sources

A voir également

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (opsi1985)