Delphi让你发送Flash电子邮件完整源代码

{******Unit1.pas源代码内容如下******} 
unit Unit1; 
interface 
uses 
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, 
Dialogs, StdCtrls, ExtCtrls, Psock, NMsmtp; 
type 
TForm1 = class(TForm) 
Label1: TLabel; 
txtTo: TEdit; 
Label2: TLabel; 
txtFrom: TEdit; 
Label3: TLabel; 
txtSubject: TEdit; 
Label4: TLabel; 
memContents: TMemo; 
Label5: TLabel; 
txtUserName: TEdit; 
Label6: TLabel; 
txtPassword: TEdit; 
chkSmtpVerify: TCheckBox; 
btnSend: TButton; 
btnOpen: TButton; 
txtSwfFile: TEdit; 
Label7: TLabel; 
OpenDialog1: TOpenDialog; 
Label8: TLabel; 
txtSmtpServer: TEdit; 
NMSMTP1: TNMSMTP; 
Label9: TLabel; 
txtPort: TEdit; 
procedure btnOpenClick(Sender: TObject); 
procedure btnSendClick(Sender: TObject); 
procedure NMSMTP1SendStart(Sender: TObject); 
procedure NMSMTP1Connect(Sender: TObject); 
procedure chkSmtpVerifyClick(Sender: TObject); 
private 
{ Private declarations } 
public 
{ Public declarations } 
end; 
var 
Form1: TForm1; 
function EncodeString(Decoded:string):String; 
function EncodeBASE64(Encoded: TMemoryStream {TMailText}; Decoded: TMemoryStream): Integer; //编码函数 
implementation 
{$R *.dfm} 
{对参数TMemoryStrema中的字节流进行Base64编码，编码后的结果 
保存在Encoded中，函数返回编码长度} 
function EncodeBASE64(Encoded: TMemoryStream ; Decoded: TMemoryStream): Integer; 
const 
_Code64: String[64] = 
('ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/'); 
var 
I: LongInt; 
B: array[0..2279] of Byte; 
J, K, L, M, Quads: Integer; 
Stream: string[76]; 
EncLine: String; 
begin 
Encoded.Clear; 
Stream := ''; 
Quads := 0; 
{为提高效率，每2280字节流为一组进行编码} 
J := Decoded.Size div 2280; 
Decoded.Position := 0; 
{对前J*2280个字节流进行编码} 
for I := 1 to J do 
begin 
Decoded.Read(B, 2280); 
for M := 0 to 39 do 
begin 
for K := 0 to 18 do 
begin 
L:= 57*M + 3*K; 
Stream[Quads+1] := _Code64[(B[L] div 4)+1]; 
Stream[Quads+2] := _Code64[(B[L] mod 4)*16 + (B[L+1] div 16)+1]; 
Stream[Quads+3] := _Code64[(B[L+1] mod 16)*4 + (B[L+2] div 64)+1]; 
Stream[Quads+4] := _Code64[B[L+2] mod 64+1]; 
Inc(Quads, 4); 
if Quads = 76 then 
begin 
Stream[0] := #76; 
EncLine := Stream+#13#10; 
Encoded.Write(EncLine[1], Length(EncLine)); 
Quads := 0; 
end; 
end; 
end; 
end; 
{对以2280为模的余数字节流进行编码} 
J := (Decoded.Size mod 2280) div 3; 
for I := 1 to J do 
begin 
Decoded.Read(B, 3); 
Stream[Quads+1] := _Code64[(B[0] div 4)+1]; 
Stream[Quads+2] := _Code64[(B[0] mod 4)*16 + (B[1] div 16)+1]; 
Stream[Quads+3] := _Code64[(B[1] mod 16)*4 + (B[2] div 64)+1]; 
Stream[Quads+4] := _Code64[B[2] mod 64+1]; 
Inc(Quads, 4); 
{每行76个字符} 
if Quads = 76 then 
begin 
Stream[0] := #76; 
EncLine := Stream+#13#10; 
Encoded.Write(EncLine[1], Length(EncLine)); 
Quads := 0; 
end; 
end; 
{“=”补位} 
if (Decoded.Size mod 3) = 2 then 
begin 
Decoded.Read(B, 2); 
Stream[Quads+1] := _Code64[(B[0] div 4)+1]; 
Stream[Quads+2] := _Code64[(B[0] mod 4)*16 + (B[1] div 16)+1]; 
Stream[Quads+3] := _Code64[(B[1] mod 16)*4 + 1]; 
Stream[Quads+4] := '='; 
Inc(Quads, 4); 
end; 
if (Decoded.Size mod 3) = 1 then 
begin 
Decoded.Read(B, 1); 
Stream[Quads+1] := _Code64[(B[0] div 4)+1]; 
Stream[Quads+2] := _Code64[(B[0] mod 4)*16 + 1]; 
Stream[Quads+3] := '='; 
Stream[Quads+4] := '='; 
Inc(Quads, 4); 
end; 
Stream[0] := Chr(Quads); 
if Quads > 0 then 
begin 
EncLine := Stream+#13#10; 
Encoded.Write(EncLine[1], Length(EncLine)); 
end; 
Result := Encoded.Size; 
end; 
{对参数Decoded字符串进行Base64编码，返回编码后的字符串} 
function EncodeString(Decoded:string):String; 
var 
mmTemp,mmDecoded:TMemoryStream; 
strTemp:TStrings; 
begin 
mmTemp := TMemoryStream.Create; 
mmDecoded:=TMemoryStream.Create; 
strTemp:=TStringList.Create; 
strTemp.Add(Decoded); 
strTemp.SaveToStream(mmTemp); 
mmTemp.Position := 0; 
{剔除mmTemp从strTemp中带来的字符#13#10} 
mmDecoded.CopyFrom(mmTemp,mmTemp.Size-2); 
{对mmDecoded进行Base64编码，由mmTemp返回编码后的结果} 
EncodeBASE64(mmTemp,mmDecoded); 
{获得Base64编码后的字符串} 
mmTemp.Position:=0; 
strTemp.LoadFromStream(mmTemp); 
{返回结果必须从strTemp[0]中获得，如果使用strTemp.Text会 
带来不必要的字符#13#10} 
Result:=strTemp[0]; 
end; 
procedure TForm1.btnOpenClick(Sender: TObject); 
begin 
{打开对话框，选择SWF文件} 
if OpenDialog1.Execute then 
begin 

nd; 
end; 
procedure TForm1.btnSendClick(Sender: TObject); 
var 
mmSwfFile,mmEncoded:TMemoryStream; 
iResult:Integer; 
strsTemp:TStrings; 
strContents:TStringList; 
i:Integer; 
begin 
{验证用户输入信息} 
if txtTo.Text='' then 
begin 
ShowMessage('请输入收信人！'); 
Exit; 
end; 
if txtFrom.Text='' then 
begin 
ShowMessage('请输入发信人！'); 
Exit; 
end; 
if txtSmtpServer.Text='' then 
begin 
ShowMessage('请输入SMTP服务器！'); 
Exit; 
end; 
if txtPort.Text='' then 
begin 
ShowMessage('请输入端口号！'); 
Exit; 
end; 
if txtSwfFile.Text='' then 
begin 
ShowMessage('请选择SWF文件!'); 
Exit; 
end; 
{检验服务器认证的用户名和密码} 
if chkSmtpVerify.Checked = True then 
if (txtUserName.Text='') or (txtPassword.Text='') then 
begin 
ShowMessage('您已选择SMTP服务器需要认证'+#13#10+'请输入用户名和密码！'); 
Exit; 
end; 
{设置SMTP服务器地址、端口} 
NMSMTP1.Host:=txtSmtpServer.Text; 
NMSMTP1.Port:=StrToInt(txtPort.Text); 
{断开原来的连接，保证TForm1.NMSMTP1Connect中服务器认证的执行} 
if NMSMTP1.Connected then 
begin 
NMSMTP1.Disconnect; 
end; 
{连接服务器} 
NMSMTP1.Connect; 
{创建流} 
mmSwfFile:=TMemoryStream.Create; 
mmEncoded:=TMemoryStream.Create; 
{加载文件至流mmSwfFile} 
mmSwfFile.LoadFromFile(txtSwfFile.Text); 
{对mmSwfFile进行Base64编码，mmEncoded为编码后内容} 
iResult:=EncodeBASE64(mmEncoded,mmSwfFile); 
strsTemp:=TStringList.Create; 
mmEncoded.Position:=0; 
strsTemp.LoadFromStream(mmEncoded); 
{----生成邮件内容----} 
strContents:=TStringList.Create; 
strContents.Add('--------------SwfEmail by JDH'); 
strContents.Add('Content-Type: text/html; charset=gb2312'); 
strContents.Add('Content-Transfer-Encoding: 8bit'); 
{注意：空行是邮件格式所必需的！} 
strContents.Add(''); 
strContents.Add('< HTML >< HEAD >< TITLE >SWFEMAIL< /TITLE >< /HEAD >'); 
strContents.Add('< BODY >'); 
{添加邮件正文内容} 
for i:=0 to memContents.Lines.Count-1 do 
begin 
strContents.Add(memContents.Lines[i] + '< br >'); 
end; 
{添加SWF文件相关内容} 
strContents.Add('< object classid="clsid:D27CDB6E-AE6D-11cf-96B8-444553540000" codebase="http://download.macromedia.com/pub/shockwave/ 
cabs/flash/swflash.cab#version=5,0,0,0">'); 
strContents.Add('< param name=movie value="cid:jdh_swfemail@001" >'); 
strContents.Add('< param name=quality value=high >'); 
strContents.Add('< embed src="cid:jdh_swfemail@001" quality=high pluginspage="http://www.macromedia.com/shockwave/download/index.cgi? 
P1_Prod_Version=ShockwaveFlash" type="application/x-shockwave-flash" >'); 
strContents.Add('< /embed>< /object >< /BODY >< /HTML >'); 
strContents.Add(''); 
strContents.Add('--------------SwfEmail by JDH'); 
strContents.Add('Content-Type: image/swf'); 
strContents.Add('Content-ID: < jdh_swfemail@001 >'); 
strContents.Add('Content-Transfer-Encoding: base64'); 
strContents.Add('Content-Disposition: inline; filename="'+ExtractFileName(txtSwfFile.Text)+'"' ); 
strContents.Add(''); 
strContents.Add(strsTemp.Text); 
strContents.Add(''); 
{----生成邮件内容结束----} 
{设置邮件发送信息} 
NMSMTP1.PostMessage.FromAddress := txtFrom.Text; 
NMSMTP1.PostMessage.FromName := txtFrom.Text; 
NMSMTP1.PostMessage.ToAddress.Text := txtTo.Text; 
NMSMTP1.PostMessage.Body.Text := strContents.Text; 
NMSMTP1.PostMessage.Subject := txtSubject.Text; 
{发送电子邮件} 
NMSMTP1.SendMail; 
ShowMessage('邮件发送成功！'); 
end; 
procedure TForm1.NMSMTP1Connect(Sender: TObject); 
var 
strUserName,strPassword:string; 
begin 
{如果SMTP服务器需要认证，则进行认证} 
if chkSmtpVerify.Checked = True then 
begin 
{对用户名和密码进行Base64编码} 
strUserName:=EncodeString(txtUserName.Text); 
strPassword:=EncodeString(txtPassword.Text); 
{进行认证，输入编码后的用户名、密码} 
nmsmtp1.Transaction('auth login'); 
nmsmtp1.Transaction(strUserName); 
nmsmtp1.Transaction(strPassword); 
end; 
end; 
procedure TForm1.NMSMTP1SendStart(Sender: TObject); 
begin 
{在邮件发送开始时修改邮件的消息头，标明邮件为多部分组成} 
NMSMTP1.FinalHeader.Values['Content-Type'] := ' 
multipart/related; boundary="------------SwfEmail by JDH"'; 
end; 
procedure TForm1.chkSmtpVerifyClick(Sender: TObject); 
begin 
{根据是否需要SMTP服务器认证，改变用户名、密码状态} 
if chkSmtpVerify.Checked = True then 
begin 
txtUserName.Enabled := True; 
txtUserName.Color:= clWindow; 
txtPassword.Enabled := True; 
txtPassword.Color:= clWindow; 
end 
else 
begin 
txtUserName.Enabled := False; 
txtUserName.Color:= clSilver; 
txtPassword.Enabled := False; 
txtPassword.Color:= clSilver; 
end; 
end; 
end.