• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1070
  • Last Modified:

feed the raw data of a image to IE

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
zxw
Asked:
zxw
  • 19
  • 10
  • 5
  • +2
1 Solution
 
jeurkCommented:
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
 
jeurkCommented:
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
 
rondiCommented:
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
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
Stuart_JohnsonCommented:
listening...
0
 
jeurkCommented:
you should ask a question for that rondi...

Go to www.euromind.com/iedelphi, you'll find everything you need...
John
0
 
zxwAuthor Commented:
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
 
jeurkCommented:
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
 
zxwAuthor Commented:
Mr. Stuart Johnson,

  Is 200 points enough for your comments?
0
 
Stuart_JohnsonCommented:
Hehehe, no, you can't buy my comments that cheap :)
0
 
zxwAuthor Commented:
Any one help me please?
0
 
jeurkCommented:
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
 
jeurkCommented:
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
 
AvonWyssCommented:
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
 
zxwAuthor Commented:
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
 
zxwAuthor Commented:
Hi jeurk,

   Unless you understand what I mean, I'll not send you the source code.
0
 
zxwAuthor Commented:
Is there no one can help me?
0
 
jeurkCommented:
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
 
zxwAuthor Commented:
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
 
zxwAuthor Commented:
If I could, I'd raise the point to 500. Where ARE the experts?
0
 
zxwAuthor Commented:
Help please.
0
 
AvonWyssCommented:
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
 
zxwAuthor Commented:
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
 
zxwAuthor Commented:
Now what?
0
 
zxwAuthor Commented:
Help!
0
 
AvonWyssCommented:
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
 
AvonWyssCommented:
Or even better make this:

         S:='Content-Type: image/jpeg'#13#10'Content:'#13#10#13#10+S;
0
 
zxwAuthor Commented:
Not work.

IE raised exception when got the iamge data.
0
 
AvonWyssCommented:
Is your ResultHTML buffer large enough to hold the whole image?
0
 
zxwAuthor Commented:
Yes, the ResultHTML buffer is setted to 512k, and the jpg file is only 154k.
0
 
zxwAuthor Commented:
Mr. AvonWyss ,

   I'm afraid whether IE can recognize the context returned by my protocal?
0
 
zxwAuthor Commented:
And I'm afraid the returned datad format is different between IE protocal and ISAPI.  
0
 
zxwAuthor Commented:
help me please.
0
 
jeurkCommented:
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
 
jeurkCommented:
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
 
zxwAuthor Commented:
give me some time to learn please.
0
 
zxwAuthor Commented:
It is working! Thanks jeurk for your kind!
0
 
jeurkCommented:
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

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

  • 19
  • 10
  • 5
  • +2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now