如何用 IdSMTPServer 寫個 Mail Server ? |
答題得分者是:artist1002
|
pcboy
版主 發表:177 回覆:1838 積分:1463 註冊:2004-01-13 發送簡訊給我 |
已經用 IdSMTPServer 搜尋過本站, 發現這篇
http://delphi.ktop.com.tw/topic.php?topic_id=39078 (為了方便閱讀, 和了解運作, 多加了 Memo2 和小作修改 在 Outlook Express 增加帳號 test@127.0.0.1 SMTP Server / POP3 Server 都是 127.0.0.1 active SMTP Server 後, 信件寄出, 從 "寄件匣" 消失, "寄件備份" 出現, 但是不論寄到哪個 ISP 的信箱, 都沒有收到信件 是否 IdSMTPServer 還要設定什麼屬性值 ? <textarea class="delphi" rows="10" cols="60" name="code">unit Unit1; {----------------------------------------------------------------------------- Demo Name: SMTPSever demo Author: Andrew Neillans Copyright: Indy Pit Crew Purpose: History: Date: 27/10/2002 01:27:09 Checked with Indy version: 9.0 - Allen O'Neill - Springboard Technologies Ltd - http://www.springboardtechnologies.com ----------------------------------------------------------------------------- Notes: Demonstration of SMTPSerer (by use of comments only!! - read the RFC to understand how to store and manage server data, and thus be able to use this component effectivly) } interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, IdBaseComponent, IdComponent, IdTCPServer, IdSMTPServer, StdCtrls, IdMessage, IdEMailAddress; type TForm1 = class(TForm) Memo1: TMemo; Label1: TLabel; Label2: TLabel; Label3: TLabel; ToLabel: TLabel; FromLabel: TLabel; SubjectLabel: TLabel; IdSMTPServer1: TIdSMTPServer; Label4: TLabel; Button1: TButton; Button2: TButton; Memo2: TMemo; procedure IdSMTPServer1ADDRESSError(AThread: TIdPeerThread; const CmdStr: String); procedure IdSMTPServer1CommandAUTH(AThread: TIdPeerThread; const CmdStr: String); procedure IdSMTPServer1CommandCheckUser(AThread: TIdPeerThread; const Username, Password: String; var Accepted: Boolean); procedure IdSMTPServer1CommandQUIT(AThread: TIdPeerThread); procedure IdSMTPServer1CommandX(AThread: TIdPeerThread; const CmdStr: String); procedure IdSMTPServer1CommandMAIL(const ASender: TIdCommand; var Accept: Boolean; EMailAddress: String); procedure IdSMTPServer1CommandRCPT(const ASender: TIdCommand; var Accept, ToForward: Boolean; EMailAddress: String; var CustomError: String); procedure IdSMTPServer1ReceiveRaw(ASender: TIdCommand; var VStream: TStream; RCPT: TIdEMailAddressList; var CustomError: String); procedure IdSMTPServer1ReceiveMessage(ASender: TIdCommand; var AMsg: TIdMessage; RCPT: TIdEMailAddressList; var CustomError: String); procedure IdSMTPServer1ReceiveMessageParsed(ASender: TIdCommand; var AMsg: TIdMessage; RCPT: TIdEMailAddressList; var CustomError: String); procedure IdSMTPServer1CommandHELP(ASender: TIdCommand); procedure IdSMTPServer1CommandSAML(ASender: TIdCommand); procedure IdSMTPServer1CommandSEND(ASender: TIdCommand); procedure IdSMTPServer1CommandSOML(ASender: TIdCommand); procedure IdSMTPServer1CommandTURN(ASender: TIdCommand); procedure IdSMTPServer1CommandVRFY(ASender: TIdCommand); procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.IdSMTPServer1ADDRESSError(AThread: TIdPeerThread; const CmdStr: String); begin // Send the Address Error String - this *WILL* be coded in eventually. AThread.Connection.Writeln('500 Syntax Error in MAIL FROM or RCPT TO'); Memo2.Lines.Add('IdSMTPServer1ADDRESSError'); end; procedure TForm1.IdSMTPServer1CommandAUTH(AThread: TIdPeerThread; const CmdStr: String); begin // This is where you would process the AUTH command - for now, we send a error AThread.Connection.Writeln(IdSMTPServer1.Messages.ErrorReply); Memo2.Lines.Add('IdSMTPServer1CommandAUTH'); end; procedure TForm1.IdSMTPServer1CommandCheckUser(AThread: TIdPeerThread; const Username, Password: String; var Accepted: Boolean); begin // This event allows you to 'login' a user - this is used internall in the // IdSMTPServer to validate users connecting using the AUTH. Accepted := False; Memo2.Lines.Add('IdSMTPServer1CommandCheckUser'); end; procedure TForm1.IdSMTPServer1CommandQUIT(AThread: TIdPeerThread); begin // Process any logoff events here - e.g. clean temp files Memo2.Lines.Add('IdSMTPServer1CommandQUIT'); end; procedure TForm1.IdSMTPServer1CommandX(AThread: TIdPeerThread; const CmdStr: String); begin // You can use this for debugging :) Memo2.Lines.Add('IdSMTPServer1CommandX'); end; procedure TForm1.IdSMTPServer1CommandMAIL(const ASender: TIdCommand; var Accept: Boolean; EMailAddress: String); begin // This is required! // You check the EMAILADDRESS here to see if it is to be accepted / processed. // Set Accept := True if its allowed Accept := True; Memo2.Lines.Add('IdSMTPServer1CommandMAIL'); end; procedure TForm1.IdSMTPServer1CommandRCPT(const ASender: TIdCommand; var Accept, ToForward: Boolean; EMailAddress: String; var CustomError: String); begin // This is required! // You check the EMAILADDRESS here to see if it is to be accepted / processed. // Set Accept := True if its allowed // Set ToForward := True if its needing to be forwarded. Accept := True; Memo2.Lines.Add('IdSMTPServer1CommandRCPT'); end; procedure TForm1.IdSMTPServer1ReceiveRaw(ASender: TIdCommand; var VStream: TStream; RCPT: TIdEMailAddressList; var CustomError: String); begin // This is the main event for receiving the message itself if you are using // the ReceiveRAW method // The message data will be given to you in VSTREAM // Capture it using a memorystream, filestream, or whatever type of stream // is suitable to your storage mechanism. // The RCPT variable is a list of recipients for the message Memo2.Lines.Add('IdSMTPServer1ReceiveRaw'); end; procedure TForm1.IdSMTPServer1ReceiveMessage(ASender: TIdCommand; var AMsg: TIdMessage; RCPT: TIdEMailAddressList; var CustomError: String); begin // This is the main event if you have opted to have idSMTPServer present the message packaged as a TidMessage // The AMessage contains the completed TIdMessage. // NOTE: Dont forget to add IdMessage to your USES clause! ToLabel.Caption := AMsg.Recipients.EMailAddresses; FromLabel.Caption := AMsg.From.Text; SubjectLabel.Caption := AMsg.Subject; Memo1.Lines := AMsg.Body; // Implement your file system here :) Memo2.Lines.Add('IdSMTPServer1ReceiveMessage'); end; procedure TForm1.IdSMTPServer1ReceiveMessageParsed(ASender: TIdCommand; var AMsg: TIdMessage; RCPT: TIdEMailAddressList; var CustomError: String); begin // This is the main event if you have opted to have the idSMTPServer to do your parsing for you. // The AMessage contains the completed TIdMessage. // NOTE: Dont forget to add IdMessage to your USES clause! ToLabel.Caption := AMsg.Recipients.EMailAddresses; FromLabel.Caption := AMsg.From.Text; SubjectLabel.Caption := AMsg.Subject; Memo1.Lines := AMsg.Body; // Implement your file system here :) Memo2.Lines.Add('IdSMTPServer1ReceiveMessageParsed'); end; procedure TForm1.IdSMTPServer1CommandHELP(ASender: TIdCommand); begin // here you can send back a lsit of supported server commands Memo2.Lines.Add('IdSMTPServer1CommandHELP'); end; procedure TForm1.IdSMTPServer1CommandSAML(ASender: TIdCommand); begin // not really used anymore - see RFC for information Memo2.Lines.Add('IdSMTPServer1CommandSMAL'); end; procedure TForm1.IdSMTPServer1CommandSEND(ASender: TIdCommand); begin // not really used anymore - see RFC for information Memo2.Lines.Add('IdSMTPServer1CommandSEND'); end; procedure TForm1.IdSMTPServer1CommandSOML(ASender: TIdCommand); begin // not really used anymore - see RFC for information Memo2.Lines.Add('IdSMTPServer1CommandSOML'); end; procedure TForm1.IdSMTPServer1CommandTURN(ASender: TIdCommand); begin // not really used anymore - see RFC for information Memo2.Lines.Add('IdSMTPServer1CommandTURN'); end; procedure TForm1.IdSMTPServer1CommandVRFY(ASender: TIdCommand); begin // not really used anymore - see RFC for information Memo2.Lines.Add('IdSMTPServer1CommandVRFY'); end; procedure TForm1.Button1Click(Sender: TObject); begin IdSMTPServer1.active := true; Button1.Enabled:=False; Button2.Enabled:=true; end; procedure TForm1.Button2Click(Sender: TObject); begin IdSMTPServer1.active := false; Button1.Enabled:=True; Button2.Enabled:=False; end; procedure TForm1.FormCreate(Sender: TObject); begin Button1.Enabled:=True; Button2.Enabled:=False; end; end. </textarea>
------
能力不足,求助於人;有能力時,幫幫別人;如果您滿意答覆,請適時結案! 子曰:問有三種,不懂則問,雖懂有疑則問,雖懂而想知更多則問! |
artist1002
高階會員 發表:2 回覆:155 積分:151 註冊:2002-09-26 發送簡訊給我 |
|
pcboy
版主 發表:177 回覆:1838 積分:1463 註冊:2004-01-13 發送簡訊給我 |
用 Google 找 IdSMTPServer1ReceiveRaw, 只有兩篇一篇就是上面的範例一篇網站上已無資料, 頁庫存檔中找到如下(但是有問題)
http://66.102.7.104/search?q=cache:RGJ7um6g6n4J:www.nlcsharp.com/Forum/showthread.php?t=3688 IdSMTPServer1ReceiveRaw&hl=zh-TW <textarea class="delphi" rows="10" cols="60" name="code"> procedure TForm1.IdSMTPServer1ReceiveRaw(ASender: TIdCommand; var VStream: TStream; RCPT: TIdEMailAddressList; var CustomError: String); var MemStream:TMemoryStream; i:integer; MailMsg : TidMessage; // 這是我補上的 E_AddressRcpt : String; // 這是我補上的 Smtp_Client1 : TIdSMTP; // 這是我補上的 begin MemStream := TMemorystream.Create; MailMsg := TidMessage.Create(nil); VStream.Seek(0, soFromEnd); VStream.Write('.'#10#13, 3); MemStream.LoadFromStream(VStream); MemStream.SaveToFile('c:\Pizza'); MailMsg.LoadFromFile('c:\Pizza'); for i := 0 to Rcpt.Count -1 do begin E_AddressRcpt := Rcpt.Items[i].Address; end; MailMsg.Recipients.EMailAddresses := E_AddressRcpt; Smtp_Client.PSendMail; // 有問題 MemStream.Free; MailMsg.Free; DeleteFile('c:\Pizza'); end; </textarea>這行有問題 Smtp_Client.PSendMail IdSMTP 沒有稱為 PSendMail 的 Method 繼續想辦法找範例, 有人可以提供嗎 ? THX (只要寄信, 轉信, 不需要有信箱管理 和 收信)
------
能力不足,求助於人;有能力時,幫幫別人;如果您滿意答覆,請適時結案! 子曰:問有三種,不懂則問,雖懂有疑則問,雖懂而想知更多則問! |
pcboy
版主 發表:177 回覆:1838 積分:1463 註冊:2004-01-13 發送簡訊給我 |
Indy 網站上的範例 SMTPServer
http://www.projectindy.org/Demos/index.iwp <textarea class="delphi" rows="10" cols="60" name="code"> { $HDR$} {**********************************************************************} { Unit archived using Team Coherence } { Team Coherence is Copyright 2002 by Quality Software Components } { } { For further information / comments, visit our WEB site at } { http://www.TeamCoherence.com } {**********************************************************************} {} { $Log: 23278: Main.pas { { Rev 1.0.1.0 25/10/2004 22:49:48 ANeillans Version: 9.0.17 { Verified } { { Rev 1.0 12/09/2003 21:41:36 ANeillans { Initial Checking. { Verified with Indy 9 and D7 } { Demo Name: SMTP Server Created By: Andy Neillans On: 27/10/2002 Notes: Demonstration of SMTPServer (by use of comments only!!) Read the RFC to understand how to store and manage server data, and therefore be able to use this component effectivly. Version History: 12th Sept 03: Andy Neillans Cleanup. Added some basic syntax checking for example. Tested: Indy 9: D5: Untested D6: Untested D7: 25th Oct 2004 by Andy Neillans Tested with Telnet and Outlook Express 6 } unit Main; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, IdBaseComponent, IdComponent, IdTCPServer, IdSMTPServer, StdCtrls, IdMessage, IdEMailAddress; type TForm1 = class(TForm) Memo1: TMemo; Label1: TLabel; Label2: TLabel; Label3: TLabel; ToLabel: TLabel; FromLabel: TLabel; SubjectLabel: TLabel; IdSMTPServer1: TIdSMTPServer; Label4: TLabel; btnServerOn: TButton; btnServerOff: TButton; procedure IdSMTPServer1CommandAUTH(AThread: TIdPeerThread; const CmdStr: String); procedure IdSMTPServer1CommandCheckUser(AThread: TIdPeerThread; const Username, Password: String; var Accepted: Boolean); procedure IdSMTPServer1CommandQUIT(AThread: TIdPeerThread); procedure IdSMTPServer1CommandX(AThread: TIdPeerThread; const CmdStr: String); procedure IdSMTPServer1CommandMAIL(const ASender: TIdCommand; var Accept: Boolean; EMailAddress: String); procedure IdSMTPServer1CommandRCPT(const ASender: TIdCommand; var Accept, ToForward: Boolean; EMailAddress: String; var CustomError: String); procedure IdSMTPServer1ReceiveRaw(ASender: TIdCommand; var VStream: TStream; RCPT: TIdEMailAddressList; var CustomError: String); procedure IdSMTPServer1ReceiveMessage(ASender: TIdCommand; var AMsg: TIdMessage; RCPT: TIdEMailAddressList; var CustomError: String); procedure IdSMTPServer1ReceiveMessageParsed(ASender: TIdCommand; var AMsg: TIdMessage; RCPT: TIdEMailAddressList; var CustomError: String); procedure IdSMTPServer1CommandHELP(ASender: TIdCommand); procedure IdSMTPServer1CommandSAML(ASender: TIdCommand); procedure IdSMTPServer1CommandSEND(ASender: TIdCommand); procedure IdSMTPServer1CommandSOML(ASender: TIdCommand); procedure IdSMTPServer1CommandTURN(ASender: TIdCommand); procedure IdSMTPServer1CommandVRFY(ASender: TIdCommand); procedure btnServerOnClick(Sender: TObject); procedure btnServerOffClick(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.IdSMTPServer1CommandAUTH(AThread: TIdPeerThread; const CmdStr: String); begin // This is where you would process the AUTH command - for now, we send a error AThread.Connection.Writeln(IdSMTPServer1.Messages.ErrorReply); end; procedure TForm1.IdSMTPServer1CommandCheckUser(AThread: TIdPeerThread; const Username, Password: String; var Accepted: Boolean); begin // This event allows you to 'login' a user - this is used internall in the // IdSMTPServer to validate users connecting using the AUTH. Accepted := False; end; procedure TForm1.IdSMTPServer1CommandQUIT(AThread: TIdPeerThread); begin // Process any logoff events here - e.g. clean temp files end; procedure TForm1.IdSMTPServer1CommandX(AThread: TIdPeerThread; const CmdStr: String); begin // You can use this for debugging :) // It should be noted, that no standard clients ever send this command. end; procedure TForm1.IdSMTPServer1CommandMAIL(const ASender: TIdCommand; var Accept: Boolean; EMailAddress: String); Var IsOK : Boolean; begin // This is required! // You check the EMAILADDRESS here to see if it is to be accepted / processed. IsOK := False; if Pos('@', EMailAddress) > 0 then // Basic checking for syntax IsOK := True; // Set Accept := True if its allowed if IsOK then Accept := True Else Accept := False; end; procedure TForm1.IdSMTPServer1CommandRCPT(const ASender: TIdCommand; var Accept, ToForward: Boolean; EMailAddress: String; var CustomError: String); Var IsOK : Boolean; begin // This is required! // You check the EMAILADDRESS here to see if it is to be accepted / processed. // Set Accept := True if its allowed // Set ToForward := True if its needing to be forwarded. IsOK := False; if Pos('@', EMailAddress) > 0 then // Basic checking for syntax IsOK := True Else CustomError := '500 No at sign'; // If you are going to use the CustomError property, you need to include the error code // This allows you to use the extended error reporting. // Set Accept := True if its allowed if IsOK then Accept := True Else Accept := False; end; procedure TForm1.IdSMTPServer1ReceiveRaw(ASender: TIdCommand; var VStream: TStream; RCPT: TIdEMailAddressList; var CustomError: String); begin // This is the main event for receiving the message itself if you are using // the ReceiveRAW method // The message data will be given to you in VSTREAM // Capture it using a memorystream, filestream, or whatever type of stream // is suitable to your storage mechanism. // The RCPT variable is a list of recipients for the message end; procedure TForm1.IdSMTPServer1ReceiveMessage(ASender: TIdCommand; var AMsg: TIdMessage; RCPT: TIdEMailAddressList; var CustomError: String); begin // This is the main event if you have opted to have idSMTPServer present the message packaged as a TidMessage // The AMessage contains the completed TIdMessage. // NOTE: Dont forget to add IdMessage to your USES clause! ToLabel.Caption := AMsg.Recipients.EMailAddresses; FromLabel.Caption := AMsg.From.Text; SubjectLabel.Caption := AMsg.Subject; Memo1.Lines := AMsg.Body; // Implement your file system here :) end; procedure TForm1.IdSMTPServer1ReceiveMessageParsed(ASender: TIdCommand; var AMsg: TIdMessage; RCPT: TIdEMailAddressList; var CustomError: String); begin // This is the main event if you have opted to have the idSMTPServer to do your parsing for you. // The AMessage contains the completed TIdMessage. // NOTE: Dont forget to add IdMessage to your USES clause! ToLabel.Caption := AMsg.Recipients.EMailAddresses; FromLabel.Caption := AMsg.From.Text; SubjectLabel.Caption := AMsg.Subject; Memo1.Lines := AMsg.Body; // Implement your file system here :) end; procedure TForm1.IdSMTPServer1CommandHELP(ASender: TIdCommand); begin // here you can send back a lsit of supported server commands end; procedure TForm1.IdSMTPServer1CommandSAML(ASender: TIdCommand); begin // not really used anymore - see RFC for information end; procedure TForm1.IdSMTPServer1CommandSEND(ASender: TIdCommand); begin // not really used anymore - see RFC for information end; procedure TForm1.IdSMTPServer1CommandSOML(ASender: TIdCommand); begin // not really used anymore - see RFC for information end; procedure TForm1.IdSMTPServer1CommandTURN(ASender: TIdCommand); begin // not really used anymore - see RFC for information end; procedure TForm1.IdSMTPServer1CommandVRFY(ASender: TIdCommand); begin // not really used anymore - see RFC for information end; procedure TForm1.btnServerOnClick(Sender: TObject); begin btnServerOn.Enabled := False; btnServerOff.Enabled := True; IdSMTPServer1.active := true; end; procedure TForm1.btnServerOffClick(Sender: TObject); begin btnServerOn.Enabled := True; btnServerOff.Enabled := False; IdSMTPServer1.active := false; end; end. </textarea>發表人 - pcboy2 於 2005/07/01 09:18:16
------
能力不足,求助於人;有能力時,幫幫別人;如果您滿意答覆,請適時結案! 子曰:問有三種,不懂則問,雖懂有疑則問,雖懂而想知更多則問! |
pcboy
版主 發表:177 回覆:1838 積分:1463 註冊:2004-01-13 發送簡訊給我 |
Indy 網站上的範例 SMTPRelay
http://www.projectindy.org/Demos/index.iwp <textarea class="delphi" rows="10" cols="60" name="code"> { $HDR$} {**********************************************************************} { Unit archived using Team Coherence } { Team Coherence is Copyright 2002 by Quality Software Components } { } { For further information / comments, visit our WEB site at } { http://www.TeamCoherence.com } {**********************************************************************} {} { $Log: 23283: fMain.pas { { Rev 1.1 25/10/2004 22:49:38 ANeillans Version: 9.0.17 { Verified } { { Rev 1.0 12/09/2003 21:50:22 ANeillans { Intial Checkin { Verified with D7 and Indy 9 { Added an event log and a few more comments } { Demo Name: SMTP Relay Created By: Allen O'Neill On: 27/10/2002 Notes: Demonstrates sending an email without the use of a local SMTP server This works by extracting the domain part form the recipient email address, then doing an MX lookup against a DNS server for that domain part, and finally connecting directly to the SMTP server that the MX record point to, to deliver the message. Version History: 12th Sept 03: Andy Neillans Added an event log and a few more comments Tested: Indy 9: D5: Untested D6: Untested D7: 25th Oct 2004 by Andy Neillans Tested with Telnet and Outlook Express 6 } unit fMain; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, IdTCPConnection, IdTCPClient, IdMessageClient, IdSMTP, IdComponent, IdUDPBase, IdUDPClient, IdDNSResolver, IdBaseComponent, IdMessage, StdCtrls, ExtCtrls, ComCtrls, IdAntiFreezeBase, IdAntiFreeze; type TfrmMain = class(TForm) IdMessage: TIdMessage; IdDNSResolver: TIdDNSResolver; IdSMTP: TIdSMTP; Label1: TLabel; sbMain: TStatusBar; Label2: TLabel; edtDNS: TEdit; Label3: TLabel; Label4: TLabel; edtSender: TEdit; Label5: TLabel; edtRecipient: TEdit; Label6: TLabel; edtSubject: TEdit; Label7: TLabel; mmoMessageText: TMemo; btnSendMail: TButton; btnExit: TButton; IdAntiFreeze: TIdAntiFreeze; Label8: TLabel; edtTimeOut: TEdit; Label9: TLabel; Label10: TLabel; lbEvents: TListBox; procedure btnExitClick(Sender: TObject); procedure btnSendMailClick(Sender: TObject); private { Private declarations } public { Public declarations } fMailServers : TStringList; Function PadZero(s:String):String; Function GetMailServers:Boolean; Function ValidData : Boolean; Procedure SendMail; OverLoad; Function SendMail(aHost : String):Boolean; OverLoad; Procedure LockControls; procedure UnlockControls; Procedure Msg(aMessage:String); end; var frmMain: TfrmMain; implementation {$R *.DFM} procedure TfrmMain.btnExitClick(Sender: TObject); begin application.terminate; end; procedure TfrmMain.btnSendMailClick(Sender: TObject); begin Msg(''); LockControls; if ValidData then SendMail; UnlockControls; Msg(''); end; function TfrmMain.GetMailServers: Boolean; var i,x : integer; LDomainPart : String; LMXRecord : TMXRecord; begin // This function does the business part of resolving the domain name and fetching // the mail server list if not assigned(fmailServers) then fMailServers := TStringList.Create; fmailServers.clear; with IdDNSResolver do begin QueryResult.Clear; QueryRecords := [qtMX]; Msg('Setting up DNS query parameters'); Host := edtDNS.text; ReceiveTimeout := StrToInt(edtTimeOut.text); // Extract the domain part from recipient email address LDomainPart := copy(edtRecipient.text,pos('@',edtRecipient.text) 1,length(edtRecipient.text)); // the domain name to resolve try Msg('Resolving DNS for domain: ' LDomainPart); Resolve(LDomainPart); if QueryResult.Count > 0 then begin for i := 0 to QueryResult.Count - 1 do begin LMXRecord := TMXRecord(QueryResult.Items[i]); fMailServers.Append(PadZero(IntToStr(LMXRecord.Preference)) '=' LMXRecord.ExchangeServer); end; // sort in order of priority and then remove extra data fMailServers.Sorted := false; for i := 0 to fMailServers.count - 1 do begin x := pos('=',fMailServers.Strings[i]); if x > 0 then fMailServers.Strings[i] := copy(fMailServers.Strings[i],x 1,length(fMailServers.Strings[i])); end; fMailServers.Sorted := true; // Ignore duplicate servers fMailServers.Duplicates := dupIgnore; Result := true; end else begin Msg('No response from the DNS server'); MessageDlg('There is no response from the DNS server !', mtInformation, [mbOK], 0); Result := false; end; except on E : Exception do begin Msg('Error resolving domain ' LDomainPart); MessageDlg('Error resolving domain: ' e.message, mtInformation, [mbOK], 0); Result := false; end; end; end; end; // Used in DNS preferance sorting procedure TfrmMain.LockControls; begin edtDNS.enabled := false; edtSender.enabled := false; edtRecipient.enabled := false; edtSubject.enabled := false; mmoMessageText.enabled := false; btnExit.enabled := false; btnSendMail.enabled := false; end; procedure TfrmMain.UnlockControls; begin edtDNS.enabled := true; edtSender.enabled := true; edtRecipient.enabled := true; edtSubject.enabled := true; mmoMessageText.enabled := true; btnExit.enabled := true; btnSendMail.enabled := true; end; function TfrmMain.PadZero(s: String): String; begin if length(s) < 2 then s := '0' s; Result := s; end; procedure TfrmMain.SendMail; var i : integer; begin if GetMailServers then begin with IdMessage do begin Msg('Assigning mail message properties'); From.Text := edtSender.text; Sender.Text := edtSender.text; Recipients.EMailAddresses := edtRecipient.text; Subject := edtSubject.text; Body := mmoMessageText.Lines; end; for i := 0 to fMailServers.count -1 do begin Msg('Attempting to send mail'); if SendMail(fMailServers.Strings[i]) then begin MessageDlg('Mail successfully sent and available for pickup by recipient !', mtInformation, [mbOK], 0); Exit; end; end; // if we are here then something went wrong .. ie there were no available servers to accept our mail! MessageDlg('Could not send mail to remote server - please try again later.', mtInformation, [mbOK], 0); end; if assigned(fMailServers) then FreeAndNil(fMailServers); end; function TfrmMain.SendMail(aHost: String): Boolean; begin with IdSMTP do begin Caption := 'Trying to sendmail via: ' aHost; Msg('Trying to sendmail via: ' aHost); Host := aHost; try Msg('Attempting connect'); Connect; Msg('Successful connect ... sending message'); Send(IdMessage); Msg('Attempting disconnect'); Disconnect; msg('Successful disconnect'); Result := true; except on E : Exception do begin if connected then try disconnect; except end; Msg('Error sending message'); result := false; ShowMessage(E.Message); end; end; end; Caption := ''; end; function TfrmMain.ValidData: Boolean; var ErrString:string; begin // Here we do some quick validation of the boxes on the form - just to make sure :) Result := True; ErrString := ''; if trim(edtDNS.text) = '' then ErrString := ErrString #13 #187 'DNS server not filled in'; if trim(edtSender.text) = '' then ErrString := ErrString #13 #187 'Sender email not filled in'; if trim(edtRecipient.text) = '' then ErrString := ErrString #13 #187 'Recipient not filled in'; if ErrString <> '' then begin lbEvents.Items.Add('Validation Error: ' ErrString); MessageDlg('Cannot proceed due to the following errors:' #13 #10 ErrString, mtInformation, [mbOK], 0); Result := False; end; end; procedure TfrmMain.Msg(aMessage: String); begin lbEvents.Items.Add(AMessage); sbMain.SimpleText := aMessage; application.ProcessMessages; end; end. </textarea>
------
能力不足,求助於人;有能力時,幫幫別人;如果您滿意答覆,請適時結案! 子曰:問有三種,不懂則問,雖懂有疑則問,雖懂而想知更多則問! |
本站聲明 |
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇! |