(*
* 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.