Mirror

Create an mht (web page single file) file (Views: 747)

Problem/Question/Abstract:

This article tells you how to create a web page archive single file that can be viewed in IE, all images are included in this file. This is the Web Archive, single file (*.mht) option in the IE save as.

Answer:

Solve 1:

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.

Component Download: http://www.baltsoft.com/files/dkb/attachment/mht.ziphttp://www.baltsoft.com/files/dkb/attachment/mht.zip


Solve 2:

function SaveToMHT(const AUrl, AFileName: string;
AShowErrorMessage: boolean = false): boolean;
var
oMSG, oConfig: OleVariant;
sFileName: string;
Retvar: boolean;
begin
sFileName := ChangeFileExt(AFileName, '.mht');
DeleteFile(sFileName);

try
oConfig := CreateOleObject('CDO.Configuration');
oMSG := CreateOleObject('CDO.Message');
oMSG.Configuration := oConfig;
oMSG.CreateMHTMLBody(AUrl);
oMSG.GetStream.SaveToFile(sFileName);
Retvar := true;
except
on E: Exception do
begin
if AShowErrorMessage then
MessageDlg(E.Message, mtError, [mbOk], 0);
Retvar := false;
end;
end;

oMSG := VarNull;
oConfig := VarNull;

Result := Retvar;
end;

<< Back to main page