Mehrere Superbareinträge für ein Programm

[Hedge]

Ich möchte das ein Programm mehrere Einträge in der Superbar haben kann.
Laut diesem Blogpost (Figure 3) geht das via
SHGetPropertyStoreForWindow.

Dazu habe ich den Code unten gefunden.
Der macht aber an allen Ecken und Enden Ärger.
Es beginnt damit, dass ich nicht finde in welcher Unit IPropertyStore und tPROPVARIANT deklariert werden.

Delphi-Quellcode:

function SHGetPropertyStoreForWindow(
  hwnd: HWND;
  const riid: TGUID;
  out ppv: IPropertyStore
): HResult; stdcall;

procedure TForm2.SetAppID(aHWND: hWnd; aAppID: string);
var pps,propsys:IPropertyStore ;
pv:tPROPVARIANT;
hr:HRESULT;
begin
 hr:= SHGetPropertyStoreForWindow (self.Handle , IID_IPropertyStore  ,@pps) ;
 if  Succeeded( hr) then
   begin
     if aAppID <>'' then
       begin
         hr:= InitPropVariantFromString(aAppID ,pv);
       end
       else
       ZeroMemory(@pv,SizeOf(pv));
       if Succeeded(hr) then
         begin
           pps.SetValue(PKEY_AppUserModel_ID,pv);
           PropVariantClear(@pv);
         end;
   end;
end;

[himitsu]

Zitat von Hedge:

Es beginnt damit, dass ich nicht finde in welcher Unit IPropertyStore und tPROPVARIANT deklariert werden.

Strg+Shift+F
und als Suchverzeichnis sowas wie
C:\Programme\Embarcadero\RAD Studio\6.0
(ab Delphi 2010 macht sich "*.pas;*.inc" als Dateifilter geschwindigkeitsmäßig nicht schlecht)

Aber mir ist so, als wenn sowas auch ohne Win7-API schon unter XP, 2K und Co. ging.


Was passiert hier denn unter Win7?

Delphi-Quellcode:

with TForm1.Create(nil) do
begin
  SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_APPWINDOW);
  Show;
end;

Unter XP seh ich einen 2. Eintrag.
Es entspricht praktisch der Umkehrung des anderen beliebten Themas "TaskBar Eintrag entfernen".

[Hedge]

@himitsu:
Danke fürs Nachschauen.
SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_APPWINDOW); funktioniert.
Beide Superbareinträge werden aber gruppiert. Ich will zwei Superbareinträge nebeneinander erzeugen.
Da scheint SHGetPropertyStoreForWindow der einzige Weg zu sein.

Also wieder zu der Lösung:

Das mit dem Find in Files war natürlich sehr gut.
Habe folgendes gefunden.

IPropertyStore gibt es in PropSys
tPROPVARIANT in ActiveX und
PKEY_AppUserModel_ID in PropKey



Die PropVariantclear wird aus der Ole32.dll dynamisch gelinkt:
function PropVariantClear(pvar: PPropVariant): HRESULT; stdcall; external 'ole32.dll';

Wie mach ich das für die InitPropVariantFromString deren Syntax so beschrieben ist in MSDN ?:

Code:

HRESULT InitPropVariantFromString(
  __in   PCWSTR psz,
  __out  PROPVARIANT *ppropvar
);

[himitsu]

Zitat von Hedge:

Beide Superbareinträge werden aber gruppiert.

Nja, in Vista werden diese Einträge standardmäßig gruppiert (sowas hab ich bei mir immer deaktiviert).

Es kann natürlich sein, daß man über die Win7-API dieses Verhalten umgehen kann, aber wissen tu ich das natürlich nicht.

Delphi-Quellcode:

function InitPropVariantFromString(psz: PWideChar; propvar: PPropVariant): HRESULT;
//und vermutlich noch ein
stdcall; external 'ole32.dll';

aber so (ein bissl delphitypischer) gefällt es mir besser und es sollte auch offensichtlicher sein), wobei satt dem OUT eigentlich ein VAR hinpaßt, paßt es hier dennoch besser

Delphi-Quellcode:

function InitPropVariantFromString(psz: PWideChar; out propvar: TPropVariant): HRESULT; stdcall; 
  external 'ole32.dll';

- die Typen übersetzen ist eigentlich recht einfach
- fast alle dieser WinAPIs nutzen STDCALL als Aufrufkonvention
- nja, und dann braucht man nur noch die nötige DLL

Bei der DLL bin ich mir nicht sicher. (notfalls kann man auch mal die propsys.dll aus der propsys.pas probieren)
Normaler Weise kann man diesen aus den Requirements im MSDN erkennen, aber hier klappt das irgendwie nicht. (meißtens heißt die Header-Datei wie die zugehörige DLL)
Man könnte sich auch mal das Windows-PSDK runterladen und könnte dort in die Heder (also in die erwähnte Propvarutil.h) reinschauen. (hab das nur nich hier installiert)

[Hedge]

An das PSDK habe ich auch gedacht.
Ohje...jetzt kompiliert es zwar durch, aber wird sofort ohne Fehlermeldung beendet.
Wie kann ich dem Fehler auf die Schliche kommen?

Delphi-Quellcode:

function PropVariantClear(pvar: PPropVariant): HRESULT; stdcall; external 'ole32.dll';
function InitPropVariantFromString(psz: PWideChar; out  propvar: TPropVariant): HRESULT; stdcall; external 'ole32.dll';
function SHGetPropertyStoreForWindow(hwnd: HWND; const riid: TGUID; out ppv: IPropertyStore): HRESULT; stdcall; external 'Shell32.dll';


procedure TForm2.SetAppID(aHWND: hWnd; aAppID: string);
var pps,propsys:IPropertyStore ;
pv:tPROPVARIANT;
hr:HRESULT;
begin
 hr:= SHGetPropertyStoreForWindow (self.Handle , IID_IPropertyStore  ,pps) ;
 if  Succeeded( hr) then
   begin
     if aAppID <>'' then
       begin
         hr:= InitPropVariantFromString(PWideChar(aAppID) ,pv);
       end
       else
       ZeroMemory(@pv,SizeOf(pv));
       if Succeeded(hr) then
         begin
           pps.SetValue(PKEY_AppUserModel_ID,pv);
           PropVariantClear(@pv);
         end;
   end;
end;

[himitsu]

Zitat von Hedge:

Wie kann ich dem Fehler auf die Schliche kommen?

Debuggen?

[Hedge]

Es liegt an
hr:= InitPropVariantFromString(PWideChar(aAppID) ,pv);

Problem ist, dass die Funktion SetAppID nicht mal ausgeführt wird und es somit auch nix bringt einen Haltepunkt darauf zu setzen.

[Björn Ole]

Stand auch eben vor dem Problem und wollte der Vollständigkeit halber mal eine funktionierende Lösung posten. So läufts:

Delphi-Quellcode:

unit uAppID;

interface

uses
  Windows,
  ActiveX,
  PropSys,
  PropKey;

function GetAppID(AHandle: THandle): string;
function SetAppID(AHandle: THandle; const AAppID: string): boolean;

implementation

function SHGetPropertyStoreForWindow(hwnd: hwnd; const riid: TGUID; out ppv: IPropertyStore)
  : HRESULT; stdcall; external 'shell32.dll';

function GetAppID(AHandle: THandle): string;
var
  hr: HRESULT;
  pps: IPropertyStore;
  v: TPropVariant;
begin
  hr := SHGetPropertyStoreForWindow(AHandle, IID_IPropertyStore, pps);
  if Succeeded(hr) then
  begin
    pps.GetValue(PKEY_AppUserModel_ID, v);
    result := v.bstrVal;
  end
  else
    result := '';
end;

function SetAppID(AHandle: THandle; const AAppID: string): boolean;
var
  hr: HRESULT;
  pps: IPropertyStore;
  v: TPropVariant;
begin
  hr := SHGetPropertyStoreForWindow(AHandle, IID_IPropertyStore, pps);
  if Succeeded(hr) then
  begin
    v.vt := VT_BSTR;
    v.bstrVal := SysAllocString(PChar(AAppID));
    result := pps.SetValue(PKEY_AppUserModel_ID, v) = S_OK;
  end
  else
    result := false;
end;

end.