Mega Code Archive

 
Categories / Delphi / Files
 

Create an mht (web page single file) file

Title: Create an mht (web page single file) file Question: 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: 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.