function TFileSecurityInformation.SetSecurity(
SecurityInformation: SECURITY_INFORMATION;
pSecurityDescriptor: PSECURITY_DESCRIPTOR): HRESULT;
var
dErr : DWORD;
aclPresent : BOOL;
aclDefault : BOOL;
SDRevision : DWORD;
psd : SECURITY_DESCRIPTOR_CONTROL;
NewSecurityDescriptor : PSECURITY_DESCRIPTOR;
os : TOsVersion;
AbsDACL,AbsSACL,NewDACL,NewSACL : PACL;
AbsGroup,AbsOwner,NewGroup,NewOwner :PSID;
dwSizes :
array[0..4]
of DWORD;
nsdRel : PSECURITY_DESCRIPTOR;
NewSI : SECURITY_INFORMATION;
procedure MakeControlBits;
begin
aclPresent := FALSE;
aclDefault := FALSE;
SDRevision := 0;
psd := 0;
if not (GetSecurityDescriptorControl(pSecurityDescriptor,psd,SDRevision))
then
DoError(GetLastError);
if ((Securityinformation
and DACL_SECURITY_INFORMATION) = DACL_SECURITY_INFORMATION)
then
begin
if ((psd
and SE_DACL_PROTECTED) = SE_DACL_PROTECTED)
then
begin
SecurityInformation := SecurityInformation
or PROTECTED_DACL_SECURITY_INFORMATION;
NewSI := NewSI
or PROTECTED_DACL_SECURITY_INFORMATION;
if not (SetSecurityDescriptorControl(NewSecurityDescriptor,SE_DACL_PROTECTED,SE_DACL_PROTECTED))
then
DoError(GetLastError);
end;
if ((psd
and SE_DACL_AUTO_INHERIT_REQ) = SE_DACL_AUTO_INHERIT_REQ)
then
begin
SecurityInformation := SecurityInformation
or UNPROTECTED_DACL_SECURITY_INFORMATION;
NewSI := NewSI
or UNPROTECTED_DACL_SECURITY_INFORMATION;
if not (SetSecurityDescriptorControl(NewSecurityDescriptor,SE_DACL_AUTO_INHERIT_REQ,SE_DACL_AUTO_INHERIT_REQ))
then
DoError(GetLastError);
end;
end;
if ((SecurityInformation
and SACL_SECURITY_INFORMATION) = SACL_SECURITY_INFORMATION)
then
begin
if ((psd
and SE_SACL_PROTECTED) = SE_SACL_PROTECTED)
then
begin
SecurityInformation := SecurityInformation
or PROTECTED_SACL_SECURITY_INFORMATION;
NewSI := NewSI
or PROTECTED_SACL_SECURITY_INFORMATION;
if not (SetSecurityDescriptorControl(NewSecurityDescriptor,SE_SACL_PROTECTED,SE_SACL_PROTECTED))
then
DoError(GetLastError);
end;
if ((psd
and SE_SACL_AUTO_INHERIT_REQ) = SE_SACL_AUTO_INHERIT_REQ)
then
begin
SecurityInformation := SecurityInformation
or UNPROTECTED_SACL_SECURITY_INFORMATION;
NewSI := NewSI
or UNPROTECTED_SACL_SECURITY_INFORMATION;
if not (SetSecurityDescriptorControl(NewSecurityDescriptor,SE_SACL_AUTO_INHERIT_REQ,SE_SACL_AUTO_INHERIT_REQ))
then
DoError(GetLastError);
end;
end;
end;
begin
//some checks if user can change anything
os := GetWindowsVersion;
if (pSecurityDescriptor =
NIL)
then
begin
RESULT := E_POINTER;
EXIT;
end;
if (do_SI_READONLY
in foptions)
then
begin
RESULT := E_ACCESSDENIED;
EXIT;
end;
NewSI := 0;
nsdRel :=
NIL;
//ok..user can
//We first get the "old" Descriptor for merging the new values to it
dERR := GetNamedSecurityInfow(pwidechar(ffilename),
SE_FILE_OBJECT,
SecurityInformation,
NIL,
NIL,
NIL,
NIL,
nsdRel);
//Make a absolut Descriptor
AbsDACL :=
NIL;
AbsSACL :=
NIL;
AbsOwner :=
NIL;
AbsGroup :=
NIL;
NewDACL :=
NIL;
NewSACL :=
NIL;
NewOwner :=
NIL;
NewGroup :=
NIL;
NewSecurityDescriptor :=
NIL;
fillchar(dwsizes,sizeof(dwsizes),0);
//First we need the sizes for allocations
MakeAbsoluteSD(nsdREL,
NIL,
dwSizes[0],
NIL,
dwSizes[1],
nil,
dwSizes[2],
nil,
dwSizes[3],
nil,
dwSizes[4]);
GetMem(NewSecurityDescriptor,dwSizes[0]);
GetMem(AbsDACL,dwSizes[1]);
GetMem(AbsSACL,dwSizes[2]);
GetMem(AbsOwner,dwSizes[3]);
GetMem(AbsGroup,dwSizes[4]);
//Now translate from self realtiv to absolute
if not (MakeAbsoluteSD(nsdRel,
NewSecurityDescriptor,
dwSizes[0],
AbsDACL,
dwSizes[1],
AbsSACL,
dwSizes[2],
AbsOwner,
dwSizes[3],
AbsGroup,
dwSizes[4]))
then
DoError(GetLastError);
LocalFree(Cardinal(nsdrel));
//Make a new SD
//Set the corresponding Controlbits
MakeControlBits;
//Get the new information from the given SD and merge them
if ((SecurityInformation
and DACL_SECURITY_INFORMATION)=DACL_SECURITY_INFORMATION)
then
begin
if not (GetSecurityDescriptorDACL(pSecurityDescriptor,aclPresent,NewDacl,aclDefault))
then
DoError(GetLastError);
if not (SetSecurityDescriptorDACL(NewSecurityDescriptor,aclPresent,NewDACL,acldefault))
then
DoError(GetLastError);
newSI := NewSI
or DACL_SECURITY_INFORMATION;
end;
if ((SecurityInformation
and SACL_SECURITY_INFORMATION)=SACL_SECURITY_INFORMATION)
then
begin
if not (GetSecurityDescriptorSACL(pSecurityDescriptor,aclPresent,NewSacl,aclDefault))
then
DoError(GetLastError);
if not (SetSecurityDescriptorSACL(NewSecurityDescriptor,aclPresent,NewSACL,acldefault))
then
DoError(GetLastError);
newSI := NewSI
or SACL_SECURITY_INFORMATION;
end;
if ((SecurityInformation
and GROUP_SECURITY_INFORMATION) = GROUP_SECURITY_INFORMATION)
then
begin
if not (GetSecurityDescriptorGroup(pSecurityDescriptor,NewGroup,@aclDefault))
then
DoError(GetLastError);
if not (SetSecurityDescriptorGroup(NewSecurityDescriptor,NewGroup,aclDefault))
then
DoError(GetLastError);
newSI := NewSI
or GROUP_SECURITY_INFORMATION;
end;
if ((SecurityInformation
and OWNER_SECURITY_INFORMATION) = OWNER_SECURITY_INFORMATION)
then
begin
if not (GetSecurityDescriptorOwner(pSecurityDescriptor,NewOwner,@aclDefault))
then
DoError(GetLastError);
if not (SetSecurityDescriptorOwner(NewSecurityDescriptor,NewOwner,aclDefault))
then
DoError(GetLastError);
newSI := NewSI
or OWNER_SECURITY_INFORMATION;
end;
//Check if we need to recurse throug a tree
if (((SecurityInformation
AND SI_OWNER_RECURSE) = SI_OWNER_RECURSE)
or
((SecurityInformation
AND SI_RESET_DACL_TREE) = SI_RESET_DACL_TREE)
or
((SecurityInformation
AND SI_RESET_SACL_TREE) = SI_RESET_SACL_TREE))
AND
fIsDir
then
begin
//For new Systems use the appropriated API-Calls
if (
os = ovXP)
or (
os = ov2003)
or (
os = ovVista)
then
begin
dErr := TreeResetNamedSecurityInfoW(Pwidechar(ffilename),
SE_FILE_OBJECT,
NewSI,
NewOwner,
NewGroup,
NewDACL,
NewSACL,
FALSE,
@DoTreeProgress,
ProgressInvokeEveryObject,
SELF);
if (dErr <> ERROR_SUCCESS)
then
DoError(dErr);
end
else
begin
//Use alternativ Method for 2000, because no API available
end;
end
else
begin
dErr := SetNamedSecurityInfoW(Pwidechar(ffilename),SE_FILE_OBJECT,SecurityInformation,NewOwner,NewGroup,NewDACL,NewSACL);
end;
FreeMem(NewSecurityDescriptor,dwSizes[0]);
FreeMem(AbsDACL,dwSizes[1]);
FreeMem(AbsSACL,dwSizes[2]);
FreeMem(AbsOwner,dwSizes[3]);
FreeMem(AbsOwner,dwSizes[4]);
if (dErr = ERROR_SUCCESS)
then
begin
result := S_OK;
fchanges := TRUE;
end
else
result := E_FAIL;
end;