VB中如何仿电子书使用异步可插入协议？？？
经常看到电子书里的网页地址是这样的：ada99:名车车标目录.htm，http://ebook/index.htm。所以我想在我的VB程序里也调用像这样的地址。也就是说本来打开“res://Z:\iPPOTV\GetUrl.exe/vlc.html"这样的地址，现在这个地址只要输入“http://GetUrl/vlc.html“这样就可以打开了。不知到底如何实现，网上只找到些Delphi介绍的文章，但我对Delphi不熟。特发此贴，望高人不吝赐教，不甚感激。
我这里有个Delphi代码给转成VB也行啊。 如果谁会我把文件发给他，也没几句代码了。大致如下：
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;
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/worksh ... gable/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.
特别是这几句VB中要怎么写啊？
'CoGetClassObject(Class_OurNSHandler, CLSCTX_SERVER, nil, IClassFactory, Factory);
'CoInternetGetSession(0, InternetSession, 0);
'InternetSession.RegisterNameSpace(Factory, Class_OurNSHandler, 'http', 0, nil, 0);
[解决办法]
不需要什么协议。
直接在注册表里添加一个 handler 然后 IE 会自动调用你的程序，即可。
http://www.cnblogs.com/JChenTech/archive/2011/03/09/1978036.html
