Solved

feed the raw data of a image to IE

Posted on 2001-09-05
37
989 Views
Last Modified: 2010-05-18
hi,

I wrote an Internet Explorer Pluggable Protocal called myprotocal, and when invoked by IE, myprotocal can feed the text contain of html to IE, that's OK.  Now I want to feed the raw data of a image to IE, how can I?

Thanks.
0
Comment
Question by:zxw
  • 19
  • 10
  • 5
  • +2
37 Comments
 
LVL 4

Expert Comment

by:jeurk
ID: 6456153
Maybe, you could refer in your text to images that can be found in the ressources of your plugin, using res://
Maybe you get the idea ?
0
 
LVL 4

Expert Comment

by:jeurk
ID: 6456157
like that:
Q: How do I use the "res:" protocol?

A: The "res:" protocol will let you Navigate to an HTML file stored as a resource. More informations is available from the Microsoft site:

procedure TForm1.LoadHTMLResource;
var
  Flags, TargetFrameName, PostData, Headers: OleVariant;
begin
  WebBrowser1.Navigate('res://' + Application.ExeName + '/myhtml', Flags, TargetFrameName, PostData, Headers)
end;

Create a resource file (*.rc) with the following code and compile it with brcc32.exe:

MYHTML 23 ".\html\myhtml.htm"

MOREHTML 23 ".\html\morehtml.htm"

Edit your project file so that it looks like this:

{$R *.RES}
{$R HTML.RES} //where html.rc was compiled into html.res

0
 
LVL 3

Expert Comment

by:rondi
ID: 6456481
Hi zxw,

Please show me how to write an IE pluggable protocol.
I know it IS possible - like that about: protocol you
see in the address bar sometimes.

rondi.
0
 
LVL 6

Expert Comment

by:Stuart_Johnson
ID: 6456908
listening...
0
 
LVL 4

Expert Comment

by:jeurk
ID: 6457411
you should ask a question for that rondi...

Go to www.euromind.com/iedelphi, you'll find everything you need...
John
0
 

Author Comment

by:zxw
ID: 6459248
TO  jeurk,

Using res:// means let the res protocal do the things I want to do in my protocal, and that is JUST what I asked for help here. And the difference is my protocal gets html text and images from a database.
0
 
LVL 4

Expert Comment

by:jeurk
ID: 6459963
I'm not sure of that, your protocol gets called in the case you have an adress of the type you_protocol://
so when you call res:// then you are asking the original protocol implemented by ie.
Except if you have overiden then res protocol... But I don't think so.
0
 

Author Comment

by:zxw
ID: 6462640
Mr. Stuart Johnson,

  Is 200 points enough for your comments?
0
 
LVL 6

Expert Comment

by:Stuart_Johnson
ID: 6462652
Hehehe, no, you can't buy my comments that cheap :)
0
 

Author Comment

by:zxw
ID: 6463182
Any one help me please?
0
 
LVL 4

Expert Comment

by:jeurk
ID: 6463307
I can...but you don't seems to be convinced by what I say.
Do you think it's not working ?
I'll try to make a sample to check if it's working or not...
0
 
LVL 4

Expert Comment

by:jeurk
ID: 6463392
Would it be possible for you to send me a sample of you plugin ? I mean with sources, at least the base...
I'll add the image for you, if I can, and will send it back.
Send it to knipjo@hotmail.com thanks.
John.
0
 
LVL 14

Expert Comment

by:AvonWyss
ID: 6464143
zxw, I supose that you must be able to specify the content type in a header. I have not implemented the pluggable thing, but for ISAPI and CGI apps you can specify these in the header you send back to the browser, e.g.

Content-Type: image/bitmap
Content-Size: 12345

hsdo8ruq4hwr8qwrzqpwo48[...]
0
 

Author Comment

by:zxw
ID: 6469295
TO  jeurk,

As I said before, since I make the protocal myself, I want myprotocal deal with all kinds of raw data itself. And also because my data comes from a database, how can I use res:// as you suggested(not stored in EXE file)?
0
 

Author Comment

by:zxw
ID: 6469797
Hi jeurk,

   Unless you understand what I mean, I'll not send you the source code.
0
 

Author Comment

by:zxw
ID: 6469802
Is there no one can help me?
0
 
LVL 4

Expert Comment

by:jeurk
ID: 6469915
No, I think I see what you want. You just did not specify the images where not be static.
In your case I suggest you make two different protocol, one that will feed your text, you already have it, and one that will feed images... that way, if you want to access to images, you will ask your image protocol for it. That way it will be easier for you to do it. Do you see what I mean?
Ok, that way we are back to your initial question with just one addition: you want to find how to build a protocol that can feed raw data only (images).
Where is your problem exactly ? You don't know where to start or you are an idea but are blocked ?
0
 

Author Comment

by:zxw
ID: 6473432
Hi jeurk,
    Can u so kind tell me how to build
a protocol that can feed raw data only (images)? And the images cann't be stored in a file, there are stored in a database.
0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 

Author Comment

by:zxw
ID: 6473448
If I could, I'd raise the point to 500. Where ARE the experts?
0
 

Author Comment

by:zxw
ID: 6478187
Help please.
0
 
LVL 14

Expert Comment

by:AvonWyss
ID: 6478220
zxw, I din't have the time to start experiencing with this topic completely on my own. However, if you agree to post some of the code you already have, we might come up with a solution which works for you.
0
 

Author Comment

by:zxw
ID: 6481308
The following code implement a Delphi:// protocal which can show the content of a delphi project.

The read function returns the result html content (in text format) to IE. What I'm asking for help is how to let the read function return the raw data of a image to IE?



Function TDelphiInternetProtocol.Start(szUrl : LPCWStr;
                                       OIProtSink : IInternetProtocolSink;
                                       OIBindInfo : IInternetBindInfo;
                                       grfPI,dwReserved : DWord) : HResult;
Var S : String;
Begin
  S := WideCharToString(szURL);
 
  Delete(S,1,9); { delphi:// }
  SetLength(S,Length(S)-1);
  S := HTTPDecode(S);
  If FileExists(S) Then S := ParseDelphiProject(S)
  Else S := Format(ProblemHTML,[S,'File was not found.']);
  CurrPos := 0;
  BytesLeft := Length(S);
 
  FillChar(ResultHTML,SizeOf(ResultHTML),0);
  StrPCopy(ResultHTML,S);
  ProtSink := OIProtSink;
 
  OIProtSink.ReportData(bscf_LastDataNotification,0,BytesLeft);
 

  OIProtSink.ReportData(bscf_DataFullyAvailable,0,BytesLeft);
  Result := S_OK;
End;


Function TDelphiInternetProtocol.Read(pv : Pointer; cb : ULONG; Out cbRead : ULONG) : HResult;
Var I : Integer;
Begin
 
  If (BytesLeft > 0) Then Begin
    I := CB;
    If (I > BytesLeft) Then I := BytesLeft;
    Move(ResultHTML[CurrPos],PV^,I);
    CBRead := I;
    Dec(BytesLeft,I);
    Inc(CurrPos,I);
    Result := S_OK; { tell IE to read more data }
  End
  Else Begin
   
    Result := S_False;
   
    ProtSink.ReportResult(S_OK,0,nil);
  End;
End;
0
 

Author Comment

by:zxw
ID: 6486740
Now what?
0
 

Author Comment

by:zxw
ID: 6486743
Help!
0
 
LVL 14

Expert Comment

by:AvonWyss
ID: 6486757
Ok, I believe that you're loading the data here:

     If FileExists(S) Then S := ParseDelphiProject(S)
     Else S := Format(ProblemHTML,[S,'File was not found.']);

To send yout a JPEG image, make this like follows:

     if FileExists(S) then begin
          with TFileStream.Create(S,fmOpenRead) do try
               SetLength(S,Size);
               Read(Pointer(S)^,Length(S));
          finally
               Free;
          end;
          S:='Content-Type: image/jpeg'#13#10#13#10+S;
     end else
          S := Format(ProblemHTML,[S,'File was not found.']);
0
 
LVL 14

Expert Comment

by:AvonWyss
ID: 6488899
Or even better make this:

         S:='Content-Type: image/jpeg'#13#10'Content:'#13#10#13#10+S;
0
 

Author Comment

by:zxw
ID: 6495536
Not work.

IE raised exception when got the iamge data.
0
 
LVL 14

Expert Comment

by:AvonWyss
ID: 6495583
Is your ResultHTML buffer large enough to hold the whole image?
0
 

Author Comment

by:zxw
ID: 6498558
Yes, the ResultHTML buffer is setted to 512k, and the jpg file is only 154k.
0
 

Author Comment

by:zxw
ID: 6498608
Mr. AvonWyss ,

   I'm afraid whether IE can recognize the context returned by my protocal?
0
 

Author Comment

by:zxw
ID: 6498622
And I'm afraid the returned datad format is different between IE protocal and ISAPI.  
0
 

Author Comment

by:zxw
ID: 6499032
help me please.
0
 
LVL 4

Accepted Solution

by:
jeurk earned 300 total points
ID: 6499469
Why are you obliged to do it with a protocol ?
Is this because you can't use a web server ?

But here should be some help for you ;)
It's done by Per L. Larsen... The author of the components
you can find on www.euromind.com/iedelphi
Let me know if it is working, it should ;)
John.



From:  "Per Larsen" <per.lindsoe@l...>
Date:  Thu Feb 10, 2000  4:24 pm
Subject: Re: streaming images from APP
A different - and perhaps easier - way  to load html, gif, jpeg, css etc.
from database or structured storage  to Webbrowser is  the following "delphi:" protocol:

unit unit2;

interface

uses
  Forms, Axctrls, Windows, dialogs, urlmon, sysutils, ActiveX, Classes,
ComObj;

const
  Class_Protocol: TGUID = '{3324FA80-A440-11D3-96C7-E5180FEDBD29}';
  DataBaseFile = 'testprogram.db';
  ProtocolName = 'delphi';

type
  TProtocol = class(TComObject, IInternetprotocol)
  protected
    DataStream: IStream;
    written, totalsize: Integer;
    function Start(szUrl: LPCWSTR; 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;
    procedure GetDataFromDB(Url: string);
  public
  end;


implementation

uses ComServ, Db, DbTables;

var
  Table: TTable;

{ TProtocol }


function TProtocol.Start(szUrl: LPCWSTR; OIProtSink: IInternetProtocolSink;
  OIBindInfo: IInternetBindInfo; grfPI, dwReserved: DWORD): HResult;
var
  s: string;
begin
  written := 0;
  Totalsize := 0;
  s := szUrl;
  s := copy(s, Length(ProtocolName)+2, length(s));
  GetDataFromDB(S);
  OIProtsink.ReportData(BSCF_FIRSTDATANOTIFICATION or
    BSCF_LASTDATANOTIFICATION or BSCF_DATAFULLYAVAILABLE, TotalSize,
TotalSize);
  OIProtsink.ReportResult(S_OK, S_OK, nil);
  Result := S_OK;
end;


function TProtocol.Abort(hrReason: HResult; dwOptions: DWORD): HResult;
begin
  Result := S_OK;
end;

function TProtocol.Continue(const ProtocolData: TProtocolData): HResult;
begin
  Result := S_OK;
end;


function TProtocol.LockRequest(dwOptions: DWORD): HResult;
begin
  Result := S_OK;
end;


function TProtocol.Read(pv: Pointer; cb: ULONG;
  out cbRead: ULONG): HResult;
begin
  DataStream.Read(pv, cb, @cbRead);
  Inc(written, cbread);
  if (written = totalSize) then result := S_FALSE else Result := S_OK;
end;

function TProtocol.Resume: HResult;
begin
  Result := S_OK;
end;

function TProtocol.Seek(dlibMove: LARGE_INTEGER; dwOrigin: DWORD;
  out libNewPosition: ULARGE_INTEGER): HResult;
begin
  Result := S_OK;
end;


function TProtocol.Suspend: HResult;
begin
  Result := S_OK;
end;

function TProtocol.Terminate(dwOptions: DWORD): HResult;
begin
  Result := S_OK;
end;

function TProtocol.UnlockRequest: HResult;
begin
  Result := S_OK;
end;


procedure TProtocol.GetDataFromDB(Url: string);
var
  Dummy: INT64;
begin
  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;


initialization
  TComObjectFactory.Create(ComServer, TProtocol, Class_Protocol,
    'Protocol', '', ciMultiInstance, tmApartment);
  Table := TTable.Create(nil);
  table.DatabaseName := ExtractFilePath(APPLICATION.EXENAME);
  table.TableName := DatabaseFile;
  table.active := true;

finalization
  table.free;

end.
0
 
LVL 4

Expert Comment

by:jeurk
ID: 6499546
The second example is done by B. Eschrich :

(****************************************************)
unit PlugProt;

interface

uses
  HttpApp, Windows, SysUtils, Classes, Graphics, Forms, ComObj, VCLCom, StdVcl,
    ActiveX, ShellConsts, ThreadComLib, ComEvents, UrlMonEx, CDBookPP_TLB;

// we using temporary name space registration ....

{** $DEFINE PERMANENT_PROTOCOL}
{$DEFINE TEMP_NAMESPACE_PROTOCOL}

const
  PROTOCOL_SCHEME = 'cdbook';
  PROTOCOL_DESC   = 'cdbook: Pluggable Protocol';

type
  TPluggableProtocol = class; // forwarded

  TURIHandler = class(TInterfacedObject)
  private
    FProtocol  : TPluggableProtocol;
    FFullURI   : String;
    FContainer : String;
    FOption    : String;
    FOptValue  : String;
    FMimeType  : String;
    FdwOptVal: Integer;
  protected
    procedure LoadResStream(var Stream: IStream; var dwWritten: Integer); virtual;
    procedure LoadDocStream(var Stream: IStream; var dwWritten: Integer); virtual;
    procedure LoadRawStream(var Stream: IStream; var dwWritten: Integer); virtual;
  public
    constructor Create(Protocol: TPluggableProtocol);
    procedure GetContents(var Stream: IStream; var dwWritten: Integer);  virtual;
    procedure ParseURI(const URI: String);  virtual;
  end;

  TPluggableProtocol = class(
     TAutoObjectWithEvents,
     ICDBookProtocol,
     IInternetProtocol,
     IInternetProtocolInfo)
  private
    { Private-Deklarationen }
    FEvents         : _CDBookEvents;          // Application event sink
    FURIHandler     : TURIHandler;            // interface object to URI handling  
    FIProtSink      : IInternetProtocolSink;  // PP implementation follows
    FIBindInfo      : IInternetBindInfo;
    FSinkCount      : Integer;
    FBindCount      : Integer;
    FStrmCount      : Integer;
    FBindType       : Integer;
    FBindInfo       : TBindInfo;
    FGrfSTI         : Integer;
    FLocked         : Boolean;
    FDone           : Boolean;
    FReallyDone     : Boolean;
    FcbTotalURLMon  : Integer;
    FcbTotalRead    : Integer;
    FcbTotalWritten : Integer;
    FcbTotalSize    : Integer;
    FProtocolStream : IStream;
    { IInternetProtocol }
    function Start(szUrl: PWideChar; OIProtSink: IInternetProtocolSink;
      OIBindInfo: IInternetBindInfo; grfPI, dwReserved: Integer): HResult; stdcall;
    function Continue(const ProtocolData: TProtocolData): HResult; stdcall;
    function Abort(hrReason: HResult; dwOptions: Integer): HResult; stdcall;
    function Terminate(dwOptions: Integer): 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: Integer;
      out libNewPosition: ULARGE_INTEGER): HResult; stdcall;
    function LockRequest (dwOptions: Integer): HResult; stdcall;
    function UnlockRequest: HResult; stdcall;
    { IInternetProtocolInfo }
    function ParseUrl(pwzUrl: PWideChar; ParseAction: LongWord; dwParseFlags: Integer;
      pwzResult: PWideChar; cchResult: Integer; out pcchResult: Integer; dwReserved: Integer): HResult; stdcall;
    function CombineUrl(pwzBaseUrl, pwzRelativeUrl: PWideChar; dwCombineFlags: Integer;
      pwzResult: PWideChar; cchResult: Integer; out pcchResult: Integer; dwReserved: Integer): HResult; stdcall;
    function CompareUrl(pwzUrl1, pwzUrl2: PWideChar; dwCompareFlags: Integer): HResult; stdcall;
    function QueryInfo(pwzUrl: PWideChar; QueryOption: TQueryOption; dwQueryFlags: Integer;
      pBuffer: Pointer; cbBuffer: Integer; var cbBuf: Integer; dwReserved: Integer): HResult; stdcall;
  protected
    procedure EventSinkChanged(const Events: IUnknown); override;
    function DoBindProtocol: HResult; virtual;
    function DoParseURLStr(const URL: String): HResult; virtual;
  protected
    property ProtocolStream : IStream read FProtocolStream;
  public
    { Public-Deklarationen }
    procedure Initialize; override;
    destructor Destroy; override;
  end;

implementation

uses
  AxCtrls, WinInet, ThreadComServ, dmDataClient;

const
  SHtmlNoDataAvial =
    '<font color=red><br><b>Data not available.</b></font>';

type
  TServerModule = class (TThreadedComServer)
  private
    FProtocolFactory: IClassFactory;
    FInternetSession: IInternetSession;
  protected
    procedure InitializeApartments; override;
    function DllRegisterServer : HResult; override;
    function DllUnregisterServer : HResult; override;
  public
    procedure Initialize; override;
    procedure Finalize; override;
  end;

var
  ProtocolCB: TPluggableProtocol;
  DataClient: TDataClient;

{=====================================================================================}
{The aparment COM server}

procedure TServerModule.InitializeApartments;
  {InitializeApartments apartments gets called right before a COM server
   starts going into its primary thread loop. This enables you to pre-initialize
   any apartments that you may always want created whenever your COM server
   starts up. InitializeApartments is only called for EXE servers.}
begin
  {must be override}
end;

function TServerModule.DllRegisterServer: HResult;
{$IFDEF PERMANENT_PROTOCOL}
var
  CLSID: String;
{$ENDIF PERMANENT_PROTOCOL}
begin
  Result:= inherited DllRegisterServer;
{$IFDEF PERMANENT_PROTOCOL}
  if SUCCEEDED(Result) then
  begin
    CLSID:= GUIDToString(Class_CDBookProtocol);
    CreateRegKey(SKeyAsyncPPHandler+'\'+PROTOCOL_SCHEME, '', PROTOCOL_DESC);
    CreateRegKey(SKeyAsyncPPHandler+'\'+PROTOCOL_SCHEME, 'CLSID', CLSID);
    CreateRegKey(PROTOCOL_SCHEME, '', PROTOCOL_DESC);
    CreateRegKey(PROTOCOL_SCHEME, 'URL Protocol', '');
    CreateRegKey(PROTOCOL_SCHEME+'\'+SKeyDefaultIcon, '', ComServer.ServerFileName+',0');
  end;
{$ENDIF PERMANENT_PROTOCOL}
end;

function TServerModule.DllUnregisterServer: HResult;
begin
{$IFDEF PERMANENT_PROTOCOL}
  DeleteRegKey(PROTOCOL_SCHEME);
  DeleteRegKey(SKeyAsyncPPHandler+'\'+PROTOCOL_SCHEME);
{$ENDIF PERMANENT_PROTOCOL}
  Result:= inherited DllUnregisterServer;
end;

procedure TServerModule.Initialize;
  {Initialize is called before anything happens for your COM server. Override
   Initialize if you want to initialize any resources that your server will need.}
begin
  inherited;
  {--}
  Application.Title:= 'CD Book Plugable Protocol';
  { Do your initialize apartments here }
  try
    DataClient:= TDataClient.Create(Application);
{$IFDEF TEMP_NAMESPACE_PROTOCOL}
    { protocol class }
    OleCheck( CoGetClassObject(
      Class_CDBookProtocol, CLSCTX_SERVER, nil, IClassFactory, FProtocolFactory));
    FProtocolFactory._AddRef;
    // ---
    OleCheck(CoInternetGetSession(0, FInternetSession, 0));
    // ---
    FInternetSession._AddRef;
    OleCheck( FInternetSession.RegisterNameSpace(
      FProtocolFactory, Class_CDBookProtocol, PROTOCOL_SCHEME, 0, nil, 0));
{$ENDIF TEMP_NAMESPACE_PROTOCOL}
  except
    Application.HandleException(ExceptObject);
  end;
end;

procedure TServerModule.Finalize;
begin
  // ---
  if ( FInternetSession <> nil ) then
  begin
    FInternetSession.UnregisterNameSpace(FProtocolFactory, PROTOCOL_SCHEME);
    FInternetSession._Release;
    FInternetSession:= NIL;
  end;
  // ---
  if ( FProtocolFactory <> nil) then
  begin
    FProtocolFactory._Release;
    FProtocolFactory:= NIL;
  end;
  // ---
  if DataClient <> NIL then
    DataClient.Free;
  // ---
  inherited;
end;

{=====================================================================================}
{TURIHandler methods}

constructor TURIHandler.Create(Protocol: TPluggableProtocol);
begin
  inherited Create;
  // ---
  FProtocol:= Protocol;
end;

procedure TURIHandler.ParseURI(const URI: String);
  {- we using this url syntax:
       cdbook://container/option=value
        options = bmp, gif, jpg  for IMG or CSS url(...)
                  raw for application callback
                  other are standard HTML generated TPageProducer
        container = is an access code for database data or resource identifier
  -}
begin
  FFullURI:= URI;
  {extract HTML container object}
  if Pos('?', FFullURI) <> 0 then
    FContainer:= Copy(FFullURI, 1, Pos('?', FFullURI)-1)
  else if Pos('/', FFullURI) <> 0 then
    FContainer:= Copy(FFullURI, 1, Pos('/', FFullURI)-1)
  else
    FContainer:= 'raw';
  FOption:= Copy(FFullURI, Length(FContainer)+2, (Pos('=', FFullURI)-1)-(Length(FContainer)+1));
  FOptValue:= Copy(FFullURI, Pos('=', FFullURI)+1, Length(FFullURI));
  FdwOptVal:= StrToIntDef(FOptValue, -1);
  // translate container/resource id to mime type
  if CompareText(FContainer, 'res') = 0 then
  begin
    {if no resource id, remove file extension}
    if FdwOptVal < 0 then begin
      FOptValue:= ChangeFileExt(FOptValue, '');
    end;
    if CompareText(FOption,  'bmp') = 0 then
      FMimeType:= CFSTR_MIME_BMP
    else if CompareText(FOption,  'jpg') = 0 then
      FMimeType:= CFSTR_MIME_JPEG
    else if CompareText(FOption,  'gif') = 0 then
      FMimeType:= CFSTR_MIME_GIF
  end
  else if CompareText(FContainer, 'raw') = 0 then
    FMimeType:= CFSTR_MIME_RAWDATA
  else
    FMimeType:= CFSTR_MIME_HTML;
end;

procedure TURIHandler.LoadResStream(var Stream: IStream; var dwWritten: Integer);
var
  cbWritten: Longint;
  MemStream: TMemoryStream;
  ResStream: TResourceStream;
  ResType  : PChar;
begin
  MemStream:= TMemoryStream.Create;
  try
    {determine which resource type to use}
    if CompareText(FMimeType, CFSTR_MIME_BMP) = 0 then
      ResType:= RT_BITMAP
    else if (CompareText(FMimeType, CFSTR_MIME_JPEG) = 0) or
            (CompareText(FMimeType, CFSTR_MIME_GIF) = 0) then
      ResType:= RT_RCDATA
    else
      ResType:= RT_RCDATA;
    {create resource stream}
    ResStream:= TResourceStream.Create(hInstance, FOptValue, ResType);
    try
      {write to memory stream}
      ResStream.SaveToStream(MemStream);
      {goto start of stream}
      MemStream.Seek(0, soFromBeginning);
      {---}
      dwWritten:= 0;
      cbWritten:= 0;
      {write to IStream interface}
      Stream.Write(MemStream.Memory, MemStream.Size, @cbWritten);
      {...}
      dwWritten:= cbWritten;
    finally
      ResStream.Free;
    end;
  finally
    MemStream.Free;
  end;
end;

procedure TURIHandler.LoadDocStream(var Stream: IStream; var dwWritten: Integer);
var
  cbWritten : Longint;
  MemStream : TMemoryStream;
  Strings   : TStringList;
begin
  MemStream:= TMemoryStream.Create;
  try
    Strings:= TStringList.Create;
    try
      with DataClient do
      begin
        // load rquested book page
        LoadBookPage(FContainer, FOption, FOptValue, Strings);
        {if no html, show default error page}
        if Strings.Count = 0 then begin
          Strings.Text:= '<html><body>'+SHtmlNoDataAvial+'</body></html>';
        end;
        {update content page producer}
        SetPageContents(Strings);
        {generate final HTML page}
        GetFinalHTMLDoc(Strings);
      end;
      {write to memory stream}
      Strings.SaveToStream(MemStream);
      {goto start of stream}
      MemStream.Seek(0, soFromBeginning);
      {---}
      dwWritten:= 0;
      cbWritten:= 0;
      {write to IStream interface}
      Stream.Write(MemStream.Memory, MemStream.Size, @cbWritten);
      {...}
      dwWritten:= cbWritten;
    finally
      Strings.Free;
    end;
  finally
    MemStream.Free;
  end;
end;

procedure TURIHandler.LoadRawStream(var Stream: IStream; var dwWritten: Integer);
var
  Strings   : IStrings;
  DocStrs   : TStringList;
  cbWritten : Longint;
  MemStream : TMemoryStream;
begin
  {check we have callback event}
  if FProtocol.FEvents = NIL then
  begin
    dwWritten:= 0;
    Exit;
  end;
  {call the application event to get data}
  FProtocol.FEvents.OnPageRequest(FdwOptVal, Strings);
  if Strings = NIL then
  begin
    dwWritten:= 0;
    Exit;
  end;
  DocStrs:= TStringList.Create;
  try
    SetOleStrings(DocStrs, Strings);
    if DocStrs.Count = 0 then
    begin
      dwWritten:= 0;
      Exit;
    end;
    MemStream:= TMemoryStream.Create;
    try
      {write to memory stream}
      DocStrs.SaveToStream(MemStream);
      {goto start of stream}
      MemStream.Seek(0, soFromBeginning);
      {---}
      dwWritten:= 0;
      cbWritten:= 0;
      {write to IStream interface}
      Stream.Write(MemStream.Memory, MemStream.Size, @cbWritten);
      {...}
      dwWritten:= cbWritten;
    finally
      MemStream.Free;
    end;
  finally
    DocStrs.Free;
  end;
end;

procedure TURIHandler.GetContents(var Stream: IStream; var dwWritten: Integer);
begin
  {internal resource (i.e. images or RC data}
  if CompareText(FContainer, 'res') = 0 then
  begin
    LoadResStream(Stream, dwWritten);
    Exit;
  end;
  {raw stream handler, manager by application}
  if CompareText(FContainer, 'raw') = 0 then
  begin
    LoadRawStream(Stream, dwWritten);
    Exit;
  end;
  {default handler}
  LoadDocStream(Stream, dwWritten);
end;

{=====================================================================================}
{Protected methods}

procedure TPluggableProtocol.Initialize;
begin
  inherited Initialize;
  {connect data provider}
  DataClient.OpenDataProvider;
end;

destructor TPluggableProtocol.Destroy;
begin
  {disconnect data provider}
  DataClient.CloseDataProvider;
  {---}
  inherited Destroy;
end;

procedure TPluggableProtocol.EventSinkChanged( const Events: IUnknown );
begin
  FEvents:= Events as _CDBookEvents;
  if ProtocolCB = Nil then
    ProtocolCB:= Self
  else if FEvents = NIL then
    ProtocolCB:= Nil;
end;

function TPluggableProtocol.DoParseURLStr(const URL: String): HResult;

  function InetCanonicalUrl(var URL: string; Flags: integer): Boolean;
  var
    dwUrlSize  : Integer;
    szCanonUrl : array[0..INTERNET_MAX_PATH_LENGTH] of char;
  begin
    Result:= False;
    dwUrlSize:= INTERNET_MAX_PATH_LENGTH;
    if InternetCanonicalizeUrl(PChar(URL), szCanonUrl, dwUrlSize, Flags) then
    begin
      URL:= Copy(szCanonUrl, 1, dwUrlSize);
      Result:= True;
    end;
  end;

var
  stURLString: string;
begin
  try
    Result:= S_OK;
    stURLString:= URL;
    if not InetCanonicalUrl(stURLString, ICU_DECODE or ICU_NO_ENCODE) then
      Result:= E_FAIL
    else
    begin
      {remove protocol schema and : }
      Delete(stURLString, 1, Length(PROTOCOL_SCHEME)+1);

      {remove double slashes if exists}
      if ( Copy(stURLString, 1, 2) = '//' ) then
        Delete(stURLString, 1, 2);

      {check valid url}
      if stURLString = '' then
      begin
        Result:= E_INVALIDARG;
        Exit;
      end;

      {remove last slash}
      if stURLString[Length(stURLString)] = '/' then
        SetLength(stURLString, Pred(Length(stURLString)));

      {prevent memory leaks}
      if Assigned(FURIHandler) then
        FURIHandler.Free;
      {create new URI object}
      FURIHandler:= TURIHandler.Create(Self);
      FURIHandler.ParseURI(stURLString);
    end;
  except
    Result:= E_FAIL;
  end;
end;

function TPluggableProtocol.DoBindProtocol: HResult;
const
  BSCF_FLAGS = BSCF_LASTDATANOTIFICATION or BSCF_DATAFULLYAVAILABLE;
var
  iStmPos : Int64;
  wcStatus: array[0..20] of WideChar;
begin
  try
    {create ole stream on global memory}
    Result:= CreateStreamOnHGlobal(0, True, FProtocolStream);
    if SUCCEEDED(Result) then
    begin
      FStrmCount:= FProtocolStream._AddRef;
      FcbTotalRead:= 0;
      {Get document contents to protocol IStream interface}
      FURIHandler.GetContents(FProtocolStream, FcbTotalRead);
      {check we any data avial...}
      if FcbTotalRead = 0 then
      begin
        Abort(0, 0);
        Result:= S_OK;
        Exit;
      end;
      {set flag}
      FDone:= True;
      {go to start of HTML document}
      FProtocolStream.Seek(0, soFromBeginning, iStmPos);
      {set content mime type}
      StringToWideChar(FURIHandler.FMimeType, wcStatus, Length(FURIHandler.FMimeType)+1);
      {notify protocol sink the content mime type}
      FIProtSink.ReportProgress(BINDSTATUS_VERIFIEDMIMETYPEAVAILABLE, wcStatus);
      {notify protocol sink, it's data ready to download}
      fIProtSink.ReportData(BSCF_FLAGS, FcbTotalRead, FcbTotalRead);
      {notify prtocol sink, status success}
      fIProtSink.ReportResult(S_OK, S_OK, nil);
      {...}
      Result:= S_OK;
    end;
  except
    Result:= E_FAIL;
  end;
end;

{ IInternetProtocol }

function TPluggableProtocol.Start(
              szUrl       : PWideChar;
              OIProtSink  : IInternetProtocolSink;
              OIBindInfo  : IInternetBindInfo;
              grfPI,
              dwReserved  : Integer): HResult;
var
  ProtocolData: TProtocolData;
begin
  try
    // Initialize variables
    // for new download
    FGrfSTI        := grfPI;
    FcbTotalRead   := 0;
    FcbTotalWritten:= 0;
    FcbTotalSize   := 0;
    FcbTotalURLMON := 0;
    FDone          := False;
    FLocked        := False;

    // save internet protocol sink of URLMON.DLL
    FIProtSink:= OIProtSink;
    FSinkCount:= fIProtSink._AddRef;

    // save bind info instance of URLMON.DLL
    FIBindInfo:= OIBindInfo;
    FBindCount:= FIBindInfo._AddRef;

    FBindInfo.cbSize:= sizeof(FBindInfo);
    FIBindInfo.GetBindInfo(FBindType, FBindInfo);

    Result:= DoParseURLStr(szUrl);
    if (fGrfSTI and PI_PARSE_URL) <> 0 then
    begin
      if SUCCEEDED(Result) then
           Result:= S_OK
      else Result:= S_FALSE;
    end;

    if (FBindType and BINDF_NEEDFILE) <> 0 then
    begin
    end;

    if SUCCEEDED(Result) then
    begin
      { We successfully parsed the url, continue }
      if (fGrfSTI and PI_FORCE_ASYNC) <> 0 then
        Result := DoBindProtocol
      else
      begin
        Result:= E_PENDING;
        //
        ProtocolData.grfFlags:= PI_FORCE_ASYNC;
        ProtocolData.dwState := 1;
        ProtocolData.pData   := nil;
        ProtocolData.cbData  := 0;
        //
        if FIProtSink <> nil then
             FIProtSink.Switch(ProtocolData)
        else Result:= E_INVALIDARG;
      end;
    end;
  except
    Result:= E_FAIL;
  end;
end;

function TPluggableProtocol.Continue(const ProtocolData: TProtocolData): HResult;
begin
  try
    Result:= E_FAIL;
    if ( ProtocolData.dwState = 1 ) then
      Result := DoBindProtocol;
  except
    Result:= E_FAIL;
  end;
end;

function TPluggableProtocol.Abort(hrReason: HResult; dwOptions: Integer): HResult;
begin
  try
    // Possibly Abort could get called with 0?
    if (SUCCEEDED(hrReason)) then
      hrReason:= E_ABORT;

    // Notify Sink of abort
    if FIProtSink <> nil then
      FIProtSink.ReportResult(hrReason, 0, nil);

    Result:= S_OK;
  except
    Result:= E_FAIL;
  end;
end;

function TPluggableProtocol.Terminate(dwOptions: Integer): HResult;
  {-Called by UrlMon.dll when we call pOIProtSink.ReportResult. All resources
    should be freed when this method is complete.}
begin
  try
    Result:= S_OK;

    if FProtocolStream <> nil then
    begin
      FStrmCount:= FProtocolStream._Release;
      FProtocolStream := nil;
    end;

    if FIProtSink <> nil then
    begin
      FSinkCount:= FIProtSink._Release;
      FIProtSink:= nil;
    end;

    if FIBindInfo <> nil then
    begin
      FBindCount:= FIBindInfo._Release;
      FIBindInfo:= nil;
    end;

    ReleaseBindInfo(FBindInfo);
  except
    Result:= E_FAIL;
  end;
end;

function TPluggableProtocol.Suspend: HResult;
begin
  try
    { Not currently Implemented }
    Result:= E_NOTIMPL;
  except
    Result:= E_FAIL;
  end;
end;

function TPluggableProtocol.Resume: HResult;
begin
  try
    { Not currently Implemented }
    Result:= E_NOTIMPL;
  except
    Result:= E_FAIL;
  end;
end;

function TPluggableProtocol.Read(pv: Pointer; cb: ULONG; out cbRead: ULONG): HResult;
begin
  try
    Result:= S_OK;
    if not FReallyDone then
    begin
      Result:= FProtocolStream.Read(pv, cb, @cbRead);
      if not SUCCEEDED(Result) then
        Exit;
    end;
    Inc(FcbTotalURLMon, cbRead);
    if SUCCEEDED(Result) and (FcbTotalURLMon = fcbTotalRead ) then
    begin
      if not fDone then
        Result:= E_PENDING
      else
      begin
        fReallyDone:= True;
        Result:= S_FALSE;
      end;
    end;
  except
    Result:= E_FAIL;
  end;
end;

function TPluggableProtocol.Seek(dlibMove: LARGE_INTEGER;
  dwOrigin: Integer; out libNewPosition: ULARGE_INTEGER): HResult;
begin
  try
    Result:= E_NOTIMPL;
  except
    Result:= E_FAIL;
  end;
end;

function TPluggableProtocol.LockRequest (dwOptions: Integer): HResult;
begin
  try
    FLocked:= True;
    Result := S_OK;
  except
    Result:= E_FAIL;
  end;
end;

function TPluggableProtocol.UnlockRequest: HResult;
begin
  try
    FLocked:= False;
    Result := S_OK;
  except
    Result:= E_FAIL;
  end;
end;

{ IInternetProtocolInfo }

function TPluggableProtocol.ParseUrl(
              pwzUrl        : PWideChar;
              ParseAction   : LongWord;
              dwParseFlags  : Integer;
              pwzResult     : PWideChar;
              cchResult     : Integer;
          out pcchResult    : Integer;
              dwReserved    : Integer): HResult;
var
  stTemp : string;
begin
  try
    stTemp:= '';
    Result:= E_NOTIMPL; file://INET_E_DEFAULT_ACTION;
    if DoParseUrlStr(WideCharToString(pwzURL)) = S_OK then
    begin
      case ParseAction of
        PARSE_CANONICALIZE    : stTemp:= PROTOCOL_SCHEME+':'+FURIHandler.FFullURI;
        PARSE_FRIENDLY        : stTemp:= 'Hier klicken...';
        PARSE_SECURITY_URL    : stTemp:= PROTOCOL_SCHEME+':'+FURIHandler.FFullURI;
        PARSE_ROOTDOCUMENT    : stTemp:= FURIHandler.FOptValue;
        PARSE_DOCUMENT        : stTemp:= FURIHandler.FOptValue;
        PARSE_ANCHOR          : stTemp:= '';
        PARSE_ENCODE          : stTemp:= PROTOCOL_SCHEME+':'+FURIHandler.FFullURI;
        PARSE_DECODE          : stTemp:= '';
        PARSE_PATH_FROM_URL   : stTemp:= '';
        PARSE_URL_FROM_PATH   : stTemp:= '';
        PARSE_MIME            : stTemp:= FURIHandler.FMimeType;
        PARSE_SERVER          : stTemp:= '';
        PARSE_SCHEMA          : stTemp:= '';
        PARSE_SITE            : stTemp:= '';
        PARSE_DOMAIN          : stTemp:= '';
        PARSE_LOCATION        : stTemp:= '';
        PARSE_SECURITY_DOMAIN : stTemp:= '';
        PARSE_ESCAPE          : stTemp:= '';
        PARSE_UNESCAPE        : stTemp:= '';
      end; file://case
    end;
    {--}
    if stTemp <> '' then
    begin
      pcchResult := Length(stTemp)*2;
      if cchResult < pcchResult then
        Result := S_FALSE
      else
      begin
        StringToWideChar(stTemp, pwzResult, pcchResult);
        Result:= S_OK;
      end;
    end;
  except
    Result:= E_FAIL;
  end;
end;

function TPluggableProtocol.CombineUrl(
              pwzBaseUrl,
              pwzRelativeUrl: PWideChar;
              dwCombineFlags: Integer;
              pwzResult     : PWideChar;
              cchResult     : Integer;
          out pcchResult    : Integer;
              dwReserved    : Integer): HResult;
var
  S1, S2: String;
begin
  try
    if pwzRelativeUrl = NIL then
      Result:= E_INVALIDARG
    else
    begin
      Result:= E_NOTIMPL; file://INET_E_DEFAULT_ACTION;
      S1:= WideCharToString(pwzBaseUrl);
      S2:= WideCharToString(pwzRelativeUrl);
      if (Length(S2) > 0) and (CompareText(S1, S2) <> 0) then
      begin
        pcchResult:= Length(S2) * 2;
        if cchResult < cchResult then
          Result:= S_FALSE
        else
        begin
          StringToWideChar(S2, pwzResult, cchResult);
          Result:= S_OK;
        end;
      end;
    end;
  except
    Result:= E_FAIL;
  end;
end;

function TPluggableProtocol.CompareUrl(pwzUrl1, pwzUrl2: PWideChar; dwCompareFlags: Integer): HResult;
var
  S1, S2: String;
begin
  try
    S1:= WideCharToString(pwzUrl1);
    S2:= WideCharToString(pwzUrl2);
    if CompareText(S1, S2) = 0 then
         Result:= S_OK
    else Result:= S_FALSE;
  except
    Result:= E_FAIL;
  end;
end;

function TPluggableProtocol.QueryInfo(pwzUrl: PWideChar; QueryOption: TQueryOption; dwQueryFlags: Integer;
   pBuffer: Pointer; cbBuffer: Integer; var cbBuf: Integer; dwReserved: Integer): HResult;
var
  stTemp : string;
begin
  try
    stTemp:= '';
    Result:= INET_E_DEFAULT_ACTION;
    cbBuf := cbBuffer;
    {--}
    case QueryOption of
      QUERY_EXPIRATION_DATE     : stTemp:= DateTimeToStr(Now);
      QUERY_TIME_OF_LAST_CHANGE : stTemp:= '';
      QUERY_CONTENT_ENCODING    : stTemp:= '';
      QUERY_CONTENT_TYPE        : stTemp:= FURIHandler.FMimeType;
      QUERY_REFRESH             : stTemp:= '';
      QUERY_RECOMBINE           : stTemp:= '';
      QUERY_CAN_NAVIGATE        : LongBool(pBuffer^):= TRUE;
      QUERY_USES_NETWORK        : LongBool(pBuffer^):= FALSE;
      QUERY_IS_CACHED           : stTemp:= '';
      QUERY_IS_INSTALLEDENTRY   : stTemp:= '';
      QUERY_IS_CACHED_OR_MAPPED : stTemp:= '';
      QUERY_USES_CACHE          : stTemp:= '';
      QUERY_IS_SECURE           : LongBool(pBuffer^):= TRUE;
      QUERY_IS_SAFE             : LongBool(pBuffer^):= TRUE;
    end; file://case
    {--}
    if stTemp <> '' then
    begin
      cbBuf := Length(stTemp)*2;
      if cbBuffer < cbBuf then
        Result := S_FALSE
      else
      begin
        StringToWideChar(stTemp, pBuffer, cbBuf);
        Result := S_OK;
      end;
    end;
  except
    Result:= E_FAIL;
  end;
end;

initialization
  { ComServer Module }
  ComServer:= TServerModule.Create('CDBOOKPP');
  { register protocol class }
  TAutoObjectWithEventsFactory.Create(ComServer, TPluggableProtocol, Class_CDBookProtocol);

end.


Explained here:
From:  "B. Eschrich" <info@e...>
Date:  Thu Feb 10, 2000  7:03 pm
Subject:  [delphi-webbrowser] Betreff: streaming images from APP

 
Hi Henri,

I've uploaded the complete unit of my pluggable protocol handle to this
group under folder Pluggable Protocol. The source based on Delphi 3 C/S
and using
some extensions.

How it works :

  The application navigate in the TWebBrowser component
  like this:
     cdbook://drugcategories?item=12345
   
  The document can have CSS/HTML
  <style>
    ul { font-family: Trebuchet MS; font-size: 12pt;
         list-style-image: url('cdbook://res/gif=ulblue.gif');}
  </style>

  <body>
    .... whatever ...
    <a href="cdbook://drugtopics?topic=xxAA" target="_self"
       onClick="myScriptingUIEvent()">
      <img src="cdbook://res/jpg=icon.jpg">
    </a>
  </body>

  The PP produces the HTML pages from the database via
  TxxPageProducer components. (To prevent the access of the standard
  UI of TWebBrowser i've implemented the IDocHostUIHandler interface
  and i've include a 'ScriptingBridge' in the HTML code, to callback
  my application UI via JavaScripting). This allows me a full
  control wahtever i think to generate in HTML)

  Flow Chart:
 
  Application->URL->Protocol->Database->PageProducer->Protocol->Browser
                            ->Resource -------------->Protocol->Browser
                            ->EventSink callback----->Protocol->Browser

  The PP will be registred temporarly as live time of the application
process.
  This method does not need a persistent registration of the pluggable
protocol
  and the same protocol handler can be used in diffrent applications at
the
  same time.

  Most published implementations of PP are descendants of TComObject,
but
  i using the event driven class from TAutoObject, so i can implement
event
  sink mechanism if i may require. Also it's easy to desing the COM
class
  in Delphis TLB editor.
 
  You can use this class to implemtent your own PP. You need to change
the
  code if you don't want to use untis from Techvanguards and Run-Time
Systems.
  You may replace the private implementation of the unit dmDataClient
with
  your own data module that produces the HTML pages in any way.
  The simplest way to generate COM class for PP you can go to File->New
and on
  the dialog you select ActiveX and AutomationObject. That is all you
need to
  generate the basics for COM. Than you copy the source to your
generated
  AutoObject and compile, register, test and stay happy !

  If you wondering if i have a global instance pointer to
TPluggableProtocol
  (see below : ProtocolCB: TPluggableProtocol;). The reason is simple.
  The application creates !FIRST! an instance of the PP and register
event
  handlers. The URLMON creates diffrent instances of PP too. The fakt is
  that the instances of the PP generated by URLMON don't have an event
sink,
  but the instance of the DLL (InProcess) are the same.

  Last but not least, sorry for my bad english,
  best regards B.Eschrich, www.esesoft.de, germany

 
0
 

Author Comment

by:zxw
ID: 6502248
give me some time to learn please.
0
 

Author Comment

by:zxw
ID: 6503155
It is working! Thanks jeurk for your kind!
0
 
LVL 4

Expert Comment

by:jeurk
ID: 6503454
I'm glad it helped...
Which one are you using ? the first one or the second one ???

Thanks for the points :)
john.
0

Featured Post

Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

Join & Write a Comment

Suggested Solutions

Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
Illustrator's Shape Builder tool will let you combine shapes visually and interactively. This video shows the Mac version, but the tool works the same way in Windows. To follow along with this video, you can draw your own shapes or download the file…
Get a first impression of how PRTG looks and learn how it works.   This video is a short introduction to PRTG, as an initial overview or as a quick start for new PRTG users.

706 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now