unit SecurityPage;

interface

uses
 Classes, SysUtils, Dialogs, JwaWinNT, JwaAclApi, JwaAccCtrl, JwaWinBase,
 JwaAclUI, JwaWinType, JwaWinError;

type
 TAccessControl = class
 private
   FAccessData: TStream;
   function GetACL: PACL;
   function GetOwnerSID: PSID;
   function StoreACL(ApACL: PACL): Boolean;
   procedure FreeSD(pSD: PSECURITY_DESCRIPTOR);
 public
   constructor Create(AccessInfo: TStream); reintroduce; overload;

   function GetSD: PSECURITY_DESCRIPTOR;
   function SetSD(pSD: PSECURITY_DESCRIPTOR): Boolean;
 end;

 TSecurityInfo = class(TInterfacedObject, ISecurityInformation)
 private
   FAccessControl: TAccessControl;
 protected
   function GetObjectInformation(out pObjectInfo: SI_OBJECT_INFO): HRESULT; stdcall;
   function GetSecurity(RequestedInformation: SECURITY_INFORMATION;
     out ppSecurityDescriptor: PSECURITY_DESCRIPTOR; fDefault: BOOL): HRESULT; stdcall;
   function SetSecurity(SecurityInformation: SECURITY_INFORMATION;
     pSecurityDescriptor: PSECURITY_DESCRIPTOR): HRESULT; stdcall;
   function GetAccessRights(pguidObjectType: LPGUID; dwFlags: DWORD;
     out ppAccess: PSI_ACCESS; out pcAccesses, piDefaultAccess: ULONG): HRESULT; stdcall;
   function MapGeneric(pguidObjectType: LPGUID; pAceFlags: PUCHAR;
     pMask: PACCESS_MASK): HRESULT; stdcall;
   function GetInheritTypes(out ppInheritTypes: PSI_INHERIT_TYPE;
     out pcInheritTypes: ULONG): HRESULT; stdcall;
   function PropertySheetPageCallback(hwnd: HWND; uMsg: UINT;
     uPage: SI_PAGE_TYPE): HRESULT; stdcall;
 public
   constructor Create(AccessInfo: TStream); reintroduce; overload;
   destructor Destroy; override;
 end;

const
 GUID_NULL: TGUID = '{00000000-0000-0000-0000-000000000000}';
 
 AccessMap: array[0..1] of SI_ACCESS = (
   (
   pguid: @GUID_NULL;
   mask: $01;
   pszName: 'Full Control';
   dwFlags: SI_ACCESS_GENERAL
   ),
   (  // We do not use it in this version!
   pguid: @GUID_NULL;
   mask: $02;
   pszName: 'View only';
   dwFlags: SI_ACCESS_GENERAL
   )
   );
var
 AccessMasks: GENERIC_MAPPING = (
   GenericRead: STANDARD_RIGHTS_READ;
   GenericWrite: STANDARD_RIGHTS_WRITE;
   GenericExecute: STANDARD_RIGHTS_EXECUTE;
   GenericAll: {STANDARD_RIGHTS_REQUIRED or }
     STANDARD_RIGHTS_READ or
     STANDARD_RIGHTS_WRITE or
     STANDARD_RIGHTS_EXECUTE;
   );

implementation

{ TSecurityInfo }

constructor TSecurityInfo.Create(AccessInfo: TStream);
begin
 inherited Create;
 FAccessControl := TAccessControl.Create(AccessInfo);
end;

destructor TSecurityInfo.Destroy;
begin
 FAccessControl.Free;
 inherited Destroy;
end;

function TSecurityInfo.GetAccessRights(pguidObjectType: LPGUID; dwFlags: DWORD;
 out ppAccess: PSI_ACCESS; out pcAccesses, piDefaultAccess: ULONG): HRESULT;
begin
 ppAccess := @AccessMap[0];
 pcAccesses := 1;
 piDefaultAccess := 0;
 Result := S_OK;
end;

function TSecurityInfo.GetInheritTypes(out ppInheritTypes: PSI_INHERIT_TYPE;
 out pcInheritTypes: ULONG): HRESULT;
begin
 ppInheritTypes := nil;
 pcInheritTypes := 0;
 Result := S_OK;
end;

function TSecurityInfo.GetObjectInformation(
 out pObjectInfo: SI_OBJECT_INFO): HRESULT;
begin
 pObjectInfo.dwFlags := SI_EDIT_PERMS or SI_NO_ACL_PROTECT
   or SI_PAGE_TITLE;
 pObjectInfo.hInstance := SysInit.HInstance;
 pObjectInfo.pszServerName := nil;
 pObjectInfo.pszObjectName := 'My object name';
 Result := S_OK;
end;

function TSecurityInfo.GetSecurity(RequestedInformation: SECURITY_INFORMATION;
 out ppSecurityDescriptor: PSECURITY_DESCRIPTOR; fDefault: BOOL): HRESULT;
begin
 ppSecurityDescriptor := FAccessControl.GetSD;
 if ppSecurityDescriptor <> nil then
   Result := S_OK
 else
   Result := E_FAIL;
end;

function TSecurityInfo.MapGeneric(pguidObjectType: LPGUID; pAceFlags: PUCHAR;
 pMask: PACCESS_MASK): HRESULT;
begin
 MapGenericMask(pMask^, AccessMasks);
 Result := S_OK;
end;

function TSecurityInfo.PropertySheetPageCallback(hwnd: HWND; uMsg: UINT;
 uPage: SI_PAGE_TYPE): HRESULT;
begin
 Result := S_OK;
end;

function TSecurityInfo.SetSecurity(SecurityInformation: SECURITY_INFORMATION;
 pSecurityDescriptor: PSECURITY_DESCRIPTOR): HRESULT;
begin
 if FAccessControl.SetSD(pSecurityDescriptor) then
   Result := S_OK
 else
   Result := E_FAIL;
end;

{ TAccessControl }

constructor TAccessControl.Create(AccessInfo: TStream);
begin
 inherited Create;
 FAccessData := AccessInfo;
end;

procedure TAccessControl.FreeSD(pSD: PSECURITY_DESCRIPTOR);
var
 pOwnerSID, pGroupSID: PSID;
 pDACL, pSACL: PACL;
 bOwnerDefaulted, bGroupDefaulted, bDaclPresent, bSaclDefaulted: Bool;
 bDaclDefaulted, bSaclPresent: LongBool;
begin
 if pSD <> nil then
 begin
   pOwnerSID := nil;
   pGroupSID := nil;
   if GetSecurityDescriptorOwner(pSD, pOwnerSID, @bOwnerDefaulted) then
   begin
     try
       HeapFree(GetProcessHeap, 0, pOwnerSID);
     except
     end;
   end;
   if GetSecurityDescriptorGroup(pSD, pGroupSID, @bGroupDefaulted) then
   begin
     try
       HeapFree(GetProcessHeap, 0, pGroupSID);
     except
     end;
   end;
   GetSecurityDescriptorDacl(pSD, bDaclPresent, pDACL, bDaclDefaulted);
 GetSecurityDescriptorSacl(pSD, bSaclPresent, pSACL, bSaclDefaulted);
 end;
 try
   if pSD <> nil then
     FreeMem(pSD);
   if bDaclPresent and (pDACL <> nil) then
     FreeMem(pDACL);
   if bSaclPresent and (pSACL <> nil) then
     FreeMem(pSACL);
 except
 end;
end;

function TAccessControl.GetACL: PACL;
begin
 Result := nil;
 try
   if FAccessData.Size < SizeOf(ACL) then
     exit;
   FAccessData.Position := 0;
   GetMem(Result, FAccessData.size);
   FAccessData.Read(Result^, FAccessData.size);
 except
 end;
end;

function TAccessControl.GetOwnerSID: PSID;
var
 pAdminSid: PSid;
 SIDAuth: SID_IDENTIFIER_AUTHORITY;
begin
 pAdminSid := nil;
 SIDAuth := SECURITY_NT_AUTHORITY;
 AllocateAndInitializeSid(@SIDAuth,
   2,
   SECURITY_BUILTIN_DOMAIN_RID,
   DOMAIN_ALIAS_RID_ADMINS,
   0, 0, 0, 0, 0, 0,
   pAdminSid);
 Result := pAdminSid;
end;

function TAccessControl.GetSD: PSECURITY_DESCRIPTOR;
var
 pntAcl: PACL;
 pSD, pSelfRelativeSD: PSECURITY_DESCRIPTOR;
 BufferLength: Cardinal;
begin
 Result := nil;
 BufferLength := 0;
 try
   pntAcl := GetACL;
   if (pntAcl = nil) or (not IsValidAcl(pntAcl)) then
   begin
     GetMem(pntAcl, SizeOf(ACL));
     if not InitializeAcl(pntAcl, SizeOf(ACL), ACL_REVISION) then
       Exit;
   end;
   GetMem(pSD, SECURITY_DESCRIPTOR_MIN_LENGTH);
   if not InitializeSecurityDescriptor(pSD, SECURITY_DESCRIPTOR_REVISION) then
     exit;
   if not SetSecurityDescriptorDacl(pSD, true, pntAcl, false) then
     exit;
   if not SetSecurityDescriptorOwner(pSD, GetOwnerSID, false) then
     exit;
   if not SetSecurityDescriptorGroup(pSD, GetOwnerSID, false) then
     exit;
   MakeSelfRelativeSD(pSD, nil, BufferLength);
   pSelfRelativeSD := PSECURITY_DESCRIPTOR(
     LocalAlloc(0, BufferLength));
   if not MakeSelfRelativeSD(pSD, pSelfRelativeSD, BufferLength) then
     Exit;
   FreeSD(pSD);
   Result := pSelfRelativeSD;
 finally

 end;
end;

function TAccessControl.SetSD(pSD: PSECURITY_DESCRIPTOR): Boolean;
var
 bDaclPresent, bDaclDefaulted: BOOL;
 pDACL: PACL;
begin
 pDACL := nil;
 Result := false;
 GetSecurityDescriptorDacl(pSD, bDaclPresent, pDACL, bDaclDefaulted);
 if bDaclPresent and (pDACL <> nil) and IsValidAcl(pDACL) and StoreACL(pDACL) then
   Result := true;
end;

function TAccessControl.StoreACL(ApACL: PACL): Boolean;
var
 AclInfo: ACL_SIZE_INFORMATION;
 nAclInformationLength: Cardinal;
begin
 Result := false;
 FAccessData.Size := 0;
 FAccessData.Position := 0;
 if ApACL = nil then
   Exit;
 try
   nAclInformationLength := SizeOf(ACL_SIZE_INFORMATION);
   GetAclInformation(ApACL, @AclInfo, nAclInformationLength,
     AclSizeInformation);
   FAccessData.Write(ApACL^, AclInfo.AclBytesInUse);
   FAccessData.Position := 0;
   Result := true;
 except

 end;
end;

end.