IHtmlDocument2的问题 ( 积分: 200 )

  • 主题发起人 主题发起人 yellowfish
  • 开始时间 开始时间
Y

yellowfish

Unregistered / Unconfirmed
GUEST, unregistred user!
如何直接把生成的HTML写入IHtmlDocument2进行解析，不用WebBrowser？
 
如何直接把生成的HTML写入IHtmlDocument2进行解析，不用WebBrowser？
 
应该是open打开，write写入HTML
 
能否For Example？
 
IHTMLDocument2 *document; // Declared earlier in the code
HRESULT hresult = S_OK;
VARIANT *param;
SAFEARRAY *sfArray;
BSTR bstr = SysAllocString(OLESTR("Written by IHTMLDocument2::write()."));

// Creates a new one-dimensional array
sfArray = SafeArrayCreateVector(VT_VARIANT, 0, 1);

if (sfArray == NULL || document == NULL) {
goto cleanup;
}

hresult = SafeArrayAccessData(sfArray,(LPVOID*) & param);
param->vt = VT_BSTR;
param->bstrVal = bstr;
hresult = SafeArrayUnaccessData(sfArray);
hresult = document->write(sfArray);

cleanup:
SysFreeString(bstr);
if (sfArray != NULL) {
SafeArrayDestroy(sfArray);
}
c的
 
...谁帮忙翻译成DELPHI一下
 
如果HTML文件比较简单的内容（没有特别的脚本代码）可以
webbrowser1.Navigate('about:<html><body>你的HTML文本代码</body></html>');

复杂的HTML代码可以
需要用SafeArray，范例：

var
Document1: IHtmlDocument2;
v:oleVariant;
begin
webbrowser1.Navigate('about:blank');
Document1 := webbrowser1.Document as IHtmlDocument2;
if (Assigned(Document1)) then begin
v := VarArrayCreate([0, 0], varVariant);
v[0] := '<html><body>你的HTML文本代码</body></html>';
Document1.Write(PSafeArray(TVarData(v).VArray));
Document1.Close;
end;
end;

第三种方法
{ 示例 ....

Uses UI_less;

procedure TForm1.Button1Click(Sender: TObject);
var
sh: TUILess;
su:boolean;//是否获取成功
isstop:boolean;//是否取消
begin
sh := TUILess.Create(nil);
sh.GetAnchorList(sh.get('http://www.163.com',sh,isstop),memo1.lines);

end; }

unit UI_Less;

interface

uses
Windows, Classes, Messages, Forms, MsHtml, Urlmon, ActiveX;

const
WM_USER_STARTWALKING = WM_USER + 1;
DISPID_AMBIENT_DLCONTROL = (-5512);
READYSTATE_COMPLETE = $00000004;

DLCTL_DLIMAGES = $00000010;
DLCTL_VIDEOS = $00000020;
DLCTL_BGSOUNDS = $00000040;
DLCTL_NO_SCRIPTS = $00000080;
DLCTL_NO_JAVA = $00000100;
DLCTL_NO_RUNACTIVEXCTLS = $00000200;
DLCTL_NO_DLACTIVEXCTLS = $00000400;
DLCTL_DOWNLOADONLY = $00000800;
DLCTL_NO_FRAMEDOWNLOAD = $00001000;
DLCTL_RESYNCHRONIZE = $00002000;
DLCTL_PRAGMA_NO_CACHE = $00004000;
DLCTL_NO_BEHAVIORS = $00008000;
DLCTL_NO_METACHARSET = $00010000;
DLCTL_URL_ENCODING_DISABLE_UTF8 = $00020000;
DLCTL_URL_ENCODING_ENABLE_UTF8 = $00040000;
DLCTL_FORCEOFFLINE = $10000000;
DLCTL_NO_CLIENTPULL = $20000000;
DLCTL_SILENT = $40000000;
DLCTL_OFFLINEIFNOTCONNECTED = $80000000;
DLCTL_OFFLINE = DLCTL_OFFLINEIFNOTCONNECTED;


type
TUILess = class(TComponent, IUnknown, IDispatch, IPropertyNotifySink, IOleClientSite)
private
FDocTitle: string;
FBodyText: TStrings;
FBodyHtml: TStrings;
protected
/// IDISPATCH
function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
/// IPROPERTYNOTIFYSINK
function OnChanged(DispID: TDispID): HResult; stdcall;
function OnRequestEdit(DispID: TDispID): HResult; stdcall;
/// IOLECLIENTSITE
function SaveObject: HResult; stdcall;
function GetMoniker(dwAssign: Longint; dwWhichMoniker: Longint;
out mk: IMoniker): HResult; stdcall;
function GetContainer(out container: IOleContainer): HResult; stdcall;
function ShowObject: HResult; stdcall;
function OnShowWindow(fShow: BOOL): HResult; stdcall;
function RequestNewObjectLayout: HResult; stdcall;
///
function LoadUrlFromMoniker: HResult;
function LoadUrlFromFile: HResult;
// * We only use LoadUrlFromMoniker, but we could use LoadUrlFromFile instead.

public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property DocTitle: string read FDocTitle;
property BodyText: TStrings read FBodyText write FBodyText;
property BodyHtml: TStrings read FBodyHtml write FBodyHtml;
function Get(URL: PWidechar; var IsSucceed: Boolean; IsStop: Boolean): IHTMLELEMENTCollection;
procedure GetAnchorList(IC: IHTMLELEMENTCollection; Anchorlist: TStrings);
procedure GetImageList(IC: IHTMLELEMENTCollection; ImageList: TStrings);
end;

implementation

var
Doc: IhtmlDocument2;
_URL: PWidechar;

constructor TUILess.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FBodyText := TStringList.Create;
FBodyHtml := TStringList.Create;
end;

destructor TUILess.Destroy;
begin
if Assigned(FBodyText) then FBodyText.Free;
if Assigned(FBodyHtml) then FBodyHtml.Free;
inherited Destroy;
end;
/// CORE ---->>>>>>>>>
function TUILess.Get(URL: PWidechar; var IsSucceed: Boolean; IsStop: Boolean): IHTMLELEMENTCollection;
var
Cookie: Integer;
CP: IConnectionPoint;
OleObject: IOleObject;
OleControl: IOleControl;
CPC: IConnectionPointContainer;
All: IHTMLElement;
Msg: TMsg;
hr: HResult;
begin
_URL := URL;
IsSucceed := false;
try
CoCreateInstance(CLASS_HTMLDocument, nil, CLSCTX_INPROC_SERVER, IID_IHTMLDocument2, Doc);
OleObject := Doc as IOleObject;
OleObject.SetClientSite(self);
OleControl := Doc as IOleControl;
OleControl.OnAmbientPropertyChange(DISPID_AMBIENT_DLCONTROL);
CPC := Doc as IConnectionPointContainer;
CPC.FindConnectionPoint(IPropertyNotifySink, CP);
CP.Advise(self, Cookie);
hr := LoadUrlFromMoniker; //如果是加载本地的HTML文件，请换用loadUrlFromFile
if ((SUCCEEDED(hr)) or (hr = E_PENDING)) then
while (GetMessage(Msg, 0, 0, 0)) do
begin
if ((Msg.message = WM_USER_STARTWALKING) and (Msg.hwnd = 0)) then
begin
PostQuitMessage(0);
result := Doc.Get_all;
All := Doc.Get_body;
FDocTitle := string(Doc.nameProp);
FBodyText.Text := string(All.outerText);返回文本代码
FBodyHtml.Text := string(All.outerHTML); //返回HTML代码
IsSucceed := true;
end else DispatchMessage(Msg);
if IsStop then Exit;
end;
except
Exit;
end;
end;

function TUILess.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
var
I: Integer;
begin
if DISPID_AMBIENT_DLCONTROL = DispID then
begin
I := DLCTL_DOWNLOADONLY + DLCTL_NO_SCRIPTS +
DLCTL_NO_JAVA + DLCTL_NO_DLACTIVEXCTLS +
DLCTL_NO_RUNACTIVEXCTLS;
PVariant(VarResult)^ := I;
result := S_OK;
end else result := DISP_E_MEMBERNOTFOUND;
end;

function TUILess.OnChanged(DispID: TDispID): HResult;
var
dp: TDispParams;
vResult: OleVariant;
begin
if (DISPID_READYSTATE = DispID) then
if SUCCEEDED((Doc as IhtmlDocument2).Invoke(DISPID_READYSTATE, GUID_null,
LOCALE_SYSTEM_DEFAULT, DISPATCH_PROPERTYGET, dp, @vResult, nil, nil)) then
if Integer(vResult) = READYSTATE_COMPLETE then
PostThreadMessage(GetCurrentThreadId(), WM_USER_STARTWALKING, 0, 0);
end;

function TUILess.LoadUrlFromMoniker: HResult;
var
Moniker: IMoniker;
BindCtx: IBindCTX;
PM: IPersistMoniker;
begin
createURLMoniker(nil, _URL, Moniker);
CreateBindCtx(0, BindCtx);
PM := Doc as IPersistMoniker;
result := PM.Load(LongBool(0), Moniker, BindCtx, STGM_READ)
end;

function TUILess.LoadUrlFromFile: HResult;
var
PF: IPersistfile;
begin
PF := Doc as IPersistfile;
result := PF.Load(_URL, 0);
end;

//获取图像链接
procedure TUILess.GetImageList(IC: IHTMLELEMENTCollection; ImageList: TStrings);
var
Image: IHTMLImgElement;
Disp: IDispatch;
x: Integer;
begin
if IC <> nil then
begin
for x := 0 to IC.Length - 1 do
begin
application.ProcessMessages;
Disp := IC.item(x, 0);
if SUCCEEDED(Disp.QueryInterface(IHTMLImgElement, Image)) then
ImageList.add(string(Image.src));
end;
end;
end;

//获取链接
procedure TUILess.GetAnchorList(IC: IHTMLELEMENTCollection; Anchorlist: TStrings);
var
anchor: IHTMLAnchorElement;
Disp: IDispatch;
x: Integer;
begin
if IC <> nil then
begin
for x := 0 to IC.Length - 1 do
begin
application.ProcessMessages;
Disp := IC.item(x, 0);
if (SUCCEEDED(Disp.QueryInterface(IHTMLAnchorElement, anchor)) and (anchor.href <> '')) then
Anchorlist.add(string(anchor.href));
end;
end;
end;

/// Don't Care ------>>>>>>>>>>>
function TUILess.OnRequestEdit(DispID: TDispID): HResult;
begin
result := E_NOTIMPL;
end;

function TUILess.SaveObject: HResult;
begin
result := E_NOTIMPL;
end;

function TUILess.GetMoniker(dwAssign: Longint; dwWhichMoniker: Longint;
out mk: IMoniker): HResult;
begin
result := E_NOTIMPL;
end;

function TUILess.GetContainer(out container: IOleContainer): HResult;
begin
result := E_NOTIMPL;
end;

function TUILess.ShowObject: HResult;
begin
result := E_NOTIMPL;
end;

function TUILess.OnShowWindow(fShow: BOOL): HResult;
begin
result := E_NOTIMPL;
end;

function TUILess.RequestNewObjectLayout: HResult;
begin
result := E_NOTIMPL;
end;

end.
 
楼上的，楼主要的是不用webbrowser的。
 
第三个方法就是不用webbrowser的
 
多人接受答案了。
 
您必须登录或注册才可回复。

Similar threads

S
[FMX]修正 FMX 组件嵌套时 Tab 顺序不正常的问题
回复
0
查看
442
swish
S
S
[教程]Delphi 函数的内部函数在匿名回调函数中无法使用的一种解决办法
回复
0
查看
556
swish
S
X
一步一步从PostgreSQL安装到delphi 访问 - xalion
回复
0
查看
668
xalion
X
X
使用kbmmw 生成客户端delphi函数原型 - xalion
回复
0
查看
705
xalion
X
X
使用双引擎，让kbmmw 的客户端访问更方便 - xalion
回复
0
查看
800
xalion
X
后退
顶部