Delphi TADSISearch Octet string

Компонент TADSISearch дает удобный доступ к данным в Active Directory (AD) из приложения на Delphi.

Однако при получении параметров ObjectSID и ObjectGUID вместо значений не считывалось. Это объекты хранятся в AD в виде OctetString и должны конвертироваться в TGUID. Однако компонент упорно выдавал пустую строку при попытке считать их.

Приходилось считывать эти данные через LDAP запрос, который обращался через Linked Server MS SQL Server. Это работало, но создавало определенные трудности при переносе приложения. Поиски по статьям и форумам сводились к одному «не правильно импортировался» ActiveDs_TLB.pas

Импорт Type Library – activeds.tlb показал что в исходных кодах компонента

  ADS_OCTET_STRING = TGUID;

А в свеже импортированном файле

  __MIDL___MIDL_itf_ads_0000_0000_0002 = record
    dwLength: LongWord;
    lpValue: ^Byte;
  end;

  ADS_OCTET_STRING = __MIDL___MIDL_itf_ads_0000_0000_0002;

Теперь вот только возникал вопрос, как извлечь данные в удобном виде из

 __MIDL___MIDL_itf_ads_0000_0000_0002 .

Данные в поля компонента извлекаются в процедуре,

function TADSISearch.GetStringValue(oSrchColumn: ads_search_column; Index: Integer): WideString;
var
  wrkPointer : PADSValue;
  oSysTime   : _SYSTEMTIME;
  dtDate,
  dtTime     : TDateTime;
begin
  Result := '';

  // advance the value pointer to the correct one of the potentially multiple
  // values in the "array of values" for this attribute
  wrkPointer := oSrchColumn.pADsValues;
  Inc(wrkPointer, Index);

  // depending on the type of the value, turning it into a string is more
  // or less straightforward
  case oSrchColumn.dwADsType of
    ADSTYPE_CASE_EXACT_STRING  : Result := wrkPointer^.__MIDL_0010.CaseExactString;
    ADSTYPE_CASE_IGNORE_STRING : Result := wrkPointer^.__MIDL_0010.CaseIgnoreString;
    ADSTYPE_DN_STRING          : Result := wrkPointer^.__MIDL_0010.DNString;
    ADSTYPE_OBJECT_CLASS       : Result := wrkPointer^.__MIDL_0010.ClassName;
    ADSTYPE_PRINTABLE_STRING   : Result := wrkPointer^.__MIDL_0010.PrintableString;
    ADSTYPE_NUMERIC_STRING     : Result := wrkPointer^.__MIDL_0010.NumericString;
    ADSTYPE_BOOLEAN            : Result := IntToStr(wrkPointer^.__MIDL_0010.Boolean);
    ADSTYPE_INTEGER            : Result := IntToStr(wrkPointer^.__MIDL_0010.Integer);
    ADSTYPE_LARGE_INTEGER      : Result := IntToStr(wrkPointer^.__MIDL_0010.LargeInteger);
    ADSTYPE_OCTET_STRING       : Result := bintostr(wrkPointer^.__MIDL_0010.OctetString.lpValue
      , 32);
    ADSTYPE_UTC_TIME:
      begin
        // ADS_UTC_TIME maps to a _SYSTEMTIME structure
        Move(wrkPointer^.__MIDL_0010.UTCTime, oSysTime, SizeOf(oSysTime));
        // create two TDateTime values for the date and the time
        dtDate := EncodeDate(oSysTime.wYear, oSysTime.wMonth, oSysTime.wDay);
        dtTime := EncodeTime(oSysTime.wHour, oSysTime.wMinute, oSysTime.wSecond, oSysTime.wMilliseconds);
        // add the two TDateTime's (really only a Float), and turn into a string
        Result := DateTimeToStr(dtDate+dtTime);
      end;
    else Result := Format(rc_UnknownDataType, [oSrchColumn.dwADsType]);
  end;
end;

надо лишь обработать возврат типа данных

    ADSTYPE_OCTET_STRING       : Result := bintostr(wrkPointer^.__MIDL_0010.OctetString.lpValue
      , 32);

Решение получилось не очень красивое, но вполне рабочее. Возможно, в дальнейшем, оно станет изящнее, но пока даже так в лоб сделанная процедура успешно работает и конвертирует octet string в удобно читаемый GUID .

function bintostr(bin: Pointer; ALength: Integer): string;
const HexSymbols = '0123456789ABCDEF';
var i, lTmp, j: integer;
  lBytes: PByteArray;
  lArray: TBytes;
  lStr, lResult: string;
  bTmp: Byte;
  lGUID: TGUID;
begin
  lBytes:= (bin);

  for i :=  0 to (16)-1 do
  begin
    bTmp:= TBuffer(bin^)[i];
    Result:= Result + HexSymbols[1 + lBytes^[i] shr 4];
    Result:= Result + HexSymbols[1 + lBytes^[i] and $0F];
  end;
  lStr:= Result[15];
  Result[15]:= Result[13];
  Result[13]:= lStr[1];

  lStr:= Result[14];
  Result[14]:= Result[16];
  Result[16]:= lStr[1];

  lStr:= Result[11];
  Result[11]:= Result[9];
  Result[9]:= lStr[1];

  lStr:= Result[12];
  Result[12]:= Result[10];
  Result[10]:= lStr[1];

  lStr:= Result[1];
  Result[1]:= Result[7];
  Result[7]:= lStr[1];

  lStr:= Result[2];
  Result[2]:= Result[8];
  Result[8]:= lStr[1];

  lStr:= Result[3];
  Result[3]:= Result[5];
  Result[5]:= lStr[1];

  lStr:= Result[4];
  Result[4]:= Result[6];
  Result[6]:= lStr[1];

  Result.Insert(20,'-');
  Result.Insert(16,'-');
  Result.Insert(12,'-');
  Result.Insert(8,'-');
  Result.Insert(0,'{');
  Result.Insert(37,'}');
end;

Полный исходный код для установки компонента и демо для проверки работоспособности можно скачать здесь ADSISearch-Sources. Надеюсь, это будет полезно другим.

Share

Tags: , , ,

One Response to “Delphi TADSISearch Octet string”

  1. евген пишет:

    Очень полезная статья! скоро попробую работоспособность кода, надеюсь не подведет.

Leave a Reply