webbroswer中怎样以流的方式实现图文混排(在线等待...) ( 积分: 100 )

webbroswer中怎样以流的方式实现图文混排

webbroswer中怎样以流的方式实现图文混排

不明白，上面叫以流的方式，是保存吗？

记得前几天有个哥们的问题和这个类似，没想到解决办法
关注关注

不是保存,而是显示。保存时图文是在不同的字段，没必要将流混在一起。

把流显示出来，你能说得再详细点吗？

在webBroswer中不用产生临时文件,就可以直接显示数据库中的文本和图片。比如：员工姓名、照片等。

能不能不用html的方式同时显示图片和照片？

如果用html将图片进行外部连接当然简单

其实实现方式有多种,你说的方法当然可以。原来我也是这样增加一个员工照片文件夹。然后用外部连接。
我现在只是想搞清楚这个问题。看看webbroswer能否不需要外部连接就可以实现。

个人看法：

1、Activex，这个当然不合楼主要求

2、WebBroswer基于ie，那么IE如果实现不了的东西它也应该实现不了，标准的HTML好像不可以这样，那就只有变通的方法，比如CHM格式的文件就一个文件，但是里面可以很多东西，比如MHT格式的文件，里面也是这样，按这种思路是不是可行，

仅供参考

如果一定要做。。。。。。我现在能想到的就是用ole连接word来实现。。。

chm。。。。不清楚

uses ActiveX;

function ShowHtml(mWebBrowser: TWebBrowser; mStrings: TStrings): Boolean;
var
vMemoryStream: TMemoryStream;
begin
Result := False;
if not (Assigned(mStrings) and Assigned(mWebBrowser)) then Exit;
mWebBrowser.Navigate('about:blank');
if not Assigned(mWebBrowser.Document) then Exit;
vMemoryStream := TMemoryStream.Create;
try
mStrings.SaveToStream(vMemoryStream);
try
vMemoryStream.Position := 0;
Application.ProcessMessages; //
(mWebBrowser.Document as IPersistStreamInit).Load(
TStreamAdapter.Create(vMemoryStream));
except
Exit;
end;
finally
vMemoryStream.Free;
end;
Result := True;
end; { ShowHtml }

http://www.delphibbs.com/delphibbs/dispq.asp?LID=1792575
找了一段代码，关键问题还是怎么形成哪个mht的流的问题，上面的Strings修改成mht的文件流是可以的，继续关注

保存mht用ez save mht

我总觉得应该有方法可以实现。但就是不知道怎么做。大家有没有asp做提取数据库中多图片和文本的代码，我认为可以参考一下。不知道想法对不。

楼主提醒我了，我用流的方式显示MHT文件有问题，代码如下，所以我想IE应该还做了一定程度的处理，不过可以看出来的是WebBrower显示的和我把mht扩展名修改成htm的效果不同，所以里面的编码是经过IE处理的，但是WebBrower不能直接显示，下面的代码关键还是那个接口IPersistStreamInit，MSDN里面的介绍比较少（可能是我没找到），所以想到在ASP里面的Response.BinaryWrite这个方法，如果我们在程序里面可以实现这样其实就可以了，继续找资料中……
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, OleCtrls, SHDocVw, Activex, StdCtrls, Buttons, ExtCtrls;

type
TForm1 = class(TForm)
WebBrowser1: TWebBrowser;
BitBtn1: TBitBtn;
procedure BitBtn1Click(Sender: TObject);
private
function ShowHtml(mWebBrowser: TWebBrowser;MS : TMemoryStream): Boolean;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

function TForm1.ShowHtml(mWebBrowser: TWebBrowser; MS : TMemoryStream): Boolean;
var
vMemoryStream: TMemoryStream;
begin
Result := False;
if not (Assigned(MS ) and Assigned(mWebBrowser)) then Exit;
mWebBrowser.Navigate('about:blank');
if not Assigned(mWebBrowser.Document) then Exit;
vMemoryStream := TMemoryStream.Create;
try
MS.SaveToStream(vMemoryStream);
try
vMemoryStream.Position := 0;
Application.ProcessMessages; //
(mWebBrowser.Document as IPersistStreamInit).Load(
TStreamAdapter.Create(vMemoryStream));
except
Exit;
end;
finally
vMemoryStream.Free;
end;
Result := True;
end; { ShowHtml }

procedure TForm1.BitBtn1Click(Sender: TObject);
var
FS : TFileStream;
MS : TMemoryStream;
begin
FS := TFileStream.Create('c:/a.mht', fmOpenRead );
MS := TMemoryStream.Create;
try
FS.Position := 0;
MS.CopyFrom(FS, Fs.Size);
ShowHtml(WebBrowser1, MS);
finally
MS.Free;
FS.Free;
end;
end;

end.

想起来了，刚刚那个MHT有点类似邮件的编码，也就是MIME编码，既然是这样，Foxmail都实现了，我们去看看那个控件可能有帮助

跟个贴，在思考这个。。

贴部分代码
FInternetProtocol := TInternetProtocol.Create(Self);
FInternetProtocol.Protocol := 'File';
FInternetProtocol.OnStart := OnInternetProtocolStart;
FInternetProtocol.Active := True;

procedure TBackgroundFrm.OnInternetProtocolStart(const Url: string;
var Stream: TStream);
begin
//返回数据流
end;


unit InetCtrls;

interface

uses
SysUtils, Classes, Windows, ComObj, ActiveX, UrlMon, SyncObjs;

type
TInternetProtocolStartEvent = procedure (const Url: string;
var Stream: TStream) of object;

TInternetProtocol = class(TComponent)
private
FInternetProtocolObject: TObject;
FActive: Boolean;
FProtocol: string;
FStream: TStream;
FOnStart: TInternetProtocolStartEvent;
procedure CheckInactived;
procedure SetActive(Value: Boolean);
procedure SetProtocol(const Value: string);
procedure ClearStream;
protected
procedure Abort;
procedure DoSetActive(Value: Boolean);
procedure Loaded; override;
procedure Start(const Url: string);
procedure Terminate;
property Stream: TStream read FStream;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function Starting: Boolean;
published
property Active: Boolean read FActive write SetActive;
property Protocol: string read FProtocol write SetProtocol;
property OnStart: TInternetProtocolStartEvent read FOnStart write FOnStart;
end;

var
InternetSession: IInternetSession;
AEvent: TSimpleEvent;

implementation

const
IID_InternetProtocolClassFactory: TCLSID = '{71A3D78B-754F-41C0-AA0E-06A0273B663C}';

type
TInternetProtocolClassFactory = class(TInterfacedObject, IClassFactory)
protected
function CreateInstance(const UnkOuter: IUnknown;
const IID: TGUID; out Obj): HResult; stdcall;
function LockServer(fLock: BOOL): HResult; stdcall;
end;

TInternetProtocolObject = class(TInterfacedObject, IInternetProtocol)
private
FInternetProtocol: TInternetProtocol;
protected
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;
public
destructor Destroy; override;
end;

var
InternetProtocolClassFactory: TInternetProtocolClassFactory;
RegisteredProtocols: TStrings;

function TInternetProtocolClassFactory.CreateInstance(const UnkOuter: IUnknown;
const IID: TGUID; out Obj): HResult;
var
lInternetProtocolObject: TInternetProtocolObject;
begin
if (unkOuter <> nil) {and not (IsEqualIID(iid, IUnknown))} then
begin
Result := CLASS_E_NOAGGREGATION;
Exit;
end;
if IsEqualIID(IID_IInternetProtocol, IID) then
begin
lInternetProtocolObject := TInternetProtocolObject.Create;
IInternetProtocol(Obj) := lInternetProtocolObject;
Result := S_OK;
end
else
begin
Pointer(Obj) := nil;
Result := E_NOINTERFACE;
end;
end;

function TInternetProtocolClassFactory.LockServer(fLock: BOOL): HResult;
begin
Result := CoLockObjectExternal(Self, fLock, True);
end;

destructor TInternetProtocolObject.Destroy;
begin
if Assigned(FInternetProtocol) then FInternetProtocol.Abort;
inherited Destroy;
end;

function TInternetProtocolObject.Start(szUrl: LPCWSTR;
OIProtSink: IInternetProtocolSink; OIBindInfo: IInternetBindInfo;
grfPI, dwReserved: DWORD): HResult;
var
S: string;
I: Integer;
begin
//Addeb by Tongdf, 防止重入Start
AEvent.WaitFor(INFINITE);
AEvent.ResetEvent;

S := WideCharToString(szUrl);
I := Pos('://', S);
if I > 0 then
I := RegisteredProtocols.IndexOf(Copy(S, 1, I - 1))
else
I := -1;
if I >= 0 then
begin
FInternetProtocol := TInternetProtocol(RegisteredProtocols.Objects);
FInternetProtocol.FInternetProtocolObject := Self;
FInternetProtocol.Start(S);
if Assigned(FInternetProtocol.Stream) then
begin
OIProtSink.ReportData(bscf_LastDataNotification, 0,
FInternetProtocol.Stream.Size);
OIProtSink.ReportData(bscf_DataFullyAvailable, 0,
FInternetProtocol.Stream.Size);
end;
Result := S_OK;
end
else
Result := INET_E_USE_DEFAULT_PROTOCOLHANDLER;
end;

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

function TInternetProtocolObject.Abort(hrReason: HResult; dwOptions: DWORD): HResult;
begin
//Modify by tongdf
AEvent.SetEvent;
//if Assigned(FInternetProtocol) then FInternetProtocol.Abort;
Result := S_OK;
end;

function TInternetProtocolObject.Terminate(dwOptions: DWORD): HResult;
begin
//Modify by Tongdf
AEvent.SetEvent;
//if Assigned(FInternetProtocol) then FInternetProtocol.Terminate;
Result := S_OK;
end;

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

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

function TInternetProtocolObject.Read(pv: Pointer; cb: ULONG; out cbRead: ULONG): HResult;
begin
if Assigned(FInternetProtocol) and Assigned(FInternetProtocol.Stream) then
cbRead := FInternetProtocol.Stream.Read(pv^, cb);
//Added by Tongdf
if cbRead = 0 then
AEvent.SetEvent;

if cbRead = 0 then Result := S_FALSE else Result := S_OK;
end;

function TInternetProtocolObject.Seek(dlibMove: LARGE_INTEGER; dwOrigin: DWORD;
out libNewPosition: ULARGE_INTEGER): HResult;
begin
if Assigned(FInternetProtocol) and Assigned(FInternetProtocol.Stream) then
begin
FInternetProtocol.Stream.Seek(dlibMove.LowPart, dwOrigin);
libNewPosition.QuadPart := FInternetProtocol.Stream.Position;
end;
Result := S_OK;
end;

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

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

destructor TInternetProtocol.Destroy;
begin
ClearStream;
Active := False;
inherited Destroy;
end;

procedure TInternetProtocol.CheckInactived;
begin
if Active then raise Exception.Create('The protocol already active');
end;

procedure TInternetProtocol.SetActive(Value: Boolean);
begin
if Active <> Value then
begin
if not (csDesigning in ComponentState) and not (csLoading in ComponentState) then
DoSetActive(Value);
FActive := Value;
end;
end;

procedure TInternetProtocol.SetProtocol(const Value: string);
begin
if not (csDesigning in ComponentState) and not (csLoading in ComponentState) then
CheckInactived;
FProtocol := Value;
end;

procedure TInternetProtocol.Abort;
begin
Terminate;
end;

procedure TInternetProtocol.DoSetActive(Value: Boolean);
var
P: array[0..Max_Path - 1] of WideChar;
begin
StringToWideChar(Protocol, P, Max_Path);
if Value then
begin
if Protocol = '' then raise Exception.Create('The protocol is null');
if RegisteredProtocols.IndexOf(Protocol) >= 0 then
raise Exception.Create('The protocol already active');
OleCheck(InternetSession.RegisterNameSpace(InternetProtocolClassFactory,
IID_InternetProtocolClassFactory, P, 0, nil, 0));
RegisteredProtocols.AddObject(Protocol, Self);
end
else
begin
if Starting then Abort;
if Assigned(InternetSession) and Assigned(InternetProtocolClassFactory) and
Assigned(RegisteredProtocols) then //这样是不对的，没有更好的办法，暂时这样
begin
OleCheck(InternetSession.UnRegisterNameSpace(InternetProtocolClassFactory, P));
RegisteredProtocols.Delete(RegisteredProtocols.IndexOf(Protocol));
end;
end;
end;

procedure TInternetProtocol.Loaded;
begin
inherited Loaded;
if Active then DoSetActive(True);
end;

procedure TInternetProtocol.Start(const Url: string);
begin
//FStream := nil;
ClearStream;
if Assigned(OnStart) then OnStart(Url, FStream);
end;

procedure TInternetProtocol.Terminate;
begin
if not Starting then Exit;
TInternetProtocolObject(FInternetProtocolObject).FInternetProtocol := nil;
FInternetProtocolObject := nil;
FStream.Free;
FStream := nil;
end;

function TInternetProtocol.Starting: Boolean;
begin
Result := Assigned(FStream);
end;

constructor TInternetProtocol.Create(AOwner: TComponent);
begin
inherited;
FStream := nil;
end;

procedure TInternetProtocol.ClearStream;
begin
if Assigned(FStream) then
begin
FStream.Free;
FStream := nil;
end;
end;

initialization
OleCheck(CoInternetGetSession(0, InternetSession, 0));
InternetProtocolClassFactory := TInternetProtocolClassFactory.Create;
InternetProtocolClassFactory._AddRef;
RegisteredProtocols := TStringList.Create;
TStringList(RegisteredProtocols).Duplicates := dupError;
TStringList(RegisteredProtocols).Sorted := True;
AEvent := TSimpleEvent.Create;
AEvent.SetEvent;

finalization
InternetProtocolClassFactory._Release;
InternetProtocolClassFactory := nil;
RegisteredProtocols.Free;
RegisteredProtocols := nil;
AEvent.Free;

end.

相关的还有mht分解单元，就不贴了，如果需要留邮件

发个我看看，谢谢satanmonkey@21cn.com