这是一个异步可插入程序演示,想把协议注册和处理部分作成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.
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.
解决方案 »
- Writeln打印出现乱码问题
- 如何实现刷IP功能
- 跟游戏有关的小问题
- TstringList里面的内容按降序排列?
- Dcom服务器端怎样添加新功能
- 关于主从表设置.怎么会出现这种错误?大家来看一下
- 一个棘手的问题?在主窗体建立后,一个窗体要实时的接受数据,我怎么办才能关闭父窗体之前,停止接受数据,
- 数据类型的内存存储
- ??我用delphi编写asp应用(web软件使用pws),dll一旦调入内存,如何关闭? 我现在只有启动计算机.有没有更好的办法?(在线等待,我用的是wind
- 怎样在Database Desktop中为表建立别名?(Parabox7)
- 如何将Dbgrid导成符合规范的xml文件?
- 怎么让DBGrid控件达到这个效果?
这些方法没法启动
只能实现InternetSession.RegisterNameSpace和反注册,但有没有注册成功不知道,
而且没法用协议加载网页
http://www.uipower.com/bbs/viewthread.php?tid=75107