Zugriffsrechte von Dateien/Verzeichnissen ändern

[Matze]

Orakel_von_Delphi hat den Source Code von Microsoft, mit dem man die Zugriffsrechte von Dateien und Verzeichnissen ändern kann, nach Delphi übersetzt. Der Code wurde hier gepostet und lautet folgendermaßen:

Delphi-Quellcode:

function AddAccessRights(lpszFileName: PChar; lpszAccountName: PChar;
                         dwAccessMask: DWORD): boolean;
const
  HEAP_ZERO_MEMORY = $00000008;
  ACL_REVISION  = 2;
  ACL_REVISION2 = 2;
  INHERITED_ACE = $10;

type
  ACE_HEADER = record
    AceType,
    AceFlags: BYTE;
    AceSize: WORD;
  end;

  PACE_HEADER = ^ACE_HEADER;

  ACCESS_ALLOWED_ACE = record
    Header: ACE_HEADER;
    Mask: ACCESS_MASK;
    SidStart: DWORD;
  end;

  PACCESS_ALLOWED_ACE = ^ACCESS_ALLOWED_ACE;

  ACL_SIZE_INFORMATION = record
    AceCount,
    AclBytesInUse,
    AclBytesFree: DWORD;
  end;

  SetSecurityDescriptorControlFnPtr =
    function (pSecurityDescriptor: PSecurityDescriptor;
              ControlBitsOfInterest: SECURITY_DESCRIPTOR_CONTROL;
              ControlBitsToSet: SECURITY_DESCRIPTOR_CONTROL): boolean; stdcall;

var
  // SID variables.
  snuType: SID_NAME_USE;
  szDomain: PChar;
  cbDomain: DWORD;
  pUserSID: Pointer;
  cbUserSID: DWORD;

  // File SD variables.
  pFileSD: PSecurityDescriptor;
  cbFileSD: DWORD;

  // New SD variables.
  newSD: TSecurityDescriptor;

  // ACL variables.
  ptrACL: PACL;
  fDaclPresent,
  fDaclDefaulted: BOOL;
  AclInfo: ACL_SIZE_INFORMATION;

  // New ACL variables.
  pNewACL: PACL;
  cbNewACL: DWORD;

  // Temporary ACE.
  pTempAce: Pointer;
  CurrentAceIndex,
  newAceIndex: UINT;

  // Assume function will fail.
  fResult,
  fAPISuccess: boolean;

  secInfo: SECURITY_INFORMATION;

  // New APIs available only in Windows 2000 and above for setting
  // SD control
  _SetSecurityDescriptorControl: SetSecurityDescriptorControlFnPtr;

  controlBitsOfInterest,
  controlBitsToSet,
  oldControlBits: SECURITY_DESCRIPTOR_CONTROL;
  dwRevision: DWORD;

  AceFlags : BYTE;

function myheapalloc(x: integer): Pointer;
begin
  Result := HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, x);
end;

function myheapfree(x: Pointer): boolean;
begin
  Result := HeapFree(GetProcessHeap(), 0, x);
end;

function SetFileSecurityRecursive(lpFileName: PChar;
                                  SecurityInformation: SECURITY_INFORMATION;
                                  pSecurityDescriptor: PSecurityDescriptor): BOOL;
var
  sr : TSearchRec;
begin
  Result := SetFileSecurity(lpFileName, SecurityInformation, pSecurityDescriptor);

  if not Result then
    Exit;

  if (FileGetAttr(lpFileName) and faDirectory) = faDirectory then
  begin
    // Rekursion beginnt
    if FindFirst(IncludeTrailingPathDelimiter(lpFileName) + '*',
                 $EFFF, sr) = 0 then
    begin
      repeat
        // msp 07.10.2004
        // if ((sr.Attr and faDirectory) = faDirectory) AND (sr.Name <> '.') AND (sr.Name <> '..') then
        if (sr.Name <> '.') and (sr.Name <> '..') then
          SetFileSecurityRecursive(PChar(IncludeTrailingPathDelimiter(
                                   lpFileName) + sr.Name), SecurityInformation,
                                   pSecurityDescriptor);
      until FindNext(sr) <> 0;
        FindClose(sr);
    end;
  end;
end;

begin
  // Init
  szDomain := nil;
  cbDomain := 0;
  pUserSID := nil;
  cbUserSID := 0;

  // File SD variables.
  pFileSD  := nil;
  cbFileSD := 0;

  // ACL variables.
  ptrACL := nil;

  // New ACL variables.
  pNewACL := nil;
  cbNewACL := 0;

  // Temporary ACE.
  pTempAce := nil;
  CurrentAceIndex := 0;

  newAceIndex := 0;

  // Assume function will fail.
  fResult := false;

  secInfo := DACL_SECURITY_INFORMATION;

  // New APIs available only in Windows 2000 and above for setting
  // SD control
  _SetSecurityDescriptorControl := nil;

  // Delphi-Result
  Result := false;

  try
    //
    // STEP 1: Get SID of the account name specified.
    //
    fAPISuccess := LookupAccountName(nil, lpszAccountName,
                                     pUserSID, cbUserSID, szDomain,
                                     cbDomain, snuType);

    // API should have failed with insufficient buffer.
    if (not fAPISuccess) and (GetLastError() <> ERROR_INSUFFICIENT_BUFFER) then
      raise Exception.Create('LookupAccountName Error=' +
                             IntToStr(GetLastError()));

    pUserSID := myheapalloc(cbUserSID);
    if pUserSID = nil then
      raise Exception.Create('myheapalloc Error=' + IntToStr(GetLastError()));

    szDomain := PChar(myheapalloc(cbDomain * sizeof(PChar)));
    if szDomain = nil then
      raise Exception.Create('myheapalloc Error=' + IntToStr(GetLastError()));

    fAPISuccess := LookupAccountName(nil, lpszAccountName,
                                     pUserSID, cbUserSID, szDomain,
                                     cbDomain, snuType);
    if not fAPISuccess then
      raise Exception.Create('LookupAccountName Error=' +
                             IntToStr(GetLastError()));

    //
    // STEP 2: Get security descriptor (SD) of the file specified.
    //
    fAPISuccess := GetFileSecurity(lpszFileName,
                                   secInfo, pFileSD, 0, cbFileSD);

    // API should have failed with insufficient buffer.
    if (not fAPISuccess) and (GetLastError() <> ERROR_INSUFFICIENT_BUFFER) then
      raise Exception.Create('GetFileSecurity Error=' +
                             IntToStr(GetLastError()));

    pFileSD := myheapalloc(cbFileSD);
    if pFileSD = nil then
      raise Exception.Create('myheapalloc Error=' + IntToStr(GetLastError()));

    fAPISuccess := GetFileSecurity(lpszFileName,
                                   secInfo, pFileSD, cbFileSD, cbFileSD);
    if not fAPISuccess then
      raise Exception.Create('GetFileSecurity Error=' +
                             IntToStr(GetLastError()));

    //
    // STEP 3: Initialize new SD.
    //
    if not InitializeSecurityDescriptor(@newSD,
                                        SECURITY_DESCRIPTOR_REVISION) then
      raise Exception.Create('InitializeSecurityDescriptor Error=' +
                             IntToStr(GetLastError()));

    //
    // STEP 4: Get DACL from the old SD.
    //
    if not GetSecurityDescriptorDacl(pFileSD, fDaclPresent, ptrACL,
                                     fDaclDefaulted) then
      raise Exception.Create('GetSecurityDescriptorDacl Error=' +
                             IntToStr(GetLastError()));

    //
    // STEP 5: Get size information for DACL.
    //
    AclInfo.AceCount := 0; // Assume NULL DACL.
    AclInfo.AclBytesFree := 0;
    AclInfo.AclBytesInUse := sizeof(ACL);

    if ptrACL = nil then
      fDaclPresent := false;

    // If not NULL DACL, gather size information from DACL.
    if fDaclPresent then
      if not GetAclInformation(ptrACL^, @AclInfo, sizeof(ACL_SIZE_INFORMATION),
                               AclSizeInformation) then
        raise Exception.Create('GetAclInformation ' + IntToStr(GetLastError()));

    //
    // STEP 6: Compute size needed for the new ACL.
    //
    cbNewACL := AclInfo.AclBytesInUse + sizeof(ACCESS_ALLOWED_ACE) +
                GetLengthSid(pUserSID) - sizeof(DWORD);

    //
    // STEP 7: Allocate memory for new ACL.
    //
    pNewACL := PACL(myheapalloc(cbNewACL));
    if  pNewACL = nil then
      raise Exception.Create('myheapalloc ' + IntToStr(GetLastError()));

    //
    // STEP 8: Initialize the new ACL.
    //
    if not InitializeAcl(pNewACL^, cbNewACL, ACL_REVISION2) then
      raise Exception.Create('InitializeAcl ' + IntToStr(GetLastError()));

    //
    // STEP 9 If DACL is present, copy all the ACEs from the old DACL
    // to the new DACL.
    //
    // The following code assumes that the old DACL is
    // already in Windows 2000 preferred order.  To conform
    // to the new Windows 2000 preferred order, first we will
    // copy all non-inherited ACEs from the old DACL to the
    // new DACL, irrespective of the ACE type.
    //

    newAceIndex := 0;

    if (fDaclPresent) and (AclInfo.AceCount > 0) then
    begin
      for CurrentAceIndex := 0 to AclInfo.AceCount - 1 do
      begin
        //
        // STEP 10: Get an ACE.
        //
        if not GetAce(ptrACL^, CurrentAceIndex, pTempAce) then
          raise Exception.Create('GetAce ' + IntToStr(GetLastError()));

        //
        // STEP 11: Check if it is a non-inherited ACE.
        // If it is an inherited ACE, break from the loop so
        // that the new access allowed non-inherited ACE can
        // be added in the correct position, immediately after
        // all non-inherited ACEs.
        //
        if PACCESS_ALLOWED_ACE(pTempAce)^.Header.AceFlags and
            INHERITED_ACE > 0 then
          break;

        //
        // STEP 12: Skip adding the ACE, if the SID matches
        // with the account specified, as we are going to
        // add an access allowed ACE with a different access
        // mask.
        //
        if EqualSid(pUserSID, @(PACCESS_ALLOWED_ACE(pTempAce)^.SidStart)) then
          continue;

        //
        // STEP 13: Add the ACE to the new ACL.
        //
        if not AddAce(pNewACL^, ACL_REVISION, MAXDWORD, pTempAce,
                      PACE_HEADER(pTempAce)^.AceSize) then
          raise Exception.Create('AddAce ' + IntToStr(GetLastError()));

        Inc(newAceIndex);
      end;
    end;

    //
    // STEP 14: Add the access-allowed ACE to the new DACL.
    // The new ACE added here will be in the correct position,
    // immediately after all existing non-inherited ACEs.
    //
    AceFlags := $1   (* OBJECT_INHERIT_ACE *)
             or $2   (* CONTAINER_INHERIT_ACE *)
             or $10  (* INHERITED_ACE*);

    if not AddAccessAllowedAceEx(pNewACL^, ACL_REVISION2, AceFlags, dwAccessMask,
                                 pUserSID) then
      raise Exception.Create('AddAccessAllowedAce ' + IntToStr(GetLastError()));
      
    //
    // STEP 15: To conform to the new Windows 2000 preferred order,
    // we will now copy the rest of inherited ACEs from the
    // old DACL to the new DACL.
    //
    if (fDaclPresent) and (AclInfo.AceCount > 0) then
    begin
      while CurrentAceIndex < AclInfo.AceCount do
      begin
        //
        // STEP 16: Get an ACE.
        //
        if not GetAce(ptrACL^, CurrentAceIndex, pTempAce) then
          raise Exception.Create('GetAce ' + IntToStr(GetLastError()));

        //
        // STEP 17: Add the ACE to the new ACL.
        //
        if not AddAce(pNewACL^, ACL_REVISION, MAXDWORD, pTempAce,
                      PACE_HEADER(pTempAce)^.AceSize) then
          raise Exception.Create('AddAce ' + IntToStr(GetLastError()));

        Inc(CurrentAceIndex);
      end;
    end;

    //
    // STEP 18: Set the new DACL to the new SD.
    //
    if not SetSecurityDescriptorDacl(@newSD, TRUE, pNewACL, FALSE) then
      raise Exception.Create('SetSecurityDescriptorDacl ' +
                             IntToStr(GetLastError()));

    //
    // STEP 19: Copy the old security descriptor control flags
    // regarding DACL automatic inheritance for Windows 2000 or
    // later where SetSecurityDescriptorControl() API is available
    // in advapi32.dll.
    //
    _SetSecurityDescriptorControl := SetSecurityDescriptorControlFnPtr(
                                     GetProcAddress(GetModuleHandle(
                                     'advapi32.dll'),
                                     'SetSecurityDescriptorControl'));
    if @_SetSecurityDescriptorControl <> nil then
    begin
      controlBitsOfInterest := 0;
      controlBitsToSet := 0;
      oldControlBits := 0;
      dwRevision := 0;

      if not GetSecurityDescriptorControl(pFileSD, oldControlBits,
                                          dwRevision) then
        raise Exception.Create('GetSecurityDescriptorControl ' +
                               IntToStr(GetLastError()));

      if (oldControlBits and SE_DACL_AUTO_INHERITED) <> 0 then
      begin
        controlBitsOfInterest := SE_DACL_AUTO_INHERIT_REQ or
                                 SE_DACL_AUTO_INHERITED;
        controlBitsToSet := controlBitsOfInterest;
      end else
      if (oldControlBits and SE_DACL_PROTECTED) <> 0 then
      begin
        controlBitsOfInterest := SE_DACL_PROTECTED;
        controlBitsToSet := controlBitsOfInterest;
      end;

      if controlBitsOfInterest <> 0 then
        if not _SetSecurityDescriptorControl(@newSD, controlBitsOfInterest,
                                             controlBitsToSet) then
          raise Exception.Create('SetSecurityDescriptorControl ' +
                                 IntToStr(GetLastError()));
    end;

    //
    // STEP 20: Set the new SD to the File.
    //
    // msp 07.09.2004: Set to all objects including subdirectories
    // if Not SetFileSecurity(lpszFileName, secInfo, @newSD) then
    if not SetFileSecurityRecursive(lpszFileName, secInfo, @newSD) then
      raise Exception.Create('SetFileSecurity ' + IntToStr(GetLastError()));

  except
    on E: Exception do
    begin
      MessageDlg(E.Message, mtError, [mbAbort], -1);
      // WriteLog(ltError, Format('AddAccessRights: Beim Ändern der Rechte auf
      //dem Verzeichnis ''%s'' für ''%s'' ist ein Fehler aufgetreten. %s',
      //[lpszFileName, lpszAccountName, E.Message]), []);
      Exit;
    end;
  end;

  //
  // STEP 21: Free allocated memory
  //
  if pUserSID <> nil then
    myheapfree(pUserSID);

  if szDomain <> nil then
    myheapfree(szDomain);

  if pFileSD <> nil then
    myheapfree(pFileSD);

  if pNewACL  <> nil then
    myheapfree(pNewACL);

  fResult := true;
end;

Ein Kommentar von kalmi01 hierzu:

Bei der Gelegenheit sind mir ein paar misteriöse Dinge aufgefallen:
1.) Rechte mit einem Domänen-Admin auf 'Jeder' setzen geht schief, wenn nur Berechtigungen für lokale Benutzer vergeben sind, auch wenn's nur auf '\\dieserPC\Gast' gestzt ist.

2.) Rechte mit einem Domänen-Admin auf 'Jeder' setzen geht sporadisch schief, wenn bereits ein Domänenuser Vollzugriff hat, insbesondere dann, wenn dieser eigentlich nur stark eingeschränkte Benutzerrechte hat.

MS empfiehlt dies als "Allheilmittel" um "Vollzugriff Jeder" zu bekommen:

SetNamedSecurityInfo(PAnsiChar(FileName), SE_FILE_OBJECT, DACL_SECURITY_INFORMATION, NIL, NIL, NIL, NIL); Leider werden dabei gelegentlich ALLE Berechtigungen und Besitzer ge-killt.

GimbaR meldete folgendes Problem:

Zitat von GimbaR:

So habe ich versucht einem User (z.B. "Max.Mustermann") mit diesem Code Vollzugriff auf einen Ordner zu geben (z.B. "H:\home\Max.Mustermann"). Leider wurden die Zugriffsrechte von dem User so gespeichert, als wenn sie von H:\home vererbt worden wären, dies sind sie aber defintiv nicht, da auf H:\home überhaupt kein Zugriffsrecht für Max.Mustermann existiert

Bis die Ursache hierfür gefunden ist, verlinke ich auf ein Sourceforge-Projekt, das diesen Code ersetzt: MS Windows ACL-Library for Delphi. Danke GimbaR für diesen Link.


[edit=Chakotay1308]Zwei Fehler korrigiert. Mfg, Chakotay1308[/edit]
[edit=JasonDX]DelphiTags korrigiert. Mfg, JasonDX[/edit]
[edit=Matze]Hinweis von GimbaR hinzugefügt. MfG, Matze[/edit]