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.