Convert sample from platform SDK to Delphi

[Remko]

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.

[Remko]

How to convert this part?

Code:

pwszTemp = (LPWSTR)((LPBYTE)pDispSpecOptions + dwPrefixOffset);
lstrcpyW(pwszTemp, pwszPrefix);

This is my conversion so far:

Delphi-Quellcode:

unit PropSheetHost;

interface

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

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

constructor TPropSheetHost.Create(hInstance: Cardinal; hwnParent: HWND);
begin

end;

destructor TPropSheetHost.Destroy;
begin

end;

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(m_ObjRefCount);
  Result := m_ObjRefCount;
  if RefCount = 0 then
    Free;
end;

function TPropSheetHost.GetData(const formatetcIn: TFormatEtc; out medium: TStgMedium):
  HRESULT; stdcall;
var hr: HResult;
begin
  hr := DV_E_FORMATETC;
  if m_cfDSDispSpecOptions = formatetcIn.cfFormat then
  begin
    hr := _GetDSDispSpecOption(formatetcIn, medium);
  end
  else if m_cfDSObjectNames = formatetcIn.cfFormat then
  begin
    hr := _GetDSObjectNames(formatetcIn, medium);
  end
  else if m_cfDSPropSheetConfig = formatetcIn.cfFormat then
  begin
    hr := _GetDSPropSheetConfig(formatetcIn, medium);
  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;
  pDispSpecOptions: PDSDISPLAYSPECOPTIONS;
  pwszTemp: PWideChar;
begin
  if (m_cfDSDispSpecOptions <> pFormatEtc.cfFormat) or (pFormatEtc.tymed and TYMED_HGLOBAL = 0) 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);
  if pStgMedium.hGlobal <> 0 then
  begin
    pDispSpecOptions := PDSDISPLAYSPECOPTIONS(GlobalLock(pStgMedium.hGlobal));
    if Assigned(pDispSpecOptions) then
    begin
      pDispSpecOptions.dwSize := SizeOf(DSDISPLAYSPECOPTIONS);
      pDispSpecOptions.dwFlags := 0;
      pDispSpecOptions.offsetAttribPrefix := dwPrefixOffset;
      pDispSpecOptions.offsetUserName := 0;
      pDispSpecOptions.offsetPassword := 0;
      pDispSpecOptions.offsetServer := 0;
      pDispSpecOptions.offsetServerConfigPath := 0;

         // Copy the prefix string.

         GlobalUnlock(pStgMedium.hGlobal);

         hr := S_OK;

    end;
  end;
end;

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

end;

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

end;

end.

[Robert Marquardt]

Zitat:

Zitat von Remko

How to convert this part?

Code:

pwszTemp = (LPWSTR)((LPBYTE)pDispSpecOptions + dwPrefixOffset);
lstrcpyW(pwszTemp, pwszPrefix);

This is rather easy.

Delphi-Quellcode:

var
  pwswTemp: PWideChar;

...

  pwszTemp := PWideChar(PChar(pDispSpecOptions) + dwPrefixOffset);
  lstrcpyW(pwszTemp, pwszPrefix);

It takes the pointer to the structure and moves it for dwPrefixOffset bytes. To increment it uses the + operator which is defined in C for any pointer type and integer. In Delphi the operator is only defined for PChar, but that is good enough to increment the pointer for the desired amount of bytes.
The resulting pointer is typecasted to PWideChar because obviously at this address a C Unicode string resides.
The Win32 funtion lstrcpyW now copies the C Unicode string residing at pwszPrefix into pwszTemp.

To add some help for the many C string types:
LP = Long Pointer. Can be ignored. It is from a time when there were 16-bit and 32-bit pointers. It denotes 32-bit pointers.
C = const. Not fully the same as const in Delphi. Can usually be dropped.
W = Wide. Unicode.
T = ANSI or Unicode depending on the preprocessor symbol UNICODE. Since most Win32 functinos come in ANSI and Unicode variant (suffix A and W) this allows to write a program which can be compiled in ANSI or Unicode without change of source.
STR = string.

LPCTSTR = Unicode or ANSI C string where the pointer cannot be changed because it is const. const PWideChar/PChar as parameter or PWideChar/PChar as parameter or variable.
LPWSTR = Unicode C string where the pointer can be changed. PWideChar as parameter or variable.
LPSTR = ANSI C string where the pointer can be changed. PChar as parameter or variable.

[Olli]

Didn't Inc() support any pointer type in Delphi and provide the same functionality as the + operator in C/C++ (i.e. incrementing the pointer by sizeof(*PPointerType))?

[Robert Marquardt]

Yes, but i wanted it to be as near as possible to the C version.

[Remko]

Thanks Robert,

That makes the compiler happy!
How about this one (I don't understand the #if 1)
#if 1
m_pwszPrefix = PROP_SHEET_PREFIX_ADMIN;
#else
m_pwszPrefix = PROP_SHEET_PREFIX_SHELL;
#endif

[Robert Marquardt]

{$IF True} is the conversion if you do not drop it completely. It is a preprocessor if then else with 1 = True forcing it to always take the then part.
Probably a lazy change to drop compatibility with an older API (probably Win 9x).

[Remko]

So you suggest to drop the whole part and just keep the true part?

Delphi-Quellcode:

m_pwszPrefix := PROP_SHEET_PREFIX_ADMIN;

Sorry to keep firing off my questions but I am grabbing the occassion :-)
is this the corret translation?

Code:

   if((m_cfDSObjectNames != pFormatEtc->cfFormat) ||
      !(pFormatEtc->tymed & TYMED_HGLOBAL))
   {
      return DV_E_FORMATETC;
   }

Delphi-Quellcode:

  if (m_cfDSObjectNames <> pFormatEtc.cfFormat) or (pFormatEtc.tymed and TYMED_HGLOBAL = 0) then
  begin
    Result := DV_E_FORMATETC;
    Exit;
  end;

[Robert Marquardt]

Yep.

[Remko]

Sorry Robert I made an edit while you were replying.
What Delphi type can I use for CComBSTR?

[Robert Marquardt]

Try WideString. The Delphi WideString is in fact the Windows BSTR used in COM interfaces.
The added conversion is correct. "&&" is "logical and" and "&" is "bitwise and". Delphi uses "and" for both.
"!" is the "logical not" so "= 0" is also correct.

[Remko]

How about this one?

Code:

CComPtr<IADs> m_spADObject;

I made this:

Delphi-Quellcode:

    m_spADObject: IADS;

and one more:

Code:

dwBytes += (sbstrADsPath.Length() + 1) * sizeof(WCHAR);

Delphi-Quellcode:

dwBytes := (length(sbstrADspath) + 1) * SizeOf(WChar); // Or use Inc here as Olli suggests?

[ste_ett]

Zitat:

Zitat von Remko

Code:

dwBytes += (sbstrADsPath.Length() + 1) * sizeof(WCHAR);

Delphi-Quellcode:

dwBytes := (length(sbstrADspath) + 1) * SizeOf(WChar); // Or use Inc here as Olli suggests?

Must be

Delphi-Quellcode:

dwBytes := dwBytes + ((length(sbstrADspath) + 1) * SizeOf(WChar));

otherwise you get a false value. :)

Delphi-Quellcode:

Inc(dwBytes, (length(sbstrADspath) + 1) * SizeOf(WChar));

is possbile also.

[Remko]

From JwaAdsTLB:

Delphi-Quellcode:

// *********************************************************************//
// Interface: IADs
// Flags:     (4416) Dual OleAutomation Dispatchable
// GUID:      {FD8256D0-FD15-11CE-ABC4-02608C9E7553}
// *********************************************************************//
  IADs = interface(IDispatch)
    ['{FD8256D0-FD15-11CE-ABC4-02608C9E7553}']
    function  Get_Name: WideString; safecall;
    function  Get_Class_: WideString; safecall;
    function  Get_GUID: WideString; safecall;
    function  Get_ADsPath: WideString; safecall;
    function  Get_Parent: WideString; safecall;
    function  Get_Schema: WideString; safecall;
    procedure GetInfo; safecall;
    procedure SetInfo; safecall;
    function  Get(const bstrName: WideString): OleVariant; safecall;
    procedure Put(const bstrName: WideString; vProp: OleVariant); safecall;
    function  GetEx(const bstrName: WideString): OleVariant; safecall;
    procedure PutEx(lnControlCode: Integer; const bstrName: WideString; vProp: OleVariant); safecall;
    procedure GetInfoEx(vProperties: OleVariant; lnReserved: Integer); safecall;
    property Name: WideString read Get_Name;
    property Class_: WideString read Get_Class_;
    property GUID: WideString read Get_GUID;
    property ADsPath: WideString read Get_ADsPath;
    property Parent: WideString read Get_Parent;
    property Schema: WideString read Get_Schema;
  end;

In the sample:

Code:

hr = m_spADObject->get_ADsPath(&sbstrADsPath);

I could use:

Delphi-Quellcode:

sbstrADspath :=  m_spADObject.get_ADsPath;

but how to get hr?

[Robert Marquardt]

Delphi-Quellcode:

sbstrADspath :=  m_spADObject.get_ADsPath;

Can be changed to

Delphi-Quellcode:

sbstrADspath :=  m_spADObject.ADsPath;

The Get_ and Set_ methods are property getters and setters just like in Delphi.
hr you can ignore. This is just COM error return value which is already hidden by the Delphi COM interface.
If really an error arises then your computer is already screwed up completely so no real need to catch it.

[Remko]

Thanks all, I attached my code so far. I will try to finish and test it today.
Please feel free to comment, improve or correct my code. I'm really learning a lot from this project, especially from all the help on DP!

[Remko]

How to do this one:

Code:

HWND CPropSheetHost::_CreateHiddenWindow()
{
    WNDCLASS  wc;

    if(!GetClassInfo(m_hInst, m_szHiddenWindowClass, &wc))
    {
        ZeroMemory(&wc, sizeof(wc));
           
        wc.style          = CS_HREDRAW | CS_VREDRAW;
        wc.lpfnWndProc    = (WNDPROC)_HiddenWindowProc;
<cut>

LRESULT CALLBACK CPropSheetHost::_HiddenWindowProc( HWND hWnd,
                                                    UINT uMessage,
                                                    WPARAM wParam,
                                                    LPARAM lParam)

I thought this:

Delphi-Quellcode:

function TPropSheetHost._CreateHiddenWindow: HWND;
var wc: TWndClass;
begin
  if not GetClassInfo(m_hInst, m_szHiddenWindowClass, wc) then
  begin
    ZeroMemory(@wc, SizeOf(wc));
    wc.style          := CS_HREDRAW or CS_VREDRAW;
    wc.lpfnWndProc    := @_HiddenWindowProc;
<cut>

function TPropSheetHost._HiddenWindowProc(hWnd: HWnd; Msg: UINT; WParam: WPARAM; LParam: LPARAM): UINT; stdcall;

But that doesn't make the compiler happy: [Pascal Error] PropSheetHost.pas(174): E2036 Variable required

Edit: Should I make that:

Delphi-Quellcode:

wc.lpfnWndProc    := @TPropSheetHost_HiddenWindowProc;
function TPropSheetHost._HiddenWindowProc(hWnd: HWnd; Msg: UINT; WParam: WPARAM; LParam: LPARAM): UINT; stdcall;

?[/delphi]
or
[delphi][pre]wc.lpfnWndProc := @_HiddenWindowProc;
function _HiddenWindowProc(hWnd: HWnd; Msg: UINT; WParam: WPARAM; LParam: LPARAM): UINT; stdcall;[/pre]?

[mkinzler]

On wich line the error is shown?

[Remko]

wc.lpfnWndProc := @_HiddenWindowProc; (see my edit above)

[Remko]

What's referenced by (LPVOID)this)?

Code:

HWND CPropSheetHost::_CreateHiddenWindow()
{
    WNDCLASS  wc;

    if(!GetClassInfo(m_hInst, m_szHiddenWindowClass, &wc))
    {
        ZeroMemory(&wc, sizeof(wc));
           
        wc.style          = CS_HREDRAW | CS_VREDRAW;
        wc.lpfnWndProc    = (WNDPROC)_HiddenWindowProc;
        wc.cbClsExtra     = 0;
        wc.cbWndExtra     = sizeof(CPropSheetHost*);
        wc.hInstance      = m_hInst;
        wc.hCursor        = LoadCursor(NULL, IDC_ARROW);
        wc.hbrBackground  = (HBRUSH)(COLOR_WINDOW + 1);
        wc.lpszClassName  = m_szHiddenWindowClass;

        if(!RegisterClass(&wc))
        {
            return NULL;
        }
    }

    m_hwndHidden = CreateWindowEx(  0,
                                    m_szHiddenWindowClass,
                                    NULL,
                                    WS_OVERLAPPED |
                                        0,
                                    CW_USEDEFAULT,
                                    CW_USEDEFAULT,
                                    CW_USEDEFAULT,
                                    CW_USEDEFAULT,
                                    NULL,
                                    NULL,
                                    m_hInst,
                                    (LPVOID)this);

    return m_hwndHidden;
}

[ste_ett]

"this" is a pointer to the current instance of the class.

"(LPVOID)" turns the pointer from a pointer to a class into a normal pointer. :)

[Remko]

Not sure I understand what you mean. Can you show me the Delphi translation?

[ste_ett]

Delphi-Quellcode:

m_hwndHidden := CreateWindowEx(  ...,
                            ...,


                                Self);

[Remko]

Thanks Stefan, you confirm what I made of it. On to the next one :-)

[Robert Marquardt]

The conversion of "(LPVOID) this" is "Pointer(Self)". _HiddenWindowProc receives a WM_CREATE message where the LParam points to a CREATESTRUCT structure. The lpCreateParams element of that structure is the value handed to CreateWindowEx. This allows to jump back into object land inside of _HiddenWindowProc function by casting the pointer back and then having access to the object again.

[Remko]

Thanks Robert, that makes it clear. (I understand now that I didn't take the most easy example to start with for a first conversion, but I'm learning not also the conversion itself but a lot more! But hey, I guess it's Luctor et Emergo!)

[Remko]

Just posting some progress (attached). I'm currently stuck at _HiddenWindowProc()

Code:

   CPropSheetHost *pThis = (CPropSheetHost*)((LONG_PTR)GetWindowLongPtr(hWnd, VIEW_POINTER_OFFSET));

    switch (uMessage)
    {
    case WM_NCCREATE:
        {
            LPCREATESTRUCT lpcs = (LPCREATESTRUCT)lParam;
            pThis = (CPropSheetHost*)(lpcs->lpCreateParams);
            ::SetWindowLongPtr(hWnd, VIEW_POINTER_OFFSET, (LONG)(LONG_PTR)pThis);

I'm going to stop for the moment, I was obviously too optimistic I'd be able to finish it today. Fröhliche Weihnachten und ein glückliches Neues Jahr to everyone here.

[Robert Marquardt]

Code:

   CPropSheetHost *pThis = (CPropSheetHost*)((LONG_PTR)GetWindowLongPtr(hWnd, VIEW_POINTER_OFFSET));

This is a local variable which is immediately initialized. GetWindowLongPtr supersedes GetWindowLong. You can use GetWindowLong instead.
The value pulled is the this or Self value handed in as parameter to CreateWindowEx.

Code:

    switch (uMessage)
    {
    case WM_NCCREATE:
        {
            LPCREATESTRUCT lpcs = (LPCREATESTRUCT)lParam;
            pThis = (CPropSheetHost*)(lpcs->lpCreateParams);
            ::SetWindowLongPtr(hWnd, VIEW_POINTER_OFFSET, (LONG)(LONG_PTR)pThis);

Now here the value is extracted from the CREATESTRUCT structure and stuffed into the extra data area of the window.
This works because WM_NCCREATE is about the first message received so the above variable initialization almost always pulls the value.
It just fails for WM_NCCREATE itself where it gets an uninitialized value, but in this case the variable is initialized from the CREATESTRUCT.
It is a bit overcoded and it contains a bug. The code is not 64 bit safe. (LONG)(LONG_PTR) is a double typecast which first casts the pointer to the type LONG_PTR. LONG_PTR can hold a 64 bit value. Unfortunately it is then casted to LONG which can hold only 32 bits. So the second typecast is actually a bug.

So this is just a trick to be always able to return to object land each time _HiddenWindowProc is called with a message.

Delphi-Quellcode:

var
  Form: TForm1; // or whatever type you have handed in to CreateWindowEx
begin
  Form := GetWindowLong(hWnd, VIEW_POINTER_OFFSET));
  case Msg of
    WM_NCCREATE:
      SetWindowLong(hWnd, VIEW_POINTER_OFFSET, LONG(LPCREATESTRUCT(lParam).lpCreateParams));

This is the trick in Delphi. You can of course drop all this and just access the global variable Form1 Delphi has created for you already.

[Remko]

OK, so:

Code:

LRESULT CALLBACK CPropSheetHost::_HiddenWindowProc( HWND hWnd,
                                                    UINT uMessage,
                                                    WPARAM wParam,
                                                    LPARAM lParam)
{
    CPropSheetHost *pThis = (CPropSheetHost*)((LONG_PTR)GetWindowLongPtr(hWnd, VIEW_POINTER_OFFSET));

    switch (uMessage)
    {
    case WM_NCCREATE:
        {
            LPCREATESTRUCT lpcs = (LPCREATESTRUCT)lParam;
            pThis = (CPropSheetHost*)(lpcs->lpCreateParams);
            ::SetWindowLongPtr(hWnd, VIEW_POINTER_OFFSET, (LONG)(LONG_PTR)pThis);
        }
        break;

    case WM_CREATE:
        break;

    case WM_DESTROY:
        break;

    case WM_ADSPROP_NOTIFY_CHANGE:
        OutputDebugString(TEXT("WM_ADSPROP_NOTIFY_CHANGE\n"));
        break;

    case WM_DSA_SHEET_CREATE_NOTIFY:
        {
            PDSA_SEC_PAGE_INFO pSecPageInfo;
            
            // Extract the secondary sheet information from the wParam.
            if(S_OK == pThis->_ExtractSecPageInfo(wParam, &pSecPageInfo))
            {
                // Create a secondary property sheet.
                pThis->_CreateSecondaryPropertySheet(pSecPageInfo);
            }
            else
            {
                // Even if the extraction failed, the wParam needs to be freed.
                pSecPageInfo = (PDSA_SEC_PAGE_INFO)wParam;
            }

            /*
            The receiver of the  message must free the DSA_SEC_PAGE_INFO 
            structure when it is no longer needed.
            */
            LocalFree(pSecPageInfo);
        }
        return 0;

    case WM_DSA_SHEET_CLOSE_NOTIFY:
        if(PROP_SHEET_HOST_ID == wParam)
        {
            OutputDebugString(TEXT("PROP_SHEET_HOST_ID\n"));
        }
        return 0;

    default:
        break;
    }

    return DefWindowProc(hWnd, uMessage, wParam, lParam);
}

Delphi-Quellcode:

function TPropSheetHost._HiddenWindowProc(hWnd: HWnd; Msg: UINT; WParam: WPARAM; LParam: LPARAM): UINT; stdcall;
var lpcs: TCreateStruct;
  PropSheetHost: TPropSheetHost;
  pSecPageInfo: PDSA_SEC_PAGE_INFO;
  begin
  PropSheetHost := TPropSheetHost(GetWindowLong(hWnd, VIEW_POINTER_OFFSET));
  case Msg of
    WM_NCCREATE: SetWindowLong(hWnd, VIEW_POINTER_OFFSET, LONG(LPCREATESTRUCT(lParam).lpCreateParams));
    WM_CREATE:;
    WM_DESTROY:;
    WM_ADSPROP_NOTIFY_CHANGE: OutputDebugString('WM_ADSPROP_NOTIFY_CHANGE'#10#13);
    WM_DSA_SHEET_CREATE_NOTIFY:
    begin
      // Extract the secondary sheet information from the wParam.
      if _ExtractSecPageInfo(wParam, pSecPageInfo) = S_OK then
      begin
        // Create a secondary property sheet.
        _CreateSecondaryPropertySheet(pSecPageInfo);
      end
      else begin
        // Even if the extraction failed, the wParam needs to be freed.
        pSecPageInfo := PDSA_SEC_PAGE_INFO(wParam);
      end;
      {*
      The receiver of the  message must free the DSA_SEC_PAGE_INFO
      structure when it is no longer needed.
      *}
      LocalFree(Cardinal(pSecPageInfo));
      Result := 0;
      Exit;
    end;
    WM_DSA_SHEET_CLOSE_NOTIFY:
    begin
      if PROP_SHEET_HOST_ID = wParam then
      begin
        OutputDebugString('PROP_SHEET_HOST_ID'#10#13);
      end;
      Result := 0;
    end;
  end;
  Result := DefWindowProc(hWnd, Msg, wParam, lParam);
end;

[Remko]

Is this translation correct?

Code:

HRESULT CPropSheetHost::_AddPagesForObject(IADs *padsObject)
{
    HRESULT hr;
    
    // Get a copy of our IDataObject.
    CComPtr<IDataObject> spDataObject;
    hr = this->QueryInterface(IID_IDataObject, (LPVOID*)&spDataObject);
    if(FAILED(hr))
    {
        return hr;
    }
    < CUT >

Delphi-Quellcode:

function TPropSheetHost._AddPagesForObject(hPage: HPROPSHEETPAGE; lParam: LPARAM): HRESULT;
var hr: HResult;
 spDataObject: IDataObject;

begin
  // Get a copy of our IDataObject.
  spDataObject := CreateComObject(IID_IDataObject) as IDataObject;
  hr := QueryInterface(IID_IDataObject, spDataObject);
  if Failed(hr) then
  begin
    Result := hr;
    Exit;
  end;
    < CUT >

Some other questions:
How to cast a WideString to PAnsiChar? //Edit: PAnsiChar := PChar(String(WideString));

Code:

    // Fill out the PROPSHEETHEADER structure.
    psh.dwSize           = sizeof(PROPSHEETHEADER);
    psh.dwFlags          = PSH_DEFAULT;
    psh.hwndParent       = m_hwndParent;
    psh.hInstance        = NULL;
    psh.pszIcon          = NULL;
    psh.pszCaption       = W2T(sbstrTemp);
    psh.nPages           = (UINT)m_rgPageHandles.GetSize();
    psh.phpage           = m_rgPageHandles.GetData();
    psh.pfnCallback      = NULL;

GetSize returns number of elements in array? --> psh.nPages := Length(m_rgPageHandles.GetSize)?
Getdata stores all members in a pointer? How to do this in Delphi? psh.u3.phpage := @m_rgPageHandles;?

Edit: adding one more question, how to convert this:

Code:

            LPBYTE pDest = (LPBYTE)*ppSecPageInfo;
            LPBYTE pSource = (LPBYTE)wParam;

            // Copy the original memory to the new block.
            CopyMemory(pDest + dwOffset, pSource, sizeOldSize);

This part CopyMemory(pDest + dwOffset will not work in Delphi. // EDIT: CopyMemory(PChar(pDest) + dwOffset, pSource, sizeOldSize); ?

Added code so far as attachment