Modifying Access to Directory Objects

(*
     * Algorithm:
     *  1. Do DAPIStart.
     *  2. Do DAPIWrite to set security descriptor.
     *  3. Do DAPIEnd.
*)

uses DAPI;
{$R *.DFM}

function SetDirObjectSD(pszServer, pszDirectoryName:PCHAR;
                                     pSelfRelSD:PSecurityDescriptor):Integer;
var
    parms:DAPI_PARMS;
    pDAPIEvent :PDAPI_EVENT;
    hDAPISession :DAPI_HANDLE;
    rgEntryAttributes,
    rgEntryValues:PATT_VALUE;
    I,ulUSN:ULONG;
    deAttributes,deValues:PDAPI_ENTRY;
    pAccount, pPassword :PChar;
    TempResult:PATT_VALUE;
begin
    (*
    * Algorithm:
    * 1. Do DAPIStart.
    * 2. Do DAPIWrite to set security descriptor.
    * 3. Do DAPIEnd.
    *)

ZeroMemory(@parms,SizeOf(DAPI_PARMS));
parms.dwDAPISignature := DAPI_SIGNATURE;
parms.pszDSAName := pszServer;
parms.pszContainer := 'Recipients';


hDAPISession := Nil;

// Initialize DAPI
pDAPIEvent := DAPIStart(@hDAPISession, @parms);
if Assigned(pDAPIEvent) then
begin
RaiseDAPIError(pDAPIEvent);
DAPIFreeMemory(pDAPIEvent);
Result:= -1;
Exit;
end;

// We have DAPI session. Use it now for read.


I:=4;

deAttributes:=DAPIAllocBuffer(SizeOf(DAPI_ENTRY), nil);
ZeroMemory(deAttributes, SizeOf(DAPI_ENTRY));

deAttributes.unAttributes := I;
deAttributes.ulEvalTag := TEXT_VALUE_ARRAY;


rgEntryAttributes:=DAPIAllocBuffer(SizeOf(ATT_VALUE)*I,nil);
ZeroMemory(rgEntryAttributes, SizeOf(ATT_VALUE)*I);


PATT_VALUE(ULONG(rgEntryAttributes)+ULONG(SizeOf(ATT_VALUE)*(I-4)))^:=
PATT_VALUE(ToAttValue('Object-Class',DAPI_TEXT))^;

PATT_VALUE(ULONG(rgEntryAttributes)+ULONG(SizeOf(ATT_VALUE)*(I-3)))^:=
PATT_VALUE(ToAttValue('Directory Name',DAPI_TEXT))^;

PATT_VALUE(ULONG(rgEntryAttributes)+ULONG(SizeOf(ATT_VALUE)*(I-2)))^:=
PATT_VALUE(ToAttValue('Home-Server',DAPI_TEXT))^;

PATT_VALUE(ULONG(rgEntryAttributes)+ULONG(SizeOf(ATT_VALUE)*(I-1)))^:=
PATT_VALUE(ToAttValue('NT-Security-Descriptor',DAPI_TEXT))^;

deAttributes.rgEntryValues:=DAPIAllocBuffer(SizeOf(ATT_VALUE)*(I), deAttributes);
ZeroMemory(deAttributes.rgEntryValues, SizeOf(ATT_VALUE)*(I));
deAttributes.rgEntryValues:=rgEntryAttributes;

deValues:=DAPIAllocBuffer(sizeof(DAPI_ENTRY), nil);
ZeroMemory(deValues, sizeof(DAPI_ENTRY));

deValues.unAttributes := I; //# of attributes
deValues.ulEvalTag := VALUE_ARRAY;

rgEntryValues:=DAPIAllocBuffer(SizeOf(ATT_VALUE)*I,nil);
ZeroMemory(rgEntryValues, SizeOf(ATT_VALUE)*I);

PATT_VALUE(ULONG(rgEntryValues)+ULONG(SizeOf(ATT_VALUE)*(I-4)))^:=
PATT_VALUE(ToAttValue('Mailbox',DAPI_TEXT))^;

PATT_VALUE(ULONG(rgEntryValues)+ULONG(SizeOf(ATT_VALUE)*(I-3)))^:=
PATT_VALUE(ToAttValue(StrPas(pszDirectoryName),DAPI_TEXT))^;

PATT_VALUE(ULONG(rgEntryValues)+ULONG(SizeOf(ATT_VALUE)*(I-2)))^:=
PATT_VALUE(ToAttValue('~SERVER',DAPI_TEXT))^;


Pointer(TempResult):=DAPIAllocBuffer(SizeOf(Att_Value),nil);
ZeroMemory(TempResult,SizeOf(Att_Value));

TempResult.DapiType:=DAPI_BINARY;
TempResult.Value.lpBinary:=Pointer(pSelfRelSD);
TempResult.size:=GetSecurityDescriptorLength(pSelfRelSD);
TempResult.pNextValue:=nil;

PATT_VALUE(ULONG(rgEntryValues)+ULONG(SizeOf(ATT_VALUE)*(I-1)))^:=
PATT_VALUE(TempResult)^;


deValues.rgEntryValues:=DAPIAllocBuffer(sizeof(ATT_VALUE)*(I), deValues);
ZeroMemory(deValues.rgEntryValues, sizeof(ATT_VALUE)*(I));

deValues.rgEntryValues:=rgEntryValues;

pAccount := Nil;
pPassword := Nil;

ulUSN := 0;

pDAPIEvent := DAPIWrite(hDAPISession,
DAPI_WRITE_UPDATE,
deAttributes,
deValues,
@ulUSN,
@pAccount, // Account
@pPassword); // Password
if Assigned(pDAPIEvent) then
begin
RaiseDAPIError(pDAPIEvent);
DapiFreeMemory(rgEntryAttributes);
DapiFreeMemory(rgEntryValues);
DapiFreeMemory(deAttributes);
DapiFreeMemory(deValues);
DAPIFreeMemory(pDAPIEvent);
Result:=-1;
Exit;
end;

DapiFreeMemory(rgEntryAttributes);
DapiFreeMemory(rgEntryValues);
DapiFreeMemory(deAttributes);
DapiFreeMemory(deValues);
DAPIFreeMemory(pDAPIEvent);

// Terminate DAPI session
DAPIEnd(hDAPISession);
Result:= 0;
end;


procedure TfrmMAIN.btModifyClick(Sender: TObject);
type
    _ACE_HEADER = record
        AceType: BYTE;
        AceFlags: BYTE;
        AceSize: WORD;
    end;
ACE_HEADER = _ACE_HEADER;
PACE_HEADER = ^_ACE_HEADER;
TAceHeader = _ACE_HEADER;
PAceHeader = ^TAceHeader;
type
    _ACCESS_ALLOWED_ACE = record
        Header: ACE_HEADER;
        Mask: ACCESS_MASK;
        SidStart: DWORD;
    end;
ACCESS_ALLOWED_ACE = _ACCESS_ALLOWED_ACE;
PACCESS_ALLOWED_ACE = ^ACCESS_ALLOWED_ACE;
TAccessAllowedAce = ACCESS_ALLOWED_ACE;
PAccessAllowedAce = PACCESS_ALLOWED_ACE;
const
// This is our SID for group "Everyone"
    sidEveryone:Array [0..11] of Byte = (1,1,0,0,0,0,0,1,0,0,0,0);
    const ACL_REVISION = 2;
var
    sd:PSecurityDescriptor;
    b:BOOL;
    dwSize,dwSelfRelSize:DWORD;
    pDacl:PACL;
    pSelfRelSD:PSecurityDescriptor;
    I:Integer;
    pszServer, pszDirectoryName:PCHAR;
begin

(*
* Algorithm:
* 1. Create a security descriptor that allows access for everyone.
* 2. Convert it to self-relative format.
* 3. Call the SetDirObjectSD function.
*)

if Trim(ebDirectory.Text)='' then exit;
if Trim(ebServer.Text)='' Then Exit;

pszServer:=PCHAR(Trim(ebServer.Text));
pszDirectoryName:=PCHAR(Trim(ebDirectory.Text));


GetMem(SD,SECURITY_DESCRIPTOR_MIN_LENGTH);

// Start with security descriptor in absolute format
b := InitializeSecurityDescriptor(sd, SECURITY_DESCRIPTOR_REVISION);
assert(b);

// Determine size for DACL, allocate and initialize it.
dwSize := sizeof(ACL) + sizeof(ACCESS_ALLOWED_ACE) + sizeof(sidEveryone) - sizeof(DWORD);


pDacl := PACL(AllocMem(dwSize));
b := InitializeAcl(pDacl^, dwSize, ACL_REVISION);
assert(b);


// Allow access for everyone.
// The mask $000100FF defines Service Account Admin. access.
b := AddAccessAllowedAce(pDacl^, ACL_REVISION, $000100FF, @sidEveryone);
assert(b);


// Insert DACL into security descriptor
b := SetSecurityDescriptorDacl(sd, TRUE, pDacl, FALSE);
assert(b);

// Set up owner and group. Exchange needs them.
b := SetSecurityDescriptorOwner(sd, @sidEveryone, FALSE);
assert(b);

b := SetSecurityDescriptorGroup(sd, @sidEveryone, FALSE);
assert(b);

// We need to convert it to self-relative format

// Determine size first
pSelfRelSD := Nil;
dwSelfRelSize := 0;
MakeSelfRelativeSD(sd, pSelfRelSD, dwSelfRelSize);

if (dwSelfRelSize>0) then
pSelfRelSD := PSecurityDescriptor(AllocMem(dwSelfRelSize));
b := MakeSelfRelativeSD(sd, pSelfRelSD, dwSelfRelSize);
assert(b);


// Set our security descriptor into the directory object
i := SetDirObjectSD(pszServer, pszDirectoryName, pSelfRelSD);
assert(S_OK = i);

if S_OK = i Then ShowMessage('OK') Else ShowMessage('Error');

// Deallocate memory
if Assigned(pSelfRelSD) then FreeMem(pSelfRelSD);
if Assigned(pDacl) then FreeMem(pDacl);
if Assigned(sd) then FreeMem(sd);

end;

function ToAttValue(OneAttr:Variant; Const DAPIType: DAPI_DATA_TYPE):PATT_VALUE; safecall;
function Hex2Dec(const S: string): Longint;
var
    HexStr: string;
begin
    if Pos('$', S) = 0 then HexStr := '$' + S
    else HexStr := S;
    Result := StrToIntDef(HexStr, 0);
end;

var
    Y, J:ULONG;
    tempStrL:string;
    TempResult:PATT_VALUE;
begin

Pointer(TempResult):=DAPIAllocBuffer(SizeOf(Att_Value),nil);
ZeroMemory(TempResult,SizeOf(Att_Value));


case DAPIType of
DAPI_TEXT:begin
TempResult.DapiType:=DAPI_STRING8;
GetMem(TempResult.Value.pszValue,Length(VarToStr(OneAttr))+1);
StrPCopy(TempResult.Value.pszValue,VarToStr(OneAttr));
TempResult.size:=StrLen(TempResult.Value.pszValue);
TempResult.pNextValue:=nil;
end;
DAPI_BINARY:begin
TempResult.DapiType:=DAPI_BINARY;
tempStrL:=VarToStr(OneAttr);
J:=Length(tempStrL);
GetMem(TempResult.Value.lpBinary,J div 2);
for Y:=0 to ((J div 2)-1) do
PBYTE(ULONG(TempResult.Value.lpBinary)+J)^:=Hex2Dec(Copy(tempStrL,1+j*2,2));
TempResult.size:=J div 2;
TempResult.pNextValue:=nil;
end;
DAPI_INT:begin
TempResult.DapiType:=DAPI_INT;
TempResult.Value.iValue:=Integer(OneAttr);
TempResult.size:=SizeOf(TempResult.Value.iValue);
TempResult.pNextValue:=nil;
end;
DAPI_BOOL:begin
TempResult.DapiType:=DAPI_BOOL;
TempResult.Value._bool:=Bool(OneAttr);
TempResult.size:=SizeOf(TempResult.Value._bool);
TempResult.pNextValue:=nil;
end;
end;
Result:=TempResult;
end;

procedure RaiseDAPIError(pDapiEvent: Pointer);stdcall;
var
    msg:PCHAR;
    strmsg:string;
    NextEv:PDAPI_EVENT;
    dwDAPIError:ULONG;
begin
NextEv:=pDapiEvent;
while NextEv<>nil do begin

FormatMessage (FORMAT_MESSAGE_FROM_HMODULE
                        or FORMAT_MESSAGE_ALLOCATE_BUFFER
                        or FORMAT_MESSAGE_ARGUMENT_ARRAY,
                        pointer (NextEv.hinstDAPI),
                        NextEv.dwDAPIError,
                        0,
                        @msg,
                        0,
                        @(NextEv.rgpszSubst));

msg[Lstrlen(msg)-2] := #0;
strmsg:=StrPas(msg);
LocalFree(Cardinal(msg));
dwDAPIError:=NextEv.dwDAPIError;
ShowMessage('Error Code: '+IntToHex(dwDAPIError,8) +#13+#10+strmsg);
NextEv:=NextEv.pNextEvent;
end;
end;

A few notes about this code.

• First, the format of the security descriptor is important - it needs to be self-relative. Otherwise the DAPIWrite function fails. Also, you need to set up owner and primary group in the security descriptor. I use the well-known security identifier assigned to "Everyone" group. This makes code shorter and more illustrative.
•  Second, notice that I have used the pszContainer member in DAPI_PARMS structure to make it work properly. If you don't supply it, the DAPIWrite may create another mailbox object in the site container instead of the Recipients container.
• Third, the Directory Name attribute that is set up before the DAPIWrite call is the last part of mailbox distinguished name. Examine raw properties of the mailbox  to get this value and change accordingly. At first I was thinking that I could use mailbox DN (similar to the way I used when retrieving security descriptors). I abandoned further attempts to make the DN working after a few unsuccessful attempts.
• All error handling is stripped to deliver readability. The topic "How to Work with DAPI_EVENT Structure" describes how to handle DAPI_EVENT.

Compiled DELPHI 5 example