Delphi - Új internet protokoll létrehozása

A mellékelt példa kipróbálásához a következő lépésekre van szükség:

nyissa meg és fordítsa le a mellékelt DSOProtocol.dpr-t
válassza a Run - Register ActiveX Server menüpontot
kattintson a mellékelt DSOProtocol.reg állományra és telepítse azt
ezek után indítson el egy böngészőt és írja be a dso://www.XXX.hu címet, ahol az XXX egy tetszőleges cím lehet. Mivel a mellékelt példa teljes mértékben szimulálja a http protokollt, így a dso:// használata egyezik a http:// használatával.

A példa eltávolításához a rendszerből a következő lépésekre van szükség:

nyissa meg a mellékelt DSOProtocol.dpr-t
válassza a Run - UnRegister ActiveX Server menüpontot
nyissa meg a regisztrációs adatbázist (pl.: RegEdit.exe)
a HKEY_CLASSES_ROOT fő kulcson belül törölje a PROTOCOLS\Handler címen a DSO kulcsot (Vigyázzon, hogy mást itt ne töröljön le, mivel ez a gép további működését jelentősen befolyásolhatja!)

A megvalósításhoz - mint az már sejthető - egy COM objektumra lesz szükségünk. Ezen belül pedig az IInternetprotocol, IInternetProtocolSink és a IInternetBindInfo interfészeket kell felhasználnunk a megvalósításhoz.

Amint azt már említettük a mellékelt példa teljes mértékben a http protokoll műveleteit valósítja meg és semmi újat nem tesz hozzá. Ezek alapján viszont már könnyedén készíthetünk olyan protokollt mely számtalan új funkcióval rendelkezik, akár csak az események naplózását, akár új funkciók megvalósítását vesszük figyelembe.

Nézzük most a megvalósítás lépéseit:
Válasszuk a File - New menüpontot majd az ActiveX lapon az ActiveX Library elemet. A COM objektum létrehozásához ismét a File - New menüpont, majd az ActiveX lapon a COM Object elemet. Ezek után adjuk meg egy új nevet a létrehozandó objektumnak, kapcsoljuk ki a Type Library-t és adjuk meg a fenti három implementálandó interfész nevét.

Ezek után megjelenik a COM objektumunk forráskódja, melynek most így kell kinéznie:

type
  TDSOProtocolClass = class(TComObject, IInternetProtocol, 
             IInternetProtocolSink, IInternetBindInfo)
  private
{Declare IInternetBindInfo methods here}
{Declare IInternetProtocolSink methods here}
{Declare IInternetProtocol methods here}
  end;

Ezek után ki kell egészítenünk az implementált interfészek metódusaival a fenti deklarációt.

type
  TDSOProtocolClass = class(TComObject, IInternetProtocol,
       IInternetProtocolSink, IInternetBindInfo)
  private
    FInternetProtocolSink: IInternetProtocolSink;
    FInternetBindInfo: IInternetBindInfo;
    FInternetProtocol: IInternetProtocol; 

{Declare IInternetBindInfo methods here}
    function GetBindInfo(out grfBINDF: DWORD;
           var bindinfo: TBindInfo): HResult; stdcall;
    function GetBindString(ulStringType: ULONG; wzStr:
          POLEStrArray; cEl: ULONG; var cElFetched: ULONG):
          HResult; stdcall;

{Declare IInternetProtocolSink methods here}
    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;

{Declare IInternetprotocol methods here}
    function Start(szUrl: LPCWSTR; OIProtSink:
         IInternetProtocolSink; OIBindInfo: 
         IInternetBindInfo; grfPI, dwReserved: DWORD):
         HResult; stdcall;
    function Continue(const ProtocolData: TProtocolData): 
          HResult; stdcall;
    function Abort(hrReason: HResult; dwOptions: DWORD):
          HResult; stdcall;
    function Terminate(dwOptions: DWORD): HResult; stdcall;
    function Suspend: HResult; stdcall;
    function Resume: HResult; stdcall;
    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;

  public
    function ObjQueryInterface(const IID: TGUID; out Obj):
           HResult; override; stdcall;
    procedure Initialize; override;

  end;

Az interfészek metódusain kívül szükségünk lesz az Initialize és a ObjQueryInterface metódusok felülírására is.

Az Initialize-vel kezdődik a munkánk, mivel a DLL-ünk indulásakor ez kerül meghívásra és nekünk itt kell egy http protokollt megvalósító példányt létrehoznunk és tárolnunk a globális FInternetProtocol változóba. Tesszük ezt azért, mert mellékelt példánk a http protokollt valósítja meg és ezt legegyszerűbben nyilván úgy tudjuk, ha rendelkezésünkre áll egy objektum mely képes erre.

procedure TDSOProtocolClass.Initialize;
begin
  inherited;
  if FInternetProtocol=nil then begin
    CoCreateInstance(Class_HttpProtocol, IUnknown(Self),
      CLSCTX_INPROC_SERVER, IUnknown, FInternetProtocol);
  end;
end;

Nézzük most az IInternetProtocol interfészt. Ezen belül is kezdjük a Start függvénnyel, mivel a protokoll használatának megkezdése is itt fog indulni. A függvény paramétereként megkapjuk a másik két szükséges interfész (IInternetProtocolSink, IInternetBindInfo) egy-egy példányát az OIProtSink és az OIBindInfo nevű paraméterben. Ezeket eltároljuk a globális változóinkban későbbi felhasználásra.
Az szUrl paraméterben megkapjuk a kért url teljes sztringjét. Ezt akár naplózhatnánk, ellenőrizhetnénk, megváltoztathatnánk, stb. Mivel most mi a http protokollt kell hogy szimuláljuk, így a dso://www.akarmi.hu/egyeb sztringnél ki kell cserélnünk a dso szöveget a http-re, majd az FInternetProtocol változóban tárolt IInternetprotocol interfész Start metódusát meghívjuk átadva neki a kapott paramétereket és természetesen a megváltoztatott szUrl-t is.

function TDSOProtocolClass.Start(szUrl: LPCWSTR; OIProtSink:
           IInternetProtocolSink; OIBindInfo: IInternetBindInfo;
           grfPI, dwReserved: DWORD): HResult;
var
  s: string;
  ws: WideString;
begin
  FInternetBindInfo:=OIBindInfo;
  FInternetProtocolSink:=OIProtSink;
  s:=szUrl;
  s:='http'+copy(s, 4, Length(s));
  ws:=s;
  result:=(FInternetProtocol as IInternetprotocol).
     Start(PWideChar(ws), Self, Self, grfPI, dwReserved);
end;

A Start függvényben érdekes lehet még a gfrPI paraméter, mely DWORD típusú. Itt az alábbi konstansok értékeinek kombinációjából létrejövő számot kapunk:

PI_PARSE_URL (értéke: $00000001)
PI_FILTER_MODE (értéke: $00000002)
PI_FORCE_ASYNC (értéke: $00000004)
PI_USE_WORKERTHREAD (értéke: $00000008)
PI_MIMEVERIFICATION (értéke: $00000010)
PI_CLSIDLOOKUP (értéke: $00000020)
PI_DATAPROGRESS (értéke: $00000040)
PI_SYNCHRONOUS (értéke: $00000080)
PI_APARTMENTTHREADED (értéke: $00000100)
PI_CLASSINSTALL (értéke: $00000200)
PI_PASSONBINDCTX (értéke: $00002000)
PI_NOMIMEHANDLER (értéke: $00008000)
PI_LOADAPPDIRECT (értéke: $00004000)
PD_FORCE_SWITCH (értéke: $00010000)

Az IInternetProtocol interfész Continue függvényénél szintén tovább adjuk a kapott paramétereket az FInternetProtocol változónkban tárolt objektum Continue nevű függvényének. A Continue akkor kerül meghívásra, ha egy megállított adatfeldolgozási folyamat folytatásra kerül.

function TDSOProtocolClass.Continue(const
      ProtocolData: TProtocolData): HResult;
begin
  result:=(FInternetProtocol as IInternetProtocol).
      Continue(ProtocolData);
end;

A Continue függvény paramétereként kapott TProtocolData típus az alábbiak szerint néz ki:

  TProtocolData = packed record
    grfFlags: DWORD;
    dwState: DWORD;
    pData: Pointer;
    cbData: ULONG;
  end;

Az Abort függvénynél szintén csak tovább adjuk a kapott paramétereket. Az Abort-al a folyamatban lévő művelet állítható le.

function TDSOProtocolClass.Abort(hrReason: HResult;
      dwOptions: DWORD): HResult;
begin
  result:=(FInternetProtocol as IInternetProtocol).
      Abort(hrReason, dwOptions);
end;

A Terminate függvény kerül meghívásra, amikor a DLL-ünk befejezi a munkát. Ekkor kell megszüntetnünk a létrehozott IInternetProtocol interfészt, illetve Start függvénynél paraméterként kapott IInternetProtocolSink és IInternetBindInfo interfészek objektumait is el kell eresztenünk.

function TDSOProtocolClass.Terminate(
     dwOptions: DWORD): HResult;
begin
  result:=(FInternetProtocol as IInternetProtocol).
      Terminate(dwOptions);
  FInternetProtocolSink._Release;
  FInternetBindInfo._Release;
end;

A Read függvénynél történik meg az adatok olvasása. A pv paraméterbe kell megadnunk egy lefoglalt memória területet, melyre az olvasott adatok kerülnek. A cb paraméterben kell megadnunk, hogy mekkora ez a lefoglalt terület, végül a cbRead paraméterbe kapjuk meg, hogy hány bájt is került olvasásra.

function TDSOProtocolClass.Read(pv: Pointer; 
      cb: ULONG; out cbRead: ULONG): HResult;
begin
  result:=(FInternetProtocol as IInternetProtocol).
     Read(pv, cb, cbread);
end;

A Seek függvénnyel pozícionálhatunk az adatfolyamban. A dlibMove adja meg, hogy mekkora legyen a pozícionálás mértéke, a dwOrigin a pozícionálás helyét, míg a libNewPosition paraméterben kapjuk meg az új pozíció értékét.

function TDSOProtocolClass.Seek(dlibMove: LARGE_INTEGER;
           dwOrigin: DWORD; out libNewPosition:
           ULARGE_INTEGER): HResult;
begin
  result:=(FInternetProtocol as IInternetProtocol).Seek(
           dLibMove, dwOrigin, libNewPosition);
end;