快讯
- 微星MPG Z890I EDGE TI WIFI 刀锋 钛评测:14 层 PCB 加持,同级之中强无敌!
- 打造低调而卓越的Ai PC,微星MEG Z890 ACE战神主板开箱
- 解密“星”制造,微星深圳恩斯迈工厂探秘之旅
- 游泳也需音乐相伴!韶音OpenSwim Pro评测
- 又一款轻量化电竞
- 元气满满的充电之旅!铂陆帝商超活动嗨翻周末
- 雷柏机甲编码主题系列警戒线S-07图赏:以机械美感诠释潮流新理念桌搭!
- 更适合新手体质的枪战游戏,《无畏契约》开战!
- 现代与传统的融合之旅:贝尔金笔记本扩展坞体验
- 航天品质下的极速充电体验——航嘉G65 GaN快速充电器评测
- 有颜有实力的外设谁能不爱?来看雷柏商超巡演
- 新潮外设引爆全场!雷柏联合PC打造潮品酷玩趴
- 幻彩绚丽,玩趣十足!雷柏V700DIY键盘图赏
- U皇就该配板皇,超频玩家现身说法教你选主板
- 13代酷睿的超频利器,有好板才有好性能
- 全新升级,雷柏V20S RGB光学游戏鼠标2023版详解
- 马斯克30亿放“烟花”,民航故事为何值钱?
- 让露营生活更精致!铂陆帝户外电源AC180评测
- 惠威音响体验:音响中的艺术品,拥有好听的灵魂
- HiFi级音响用料 仙籁 N8音响专用交换机售2980元
- 微星MPG Z890I EDGE TI WIFI 刀锋 钛评测:14 层 PCB 加持,同级之中强无敌!29日
- 打造低调而卓越的Ai PC,微星MEG Z890 ACE战神主板开箱10日
- 解密“星”制造,微星深圳恩斯迈工厂探秘之旅02日
- 游泳也需要音乐相伴!韶音新一代游泳耳机OpenSwim Pro评测12日
- 又一款轻量化电竞"神鼠"来袭!玄熊猫3395游戏鼠标今晚首发149元10日
- 元气满满的充电之旅!铂陆帝商超活动嗨翻周末27日
- 雷柏机甲编码主题系列警戒线S-07图赏:以机械美感诠释潮流新理念桌搭!24日
- 更适合新手体质的枪战游戏,《无畏契约》国服正式开战!20日
- 玩物近话论:现代科技与甘南秘境的融合之旅 贝尔金笔记本扩展坞体验14日
- 航天品质下的极速充电体验——航嘉G65 GaN快速充电器评测12日
- 有颜有实力的外设好物谁能不爱?雷柏点燃PCGROUP潮品商超巡演15日
- 新潮外设好物引爆全场!雷柏联合PCGROUP打造潮品酷玩趴15日
- 幻彩绚丽,玩趣十足!雷柏V700DIY热插拔机械键盘图赏10日
- U皇就该配板皇,超频玩家现身说法教你选主板26日
- 13代酷睿的超频利器,有好板才有好性能25日
- 全新升级 经典复刻 雷柏V20S RGB光学游戏鼠标2023版详解25日
- 马斯克30亿放“烟花”,民航故事为何值钱?23日
- 告别电量焦虑,让露营生活多一分精致!铂陆帝户外电源AC180开箱评测17日
- 惠威音响体验:音响中的艺术品,拥有好听的灵魂04日
- HiFi级音响用料 仙籁 N8音响专用交换机售2980元27日
Delphi让你发送Flash电子邮件(2)
2004-02-14 09:34 出处:电脑爱好者 作者:江德华 责任编辑:zwg
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. |
最热搜索
无线路由器怎么用 会说话的汤姆猫电脑版 12306网上订火车票 跳舞吧 flash player 下载 PP助手电脑版 Adobe Reader(pdf阅读) iOS6正式版12项新功能 QQ空间克隆器 9158视频KTV 植物大战僵尸辅助工具 Win8怎么关机 QQ空间进不去 2013年春节是几月几号 QQ昵称 QQ空间皮肤 PPT模板 电脑输入法不见了怎么办 2012中秋节是几月几日 word安全模式 qq输入法怎么点亮 IE修复 感恩节是几月几日 CSS布局 PS快捷键 Outlook设置 声卡驱动器官方免费下载 格式工厂怎么用 桌面图标有阴影怎么去掉 Windows RT是什么意思 2013年日历设计 Word打不开怎么办 Win8专区 腾讯微云网 windows8激活工具 剑灵什么时候公测 QQ通讯录怎么用 开心斗地主 拖拉机小游戏 麻将游戏 中国象棋 德州扑克 黄金矿工中文版 保皇扑克游戏 四国军棋 万圣节是几月几日 ps抠图教程 12306订票助手 万圣节小游戏大全 rar文件怎么打开 Photoshop CS6教程 iOS6完美越狱 QQ个性签名