coldboy
asked on
LOad Image Directly From Stream IN TWebbrowser
dear EE!
I have placed many image in a database and want to use TWebbrowser to display them with comment. BUt I must create image on harddisk before use it, It's inconvenient because user can get my image. I don't want any one to get my image, (only look at it), So I want to load Image from memory stream. Is it possible? CaN i hook the event which TWEbrrowser start to download any file and replace the download procedure with my own procedure?
THanks for care!
I have placed many image in a database and want to use TWebbrowser to display them with comment. BUt I must create image on harddisk before use it, It's inconvenient because user can get my image. I don't want any one to get my image, (only look at it), So I want to load Image from memory stream. Is it possible? CaN i hook the event which TWEbrrowser start to download any file and replace the download procedure with my own procedure?
THanks for care!
I think the best way that you could use is to show the image in a TPicture with your comment as a TLabel or similar. This way you can load your image easily, and you also remove the dependancy on IE.
is the image the only thing you want to display?
or you want regular HTML and whenever there is an image load those from a different source?
this might be of interest to you... depending on what exactly you are trying to do:
http://delphi.about.com/od/internetintranet/l/aa061901a.htm
or you want regular HTML and whenever there is an image load those from a different source?
this might be of interest to you... depending on what exactly you are trying to do:
http://delphi.about.com/od/internetintranet/l/aa061901a.htm
ASKER
dear paulb1989!
I have animate gif. With any component I tried (like TjvAnimateGIF), they will give somuch Error (like canvas doesnot allow drawing) when I create many Image(about >15). There only one way: uses TWebbrowser. It works so smooth that I can't find any component that can compare with it!
dear backtigerX!
I place image in a database. I think resources be well for small data, not for a slide show with two much image!
Thank for care. Can any one show me how to hook the event which IE start to load it data?
I have animate gif. With any component I tried (like TjvAnimateGIF), they will give somuch Error (like canvas doesnot allow drawing) when I create many Image(about >15). There only one way: uses TWebbrowser. It works so smooth that I can't find any component that can compare with it!
dear backtigerX!
I place image in a database. I think resources be well for small data, not for a slide show with two much image!
Thank for care. Can any one show me how to hook the event which IE start to load it data?
Well, one way would be to create an MHTML file dynamically and stream it to the browser.
Let me whip up something for you and ss if I can make it work.
Let me whip up something for you and ss if I can make it work.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, OleCtrls, SHDocVw, uBase64, ActiveX, MSHTML, ExtCtrls;
type
TForm1 = class(TForm)
WebBrowser1: TWebBrowser;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
// Quote Printable source from Synapse library...
type
TSpecials = set of AnsiChar;
const
SpecialChar: TSpecials =
['=', '(', ')', '[', ']', '<', '>', ':', ';', ',', '@', '/', '?', '\',
'"', '_'];
NonAsciiChar: TSpecials =
[Char(0)..Char(31), Char(127)..Char(255)];
URLFullSpecialChar: TSpecials =
[';', '/', '?', ':', '@', '=', '&', '#', '+'];
URLSpecialChar: TSpecials =
[#$00..#$20, '_', '<', '>', '"', '%', '{', '}', '|', '\', '^', '~', '[', ']',
'`', #$7F..#$FF];
TableBase64 =
'ABCDEFGHIJKLMNOPQRSTUVWXY Zabcdefghi jklmnopqrs tuvwxyz012 3456789+/= ';
TableBase64mod =
'ABCDEFGHIJKLMNOPQRSTUVWXY Zabcdefghi jklmnopqrs tuvwxyz012 3456789+,= ';
TableUU =
'`!"#$%&''()*+,-./01234567 89:;<=>?@A BCDEFGHIJK LMNOPQRSTU VWXYZ[\]^_ ';
TableXX =
'+-0123456789ABCDEFGHIJKLM NOPQRSTUVW XYZabcdefg hijklmnopq rstuvwxyz' ;
ReTablebase64 =
#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$3E +#$40
+#$40 +#$40 +#$3F +#$34 +#$35 +#$36 +#$37 +#$38 +#$39 +#$3A +#$3B +#$3C
+#$3D +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$00 +#$01 +#$02 +#$03
+#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A +#$0B +#$0C +#$0D +#$0E +#$0F
+#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18 +#$19 +#$40 +#$40
+#$40 +#$40 +#$40 +#$40 +#$1A +#$1B +#$1C +#$1D +#$1E +#$1F +#$20 +#$21
+#$22 +#$23 +#$24 +#$25 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D
+#$2E +#$2F +#$30 +#$31 +#$32 +#$33 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;
ReTableUU =
#$01 +#$02 +#$03 +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A +#$0B +#$0C
+#$0D +#$0E +#$0F +#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18
+#$19 +#$1A +#$1B +#$1C +#$1D +#$1E +#$1F +#$20 +#$21 +#$22 +#$23 +#$24
+#$25 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D +#$2E +#$2F +#$30
+#$31 +#$32 +#$33 +#$34 +#$35 +#$36 +#$37 +#$38 +#$39 +#$3A +#$3B +#$3C
+#$3D +#$3E +#$3F +#$00 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40
+#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40
+#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;
ReTableXX =
#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$00 +#$40
+#$01 +#$40 +#$40 +#$02 +#$03 +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A
+#$0B +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$0C +#$0D +#$0E +#$0F
+#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18 +#$19 +#$1A +#$1B
+#$1C +#$1D +#$1E +#$1F +#$20 +#$21 +#$22 +#$23 +#$24 +#$25 +#$40 +#$40
+#$40 +#$40 +#$40 +#$40 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D
+#$2E +#$2F +#$30 +#$31 +#$32 +#$33 +#$34 +#$35 +#$36 +#$37 +#$38 +#$39
+#$3A +#$3B +#$3C +#$3D +#$3E +#$3F +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;
function EncodeTriplet(const Value: AnsiString; Delimiter: AnsiChar;
Specials: TSpecials): AnsiString;
var
n, l: Integer;
s: AnsiString;
c: AnsiChar;
begin
SetLength(Result, Length(Value) * 3);
l := 1;
for n := 1 to Length(Value) do
begin
c := Value[n];
if c in Specials then
begin
Result[l] := Delimiter;
Inc(l);
s := IntToHex(Ord(c), 2);
Result[l] := s[1];
Inc(l);
Result[l] := s[2];
Inc(l);
end
else
begin
Result[l] := c;
Inc(l);
end;
end;
Dec(l);
SetLength(Result, l);
end;
{========================= ========== ========== ========== ========== ========== ===}
function EncodeQuotedPrintable(cons t Value: AnsiString): AnsiString;
begin
Result := EncodeTriplet(Value, '=', ['='] + NonAsciiChar);
end;
procedure TForm1.Button1Click(Sender : TObject);
var
slMHTMLBody: TStringList;
slMHTMLHeader: TStringList;
slImageEncoded: TStringList;
slImageFileList: TStringList;
fsImage: TFileStream;
i: Integer;
s: String;
IDoc: IHTMLDocument2;
v: Variant;
AStream: TMemoryStream;
begin
WebBrowser1.Navigate('abou t:blank');
slMHTMLBody := TStringList.Create;
slMHTMLHeader := TStringList.Create;
slImageFileList := TStringList.Create;
slImageEncoded := TStringList.Create;
try
// Let's build the body first, it needs to be QP Encoded
slMHTMLBody.Add('<html>');
slMHTMLBody.Add('<head>');
slMHTMLBody.Add(' <title>Untitled</title>');
slMHTMLBody.Add('</head>') ;
slMHTMLBody.Add('');
slMHTMLBody.Add('<body>');
slMHTMLBody.Add('<br><br>< b><font color="red">Experts-Exchan ge</font>< /b><br><br ><br>');
slMHTMLBody.Add('<img src="cid:sm69yellow.gif"') ;
slMHTMLBody.Add(' width="16" height="22" alt="" border="0"><img src="cid:sm120yellow.gif"' );
slMHTMLBody.Add(' width="16" height="22" alt="" border="0"><img src="cid:sm112yellow.gif"' );
slMHTMLBody.Add(' width="16" height="22" alt="" border="0"><img src="cid:sm101yellow.gif"' );
slMHTMLBody.Add(' width="16" height="22" alt="" border="0"><img src="cid:sm114yellow.gif"' );
slMHTMLBody.Add(' width="16" height="22" alt="" border="0"><img src="cid:sm116yellow.gif"' );
slMHTMLBody.Add(' width="16" height="22" alt="" border="0">');
slMHTMLBody.Add('</body>') ;
slMHTMLBody.Add('</html>') ;
s := slMHTMLBody.Text;
// Remove the CR/LF pairs
s := StringReplace(s, #13, '', [rfReplaceAll]);
s := StringReplace(s, #10, '', [rfReplaceAll]);
s := EncodeQuotedPrintable(s);
slMHTMLBody.Text := s;
// Now build the header
slMHTMLHeader.Add('From: <Saved by Microsoft Internet Explorer 5>');
slMHTMLHeader.Add('Subject :');
slMHTMLHeader.Add('Date: Mon, 25 Apr, 2005, 12:00:00');
slMHTMLHeader.Add('MIME-Ve rsion: 1.0');
slMHTMLHeader.Add('Content -Type: multipart/related;');
slMHTMLHeader.Add(' boundary="----=_NextPart_3 5_49_15.20 05_04_25"; ');
slMHTMLHeader.Add(' type="text/html"');
slMHTMLHeader.Add('X-MimeO LE: Produced By Microsoft MimeOLE V6.00.2800.1441');
slMHTMLHeader.Add('');
slMHTMLHeader.Add('This is a multi-part message in MIME format.');
slMHTMLHeader.Add('');
slMHTMLHeader.Add('------= _NextPart_ 35_49_15.2 005_04_25' );
slMHTMLHeader.Add('Content -Type: text/html;');
slMHTMLHeader.Add(' charset="Windows-1252"');
slMHTMLHeader.Add('Content -Transfer- Encoding: quoted-printable');
slMHTMLHeader.Add('Content -Location: c:\blah.html');
slMHTMLHeader.Add(''); // must have this blank line!!!
// Now add the body to the header:
slMHTMLHeader.AddStrings(s lMHTMLBody );
slMHTMLHeader.Add(''); // must have this blank line!!!
// Let's build a list of the images we want to include,
// for you, you will have to write something to create the base64 (MIME)
// encoded strings yourself, I'm encoding these on the fly below.
// You can encode them and save as string resources.
slImageFileList.Add('c:\in etpub\wwwr oot\images \digits\sm 69yellow.g if');
slImageFileList.Add('c:\in etpub\wwwr oot\images \digits\sm 120yellow. gif');
slImageFileList.Add('c:\in etpub\wwwr oot\images \digits\sm 112yellow. gif');
slImageFileList.Add('c:\in etpub\wwwr oot\images \digits\sm 101yellow. gif');
slImageFileList.Add('c:\in etpub\wwwr oot\images \digits\sm 114yellow. gif');
slImageFileList.Add('c:\in etpub\wwwr oot\images \digits\sm 116yellow. gif');
// Now add each of your images
for i := 0 to slImageFileList.count-1 do
begin
// This line MUST match the one above in the header!!!
slMHTMLHeader.Add('------= _NextPart_ 35_49_15.2 005_04_25' );
slMHTMLHeader.Add('Content -Type: application/binary');
slMHTMLHeader.Add('Content -Transfer- Encoding: base64');
slMHTMLHeader.Add('Content -ID: '+ ExtractFileName(slImageFil eList[i])) ;
slMHTMLHeader.Add(''); // must have this blank line!!!
// Now add the base64 encoded image
fsImage := TFileStream.Create(slImage FileList[i ], fmOpenRead);
try
slImageEncoded := encode_base64(fsImage);
slMHTMLHeader.AddStrings(s lImageEnco ded);
finally
fsImage.Free;
end;
slMHTMLHeader.Add(''); // must have this blank line!!!
end;
slMHTMLHeader.Add('------= _NextPart_ 35_49_15.2 005_04_25' );
slMHTMLHeader.Add(''); // must have this blank line!!!
slMHTMLHeader.SaveToFile(' c:\ee.mht' );
{
//
// Tried writing the MHT directly into WebBrowser...
//
IDoc := WebBrowser1.Document as IHTMLDocument2;
try
IDoc.designMode:='on';
while IDoc.readyState<>'complete ' do
Application.ProcessMessage s;
v:=VarArrayCreate([0,0],Va rVariant);
v[0]:= slMHTMLHeader.Text;
IDoc.write(PSafeArray(Syst em.TVarDat a(v).VArra y));
IDoc.designMode:='off';
while IDoc.readyState<>'complete ' do
Application.ProcessMessage s;
finally
IDoc := nil;
end;
//
// Also tried streaming directly into WebBrowser...
//
AStream := TMemoryStream.Create;
try
slMHTMLHeader.SaveToStream (AStream);
AStream.Position := 0;
(WebBrowser1.Document as IPersistStreamInit).Load(T StreamAdap ter.Create (AStream)) ;
finally
AStream.Free;
end;
}
// Since I was unable to get it to write directly to the webrowser
// because WebBrowser can't read content-type thus it comes up
// incorrectly, from what I can see, you MUST save it to disk,
// first, neither of the above techniques worked.
WebBrowser1.Navigate('c:\e e.mht');
finally
slImageFileList.Free;
slImageEncoded.Free;
slMHTMLHeader.Free;
slMHTMLBody.Free;
end;
end;
(*
Here is the DFM text for each image, open a dfm with a TImage and replace it's
Picture.data with this and you can then save each image to a file
sm69yellow.gif:
Picture.Data = {
0954474946496D616765770300 0047494638 3961100016 00F7000000 0000FFFF
00003333000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 000000002C 00000000
1000160000085C0001081C48B0 A0C0000100 20549870E1 4286101D36 4C68B022
C185020400C8B8512347881C43 7AD468B124 C6911D5382 4429B2A4C9 8911137E
941853A54B832753B65CA913E5 4D9C3259FA CCD9F2E3CF 8B30693E54 9A94E251
810101003B}
sm120yellow.gif:
Picture.Data = {
0954474946496D616765750300 0047494638 3961100016 00F7000000 0000FFFF
00003333000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 000000002C 00000000
1000160000085A0001081C48B0 A040010200 20549870E1 4286101D36 4C68B022
418911271ED488F1A1458B0102 6484185260 C98E094B7E B4B8F0644A 910F5BC2
7C097165458C2E6BE29C59D366 4199247906 1DEAD1E7C0 9C3B4DF24C 6A746040
00003B}
sm112yellow.gif:
Picture.Data = {
0954474946496D616765780300 0047494638 3961100016 00F7000000 0000FFFF
00003333000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 000000002C 00000000
1000160000085D0001081C48B0 A040010200 20549870E1 4286101D36 4C68B022
418911271ED488F1A1458B0102 0008395224 C98724539A 14E9F1A3C1 931C1392
2C9911E24C972F57D2842950E5 4E96147116 E4D99122D1 984273D6C4 48B328C4
A4030302003B}
sm101yellow.gif:
Picture.Data = {
0954474946496D6167657A0300 0047494638 3961100016 00F7000000 00000033
33FFFF00000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 000000002C 00000000
1000160000085F0001081C48B0 A0C0000100 20549870E1 4286101D36 4C68B022
418911271ED488F1A1458B0B05 08002092E4 C887214796 2CE9F1A341 961C1396
349911E24C972F55EAA43973E5 4E9F382BC2 ACF9706847 8A412FCAFC 7992624A
9E4D93120C08003B}
sm114yellow.gif
Picture.Data = {
0954474946496D616765730300 0047494638 3961100016 00F7000000 0000FFFF
00003333000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 000000002C 00000000
100016000008580001081C48B0 A040010200 20549870E1 4286101D36 4C68B022
418911271ED488F1A1458B0102 400C0980E4 43930949A2 FCF851A548 8C244B8A
5CB930264B83343952CC99F166 459E1865F6 0CEA932050 8D423B222D 2A302000
3B}
sm116yellow.gif:
Picture.Data = {
0954474946496D616765780300 0047494638 3961100016 00F7000000 00000033
33FFFF00000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 0000000000 00000000
00000000000000000000000000 0000000000 0000000000 000000002C 00000000
1000160000085D0001081C48B0 A0C0000100 20549870E1 4286101D36 4C68B022
C1850204449C783061C68D102D 8AFC4852A3 448125017C 3C29D22246 931C1FBE
04F9B0A5C19927657A8409D2E6 CD9D203F42 5CC951A8CF 8B453512ED 385429CF
A3030302003B}
*)
end.
uBase64 unit:
unit uBase64;
{
Unit source cut from Andreas Horstmeier's TCP/IP component suite.
}
interface
uses
sysutils,
windows,
classes;
type
ta_8u=packed array [0..65530] of byte;
t_encoding=(uuencode,base6 4,mime);
function encode_base64(data: TStream):TStringList;
function decode_base64(source:TStri ngList):TM emoryStrea m;
function encode_line(mode:t_encodin g; const buf; size:Integer):String;
function decode_line(mode:t_encodin g; const inp:String):String;
function poscn(c:char; const s:String; n: Integer):Integer;
const
bin2b64:String='ABCDEFGHIJ KLMNOPQRST UVWXYZabcd efghijklmn opqrstuvwx yz01234567 89+/';
b642bin:String='~~~~~~~~~~ ~^~~~_TUVW XYZ[\]~~~| ~~~ !"#$%&''()*+,-./0123456789 ~~~~~~:;<= >?@ABCDEFG HIJKLMNOPQ RS';
bin2uue:String='`!"#$%&''( )*+,-./012 3456789:;< =>?@ABCDEF GHIJKLMNOP QRSTUVWXYZ [\]^_';
uue2bin:String=' !"#$%&''()*+,-./0123456789 :;<=>?@ABC DEFGHIJKLM NOPQRSTUVW XYZ[\]^_ ';
linesize = 45;
implementation
function poscn(c:char; const s:String; n: Integer):Integer;
var
i: Integer;
begin
if n=0 then n:=1;
if n>0 then
begin
for i:=1 to length(s) do
begin
if s[i]<>c then
begin
dec(n);
Result:=i;
if n=0 then
begin
EXIT;
end;
end;
end;
end
else
begin
for i:=length(s) downto 1 do
begin
if s[i]<>c then
begin
inc(n);
Result:=i;
if n=0 then
begin
EXIT;
end;
end;
end;
end;
poscn:=0;
end;
function decode_line(mode:t_encodin g; const inp:String):String;
var
count,pos1,pos2: Integer;
offset: shortint;
s: String;
sOut: String;
begin
s:=inp;
setlength(sOut,length(s)*3 div 4 +3);
fillchar(sOut[1],length(s) *3 div 4 +3,#0);
if (mode=uuencode) and not (s[1] in [' '..'M','`']) then
count:=0
else
begin
count:=0;
pos1:=0;
case mode of
uuencode:
begin
count:=(ord(s[1]) - $20) and $3f;
for pos1:=2 to length(s)-1 do
s[pos1]:=char(ord(uue2bin[ ord(s[pos1 ])-$20+1]) -$20);
pos1:=2;
end;// uuencode
base64,mime:
begin
count:=poscn('=',s,-1)*3 div 4;
for pos1:=1 to length(s) do
s[pos1]:=char(ord(b642bin[ ord(s[pos1 ])-$20+1]) -$20);
pos1:=1;
end;// base64, mime
end;// case
pos2:=1;
offset:=2;
while pos2<=count do
begin
if (pos1>length(s)) or ((mode<>uuencode) and (s[pos1]='\')) then
begin
if offset<>2 then
inc(pos2);
count:=pos2-1;
end
else
if ((mode<>uuencode) and (s[pos1]='^')) then
inc(pos1)
else
if offset>0 then
begin
sOut[pos2]:=char(ord(sOut[ pos2]) or (ord(s[pos1]) shl offset));
inc(pos1);
offset:=offset-6;
end
else
if offset<0 then
begin
offset:=abs(offset);
sOut[pos2]:=char(ord(sOut[ pos2]) or (ord(s[pos1]) shr offset));
inc(pos2);
offset:=8-offset;
end
else
begin
sOut[pos2]:=char(ord(sOut[ pos2]) or ord(s[pos1]));
inc(pos1);
inc(pos2);
offset:=2;
end;// if ((mode<>uuencode) and (s[pos1]='^'))
end;// while pos2<=count
end;// if (mode=uuencode) and not (s[1] in [' '..'M','`'])
decode_line:=copy(sOut,1,c ount);
end;// function decode_line
function encode_line(mode:t_encodin g; const buf; size:Integer):String;
var
buff: ta_8u absolute buf;
offset: shortint;
pos1,pos2: byte;
i: byte;
sOut: String;
begin
setlength(sOut,size*4 div 3 + 4);
fillchar(sOut[1],size*4 div 3 +2,#0);
if mode=uuencode then
begin
sOut[1]:=char(((size-1) and $3f)+$21);
size:=((size+2) div 3)*3;
end;// if
offset:=2;
pos1:=0;
pos2:=0;
case mode of
uuencode: pos2:=2;
base64, mime: pos2:=1;
end;// case
sOut[pos2]:=#0;
while pos1<size do
begin
if offset > 0 then
begin
sOut[pos2]:=char(ord(sOut[ pos2]) or ((buff[pos1] and ($3f shl offset)) shr offset));
offset:=offset-6;
inc(pos2);
sOut[pos2]:=#0;
end
else
if offset < 0 then
begin
offset:=abs(offset);
sOut[pos2]:=char(ord(sOut[ pos2]) or ((buff[pos1] and ($3f shr offset)) shl offset));
offset:=8-offset;
inc(pos1);
end
else
begin
sOut[pos2]:=char(ord(sOut[ pos2]) or ((buff[pos1] and $3f)));
inc(pos2);
inc(pos1);
sOut[pos2]:=#0;
offset:=2;
end;
end;
case mode of
uuencode:
begin
if offset=2 then dec(pos2);
for i:=2 to pos2 do
sOut[i]:=bin2uue[ord(sOut[ i])+1];
end;// uuencode
base64, mime:
begin
if offset=2 then dec(pos2);
for i:=1 to pos2 do
sOut[i]:=bin2b64[ord(sOut[ i])+1];
while (pos2 and 3)<>0 do
begin
inc(pos2);
sOut[pos2]:='=';
end;
end;// base64, mime
end;// case
encode_line:=copy(sOut,1,p os2);
end;// function encode_line
function encode_base64(data: TStream):TStringList;
var
buf: pointer;
size: Integer;
begin
buf:=NIL;
try
Result:=TStringList.Create ;
getmem(buf,linesize);
data.seek(0,0);
size:=linesize;
while size>0 do
begin
size:=data.read(buf^,lines ize);
if size>0 then
Result.add(encode_line(bas e64,buf^,s ize));
end;// while
finally
if buf<>NIL then
freemem(buf,linesize);
end;// try
end;// function encode_base64
function decode_base64(source:TStri ngList):TM emoryStrea m;
var
i: Integer;
s: String;
begin
Result:=TMemoryStream.Crea te;
for i:=0 to source.count-1 do
begin
s:=decode_line(base64,sour ce[i]);
Result.write(s[1],length(s ));
end;// for
end;// function decode_base64
end.
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, OleCtrls, SHDocVw, uBase64, ActiveX, MSHTML, ExtCtrls;
type
TForm1 = class(TForm)
WebBrowser1: TWebBrowser;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
// Quote Printable source from Synapse library...
type
TSpecials = set of AnsiChar;
const
SpecialChar: TSpecials =
['=', '(', ')', '[', ']', '<', '>', ':', ';', ',', '@', '/', '?', '\',
'"', '_'];
NonAsciiChar: TSpecials =
[Char(0)..Char(31), Char(127)..Char(255)];
URLFullSpecialChar: TSpecials =
[';', '/', '?', ':', '@', '=', '&', '#', '+'];
URLSpecialChar: TSpecials =
[#$00..#$20, '_', '<', '>', '"', '%', '{', '}', '|', '\', '^', '~', '[', ']',
'`', #$7F..#$FF];
TableBase64 =
'ABCDEFGHIJKLMNOPQRSTUVWXY
TableBase64mod =
'ABCDEFGHIJKLMNOPQRSTUVWXY
TableUU =
'`!"#$%&''()*+,-./01234567
TableXX =
'+-0123456789ABCDEFGHIJKLM
ReTablebase64 =
#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$3E +#$40
+#$40 +#$40 +#$3F +#$34 +#$35 +#$36 +#$37 +#$38 +#$39 +#$3A +#$3B +#$3C
+#$3D +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$00 +#$01 +#$02 +#$03
+#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A +#$0B +#$0C +#$0D +#$0E +#$0F
+#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18 +#$19 +#$40 +#$40
+#$40 +#$40 +#$40 +#$40 +#$1A +#$1B +#$1C +#$1D +#$1E +#$1F +#$20 +#$21
+#$22 +#$23 +#$24 +#$25 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D
+#$2E +#$2F +#$30 +#$31 +#$32 +#$33 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;
ReTableUU =
#$01 +#$02 +#$03 +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A +#$0B +#$0C
+#$0D +#$0E +#$0F +#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18
+#$19 +#$1A +#$1B +#$1C +#$1D +#$1E +#$1F +#$20 +#$21 +#$22 +#$23 +#$24
+#$25 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D +#$2E +#$2F +#$30
+#$31 +#$32 +#$33 +#$34 +#$35 +#$36 +#$37 +#$38 +#$39 +#$3A +#$3B +#$3C
+#$3D +#$3E +#$3F +#$00 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40
+#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40
+#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;
ReTableXX =
#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$00 +#$40
+#$01 +#$40 +#$40 +#$02 +#$03 +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A
+#$0B +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$0C +#$0D +#$0E +#$0F
+#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18 +#$19 +#$1A +#$1B
+#$1C +#$1D +#$1E +#$1F +#$20 +#$21 +#$22 +#$23 +#$24 +#$25 +#$40 +#$40
+#$40 +#$40 +#$40 +#$40 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D
+#$2E +#$2F +#$30 +#$31 +#$32 +#$33 +#$34 +#$35 +#$36 +#$37 +#$38 +#$39
+#$3A +#$3B +#$3C +#$3D +#$3E +#$3F +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;
function EncodeTriplet(const Value: AnsiString; Delimiter: AnsiChar;
Specials: TSpecials): AnsiString;
var
n, l: Integer;
s: AnsiString;
c: AnsiChar;
begin
SetLength(Result, Length(Value) * 3);
l := 1;
for n := 1 to Length(Value) do
begin
c := Value[n];
if c in Specials then
begin
Result[l] := Delimiter;
Inc(l);
s := IntToHex(Ord(c), 2);
Result[l] := s[1];
Inc(l);
Result[l] := s[2];
Inc(l);
end
else
begin
Result[l] := c;
Inc(l);
end;
end;
Dec(l);
SetLength(Result, l);
end;
{=========================
function EncodeQuotedPrintable(cons
begin
Result := EncodeTriplet(Value, '=', ['='] + NonAsciiChar);
end;
procedure TForm1.Button1Click(Sender
var
slMHTMLBody: TStringList;
slMHTMLHeader: TStringList;
slImageEncoded: TStringList;
slImageFileList: TStringList;
fsImage: TFileStream;
i: Integer;
s: String;
IDoc: IHTMLDocument2;
v: Variant;
AStream: TMemoryStream;
begin
WebBrowser1.Navigate('abou
slMHTMLBody := TStringList.Create;
slMHTMLHeader := TStringList.Create;
slImageFileList := TStringList.Create;
slImageEncoded := TStringList.Create;
try
// Let's build the body first, it needs to be QP Encoded
slMHTMLBody.Add('<html>');
slMHTMLBody.Add('<head>');
slMHTMLBody.Add(' <title>Untitled</title>');
slMHTMLBody.Add('</head>')
slMHTMLBody.Add('');
slMHTMLBody.Add('<body>');
slMHTMLBody.Add('<br><br><
slMHTMLBody.Add('<img src="cid:sm69yellow.gif"')
slMHTMLBody.Add(' width="16" height="22" alt="" border="0"><img src="cid:sm120yellow.gif"'
slMHTMLBody.Add(' width="16" height="22" alt="" border="0"><img src="cid:sm112yellow.gif"'
slMHTMLBody.Add(' width="16" height="22" alt="" border="0"><img src="cid:sm101yellow.gif"'
slMHTMLBody.Add(' width="16" height="22" alt="" border="0"><img src="cid:sm114yellow.gif"'
slMHTMLBody.Add(' width="16" height="22" alt="" border="0"><img src="cid:sm116yellow.gif"'
slMHTMLBody.Add(' width="16" height="22" alt="" border="0">');
slMHTMLBody.Add('</body>')
slMHTMLBody.Add('</html>')
s := slMHTMLBody.Text;
// Remove the CR/LF pairs
s := StringReplace(s, #13, '', [rfReplaceAll]);
s := StringReplace(s, #10, '', [rfReplaceAll]);
s := EncodeQuotedPrintable(s);
slMHTMLBody.Text := s;
// Now build the header
slMHTMLHeader.Add('From: <Saved by Microsoft Internet Explorer 5>');
slMHTMLHeader.Add('Subject
slMHTMLHeader.Add('Date: Mon, 25 Apr, 2005, 12:00:00');
slMHTMLHeader.Add('MIME-Ve
slMHTMLHeader.Add('Content
slMHTMLHeader.Add(' boundary="----=_NextPart_3
slMHTMLHeader.Add(' type="text/html"');
slMHTMLHeader.Add('X-MimeO
slMHTMLHeader.Add('');
slMHTMLHeader.Add('This is a multi-part message in MIME format.');
slMHTMLHeader.Add('');
slMHTMLHeader.Add('------=
slMHTMLHeader.Add('Content
slMHTMLHeader.Add(' charset="Windows-1252"');
slMHTMLHeader.Add('Content
slMHTMLHeader.Add('Content
slMHTMLHeader.Add(''); // must have this blank line!!!
// Now add the body to the header:
slMHTMLHeader.AddStrings(s
slMHTMLHeader.Add(''); // must have this blank line!!!
// Let's build a list of the images we want to include,
// for you, you will have to write something to create the base64 (MIME)
// encoded strings yourself, I'm encoding these on the fly below.
// You can encode them and save as string resources.
slImageFileList.Add('c:\in
slImageFileList.Add('c:\in
slImageFileList.Add('c:\in
slImageFileList.Add('c:\in
slImageFileList.Add('c:\in
slImageFileList.Add('c:\in
// Now add each of your images
for i := 0 to slImageFileList.count-1 do
begin
// This line MUST match the one above in the header!!!
slMHTMLHeader.Add('------=
slMHTMLHeader.Add('Content
slMHTMLHeader.Add('Content
slMHTMLHeader.Add('Content
slMHTMLHeader.Add(''); // must have this blank line!!!
// Now add the base64 encoded image
fsImage := TFileStream.Create(slImage
try
slImageEncoded := encode_base64(fsImage);
slMHTMLHeader.AddStrings(s
finally
fsImage.Free;
end;
slMHTMLHeader.Add(''); // must have this blank line!!!
end;
slMHTMLHeader.Add('------=
slMHTMLHeader.Add(''); // must have this blank line!!!
slMHTMLHeader.SaveToFile('
{
//
// Tried writing the MHT directly into WebBrowser...
//
IDoc := WebBrowser1.Document as IHTMLDocument2;
try
IDoc.designMode:='on';
while IDoc.readyState<>'complete
Application.ProcessMessage
v:=VarArrayCreate([0,0],Va
v[0]:= slMHTMLHeader.Text;
IDoc.write(PSafeArray(Syst
IDoc.designMode:='off';
while IDoc.readyState<>'complete
Application.ProcessMessage
finally
IDoc := nil;
end;
//
// Also tried streaming directly into WebBrowser...
//
AStream := TMemoryStream.Create;
try
slMHTMLHeader.SaveToStream
AStream.Position := 0;
(WebBrowser1.Document as IPersistStreamInit).Load(T
finally
AStream.Free;
end;
}
// Since I was unable to get it to write directly to the webrowser
// because WebBrowser can't read content-type thus it comes up
// incorrectly, from what I can see, you MUST save it to disk,
// first, neither of the above techniques worked.
WebBrowser1.Navigate('c:\e
finally
slImageFileList.Free;
slImageEncoded.Free;
slMHTMLHeader.Free;
slMHTMLBody.Free;
end;
end;
(*
Here is the DFM text for each image, open a dfm with a TImage and replace it's
Picture.data with this and you can then save each image to a file
sm69yellow.gif:
Picture.Data = {
0954474946496D616765770300
00003333000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
1000160000085C0001081C48B0
C185020400C8B8512347881C43
941853A54B832753B65CA913E5
810101003B}
sm120yellow.gif:
Picture.Data = {
0954474946496D616765750300
00003333000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
1000160000085A0001081C48B0
418911271ED488F1A1458B0102
7C097165458C2E6BE29C59D366
00003B}
sm112yellow.gif:
Picture.Data = {
0954474946496D616765780300
00003333000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
1000160000085D0001081C48B0
418911271ED488F1A1458B0102
2C9911E24C972F57D2842950E5
A4030302003B}
sm101yellow.gif:
Picture.Data = {
0954474946496D6167657A0300
33FFFF00000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
1000160000085F0001081C48B0
418911271ED488F1A1458B0B05
349911E24C972F55EAA43973E5
9E4D93120C08003B}
sm114yellow.gif
Picture.Data = {
0954474946496D616765730300
00003333000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
100016000008580001081C48B0
418911271ED488F1A1458B0102
5CB930264B83343952CC99F166
3B}
sm116yellow.gif:
Picture.Data = {
0954474946496D616765780300
33FFFF00000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
00000000000000000000000000
1000160000085D0001081C48B0
C1850204449C783061C68D102D
04F9B0A5C19927657A8409D2E6
A3030302003B}
*)
end.
uBase64 unit:
unit uBase64;
{
Unit source cut from Andreas Horstmeier's TCP/IP component suite.
}
interface
uses
sysutils,
windows,
classes;
type
ta_8u=packed array [0..65530] of byte;
t_encoding=(uuencode,base6
function encode_base64(data: TStream):TStringList;
function decode_base64(source:TStri
function encode_line(mode:t_encodin
function decode_line(mode:t_encodin
function poscn(c:char; const s:String; n: Integer):Integer;
const
bin2b64:String='ABCDEFGHIJ
b642bin:String='~~~~~~~~~~
bin2uue:String='`!"#$%&''(
uue2bin:String=' !"#$%&''()*+,-./0123456789
linesize = 45;
implementation
function poscn(c:char; const s:String; n: Integer):Integer;
var
i: Integer;
begin
if n=0 then n:=1;
if n>0 then
begin
for i:=1 to length(s) do
begin
if s[i]<>c then
begin
dec(n);
Result:=i;
if n=0 then
begin
EXIT;
end;
end;
end;
end
else
begin
for i:=length(s) downto 1 do
begin
if s[i]<>c then
begin
inc(n);
Result:=i;
if n=0 then
begin
EXIT;
end;
end;
end;
end;
poscn:=0;
end;
function decode_line(mode:t_encodin
var
count,pos1,pos2: Integer;
offset: shortint;
s: String;
sOut: String;
begin
s:=inp;
setlength(sOut,length(s)*3
fillchar(sOut[1],length(s)
if (mode=uuencode) and not (s[1] in [' '..'M','`']) then
count:=0
else
begin
count:=0;
pos1:=0;
case mode of
uuencode:
begin
count:=(ord(s[1]) - $20) and $3f;
for pos1:=2 to length(s)-1 do
s[pos1]:=char(ord(uue2bin[
pos1:=2;
end;// uuencode
base64,mime:
begin
count:=poscn('=',s,-1)*3 div 4;
for pos1:=1 to length(s) do
s[pos1]:=char(ord(b642bin[
pos1:=1;
end;// base64, mime
end;// case
pos2:=1;
offset:=2;
while pos2<=count do
begin
if (pos1>length(s)) or ((mode<>uuencode) and (s[pos1]='\')) then
begin
if offset<>2 then
inc(pos2);
count:=pos2-1;
end
else
if ((mode<>uuencode) and (s[pos1]='^')) then
inc(pos1)
else
if offset>0 then
begin
sOut[pos2]:=char(ord(sOut[
inc(pos1);
offset:=offset-6;
end
else
if offset<0 then
begin
offset:=abs(offset);
sOut[pos2]:=char(ord(sOut[
inc(pos2);
offset:=8-offset;
end
else
begin
sOut[pos2]:=char(ord(sOut[
inc(pos1);
inc(pos2);
offset:=2;
end;// if ((mode<>uuencode) and (s[pos1]='^'))
end;// while pos2<=count
end;// if (mode=uuencode) and not (s[1] in [' '..'M','`'])
decode_line:=copy(sOut,1,c
end;// function decode_line
function encode_line(mode:t_encodin
var
buff: ta_8u absolute buf;
offset: shortint;
pos1,pos2: byte;
i: byte;
sOut: String;
begin
setlength(sOut,size*4 div 3 + 4);
fillchar(sOut[1],size*4 div 3 +2,#0);
if mode=uuencode then
begin
sOut[1]:=char(((size-1) and $3f)+$21);
size:=((size+2) div 3)*3;
end;// if
offset:=2;
pos1:=0;
pos2:=0;
case mode of
uuencode: pos2:=2;
base64, mime: pos2:=1;
end;// case
sOut[pos2]:=#0;
while pos1<size do
begin
if offset > 0 then
begin
sOut[pos2]:=char(ord(sOut[
offset:=offset-6;
inc(pos2);
sOut[pos2]:=#0;
end
else
if offset < 0 then
begin
offset:=abs(offset);
sOut[pos2]:=char(ord(sOut[
offset:=8-offset;
inc(pos1);
end
else
begin
sOut[pos2]:=char(ord(sOut[
inc(pos2);
inc(pos1);
sOut[pos2]:=#0;
offset:=2;
end;
end;
case mode of
uuencode:
begin
if offset=2 then dec(pos2);
for i:=2 to pos2 do
sOut[i]:=bin2uue[ord(sOut[
end;// uuencode
base64, mime:
begin
if offset=2 then dec(pos2);
for i:=1 to pos2 do
sOut[i]:=bin2b64[ord(sOut[
while (pos2 and 3)<>0 do
begin
inc(pos2);
sOut[pos2]:='=';
end;
end;// base64, mime
end;// case
encode_line:=copy(sOut,1,p
end;// function encode_line
function encode_base64(data: TStream):TStringList;
var
buf: pointer;
size: Integer;
begin
buf:=NIL;
try
Result:=TStringList.Create
getmem(buf,linesize);
data.seek(0,0);
size:=linesize;
while size>0 do
begin
size:=data.read(buf^,lines
if size>0 then
Result.add(encode_line(bas
end;// while
finally
if buf<>NIL then
freemem(buf,linesize);
end;// try
end;// function encode_base64
function decode_base64(source:TStri
var
i: Integer;
s: String;
begin
Result:=TMemoryStream.Crea
for i:=0 to source.count-1 do
begin
s:=decode_line(base64,sour
Result.write(s[1],length(s
end;// for
end;// function decode_base64
end.
ASKER
Thank for your care.
I think you must work hard!
But If TWebbrowser is unable to load MHT code directly from Stream, your code is no use to me!
I will try if it can help me!
I think you must work hard!
But If TWebbrowser is unable to load MHT code directly from Stream, your code is no use to me!
I will try if it can help me!
It will load plain HTML but any images will have to either reside on the sytem in question or on the internet with the
system having an internet connection.
These are the ONLY options you have as you can not make TWebbrowser load something from stream and also
tell it what content you are loading.
system having an internet connection.
These are the ONLY options you have as you can not make TWebbrowser load something from stream and also
tell it what content you are loading.
ASKER
who know about Microsoft® DirectAnimation®? I know how to create it, but how to use it!
That is another question. do not ask in this thread.
ASKER
May be Microsoft® DirectAnimation® control allow us to load image directly from stream!
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
I am working on a demo for you.
Taking the demo from the URL mentioned above and the source I posted above, here is a working sample:
unit Unit1;
interface
uses
{$IFDEF VER120} d4_app,{$ENDIF} OurNSHandler, Classes, Windows, Messages, SysUtils,
Graphics, Controls, Forms, Dialogs, Activex, urlMon, StdCtrls, OleCtrls,
SHDocVw;
type
TForm1 = class(TForm)
WebBrowser1: TWebBrowser;
Button1: TButton;
Button2: TButton;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
LoadMethod: Byte;
implementation
{$R *.DFM}
var
Factory: IClassFactory;
InternetSession: IInternetSession;
procedure TForm1.Button1Click(Sender : TObject);
var
Url : Widestring;
v : OleVariant;
begin
Url:='http://testprogram/ee.mht';
LoadMethod := 1;
webbrowser1.navigate(Url,v ,v,v,v);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
CoGetClassObject(Class_Our NSHandler, CLSCTX_SERVER, nil, IClassFactory, Factory);
CoInternetGetSession(0, InternetSession, 0);
InternetSession.RegisterNa meSpace(Fa ctory, Class_OurNSHandler, 'http', 0, nil, 0);
WebBrowser1.Navigate('abou t:blank');
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
InternetSession.Unregister NameSpace( Factory, 'http');
end;
procedure TForm1.Button3Click(Sender : TObject);
var
Url: Widestring;
v: OleVariant;
begin
{
Make sure you set this to a filename with the MHT extension,
if you don't , it will show you the MHT source.
}
Url:='http://testprogram/ee2.mht';
LoadMethod := 3;
Webbrowser1.navigate(Url,v ,v,v,v);
end;
end.
unit OurNSHandler;
interface
uses
{$IFDEF VER120} d4_app,{$ENDIF} Classes, Windows, Forms, Axctrls, dialogs, SysUtils,
ComObj, ActiveX, UrlMon, MSHTML, uBase64;
const
Class_OurNSHandler: TGUID = '{518F3C32-964D-4964-82B6- FD214B17FA 3E}';
NameSpace = 'testprogram';
type
TOurNSHandler = class(TComObject, IInternetProtocol)
private
Url: string;
Written, TotalSize: Integer;
ProtSink: IInternetProtocolSink;
DataStream: IStream;
protected
function Start(szUrl: PWideChar; 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;
// Helper functions
procedure GetDataFromFile(Url: string);
procedure GetDataFromStream(Url: string);
end;
implementation
uses
unit1, comserv;
// Quote Printable source from Synapse library...
type
TSpecials = set of AnsiChar;
const
SpecialChar: TSpecials =
['=', '(', ')', '[', ']', '<', '>', ':', ';', ',', '@', '/', '?', '\',
'"', '_'];
NonAsciiChar: TSpecials =
[Char(0)..Char(31), Char(127)..Char(255)];
URLFullSpecialChar: TSpecials =
[';', '/', '?', ':', '@', '=', '&', '#', '+'];
URLSpecialChar: TSpecials =
[#$00..#$20, '_', '<', '>', '"', '%', '{', '}', '|', '\', '^', '~', '[', ']',
'`', #$7F..#$FF];
TableBase64 =
'ABCDEFGHIJKLMNOPQRSTUVWXY Zabcdefghi jklmnopqrs tuvwxyz012 3456789+/= ';
TableBase64mod =
'ABCDEFGHIJKLMNOPQRSTUVWXY Zabcdefghi jklmnopqrs tuvwxyz012 3456789+,= ';
TableUU =
'`!"#$%&''()*+,-./01234567 89:;<=>?@A BCDEFGHIJK LMNOPQRSTU VWXYZ[\]^_ ';
TableXX =
'+-0123456789ABCDEFGHIJKLM NOPQRSTUVW XYZabcdefg hijklmnopq rstuvwxyz' ;
ReTablebase64 =
#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$3E +#$40
+#$40 +#$40 +#$3F +#$34 +#$35 +#$36 +#$37 +#$38 +#$39 +#$3A +#$3B +#$3C
+#$3D +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$00 +#$01 +#$02 +#$03
+#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A +#$0B +#$0C +#$0D +#$0E +#$0F
+#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18 +#$19 +#$40 +#$40
+#$40 +#$40 +#$40 +#$40 +#$1A +#$1B +#$1C +#$1D +#$1E +#$1F +#$20 +#$21
+#$22 +#$23 +#$24 +#$25 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D
+#$2E +#$2F +#$30 +#$31 +#$32 +#$33 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;
ReTableUU =
#$01 +#$02 +#$03 +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A +#$0B +#$0C
+#$0D +#$0E +#$0F +#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18
+#$19 +#$1A +#$1B +#$1C +#$1D +#$1E +#$1F +#$20 +#$21 +#$22 +#$23 +#$24
+#$25 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D +#$2E +#$2F +#$30
+#$31 +#$32 +#$33 +#$34 +#$35 +#$36 +#$37 +#$38 +#$39 +#$3A +#$3B +#$3C
+#$3D +#$3E +#$3F +#$00 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40
+#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40
+#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;
ReTableXX =
#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$00 +#$40
+#$01 +#$40 +#$40 +#$02 +#$03 +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A
+#$0B +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$0C +#$0D +#$0E +#$0F
+#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18 +#$19 +#$1A +#$1B
+#$1C +#$1D +#$1E +#$1F +#$20 +#$21 +#$22 +#$23 +#$24 +#$25 +#$40 +#$40
+#$40 +#$40 +#$40 +#$40 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D
+#$2E +#$2F +#$30 +#$31 +#$32 +#$33 +#$34 +#$35 +#$36 +#$37 +#$38 +#$39
+#$3A +#$3B +#$3C +#$3D +#$3E +#$3F +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;
function EncodeTriplet(const Value: AnsiString; Delimiter: AnsiChar;
Specials: TSpecials): AnsiString;
var
n, l: Integer;
s: AnsiString;
c: AnsiChar;
begin
SetLength(Result, Length(Value) * 3);
l := 1;
for n := 1 to Length(Value) do
begin
c := Value[n];
if c in Specials then
begin
Result[l] := Delimiter;
Inc(l);
s := IntToHex(Ord(c), 2);
Result[l] := s[1];
Inc(l);
Result[l] := s[2];
Inc(l);
end
else
begin
Result[l] := c;
Inc(l);
end;
end;
Dec(l);
SetLength(Result, l);
end;
{========================= ========== ========== ========== ========== ========== ===}
function EncodeQuotedPrintable(cons t Value: AnsiString): AnsiString;
begin
Result := EncodeTriplet(Value, '=', ['='] + NonAsciiChar);
end;
function TOurNSHandler.Start(szUrl: PWideChar; OIProtSink: IInternetProtocolSink;
OIBindInfo: IInternetBindInfo; grfPI, dwReserved: DWORD): HResult; stdcall;
begin
(* We receive all http://-URL's here and let the default protocolhandler take over if we don't find our namespace. *)
if Pos('http://' + NameSpace + '/', LowerCase(szUrl)) <> 1
then Result := INET_E_USE_DEFAULT_PROTOCO LHANDLER
else begin
Url := SzUrl;
written := 0;
ProtSink := OIProtSink; //Get interface to Transaction handlers IInternetnetProtocolSink
(* Now get the data and load it in DataStream *)
if LoadMethod = 1 then GetDataFromFile(Url) else GetDataFromStream(url);
(*Inform Transaction handler that all data is ready *)
ProtSink.ReportData(BSCF_F IRSTDATANO TIFICATION or
BSCF_LASTDATANOTIFICATION or BSCF_DATAFULLYAVAILABLE, TotalSize, TotalSize);
(* -> Here our Read Method is called by transaction handler*)
ProtSink.ReportResult(S_OK , S_OK, nil);
(* Report result to transaction handler. Our Terminate method will be called *)
Result := S_OK;
end;
end;
function TOurNSHandler.Read(pv: Pointer; cb: ULONG; out cbRead: ULONG): HResult;
begin
(*Read Data from DataStream to Browser/URLMON *)
DataStream.Read(pv, cb, @cbRead);
Inc(written, cbread);
if (written = totalSize) then result := S_FALSE else Result := E_PENDING;
end;
procedure TOurNSHandler.GetDataFromS tream(Url: string);
var
Dummy: INT64;
var
slMHTMLBody: TStringList;
slMHTMLHeader: TStringList;
slImageEncoded: TStringList;
slImageFileList: TStringList;
fsImage: TFileStream;
i: Integer;
s: String;
AStream: TMemoryStream;
begin
slMHTMLBody := TStringList.Create;
slMHTMLHeader := TStringList.Create;
slImageFileList := TStringList.Create;
slImageEncoded := TStringList.Create;
try
// Let's build the body first, it needs to be QP Encoded
slMHTMLBody.Add('<html>');
slMHTMLBody.Add('<head>');
slMHTMLBody.Add(' <title>Untitled</title>');
slMHTMLBody.Add('</head>') ;
slMHTMLBody.Add('');
slMHTMLBody.Add('<body>');
slMHTMLBody.Add('<br><br>< b><font color="red">Experts-Exchan ge</font>< /b><br><br ><br>');
slMHTMLBody.Add('<img src="cid:sm69yellow.gif"') ;
slMHTMLBody.Add(' width="16" height="22" alt="" border="0"><img src="cid:sm120yellow.gif"' );
slMHTMLBody.Add(' width="16" height="22" alt="" border="0"><img src="cid:sm112yellow.gif"' );
slMHTMLBody.Add(' width="16" height="22" alt="" border="0"><img src="cid:sm101yellow.gif"' );
slMHTMLBody.Add(' width="16" height="22" alt="" border="0"><img src="cid:sm114yellow.gif"' );
slMHTMLBody.Add(' width="16" height="22" alt="" border="0"><img src="cid:sm116yellow.gif"' );
slMHTMLBody.Add(' width="16" height="22" alt="" border="0">');
slMHTMLBody.Add('</body>') ;
slMHTMLBody.Add('</html>') ;
s := slMHTMLBody.Text;
// Remove the CR/LF pairs
s := StringReplace(s, #13, '', [rfReplaceAll]);
s := StringReplace(s, #10, '', [rfReplaceAll]);
s := EncodeQuotedPrintable(s);
slMHTMLBody.Text := s;
// Now build the header
slMHTMLHeader.Add('From: <Saved by Microsoft Internet Explorer 5>');
slMHTMLHeader.Add('Subject :');
slMHTMLHeader.Add('Date: Mon, 25 Apr, 2005, 12:00:00');
slMHTMLHeader.Add('MIME-Ve rsion: 1.0');
slMHTMLHeader.Add('Content -Type: multipart/related;');
slMHTMLHeader.Add(' boundary="----=_NextPart_3 5_49_15.20 05_04_25"; ');
slMHTMLHeader.Add(' type="text/html"');
slMHTMLHeader.Add('X-MimeO LE: Produced By Microsoft MimeOLE V6.00.2800.1441');
slMHTMLHeader.Add('');
slMHTMLHeader.Add('This is a multi-part message in MIME format.');
slMHTMLHeader.Add('');
slMHTMLHeader.Add('------= _NextPart_ 35_49_15.2 005_04_25' );
slMHTMLHeader.Add('Content -Type: text/html;');
slMHTMLHeader.Add(' charset="Windows-1252"');
slMHTMLHeader.Add('Content -Transfer- Encoding: quoted-printable');
slMHTMLHeader.Add('Content -Location: c:\blah.html');
slMHTMLHeader.Add(''); // must have this blank line!!!
// Now add the body to the header:
slMHTMLHeader.AddStrings(s lMHTMLBody );
slMHTMLHeader.Add(''); // must have this blank line!!!
// Let's build a list of the images we want to include,
// for you, you will have to write something to create the base64 (MIME)
// encoded strings yourself, I'm encoding these on the fly below.
// You can encode them and save as string resources.
slImageFileList.Add('c:\in etpub\wwwr oot\images \digits\sm 69yellow.g if');
slImageFileList.Add('c:\in etpub\wwwr oot\images \digits\sm 120yellow. gif');
slImageFileList.Add('c:\in etpub\wwwr oot\images \digits\sm 112yellow. gif');
slImageFileList.Add('c:\in etpub\wwwr oot\images \digits\sm 101yellow. gif');
slImageFileList.Add('c:\in etpub\wwwr oot\images \digits\sm 114yellow. gif');
slImageFileList.Add('c:\in etpub\wwwr oot\images \digits\sm 116yellow. gif');
// Now add each of your images
for i := 0 to slImageFileList.count-1 do
begin
// This line MUST match the one above in the header!!!
slMHTMLHeader.Add('------= _NextPart_ 35_49_15.2 005_04_25' );
slMHTMLHeader.Add('Content -Type: application/binary');
slMHTMLHeader.Add('Content -Transfer- Encoding: base64');
slMHTMLHeader.Add('Content -ID: '+ ExtractFileName(slImageFil eList[i])) ;
slMHTMLHeader.Add(''); // must have this blank line!!!
// Now add the base64 encoded image
fsImage := TFileStream.Create(slImage FileList[i ], fmOpenRead);
try
slImageEncoded := encode_base64(fsImage);
slMHTMLHeader.AddStrings(s lImageEnco ded);
finally
fsImage.Free;
end;
slMHTMLHeader.Add(''); // must have this blank line!!!
end;
slMHTMLHeader.Add('------= _NextPart_ 35_49_15.2 005_04_25' );
slMHTMLHeader.Add(''); // must have this blank line!!!
(*
Setting this is the key to the whole thing working!
)*
Url := ExtractFilePath(Applicatio n.exename) +
Copy(Url, Pos(NameSpace, Url) +
Length(NameSpace) + 1, Length(Url));
AStream := TMemoryStream.Create;
try
slMHTMLHeader.SaveToStream (AStream);
AStream.Position := 0;
CreateStreamOnHGlobal(0, True, DataStream);
TOleStream.Create(DataStre am).CopyFr om(AStream , AStream.Size);
DataStream.Seek(0, STREAM_SEEK_SET, Dummy);
TotalSize := AStream.Size;
finally
AStream.Free;
end;
finally
slImageFileList.Free;
slImageEncoded.Free;
slMHTMLHeader.Free;
slMHTMLBody.Free;
end;
end;
procedure TOurNSHandler.GetDataFromF ile(Url: string);
var
F: TFileStream;
Dummy: INT64;
begin
Url := ExtractFilePath(Applicatio n.exename) +
Copy(Url, Pos(NameSpace, Url) +
Length(NameSpace) + 1, Length(Url));
F := TFileStream.Create(Url, fmOpenRead);
CreateStreamOnHGlobal(0, True, DataStream);
TOleStream.Create(DataStre am).CopyFr om(F, F.Size);
DataStream.Seek(0, STREAM_SEEK_SET, Dummy);
TotalSize := F.Size;
F.Free;
end;
function TOurNSHandler.Terminate(dw Options: DWORD): HResult; stdcall;
begin
DataStream._Release;
Protsink._Release;
result := S_OK;
end;
function TOurNSHandler.LockRequest( dwOptions: DWORD): HResult; stdcall;
begin
result := S_OK;
end;
function TOurNSHandler.UnlockReques t: HResult;
begin
result := S_OK;
end;
function TOurNSHandler.Continue(con st ProtocolData: TProtocolData): HResult;
begin
result := S_OK;
end;
function TOurNSHandler.Abort(hrReas on: HResult; dwOptions: DWORD): HResult; stdcall;
begin
result := E_NOTIMPL;
end;
function TOurNSHandler.Suspend: HResult; stdcall;
begin
result := E_NOTIMPL;
end;
function TOurNSHandler.Resume: HResult; stdcall;
begin
result := E_NOTIMPL;
end;
function TOurNSHandler.Seek(dlibMov e: LARGE_INTEGER; dwOrigin: DWORD;
out libNewPosition: ULARGE_INTEGER): HResult;
begin
result := E_NOTIMPL;
end;
initialization
begin
TComObjectFactory.Create(C omServer, TOurNSHandler, Class_OurNSHandler,
'OurNSHandler', 'OurNSHandler', ciMultiInstance, tmApartment);
end;
end.
unit Unit1;
interface
uses
{$IFDEF VER120} d4_app,{$ENDIF} OurNSHandler, Classes, Windows, Messages, SysUtils,
Graphics, Controls, Forms, Dialogs, Activex, urlMon, StdCtrls, OleCtrls,
SHDocVw;
type
TForm1 = class(TForm)
WebBrowser1: TWebBrowser;
Button1: TButton;
Button2: TButton;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
LoadMethod: Byte;
implementation
{$R *.DFM}
var
Factory: IClassFactory;
InternetSession: IInternetSession;
procedure TForm1.Button1Click(Sender
var
Url : Widestring;
v : OleVariant;
begin
Url:='http://testprogram/ee.mht';
LoadMethod := 1;
webbrowser1.navigate(Url,v
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
CoGetClassObject(Class_Our
CoInternetGetSession(0, InternetSession, 0);
InternetSession.RegisterNa
WebBrowser1.Navigate('abou
end;
procedure TForm1.FormDestroy(Sender:
begin
InternetSession.Unregister
end;
procedure TForm1.Button3Click(Sender
var
Url: Widestring;
v: OleVariant;
begin
{
Make sure you set this to a filename with the MHT extension,
if you don't , it will show you the MHT source.
}
Url:='http://testprogram/ee2.mht';
LoadMethod := 3;
Webbrowser1.navigate(Url,v
end;
end.
unit OurNSHandler;
interface
uses
{$IFDEF VER120} d4_app,{$ENDIF} Classes, Windows, Forms, Axctrls, dialogs, SysUtils,
ComObj, ActiveX, UrlMon, MSHTML, uBase64;
const
Class_OurNSHandler: TGUID = '{518F3C32-964D-4964-82B6-
NameSpace = 'testprogram';
type
TOurNSHandler = class(TComObject, IInternetProtocol)
private
Url: string;
Written, TotalSize: Integer;
ProtSink: IInternetProtocolSink;
DataStream: IStream;
protected
function Start(szUrl: PWideChar; 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;
// Helper functions
procedure GetDataFromFile(Url: string);
procedure GetDataFromStream(Url: string);
end;
implementation
uses
unit1, comserv;
// Quote Printable source from Synapse library...
type
TSpecials = set of AnsiChar;
const
SpecialChar: TSpecials =
['=', '(', ')', '[', ']', '<', '>', ':', ';', ',', '@', '/', '?', '\',
'"', '_'];
NonAsciiChar: TSpecials =
[Char(0)..Char(31), Char(127)..Char(255)];
URLFullSpecialChar: TSpecials =
[';', '/', '?', ':', '@', '=', '&', '#', '+'];
URLSpecialChar: TSpecials =
[#$00..#$20, '_', '<', '>', '"', '%', '{', '}', '|', '\', '^', '~', '[', ']',
'`', #$7F..#$FF];
TableBase64 =
'ABCDEFGHIJKLMNOPQRSTUVWXY
TableBase64mod =
'ABCDEFGHIJKLMNOPQRSTUVWXY
TableUU =
'`!"#$%&''()*+,-./01234567
TableXX =
'+-0123456789ABCDEFGHIJKLM
ReTablebase64 =
#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$3E +#$40
+#$40 +#$40 +#$3F +#$34 +#$35 +#$36 +#$37 +#$38 +#$39 +#$3A +#$3B +#$3C
+#$3D +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$00 +#$01 +#$02 +#$03
+#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A +#$0B +#$0C +#$0D +#$0E +#$0F
+#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18 +#$19 +#$40 +#$40
+#$40 +#$40 +#$40 +#$40 +#$1A +#$1B +#$1C +#$1D +#$1E +#$1F +#$20 +#$21
+#$22 +#$23 +#$24 +#$25 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D
+#$2E +#$2F +#$30 +#$31 +#$32 +#$33 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;
ReTableUU =
#$01 +#$02 +#$03 +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A +#$0B +#$0C
+#$0D +#$0E +#$0F +#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18
+#$19 +#$1A +#$1B +#$1C +#$1D +#$1E +#$1F +#$20 +#$21 +#$22 +#$23 +#$24
+#$25 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D +#$2E +#$2F +#$30
+#$31 +#$32 +#$33 +#$34 +#$35 +#$36 +#$37 +#$38 +#$39 +#$3A +#$3B +#$3C
+#$3D +#$3E +#$3F +#$00 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40
+#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40
+#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;
ReTableXX =
#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$00 +#$40
+#$01 +#$40 +#$40 +#$02 +#$03 +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A
+#$0B +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$0C +#$0D +#$0E +#$0F
+#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18 +#$19 +#$1A +#$1B
+#$1C +#$1D +#$1E +#$1F +#$20 +#$21 +#$22 +#$23 +#$24 +#$25 +#$40 +#$40
+#$40 +#$40 +#$40 +#$40 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D
+#$2E +#$2F +#$30 +#$31 +#$32 +#$33 +#$34 +#$35 +#$36 +#$37 +#$38 +#$39
+#$3A +#$3B +#$3C +#$3D +#$3E +#$3F +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;
function EncodeTriplet(const Value: AnsiString; Delimiter: AnsiChar;
Specials: TSpecials): AnsiString;
var
n, l: Integer;
s: AnsiString;
c: AnsiChar;
begin
SetLength(Result, Length(Value) * 3);
l := 1;
for n := 1 to Length(Value) do
begin
c := Value[n];
if c in Specials then
begin
Result[l] := Delimiter;
Inc(l);
s := IntToHex(Ord(c), 2);
Result[l] := s[1];
Inc(l);
Result[l] := s[2];
Inc(l);
end
else
begin
Result[l] := c;
Inc(l);
end;
end;
Dec(l);
SetLength(Result, l);
end;
{=========================
function EncodeQuotedPrintable(cons
begin
Result := EncodeTriplet(Value, '=', ['='] + NonAsciiChar);
end;
function TOurNSHandler.Start(szUrl:
OIBindInfo: IInternetBindInfo; grfPI, dwReserved: DWORD): HResult; stdcall;
begin
(* We receive all http://-URL's here and let the default protocolhandler take over if we don't find our namespace. *)
if Pos('http://' + NameSpace + '/', LowerCase(szUrl)) <> 1
then Result := INET_E_USE_DEFAULT_PROTOCO
else begin
Url := SzUrl;
written := 0;
ProtSink := OIProtSink; //Get interface to Transaction handlers IInternetnetProtocolSink
(* Now get the data and load it in DataStream *)
if LoadMethod = 1 then GetDataFromFile(Url) else GetDataFromStream(url);
(*Inform Transaction handler that all data is ready *)
ProtSink.ReportData(BSCF_F
BSCF_LASTDATANOTIFICATION or BSCF_DATAFULLYAVAILABLE, TotalSize, TotalSize);
(* -> Here our Read Method is called by transaction handler*)
ProtSink.ReportResult(S_OK
(* Report result to transaction handler. Our Terminate method will be called *)
Result := S_OK;
end;
end;
function TOurNSHandler.Read(pv: Pointer; cb: ULONG; out cbRead: ULONG): HResult;
begin
(*Read Data from DataStream to Browser/URLMON *)
DataStream.Read(pv, cb, @cbRead);
Inc(written, cbread);
if (written = totalSize) then result := S_FALSE else Result := E_PENDING;
end;
procedure TOurNSHandler.GetDataFromS
var
Dummy: INT64;
var
slMHTMLBody: TStringList;
slMHTMLHeader: TStringList;
slImageEncoded: TStringList;
slImageFileList: TStringList;
fsImage: TFileStream;
i: Integer;
s: String;
AStream: TMemoryStream;
begin
slMHTMLBody := TStringList.Create;
slMHTMLHeader := TStringList.Create;
slImageFileList := TStringList.Create;
slImageEncoded := TStringList.Create;
try
// Let's build the body first, it needs to be QP Encoded
slMHTMLBody.Add('<html>');
slMHTMLBody.Add('<head>');
slMHTMLBody.Add(' <title>Untitled</title>');
slMHTMLBody.Add('</head>')
slMHTMLBody.Add('');
slMHTMLBody.Add('<body>');
slMHTMLBody.Add('<br><br><
slMHTMLBody.Add('<img src="cid:sm69yellow.gif"')
slMHTMLBody.Add(' width="16" height="22" alt="" border="0"><img src="cid:sm120yellow.gif"'
slMHTMLBody.Add(' width="16" height="22" alt="" border="0"><img src="cid:sm112yellow.gif"'
slMHTMLBody.Add(' width="16" height="22" alt="" border="0"><img src="cid:sm101yellow.gif"'
slMHTMLBody.Add(' width="16" height="22" alt="" border="0"><img src="cid:sm114yellow.gif"'
slMHTMLBody.Add(' width="16" height="22" alt="" border="0"><img src="cid:sm116yellow.gif"'
slMHTMLBody.Add(' width="16" height="22" alt="" border="0">');
slMHTMLBody.Add('</body>')
slMHTMLBody.Add('</html>')
s := slMHTMLBody.Text;
// Remove the CR/LF pairs
s := StringReplace(s, #13, '', [rfReplaceAll]);
s := StringReplace(s, #10, '', [rfReplaceAll]);
s := EncodeQuotedPrintable(s);
slMHTMLBody.Text := s;
// Now build the header
slMHTMLHeader.Add('From: <Saved by Microsoft Internet Explorer 5>');
slMHTMLHeader.Add('Subject
slMHTMLHeader.Add('Date: Mon, 25 Apr, 2005, 12:00:00');
slMHTMLHeader.Add('MIME-Ve
slMHTMLHeader.Add('Content
slMHTMLHeader.Add(' boundary="----=_NextPart_3
slMHTMLHeader.Add(' type="text/html"');
slMHTMLHeader.Add('X-MimeO
slMHTMLHeader.Add('');
slMHTMLHeader.Add('This is a multi-part message in MIME format.');
slMHTMLHeader.Add('');
slMHTMLHeader.Add('------=
slMHTMLHeader.Add('Content
slMHTMLHeader.Add(' charset="Windows-1252"');
slMHTMLHeader.Add('Content
slMHTMLHeader.Add('Content
slMHTMLHeader.Add(''); // must have this blank line!!!
// Now add the body to the header:
slMHTMLHeader.AddStrings(s
slMHTMLHeader.Add(''); // must have this blank line!!!
// Let's build a list of the images we want to include,
// for you, you will have to write something to create the base64 (MIME)
// encoded strings yourself, I'm encoding these on the fly below.
// You can encode them and save as string resources.
slImageFileList.Add('c:\in
slImageFileList.Add('c:\in
slImageFileList.Add('c:\in
slImageFileList.Add('c:\in
slImageFileList.Add('c:\in
slImageFileList.Add('c:\in
// Now add each of your images
for i := 0 to slImageFileList.count-1 do
begin
// This line MUST match the one above in the header!!!
slMHTMLHeader.Add('------=
slMHTMLHeader.Add('Content
slMHTMLHeader.Add('Content
slMHTMLHeader.Add('Content
slMHTMLHeader.Add(''); // must have this blank line!!!
// Now add the base64 encoded image
fsImage := TFileStream.Create(slImage
try
slImageEncoded := encode_base64(fsImage);
slMHTMLHeader.AddStrings(s
finally
fsImage.Free;
end;
slMHTMLHeader.Add(''); // must have this blank line!!!
end;
slMHTMLHeader.Add('------=
slMHTMLHeader.Add(''); // must have this blank line!!!
(*
Setting this is the key to the whole thing working!
)*
Url := ExtractFilePath(Applicatio
Copy(Url, Pos(NameSpace, Url) +
Length(NameSpace) + 1, Length(Url));
AStream := TMemoryStream.Create;
try
slMHTMLHeader.SaveToStream
AStream.Position := 0;
CreateStreamOnHGlobal(0, True, DataStream);
TOleStream.Create(DataStre
DataStream.Seek(0, STREAM_SEEK_SET, Dummy);
TotalSize := AStream.Size;
finally
AStream.Free;
end;
finally
slImageFileList.Free;
slImageEncoded.Free;
slMHTMLHeader.Free;
slMHTMLBody.Free;
end;
end;
procedure TOurNSHandler.GetDataFromF
var
F: TFileStream;
Dummy: INT64;
begin
Url := ExtractFilePath(Applicatio
Copy(Url, Pos(NameSpace, Url) +
Length(NameSpace) + 1, Length(Url));
F := TFileStream.Create(Url, fmOpenRead);
CreateStreamOnHGlobal(0, True, DataStream);
TOleStream.Create(DataStre
DataStream.Seek(0, STREAM_SEEK_SET, Dummy);
TotalSize := F.Size;
F.Free;
end;
function TOurNSHandler.Terminate(dw
begin
DataStream._Release;
Protsink._Release;
result := S_OK;
end;
function TOurNSHandler.LockRequest(
begin
result := S_OK;
end;
function TOurNSHandler.UnlockReques
begin
result := S_OK;
end;
function TOurNSHandler.Continue(con
begin
result := S_OK;
end;
function TOurNSHandler.Abort(hrReas
begin
result := E_NOTIMPL;
end;
function TOurNSHandler.Suspend: HResult; stdcall;
begin
result := E_NOTIMPL;
end;
function TOurNSHandler.Resume: HResult; stdcall;
begin
result := E_NOTIMPL;
end;
function TOurNSHandler.Seek(dlibMov
out libNewPosition: ULARGE_INTEGER): HResult;
begin
result := E_NOTIMPL;
end;
initialization
begin
TComObjectFactory.Create(C
'OurNSHandler', 'OurNSHandler', ciMultiInstance, tmApartment);
end;
end.
ASKER
A Great job. Point for you!
ASKER
Thank for your help!