Back to Page 1

 

 

unit OurNSHandler;

(* Simple demo for temporary pluggable NameSpacehandler
   To add more functionality to the namespacehandler
   take a look at the following link:

 http://msdn.microsoft.com/workshop/networking/pluggable/pluggable.asp

For discussions about APP, namespacehandlers, mimefilters and
other delphi-webbrowser topics use:

  http://www.egroups.com/group/delphi-webbrowser/info.html

   Go to http://www.euromind.com/iedelphi for more info about
   this sample and updated versions.
           Per Lindsų Larsen, Nov. 1999
*)

interface
uses
  Classes, Windows, Forms, Axctrls, dialogs, SysUtils, ComObj, ActiveX, UrlMon;

const
  Class_OurNSHandler: TGUID = '{0EB00680-8FA1-11D3-96C7-829E3EA50C29}';
  // Create your own GUID - In Delphi IDE: Ctrl-Shift-G

  NameSpace = 'testprogram';
  DataBaseFile = 'testprogram.db';

type
  TOurNSHandler = class(TComObject, IInternetProtocol)
  private
    Url: string;
    Written, TotalSize: Integer;
    ProtSink: IInternetProtocolSink;
    DataStream: IStream;
  protected
// IInternetProtocol Methods
    function Start(szUrl: PWideChar; 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;
// Helper functions
    procedure GetDataFromFile(Url: string);
    procedure GetDataFromDB(Url: string);
  end;



implementation

uses
  unit1, comserv, Db, DbTables;

var
  Table: TTable;


function TOurNSHandler.Start(szUrl: PWideChar; OIProtSink: IInternetProtocolSink;
  OIBindInfo: IInternetBindInfo; grfPI, dwReserved: DWORD): HResult; stdcall;
begin
(* We receive all http://-URL's here and let the
default protocolhandler take over if we don't find
our namespace.
*)
  if Pos('http://' + NameSpace + '/', LowerCase(szUrl)) <> 1
  then Result := INET_E_USE_DEFAULT_PROTOCOLHANDLER

  else begin
  Url := SzUrl;
  written := 0;
  ProtSink := OIProtSink; //Get interface to Transaction handlers IInternetnetProtocolSink
(* Now get the data and load it in DataStream *)
  if LoadMethod = 1 then GetDataFromFile(Url) else GetDataFromDB(Url);
(*Inform Transaction handler that all data is ready *)
  ProtSink.ReportData(BSCF_FIRSTDATANOTIFICATION or
        BSCF_LASTDATANOTIFICATION or BSCF_DATAFULLYAVAILABLE, TotalSize, TotalSize);
(* -> Here our Read Method is called by transaction handler*)
  ProtSink.ReportResult(S_OK, S_OK, nil);
(* Report result to transaction handler. Our Terminate method will be called *)
  Result := S_OK;
  end;
end;


function TOurNSHandler.Read(pv: Pointer; cb: ULONG; out cbRead: ULONG): HResult;
begin
(*Read Data from DataStream to Browser/URLMON *)
  DataStream.Read(pv, cb, @cbRead);
  Inc(written, cbread);
  if (written = totalSize) then  result := S_FALSE else Result := E_PENDING;
end;


procedure TOurNSHandler.GetDataFromDB(Url: string);
(* Get data from Database. Databasefile contains two fields:
'Url': Stringfield = filename.ext
'Content': Blobfield = Content of file

To load html-pages, pictures, stylesheets etc. into table you can use something like:
begin
    Table1.Append;
    Table1.FieldByName('Url').AsString := 'picture.gif';
    TBlobField(Table1.FieldByName('Content')).LoadFromFile('c:\temp\picture.gif');
    Table1.Post;
end;
*)
var
  Dummy: INT64;
begin
  Url := Copy(Url, Pos(NameSpace, Url) + Length(NameSpace) + 1, Length(Url));
  Table.Locate('Url', Url, [locaseinsensitive]);
  CreateStreamOnHGlobal(0, True, DataStream);
  TBlobField(Table.FieldByName('Content')).SaveToStream(TOleStream.Create(DataStream));
  DataStream.Seek(0, STREAM_SEEK_SET, Dummy);
  TotalSize := TBlobField(Table.FieldByName('Content')).BlobSize;
end;

Procedure TOurNSHandler.GetDataFromFile(Url: string);
var
  F: TFileStream;
  Dummy: INT64;
begin
  Url := ExtractFilePath(Application.exename) +
    Copy(Url, Pos(NameSpace, Url) +
    Length(NameSpace) + 1, Length(Url));
  F := TFileStream.Create(Url, fmOpenRead);
  CreateStreamOnHGlobal(0, True, DataStream);
  TOleStream.Create(DataStream).CopyFrom(F, F.Size);
  DataStream.Seek(0, STREAM_SEEK_SET, Dummy);
  TotalSize := F.Size;
  F.Free;
end;



function TOurNSHandler.Terminate(dwOptions: DWORD): HResult; stdcall;
begin
  DataStream._Release;
  Protsink._Release;
  result := S_OK;
end;

function TOurNSHandler.LockRequest(dwOptions: DWORD): HResult; stdcall;
begin
  result := S_OK;
end;

function TOurNSHandler.UnlockRequest: HResult;
begin
  result := S_OK;
end;

function TOurNSHandler.Continue(const ProtocolData: TProtocolData): HResult;
begin
  result := S_OK;
end;

function TOurNSHandler.Abort(hrReason: HResult; dwOptions: DWORD): HResult; stdcall;
begin
  result := E_NOTIMPL;
end;

function TOurNSHandler.Suspend: HResult; stdcall;
begin
  result := E_NOTIMPL;
end;

function TOurNSHandler.Resume: HResult; stdcall;
begin
  result := E_NOTIMPL;
end;

function TOurNSHandler.Seek(dlibMove: LARGE_INTEGER; dwOrigin: DWORD;
  out libNewPosition: ULARGE_INTEGER): HResult;
begin
  result := E_NOTIMPL;
end;

initialization
  begin
    TComObjectFactory.Create(ComServer, TOurNSHandler, Class_OurNSHandler,
      'OurNSHandler', 'OurNSHandler', ciMultiInstance, tmApartment);

    Table := TTable.Create(nil);
    table.DatabaseName := ExtractFilePath(Application.ExeName);
    table.TableName := DatabaseFile;
    table.active := true;
  end;

finalization
  table.free;
end.




IE & Delphi