{******************************************************************************}
// OBJECT: THIS FUNCTION EXECUTES A SEARCH.
// EXPECTED PARAMETERS: searchfilter eg. = (&(|(objectClass=user)(objectClass=group)(objectClass=organizationalUnit))(|(Name=*'+EdSearch.Text+'*)(sAMAccountName=*'+EdSearch.Text+'*)))
// CallBackFunction interface: TCallBackResultArray = procedure(data: TResultArray) of object; -> TResultArray is an 2dimensional array of string
// OPTIONAL PARAMETERS: Attributes: eg: 'Name;AdsPath;Class;' -> A delimited String to pass which defines the attributes you want to get. default: Name;AdsPath;
// LDAPBeginingPath: eg: OU=example,OU=this,DC=domain1,DC=lan -> means the search will be executed on this path. default: search whole AD
{******************************************************************************}
procedure TEADSObject.DirectorySearch(searchfilter:
string; CallBackFunction: TCallBackResultArray; Attributes:
string = '
Name;AdsPath;'; LDAPBeginingPath:
string = '
ROOTDSE');
var
search: IDirectorySearch;
ptrResult: THandle;
opt: ads_searchpref_info;
dwCount: DWORD;
hr: HResult;
col: ads_search_column;
dwErr: DWord;
szErr :
array[0..255]
of WideChar;
szName :
array[0..255]
of WideChar;
I: Integer;
ArrResult: TStringArray2;
ArrResCnt: Integer;
AttrArray:
array of PWideChar;
Attribute:
string;
empty: Boolean;
begin
// create an attributes array from the attributes passed by a delimitted string
for I := 1
to Length(Attributes)
do
begin
if Attributes[I] = '
;'
then
begin
SetLength(AttrArray, Length(AttrArray)+1);
getmem(AttrArray[Length(AttrArray)-1], 256);
StringToWideChar(Attribute, AttrArray[Length(AttrArray)-1], 256);
Attribute := '
';
end
else
Attribute := Attribute + Attributes[I]
end;
// for faster search set a LDAPBeginingPath to execute the search within this container
if LDAPBeginingPath = '
ROOTDSE'
then
LDAPBeginingPath := AdsMgr.ADSController.LDAPPATH;
// get the search object
if SUCCEEDED(AccessObject(LDAPBeginingPath, IDirectorySearch, search))
then
begin
try
// set parameters
opt.dwSearchPref := ADS_SEARCHPREF_SEARCH_SCOPE
OR ADS_SEARCHPREF_SORT_ON;
opt.vValue.dwType := ADSTYPE_INTEGER;
opt.vValue.__MIDL_0010.Integer := ADS_SCOPE_SUBTREE;
// setting search preferences
if not SUCCEEDED(search.SetSearchPreference(opt, 1))
then
begin
ADsGetLastError(dwErr, @szErr[0], 254, @szName[0], 254);
ShowMessage(WideCharToString(szErr));
Exit;
end;
// prepare
dwCount := Length(AttrArray);
ArrResCnt := 1;
// execute the search
hr := search.ExecuteSearch(LPCWSTR(searchfilter), @AttrArray[0], dwCount, Pointer(ptrResult));
// handle the result if hr is S_OK
if SUCCEEDED(hr)
then
begin
// get first row
hr := search.GetNextRow(Pointer(ptrResult));
// <<<<<<<<<< ACCESS VIOLATION
// repeat until no more rows
while (hr = S_OK)
do // (S_NOMORE_ROWS) < JEDI scheints nicht zu kennen
begin
// redim result array
SetLength(ArrResult, ArrResCnt);
empty := true;
// for each attribute you want to get (defined in AttrArray)
for I := 0
to dwCount -1
do
begin
// get column
if Succeeded(search.GetColumn(Pointer(ptrResult), @AttrArray[I], col))
then
begin
if col.pADsValues <>
nil then
begin
// redim result array (2 dimensional string array)
SetLength(ArrResult[ArrResCnt-1], I+1);
// fill values into the result array
ArrResult[ArrResCnt-1,I] := col.pADsValues^.__MIDL_0010.DNString;
//ArrResult[ArrResCnt-1,I] := col.pADsValues^.__MIDL_0010.BackLink.ObjectName; [AHAAA]
empty := false;
end;
search.FreeColumn(col);
end;
end;
hr := search.GetNextRow(Pointer(ptrResult));
// only redim the result array next time, if there was a value found
// we dont want empty fields in the result array.
if not empty
then
Inc(ArrResCnt);
end;
end;
//search.CloseSearchHandle(ptrResult);
except
//search._Release;
on e: EOleException
do
AdsMgr.SetLastError(e.
Message);
end;
end;
if Length(ArrResult) > 0
then
CallBackFunction(ArrResult);
end;