这是一个异步可插入程序演示,想把协议注册和处理部分作成DLL,实现LoadMethod := 1就行了,我是新手,没有办法,请各位大侠指点
Unit1.pas文件内容如下:
unit Unit1;interfaceuses
  {$IFDEF VER120} d4_app,{$ENDIF} OurNSHandler, Classes, Windows, Messages, SysUtils, Graphics, Controls, Forms, Dialogs,
  Activex, urlMon, StdCtrls, OleCtrls;type
  TForm1 = class(TForm)
    WebBrowser1: TWebBrowser;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;
  LoadMethod: Byte;implementation{$R *.DFM}var
  Factory: IClassFactory;
  InternetSession: IInternetSession;
procedure TForm1.Button1Click(Sender: TObject);
var
Url : Widestring;
v : OleVariant;
begin
  Url:='http://testprogram/page1.htm';
  LoadMethod := 1;
  webbrowser1.navigate(Url,v,v,v,v);
end;procedure TForm1.Button2Click(Sender: TObject);
var
Url : Widestring;
v : OleVariant;
begin
  Url:='http://testprogram/page1.htm';
  LoadMethod := 2;
  webbrowser1.navigate(Url,v,v,v,v);
end;procedure TForm1.FormCreate(Sender: TObject);
begin
  CoGetClassObject(Class_OurNSHandler, CLSCTX_SERVER, nil, IClassFactory, Factory);
  CoInternetGetSession(0, InternetSession, 0);
  InternetSession.RegisterNameSpace(Factory, Class_OurNSHandler, 'http', 0, nil, 0);
end;procedure TForm1.FormDestroy(Sender: TObject);
begin
  InternetSession.UnregisterNameSpace(Factory, 'http');
end;end.
OurNSHandler.pas文件内容如下:
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.aspFor 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
  {$IFDEF VER120} d4_app,{$ENDIF} 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;implementationuses
  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 fileTo 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.