How can I implement IServiceProvider?

How can I implement IServiceProvider in the class which I inherit other interfaces from so their methods actually get called? Right now I always get E_NOINTERFACE back from QueryInterface.

    TPassthrough = class(TComObject, IInternetProtocolRoot, IInternetProtocolSink, IInternetProtocol, IServiceProvider)
    private
      FDefaultSink: IInternetProtocol;
      FProtSink: IInternetProtocolSink;
      FBindInfo: IInternetBindInfo;
    public
    { IServiceProvider }
    function QueryService(const rsid, iid: TGuid; out Obj): HResult; stdcall;

    { IInternetProtocolSink }
    function Switch(const ProtocolData: TProtocolData): HResult; stdcall;
    function ReportProgress(ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult; stdcall;
    function ReportData(grfBSCF: DWORD; ulProgress, ulProgressMax: ULONG): HResult; stdcall;
    function ReportResult(hrResult: HResult; dwError: DWORD; szResult: LPCWSTR): HResult; stdcall;

    { IInternetProtocolRoot }
    function Start(szUrl: LPCWSTR; OIProtSink: IInternetProtocolSink; OIBindInfo: IInternetBindInfo; grfPI, dwReserved: DWORD): HResult; stdcall;
    function Continue(const ProtocolData: TProtocolData): HResult; overload; stdcall;
    function Abort(hrReason: HResult; dwOptions: DWORD): HResult; stdcall;
    function Terminate(dwOptions: DWORD): HResult; stdcall;
    function Suspend: HResult; stdcall;
    function Resume: HResult; stdcall;

    { IInternetProtocol }
    function Read(pv: Pointer; cb: ULONG; out cbRead: ULONG): HResult; stdcall;
    function Seek(dlibMove: LARGE_INTEGER; dwOrigin: DWORD; out libNewPosition: ULARGE_INTEGER): HResult; stdcall;
    function LockRequest(dwOptions: DWORD): HResult; stdcall;
    function UnlockRequest: HResult; stdcall;
    end;

...

function TPassthrough.Start(szUrl: LPCWSTR; OIProtSink: IInternetProtocolSink; OIBindInfo: IInternetBindInfo; grfPI, dwReserved: DWORD): HResult; stdcall;
begin
  if (FDefaultSink = nil) then
  OleCheck(CoCreateInstance(CLSID_HttpProtocol, nil, CLSCTX_INPROC_SERVER, IUnknown, FDefaultSink));

  FBindInfo := OIBindInfo;
  FProtSink := OIProtSink;

  if (Assigned(FDefaultSink)) then
    Result := (FDefaultSink as IInternetProtocolRoot).Start(szUrl, Self, Self, grfPI, dwReserved)
  else
    Result := E_NOTIMPL;
end; 

function TPassthrough.QueryService(const rsid, iid: TGuid; out Obj): HResult; stdcall;
begin
  Result := E_NOINTERFACE;
  Pointer(Obj) := nil;

  if Succeeded(QueryInterface(rsid, Obj)) and
    Assigned(Pointer(Obj))
  then
    Result := S_OK;
end; 

The purpose of QueryService is different from the purpose of QueryInterface.

QueryService should return a pointer to the object itself if it provides the requested service (through rsid), otherwise it should delegate to some other object, typically a container and with another QueryService call.

If no such service is found, it should return E_NOTIMPL.

The returned interface pointer will be of the requested type (through iid), so if the service is found, the object that implements the service is finally QueryInterfaced.

If no such interface is implemented by the object, it should return E_NOINTERFACE.

It so happens that many service IDs (SID) are the same GUID as the typically implemented interface ID (IID), for instance, SID_SInternetSecurityManager and IID_IInternetSecurityManager. Although this is a widely used convention, it is not a rule. For instance, you can ask for the SID_SWebBrowserApp service as a IID_IWebBrowser2 interface pointer.

So, analysing your original code:

function TPassthrough.QueryService(const rsid, iid: TGuid; out Obj): HResult; stdcall;
begin
  Result := E_NOINTERFACE;
  Pointer(Obj) := nil;

  if Succeeded(QueryInterface(rsid, Obj)) and
    Assigned(Pointer(Obj))
  then
    Result := S_OK;
end;

You're kind of just transforming QueryService into QueryInterface using a service ID (rsid), which is similar but not necessarily related to interface IDs (iid). As such, if the two differ, the caller may get an incompatible interface pointer.

Then, the changed code:

function TMonitor.QueryService(const rsid, iid: TGuid; out Obj): HResult; stdcall;
begin
  Result := E_NOINTERFACE;
  Pointer(Obj) := nil;

  if Succeeded(QueryInterface(iid, Obj)) and
    Assigned(Pointer(Obj))
  then
    Result := S_OK;
end;

This is saying that the object implements every imaginable service, so it merely delegates to QueryInterface, but at least correctly with iid.

This is what you should do:

function TMonitor.QueryService(const rsid, iid: TGuid; out Obj): HResult; stdcall;
begin
  if Not Assigned(@Obj) then
  begin
    Result := E_POINTER;
    Exit;
  end;

  Pointer(Obj) := nil;
  Result := E_NOTIMPL;

  if Assigned(FServiceProvider) then
    Result := FServiceProvider.QueryService(rsid, iid, Obj);
end;

Should you want to provide your own services, you can optionally use the following code:

function TMonitor.QueryService(const rsid, iid: TGuid; out Obj): HResult; stdcall;
begin
  if Not Assigned(@Obj) then
  begin
    Result := E_POINTER;
    Exit;
  end;

  Pointer(Obj) := nil;
  Result := E_NOTIMPL;

  if IsEqualGUID(rsid, SID_SOverrideService1) or
     IsEqualGUID(rsid, SID_SOverrideService2)
  then
    Result := QueryInterface(iid, Obj);

  if Result = E_NOTIMPL and
     Assigned(FServiceProvider)
  then
    Result := FServiceProvider.QueryService(rsid, iid, Obj);

  if Result = E_NOTIMPL and
     (IsEqualGUID(rsid, SID_SFallbackService1) or
      IsEqualGUID(rsid, SID_SFallbackService2))
  then
    Result := QueryInterface(iid, Obj);
end;

Where SID_OverrideServiceN are the service IDs you want to override and SID_FallbackServiceN are the service IDs you want to fallback to. Note that I changed Succeeded(Result) to Result <> E_NOTIMPL, because I don't want to keep looking for services if one was actually found but some other error happened, e.g. the requested interface was not implemented (E_NOINTERFACE).