如何将网页保存成mht文件呀?请给个Demo例子,我找到的执行时报错(Unknown Error.)(50分)

  • 主题发起人 主题发起人 11830
  • 开始时间 开始时间
1

11830

Unregistered / Unconfirmed
GUEST, unregistred user!
以下是我的代码,执行时报错(Unknown Error.),请高人调试一下,将程序发到我的邮件中getrose@sina.com,谢谢
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, OleCtrls, SHDocVw,ComObj,CDO_TLB, ADODB_TLB;

type
TForm1 = class(TForm)
WebBrowser1: TWebBrowser;
Edit1: TEdit;
Button1: TButton;
Button2: TButton;
SaveDialog1: TSaveDialog;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation



{$R *.dfm}


procedure WB_SaveAs_MHT(WB: TWebBrowser; FileName: TFileName);
var
Msg: IMessage;
Conf: IConfiguration;
Stream: _Stream;
URL : widestring;
begin
if not Assigned(WB.Document) then Exit;
URL := WB.LocationURL;

Msg := CoMessage.Create;
Conf := CoConfiguration.Create;
try
Msg.Configuration := Conf;
Msg.CreateMHTMLBody(URL, cdoSuppressAll, '', '');
Stream := Msg.GetStream;
Stream.SaveToFile(FileName, adSaveCreateOverWrite);
finally
Msg := nil;
Conf := nil;
Stream := nil;
end;
end; (* WB_SaveAs_MHT *)



procedure TForm1.Button1Click(Sender: TObject);
begin
WebBrowser1.Navigate(Edit1.Text);
end;



procedure TForm1.Button2Click(Sender: TObject);
begin
if SaveDialog1.Execute then
begin
WB_SaveAs_MHT(WebBrowser1,SaveDialog1.FileName);
end;
end;

end.
 
Create an mht (web page single file) file
----------------------------------------------
Below are 2 versions of the source code to do this. Also a test application from the component link.

procedure SaveToMHT(const URL, DestFileName: string);

This procedure can be used as long as the threading model has not been set to Multithreaded. If you try, you will get an "Interface not supported" error.

But if you have already set COM to multithreaded through the CoInitializeEx function then use the other function:

This one:
procedure SaveToMHT_InCOThread(const URL, DestFileName: string);



The difference in this last function is that it runs the 1st function in a separate thread with CoInitialize(nil) called. This allows you to still call the SaveToMHT when you have previously set COM to multithreaded. (Its still blocking, so the function will only return when it is finished)

Beware, it is possible to get a "security" error when downloading from a secure https website. The only workaround I am aware of is to remove the "s" and just use http.


In adition to the unit containing the 2 procedures, I have also included the import type libraries required (click the component link above). This should save you about 30 minutes of hunting the internet trying to find which dll you have to import.

In the event you have to re-import it, the dll is cdosys.dll in the system32 directory.



---------------------
unit SaveMHT;

interface
uses
CDO_TLB, ADODB_TLB, Classes, SysUtils, ActiveX;

procedure SaveToMHT(const URL, DestFileName: string);

// This should be used when you have already set the threading model to multithreaded
procedure SaveToMHT_InCOThread(const URL, DestFileName: string);

implementation

procedure SaveToMHT(const URL, DestFileName: string);
var
Msg: IMessage;
Conf: IConfiguration;
Stream : _Stream;
begin
Msg := CoMessage.Create;
Conf := CoConfiguration.Create;
Msg.Configuration := Conf;
Msg.CreateMHTMLBody(URL, cdoSuppressNone, '', '');
Stream := Msg.GetStream;
Stream.SaveToFile(DestFileName, adSaveCreateOverWrite);
end;

type
TCOMInitNullThread = class(TThread)
protected
FPage, FFile: string;
Ex: Exception;
procedure Execute; override;
end;

procedure SaveToMHT_InCOThread(const URL, DestFileName: string);
begin
with TCOMInitNullThread.Create(True) do
try
FPage:= URL;
FFile:= DestFileName;
Resume;
WaitFor;
if Ex <> nil then
raise Ex;
finally
Free;
end;
end;

{ TCOMInitNullThread }

procedure TCOMInitNullThread.Execute;
begin
CoInitialize(nil);
try
SaveToMHT(FPage, FFile);
except
on E:Exception do
begin
Ex:= E.ClassType.Create as Exception;
Ex.Message:= E.Message;
end;
end;
CoUninitialize;
end;

end.
 
本地带图片的比较难,用过id来做,不够完美.
有哪位大侠可以解决本地与网络的 htm -> mht 方案?
 
问题解决了
 
后退
顶部