AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Probleme mit Plugable Protocol

Ein Thema von Thebe · begonnen am 4. Jan 2006 · letzter Beitrag vom 20. Sep 2007
Antwort Antwort
Thebe

Registriert seit: 25. Jul 2004
Ort: Wedel
78 Beiträge
 
Delphi 6 Enterprise
 
#1

Probleme mit Plugable Protocol

  Alt 4. Jan 2006, 18:57
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
  Mit Zitat antworten Zitat
Benutzerbild von TKC
TKC

Registriert seit: 21. Apr 2004
Ort: Tuningen
367 Beiträge
 
Delphi XE2 Enterprise
 
#2

Re: Probleme mit Plugable Protocol

  Alt 5. Jan 2006, 02:15
Hi,

also für das was du machen möchtest ist wohl ein Pluggable Mime Filter das richtige....

Ich habe selbst so einen im einsatz (um mein ogame zu erweitern ) ... quellcodes findest du hier IE Delphi


greez
  Mit Zitat antworten Zitat
Thebe

Registriert seit: 25. Jul 2004
Ort: Wedel
78 Beiträge
 
Delphi 6 Enterprise
 
#3

Re: Probleme mit Plugable Protocol

  Alt 5. Jan 2006, 02:48
JAWOLL!

Das is genau das was ich gesucht habe, das passt sogar auch für nen BrowerGame bei mir. Danke Dir.

- Thebe
  Mit Zitat antworten Zitat
dtrace

Registriert seit: 7. Jan 2003
Ort: Gevelsberg
94 Beiträge
 
Delphi 2006 Enterprise
 
#4

Re: Probleme mit Plugable Protocol

  Alt 20. Sep 2007, 16:44
Ich benötige auch diesen Quelltext
Dennis van der Vlugt
  Mit Zitat antworten Zitat
Antwort Antwort


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 11:56 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz