Mehrere Superbareinträge für ein Programm

[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.