[Delphi] property sheet handler crasht onder WinXP

[Tomatoman]

In Delphi heb ik volgens een voorbeeld uit het boek Delphi COM Programming een property sheet handler gemaakt, zie ook mijn posting hier. Die werkt prima onder alle Windows versies, behalve onder Windows XP. Als ik het dialoogvenster 'Eigenschappen' voor precies 1 bestand selecteer, crasht de Explorer. Als ik meer dan 1 bestand selecteer, gaat alles goed. Nogmaals, dit probleem doet zich alleen onder Windows XP voor.

Ik heb de auteur van het boek het probleem voorgelegd. Hij kende het nog niet en wist ook geen oplossing. Dat moeten wij tweakers toch beter kunnen . Heeft iemand een idee waarom deze shell extensie de explorer laat crashen onder Windows XP? Beter nog, heeft iemand een workaround?

Ik heb de code helemaal uitgekleed tot de bare essentials, maar hij crasht nog steeds als je precies 1 bestand in de Explorer selecteert. Het probleem treedt trouwens op nadat de finalization-sectie van de code is uitgevoerd.

code:

unit PropSheet;

interface

uses
  Windows, ActiveX, Classes, ComObj, CommCtrl, ShlObj, SysUtils, Messages,
  Dialogs, ComCtrls, Graphics, ExtCtrls;

type
  TStrucStorSheet = class(TComObject, IShellExtInit, IShellPropSheetExt)
  private
    function IShellExtInit.Initialize = InitShellExtension;
  protected
    { IShellExtInit }
    function InitShellExtension(pidlFolder: PItemIDList; lpdobj: IDataObject;
      hKeyProgID: HKEY): HResult; stdcall;
    { IShellPropSheetExt }
    function AddPages(lpfnAddPage: TFNAddPropSheetPage;
      lParam: LPARAM): HResult; stdcall;
    function ReplacePage(uPageID: UINT; lpfnReplaceWith: TFNAddPropSheetPage;
      lParam: LPARAM): HResult; stdcall;
  end;

  TPropertySheetFactory = class(TComObjectFactory)
  public
    procedure UpdateRegistry(Register: Boolean); override;
  end;

const
  Class_StrucStorSheet: TGUID = '{5C497E69-6636-4E4B-9EA8-5BEC5F409109}';

implementation

uses ComServ, ShellAPI, AxCtrls, ResStrings;

const
  IDD_STRUCSTOR  = 100;  // dialog

{$R StrucStor.RES}

function PropertySheetDlgProc(hDlg: HWND; uMessage: UINT;
  wParam: WPARAM; lParam: LPARAM): Boolean; stdcall;
var
  psp: PPropSheetPage;
  Sheet: TStrucStorSheet;
begin
  Result := True;

  case uMessage of
    WM_INITDIALOG: begin
      psp := PPropSheetPage(lParam);
      Sheet := TStrucStorSheet(psp.lParam);
      // hier code om wat met de property sheet page te doen
    end;
    else
      Result := False;
  end;
end;

function PropertySheetCallback(hWnd: HWND; uMessage: UINT;
  var psp: TPropSheetPage): UINT; stdcall;
begin
  case uMessage of
    PSPCB_RELEASE:
      if psp.lParam <> 0 then
        { Allow the class to be released. }
        TStrucStorSheet(psp.lParam)._Release;
  end;
  Result := 1;
end;

{ TStrucStorSheet }

function TStrucStorSheet.InitShellExtension(pidlFolder: PItemIDList;
  lpdobj: IDataObject; hKeyProgID: HKEY): HResult; stdcall;
begin
  Result := NOERROR;
end;

function TStrucStorSheet.AddPages(lpfnAddPage: TFNAddPropSheetPage;
  lParam: LPARAM): HResult;
var
  psp: TPropSheetPage;
  hPage: HPropSheetPage;
begin
  FillChar(psp, SizeOf(psp), 0);
  psp.dwSize := SizeOf(psp);
  psp.dwFlags := PSP_USETITLE or PSP_USECALLBACK;
  psp.hInstance := HInstance;
  psp.pszTemplate := MAKEINTRESOURCE(IDD_STRUCSTOR);
  psp.pszTitle := PChar(PageTitle);
  psp.pfnDlgProc := @PropertySheetDlgProc;
  psp.pfnCallback := @PropertySheetCallback;
  psp.lParam := Integer(Self);   // points to the TStrucStorSheet instance

  hPage := CreatePropertySheetPage(psp);

  if hPage <> nil then
    if not lpfnAddPage(hPage, lParam) then
      DestroyPropertySheetPage(hPage);

  { Prevent the class from being destroyed before the COM server is destroyed. }
  _AddRef;

  Result := NOERROR;
end;

function TStrucStorSheet.ReplacePage(uPageID: UINT;
  lpfnReplaceWith: TFNAddPropSheetPage; lParam: LPARAM): HResult;
begin
  Result := E_NOTIMPL;
end;

{ TPropertySheetFactory }

procedure TPropertySheetFactory.UpdateRegistry(Register: Boolean);
const
  Key = '*\shellex\PropertySheetHandlers\';
begin
  inherited UpdateRegistry(Register);
  if Register then
    CreateRegKey(Key + ClassName, '', GUIDToString(ClassID))
  else
    DeleteRegKey(Key + ClassName);
end;

initialization
  TPropertySheetFactory.Create(ComServer, TStrucStorSheet, Class_StrucStorSheet,
    'StrucStorSheet', Description, ciMultiInstance, tmApartment);
finalization
  // de Explorer crasht pas als dit punt in de code gepasseerd is.
end.

[jopiek]

is wel zo specifiek! ik denk dat je dit probleem eens bij M$ moet voorleggen, ligt waarschijnlijk aan exploder zo te lezen...

[LordLarry]

tomatoman schreef op 13 augustus 2002 @ 22:46:
Het probleem treedt trouwens op nadat de finalization-sectie van de code is uitgevoerd.

Zet de Debug DCU's eens aan? Het ligt dan waarschijnlijk in 1 van de finalizations in de andere units

[Anoniem: 62306]

Misschien kun je een breakpoint in de finalization zetten en dan in de CPU view verder stappen om te kijken waar de crash precies plaats vindt? Misschien krijg je dan een idee. In eerste instantie zou ik denken dat het met de reference counting te maken heeft.