Probleme mit Plugable Protocol

[Thebe]

Hiho

Ich versuch gerade mit nen eigenes Protokoll zusammenzubasteln, weil ich damit für diverse Projekte u.A. nem Werbungsfilter Protokoll was anfangen möchte.

Ich hab mir dazu folgende Seiten angeguckt:

http://www.oligo.dk/iedelphi/toolbox/ierestool.htm
http://www.codeguru.com/Cpp/COM-Tech...rticle.php/c37 (ist zwar ATL, ka was das is aber ich konnte es übersetzen)

Das Protokoll soll folgendes machen: wenn ich z.b. im Browser eintippe "siel://www.google.de" dann soll das Ding ERSTMAL die Daten von http://www.google.de holen und dann dem Browser präsentieren, später soll die Informationen vorm Präsentieren durchgefiltert werden auf Werbung usw.

DLL hab ich registriert gekriegt, sie läuft auch im Hintergrund nur wenn ich im Browser "siel://www.google.de" eingebe, dann kommt nur ne Fehlermeldung das der Browser "shell://www.google.de" nicht finden kann.

Hat da wer ne Ahnung von den Plugable Protocols ? Ich hab atm nicht mehr wirklich den Überblick.

Mal der Source zum reinziehen und mich anmeckern:

DLL Project File

Delphi-Quellcode:

library ppt_dll;

uses
  ComServ,
  ProtocolUnit in 'ProtocolUnit.pas';

{$R *.res}

exports
  DllGetClassObject,
  DllCanUnloadNow,
  DllInstall,
  DllRegisterServer,
  DllUnregisterServer;

begin
end.

ProtocolUnit.pas

Delphi-Quellcode:

unit ProtocolUnit;

interface

uses
 Comserv, Registry, SysUtils, ComObj, Classes, AxCtrls, Windows, ActiveX,
 Urlmon, WinInet;

const
  Class_SIELProtocol: TGUID = '{00864000-0246-0746-C834-016734946546}';
  AgentName: pchar = 'Plugable';

type
  TSIELProtocolFactory = class(TComObjectFactory)
  private
    procedure AddKeys;
    procedure RemoveKeys;
  public
    procedure UpdateRegistry(Register: Boolean); override;
  end;

  TSIELProtocol = class(TComObject, IInternetProtocol)
  private
    hHttpSession: HINTERNET;
    hInternetSession: HINTERNET;

    pProtSink: IInternetProtocolSink;
    pBindInfo: IInternetBindInfo;

  protected
    function Start(szUrl: LPCWSTR; OIProtSink: IInternetProtocolSink;
      OIBindInfo: IInternetBindInfo; grfPI, dwReserved: DWORD): HResult; stdcall;
    function Abort(hrReason: HResult; dwOptions: DWORD): HResult; stdcall;
    function Read(pv: Pointer; cb: ULONG; out cbRead: ULONG): HResult; stdcall;

    function Continue(const ProtocolData: TProtocolData): HResult; stdcall;
    function Terminate(dwOptions: DWORD): HResult; stdcall;
    function Suspend: HResult; stdcall;
    function Resume: 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;

var
  Factory: IClassFactory;
  fac: TSIELProtocolFactory;
  InternetSession: IInternetSession;


procedure InternetStatusCallback(hSession: HINTERNET; Context: DWORD; Status: DWORD; pInformation: Pointer; InfoLength: DWORD ); stdcall;
procedure RegisterSIELProtocol;
procedure UnRegisterSIELProtocol;

procedure DllInstall; stdcall;

implementation

procedure InternetStatusCallback(hSession: HINTERNET;
  Context, Status: DWORD; pInformation: Pointer; InfoLength: DWORD);
var
  pClass: TSIELProtocol;
begin
  pClass := TObject(Pointer( Context )) as TSIELProtocol;

  case Status of
    INTERNET_STATUS_HANDLE_CREATED: pClass.hHttpSession := HINTERNET(pInformation^);
    INTERNET_STATUS_REQUEST_COMPLETE: pClass.pProtSink.ReportData(BSCF_DATAFULLYAVAILABLE, 100, 100);
  end;
end;

procedure RegisterSIELProtocol;
begin
  CoGetClassObject(Class_SIELProtocol, CLSCTX_SERVER, nil, IClassFactory, Factory);
  CoInternetGetSession(0, InternetSession, 0);
  InternetSession.RegisterNameSpace(Factory, Class_SIELProtocol, 'SIEL', 0, nil, 0);

 // WriteLn(' Registered');
end;

procedure UnRegisterSIELProtocol;
begin
  InternetSession.UnregisterNameSpace(Factory, '[NAME]');
end;

{ TSIELProtocolFactory }

procedure TSIELProtocolFactory.UpdateRegistry(Register: Boolean);
begin
  inherited UpdateRegistry(Register);
  if Register then AddKeys else RemoveKeys;

  //WriteLn(' TSIELProtocolFactory.UpdateRegistry()');
end;

procedure TSIELProtocolFactory.AddKeys;
var S: string;
begin
  S := GUIDToString(CLASS_SIELProtocol);
  with TRegistry.Create do
  try
    RootKey := HKEY_CLASSES_ROOT;
    if OpenKey('PROTOCOLS\Handler\SIEL', True) then
    begin
      WriteString('', 'SIEL');
      WriteString('CLSID', S);
      CloseKey;
    end;
  finally
    Free;
  end;

 // WriteLn(' Added Reg Keys');
end;

procedure TSIELProtocolFactory.RemoveKeys;
var S: string;
begin
  S := GUIDToString(CLASS_SIELProtocol);
  with TRegistry.Create do
  try
    RootKey := HKEY_CLASSES_ROOT;
    DeleteKey('PROTOCOLS\Handler\SIEL');
  finally
    Free;
  end;

//  WriteLn(' Removed Reg Keys');
end;

{ TSIELProtocol }

function TSIELProtocol.Abort(hrReason: HResult; dwOptions: DWORD): HResult;
begin
  InternetSetStatusCallback( hInternetSession, nil );

  if ( hHttpSession <> nil ) then
  begin
    InternetCloseHandle( hHttpSession );
    hHttpSession := nil;
  end;

  if ( hInternetSession <> nil ) then
  begin
    InternetCloseHandle( hInternetSession );
    hInternetSession := nil;
  end;

  result := S_OK;
  exit;
end;

function TSIELProtocol.Continue(
  const ProtocolData: TProtocolData): HResult;
begin
  Result := S_OK;
end;

function TSIELProtocol.LockRequest(dwOptions: DWORD): HResult;
begin
  Result := S_OK;
end;

function TSIELProtocol.Read(pv: Pointer; cb: ULONG;
  out cbRead: ULONG): HResult;
var
  status: boolean;
  error: cardinal;
begin
  status := InternetReadFile( hHttpSession, pv, cb, cbRead );

  if ( not Status ) then
  begin
    error := GetLastError;
  //  WriteLn('--Error = '+IntToStr(error) );
    result := INET_E_DOWNLOAD_FAILURE;
    exit;
  end
  else
    if ( cbRead = cb ) then
    begin
      result := S_OK;
      exit;
    end;

  result := S_FALSE;
  exit;
end;

function TSIELProtocol.Resume: HResult;
begin
  Result := S_OK;
end;

function TSIELProtocol.Seek(dlibMove: LARGE_INTEGER; dwOrigin: DWORD;
  out libNewPosition: ULARGE_INTEGER): HResult;
begin
  Result := S_OK;
end;

function TSIELProtocol.Start(szUrl: LPCWSTR;
  OIProtSink: IInternetProtocolSink; OIBindInfo: IInternetBindInfo; grfPI,
  dwReserved: DWORD): HResult;
begin
 // WriteLn('TSIELProtocol.Start()');

  pProtSink := OIProtSink;
  pBindInfo := OIBindInfo;

  hInternetSession := InternetOpen( AgentName, INTERNET_OPEN_TYPE_DIRECT, nil, nil, INTERNET_FLAG_ASYNC );

  if ( hInternetSession = nil  ) then
  begin
   // WriteLn('--InternetOpen() failed');
    result := S_FALSE;
    exit;
  end
  else
   // WriteLn('--InternetOpen() success');

  InternetSetStatusCallback( hInternetSession, @InternetStatusCallback );

  InternetOpenUrl( hInternetSession, 'http://www.google.de', nil, 0, INTERNET_FLAG_RELOAD, Cardinal(Pointer(self)) );

  result := S_OK;
  exit;
end;

function TSIELProtocol.Suspend: HResult;
begin
  Result := S_OK;
end;

function TSIELProtocol.Terminate(dwOptions: DWORD): HResult;
begin
  Result := S_OK;
end;

function TSIELProtocol.UnlockRequest: HResult;
begin
  Result := S_OK;
end;

procedure DllInstall; stdcall;
begin
    TSIELProtocolFactory.Create(ComServer, TSIELProtocol, Class_SIELProtocol,
      'SIELProtocol', '', ciMultiInstance, tmApartment);

    RegisterSIELProtocol;
end;

end.

Vielen Dank schon mal im Vorraus

- Thebe