Delphi让你发送Flash电子邮件完整源代码 - 16 April 2009 - Blog - ystyle paltform
Home » 2009 » April » 16 » Delphi让你发送Flash电子邮件完整源代码
6:03 PM
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.
Views: 706 | Added by: ystyle | Rating: 0.0/0
Total comments: 0
Only registered users can add comments.
[ Sign Up | Log In ]