Einzelnen Beitrag anzeigen

Benutzerbild von Remko
Remko

Registriert seit: 10. Okt 2006
Ort: 's-Hertogenbosch, Die Niederlande
222 Beiträge
 
RAD-Studio 2010 Arc
 
#1

Convert sample from platform SDK to Delphi

  Alt 21. Dez 2006, 10:34
Sorry for writing in English but my German is really insufficient.
I want to call from my app the default properties dialog for Active Directory objects from Active Directory Users & Computers.
According to this MS article: http://msdn.microsoft.com/library/de...rty_sheets.asp it can be done. The article also talks about a sample in the Platform SDK (attached). I'm currently trying to convert the sample to Delphi, but as it's the first time I'm undertaking such a project myself I find it difficult and are unsure about my results. I would really appreciate help on the conversion and comments or correction of my results so far.
(Header file is in PropSheetHost.h, implementation is in: DataObj.cpp, complete sample attached in .zip)

Delphi-Quellcode:
unit PropSheetHost;

interface

uses Messages, Windows, JwaActiveX, JwaDSClient, JwaAdsTLB, JwaPrSht, SysUtils;

const GWLP_USERDATA = -21;
const VIEW_POINTER_OFFSET = GWLP_USERDATA;

const CFSTR_DS_PARENTHWND_W: PWideChar = 'DsAdminParentHwndClipFormat';
const CFSTR_DS_PARENTHWND_A: PChar = 'DsAdminParentHwndClipFormat';

{$IFDEF UNICODE}
  const CFSTR_DS_PARENTHWND: PWideChar = 'DsAdminParentHwndClipFormat';
{$ELSE}
  const CFSTR_DS_PARENTHWND: PChar = 'DsAdminParentHwndClipFormat';
{$ENDIF} //UNICODE

const CFSTR_DS_PROPSHEETCONFIG_W: PWideChar = 'DsPropSheetCfgClipFormat';
const CFSTR_DS_PROPSHEETCONFIG_A: PChar = 'DsPropSheetCfgClipFormat';

{$IFDEF UNICODE}
  const CFSTR_DS_PROPSHEETCONFIG: PWideChar = 'DsPropSheetCfgClipFormat';
{$ELSE}
  const CFSTR_DS_PROPSHEETCONFIG: PChar = 'DsPropSheetCfgClipFormat';
{$ENDIF} //UNICODE

const WM_ADSPROP_SHEET_CREATE = (WM_USER + 1108);
const WM_DSA_SHEET_CREATE_NOTIFY = (WM_USER + 6);
const WM_DSA_SHEET_CLOSE_NOTIFY = (WM_USER + 5);

{$EXTERNALSYM TYMED_HGLOBAL}
const TYMED_HGLOBAL = 1;

type
  PDSA_SEC_PAGE_INFO = ^DSA_SEC_PAGE_INFO;
  _DSA_SEC_PAGE_INFO = record
    hwndParentSheet: HWND;
    offsetTitle: DWord;
    dsObjectnames: dsObjectNames;
  end;
  DSA_SEC_PAGE_INFO = _DSA_SEC_PAGE_INFO;
  TDsaSecPageInfo = DSA_SEC_PAGE_INFO;
  PDsaSecPageInfo = PDSA_SEC_PAGE_INFO;

  PPROPSHEETCFG = ^PROPSHEETCFG;
  _PROPSHEETCFG= record
    lNotifyHandle: PLongInt;
    hwndParentSheet: HWND;
    hwndHidden: HWND;
    wParamSheetClose: WPARAM;
  end;
  PROPSHEETCFG = _PROPSHEETCFG;

const PROP_SHEET_HOST_ID = $CDCDCDCD;

const PROP_SHEET_PREFIX_ADMIN: PWideChar = 'admin';
const PROP_SHEET_PREFIX_SHELL: PWideChar = 'shell';

type
  TPropSheetHost = class(TInterfacedObject, IDataObject)
    m_hwndParent: HWND;
    m_hwndHidden: HWND;
    m_ObjRefCount: DWORD;
    m_spADObject: IADS;
    m_cfDSPropSheetConfig: ATOM;
    m_cfDSObjectNames: ATOM;
    m_cfDSDispSpecOptions: ATOM;
    m_rgPageHandles: array of HPROPSHEETPAGE;
    {$IFDEF UNICODE}
      m_szHiddenWindowClass: PWideChar;
    {$ELSE}
      m_szHiddenWindowClass: PChar;
    {$ENDIF}
    m_hInst: Cardinal;
    m_pwszPrefix: PWideChar;
  public
    { IDataObject }
    function QueryInterface(const iid: TIID; out Obj): HResult; stdcall;
    function AddRef: Longint; stdcall;
    function Release: Longint; stdcall;

    function GetData(const formatetcIn: TFormatEtc; out medium: TStgMedium):
      HResult; stdcall;
    function GetDataHere(const formatetc: TFormatEtc; out medium: TStgMedium):
      HResult; stdcall;
    function QueryGetData(const formatetc: TFormatEtc): HResult;
      stdcall;
    function GetCanonicalFormatEtc(const formatetc: TFormatEtc;
      out formatetcOut: TFormatEtc): HResult; stdcall;
    function SetData(const formatetc: TFormatEtc; var medium: TStgMedium;
      fRelease: BOOL): HResult; stdcall;
    function EnumFormatEtc(dwDirection: Longint; out enumFormatEtc:
      IEnumFormatEtc): HResult; stdcall;
    function DAdvise(const formatetc: TFormatEtc; advf: Longint;
      const advSink: IAdviseSink; out dwConnection: Longint): HResult; stdcall;
    function DUnadvise(dwConnection: Longint): HResult; stdcall;
    function EnumDAdvise(out enumAdvise: IEnumStatData): HResult;
      stdcall;
  public
    constructor Create(hInstance: Cardinal; hwnParent: HWND);
    destructor Destroy;
  public
    function SetObject(pwsaADsPath: PWideString): HRESULT; overload;
    function SetObject(IADs: IADS): HRESULT; overload;
  private
    function _CreateHiddenWindow: HWND;
    function _AddPagesForObject(hPage: HPROPSHEETPAGE; lParam: LPARAM): HRESULT;
    procedure _CreateSecondaryPropertySheet(pDSASecPageInfo: DSA_SEC_PAGE_INFO);
    function _GetDSDispSpecOPtion(pFormatEtc: FORMATETC; pStgMedium: STGMEDIUM): HRESULT;
    function _GetDSObjectNames(pFormatETC: FORMATETC; pStgMedium: STGMEDIUM): HRESULT;
    function _GetDSPropSheetConfig(pFormatEtc: FORMATETC; pStgMedium: STGMEDIUM): HRESULT;
    function _ExtractSecPageInfo(wParam: WPARAM; ppSecPageInfo: PDSA_SEC_PAGE_INFO): HRESULT;
  end;

implementation

function TPropSheetHost.QueryInterface(const IID: TGUID; out Obj): HRESULT;
var IID_IDataObject: TGUID;
begin
  IID_IDataObject := IDataObject;
  if GetInterFace(IID, Obj) then
  begin
    AddRef;
    Result := S_OK;
  end
  else
  begin
    Result := E_NOINTERFACE;
  end;
end;

function TPropSheetHost.AddRef: LongInt;
begin
  Inc(m_ObjRefCount);
  Result := m_ObjRefCount;
end;

function TPropSheetHost.Release: LongInt;
begin
  Dec(RefCount);
  Result := RefCount;
  if RefCount = 0 then
    Free;
end;

function TPropSheetHost.GetData(var formatetcIn: TFormatEtc; var medium: TStgMedium):
      HResult; stdcall;
var hr: HResult;
begin
  hr := DV_E_FORMATETC;
  if m_cfDSDispSpecOptions = formatetcIn.cfFormat then
  begin
    hr := _GetDSDispSpecOption(formatetcIn, pStgMedium);
  end
  else if m_cfDSObjectNames = formatetcIn.cfFormat then
  begin
    hr := _GetDSObjectNames(formatetcIn, TStgMedium);
  end
  else if m_cfDSPropSheetConfig = formatetcIn.cfFormat then
  begin
    hr := _GetDSPropSheetConfig(pFormatEtc, pStgMedium);
  end;
  Result := hr;
end;

function TPropSheetHost.GetDataHere(const formatetc: FORMATETC; out medium: STGMEDIUM): HResult;
begin
  Result := E_NOTIMPL;
end;

function TPropSheetHost.QueryGetData(const formatetc: FORMATETC): HResult;
begin
  if m_cfDSDispSpecOptions = formatetc.cfFormat then
  begin
    Result := S_OK;
  end
  else if m_cfDSObjectNames = formatetc.cfFormat then
  begin
    Result := S_OK;
  end
  else if m_cfDSPropSheetConfig = formatetc.cfFormat then
  begin
    Result := S_OK;
  end
  else
  begin
    Result := DV_E_FORMATETC;
  end;
end;

function TPropSheetHost.GetCanonicalFormatEtc(const formatetc: FORMATETC; out formatetcOut: FORMATETC): HResult;
begin
  Result := E_NOTIMPL;
end;

function TPropSheetHost.EnumFormatEtc(dwDirection: Integer; out enumFormatEtc: IEnumFORMATETC): HResult;
begin
  Result := E_NOTIMPL;
end;

function TPropSheetHost.SetData(const formatetc: FORMATETC; var medium: STGMEDIUM; fRelease: LongBool): HResult;
begin
  Result := E_NOTIMPL;
end;

function TPropSheetHost.DAdvise(const formatetc: FORMATETC; advf: Integer; const advSink: IAdviseSink; out dwConnection: Integer): HResult;
begin
  Result := E_NOTIMPL;
end;

function TPropSheetHost.DUnadvise(dwConnection: Integer): HResult;
begin
  Result := E_NOTIMPL;
end;

function TPropSheetHost.EnumDAdvise(out enumAdvise: IEnumSTATDATA): HResult;
begin
  Result := E_NOTIMPL;
end;

function TPropSheetHost._GetDSDispSpecOPtion(pFormatEtc: FORMATETC; pStgMedium: STGMEDIUM): HResult;
var hr: HResult;
  pwszPrefix: PWideChar;
  dwPrefixOffset: DWORD;
  dwBytes: DWORD;
begin
  if (m_cfDSDispSpecOptions <> pFormatEtc.cfFormat) or not (pFormatEtc.tymed and TYMED_HGLOBAL) then
  begin
    Result := DV_E_FORMATETC;
    Exit;
  end;
  hr := E_OUTOFMEMORY;
  pwszPrefix := m_pwszPrefix;

   // Size of the DSDISPLAYSPECOPTIONS structure.
  dwPrefixOffset := SizeOf(DSDISPLAYSPECOPTIONS);

  // Store the offset to the prefix.
  dwPrefixOffset := dwBytes;

  // Length of the prefix Unicode string, including the null terminator.
  dwBytes := (Length(pwszPrefix) + 1) * SizeOf(WChar);

  pStgMedium.unkForRelease := nil;
  pStgMedium.tymed := TYMED_HGLOBAL;
  pStgMedium.hGlobal := GlobalAlloc(GPTR, dwBytes);

end;

function TPropSheetHost._GetDSObjectNames(pFormatETC: FORMATETC; pStgMedium: STGMEDIUM): HResult;
begin

end;

function TPropSheetHost._GetDSPropSheetConfig(pFormatEtc: FORMATETC; pStgMedium: STGMEDIUM): HResult;
begin

end;

end.
Angehängte Dateien
Dateityp: zip propsheethost_144.zip (17,7 KB, 21x aufgerufen)
  Mit Zitat antworten Zitat