uses
ActiveX;
const
CLSID_ApplicationAssociationRegistration: TGUID = '
{591209c7-767b-42b2-9fba-44ee4615f2c7}';
type
ASSOCIATIONTYPE = (AT_FILEEXTENSION, AT_URLPROTOCOL,
AT_STARTMENUCLIENT, AT_MIMETYPE);
ASSOCIATIONLEVEL = (AL_MACHINE, AL_EFFECTIVE, AL_USER);
IApplicationAssociationRegistration =
interface(IUnknown)
['
{4e530b0a-e611-4c77-a3ac-9031d022281b}']
function ClearUserAssociations: HRESULT;
stdcall;
function QueryAppIsDefault(pszQuery: PWideChar; atQueryType:
ASSOCIATIONTYPE; alQueryLevel: ASSOCIATIONLEVEL; pszAppRegistryName:
PWideChar;
var pfDefault: BOOL): HRESULT;
stdcall;
function QueryAppIsDefaultAll(alQueryLevel: ASSOCIATIONLEVEL;
pszAppRegistryName: PWideChar;
var pfDefault: BOOL): HRESULT;
stdcall;
function QueryCurrentDefault(pszQuery: PWideChar; atQueryType:
ASSOCIATIONTYPE; alQueryLevel: ASSOCIATIONLEVEL;
var ppszAssociation:
PWideChar): HRESULT;
stdcall;
function SetAppAsDefault(pszAppRegistryName: PWideChar; pszSet:
PWideChar; atSetType: ASSOCIATIONTYPE): HRESULT;
stdcall;
function SetAppAsDefaultAll(pszAppRegistryName: PWideChar):
HRESULT;
stdcall;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
pAAR: IApplicationAssociationRegistration;
sAssociation: PWideChar;
Res : HRESULT;
begin
Res := CoCreateInstance(CLSID_ApplicationAssociationRegistration,
nil, CLSCTX_INPROC, IApplicationAssociationRegistration, pAAR);
if SUCCEEDED(Res)
then
begin
pAAR.QueryCurrentDefault('
http', AT_URLPROTOCOL, AL_EFFECTIVE, sAssociation);
ShowMessage(sAssociation);
end;
end;