Итак код SMTP сервера код для Indy9 могу если, что и для версии 10 выложить если нужно будет..
Код:
| Код |
{ $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,
IdTCPServer, IdSMTPServer, StdCtrls,
IdMessage, IdEMailAddress, IdBaseComponent, IdComponent;
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 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);
procedure IdSMTPServer1CheckUser(ASender: TIdCommand;
var Accept: Boolean; Username, Password: String);
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.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;
procedure TForm1.IdSMTPServer1CheckUser(ASender: TIdCommand;
var Accept: Boolean; Username, Password: String);
begin
Accept:= False;
if ((UserName = 'kedr@teslacharge.homeip.net') and (Password = '1234')) then
Accept:= True;
end;
end.
|
И код POP3 Сервера:
| Код |
{ $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: 22918: MainFrm.pas
{
{ Rev 1.2 25/10/2004 22:49:28 ANeillans Version: 9.0.17
{ Verified
}
{
{ Rev 1.1 12/09/2003 21:18:36 ANeillans
{ Verified with Indy 9 on D7.
{ Added instruction memo.
}
{
{ Rev 1.0 10/09/2003 20:40:48 ANeillans
{ Initial Import (Used updated version - not original 9 Demo)
}
{
Demo Name: POP3 Server
Created By: Siamak Sarmady
On: 27/10/2002
Notes:
Demonstrates POP3 server events (by way of comment - NOT functional!)
Version History:
12th Sept 03: Andy Neillans
Added the comments memo on the form for information.
8th July 03: Andy Neillans
Fixed the demo for I9.014
Unknown: Allen O'Neill
Added in some missing command handler comments
Tested:
Indy 9:
D5: Untested
D6: Untested
D7: 25th Oct 2004 by Andy Neillans
Tested with Telnet and Outlook Express 6
}
unit MainFrm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
IdBaseComponent, IdComponent, IdTCPServer, IdPOP3Server, StdCtrls;
type
TfrmMain = class(TForm)
btnExit: TButton;
IdPOP3Server1: TIdPOP3Server;
moComments: TMemo;
procedure btnExitClick(Sender: TObject);
procedure IdPOP3Server1Connect(AThread: TIdPeerThread);
procedure FormActivate(Sender: TObject);
procedure IdPOP3Server1CheckUser(AThread: TIdPeerThread;
LThread: TIdPOP3ServerThread);
procedure IdPOP3Server1DELE(ASender: TIdCommand; AMessageNum: Integer);
procedure IdPOP3Server1Exception(AThread: TIdPeerThread;
AException: Exception);
procedure IdPOP3Server1LIST(ASender: TIdCommand; AMessageNum: Integer);
procedure IdPOP3Server1QUIT(ASender: TIdCommand);
procedure IdPOP3Server1RETR(ASender: TIdCommand; AMessageNum: Integer);
procedure IdPOP3Server1RSET(ASender: TIdCommand);
procedure IdPOP3Server1STAT(ASender: TIdCommand);
procedure IdPOP3Server1TOP(ASender: TIdCommand; AMessageNum,
ANumLines: Integer);
procedure IdPOP3Server1UIDL(ASender: TIdCommand; AMessageNum: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
implementation
{$R *.DFM}
//If user presses exit button close socket and exit
procedure TfrmMain.btnExitClick(Sender: TObject);
begin
if IdPop3Server1.Active=True then
IdPop3Server1.Active:=False;
Application.Terminate;
end;
procedure TfrmMain.IdPOP3Server1Connect(AThread: TIdPeerThread);
begin
// When a clinet connects to our server we must reply with +OK, or -ERR
// Set this via Greeting.Text at runtime, or possibly in OnBeforeCommandHandler?
// You may also wish to initialise some global vars here, set the POP3 box to locked state, etc.
end;
//Activate the server socket when activating server main window.
procedure TfrmMain.FormActivate(Sender: TObject);
begin
IdPop3Server1.Active:=True;
end;
// This is where you validate the user/pass credentials of the user logging in
procedure TfrmMain.IdPOP3Server1CheckUser(AThread: TIdPeerThread;
LThread: TIdPOP3ServerThread);
begin
// LThread.Username -> examine this for valid username
// LThread.Password -> examine this for valid password
// if the user/pass pair are valid, then respond with
// LThread.State := Trans
// to reject the user/pass pair, do not change the state
LThread.State := Trans;
end;
// This is where the client program issues a delete command for a particular message
procedure TfrmMain.IdPOP3Server1DELE(ASender: TIdCommand;
AMessageNum: Integer);
begin
// if the message has been deleted, then return a success command as follows;
// ASender.Thread.Connection.Writeln('+OK - Message ' + IntToStr(AMessageNum) + ' Deleted')
// otherwise, if there was an error in deleting the message, or the message number
// did not exist in the first place, then return the following:
// ASender.Thread.Connection.Writeln('-ERR - Message ' + IntToStr(AMessageNum) + ' not deleted because.... [reason]')
// Usually, messages are deleted after being retrieved from pop3 server
// This is done when client sents DELE command after retrieving a message
// Client command is something like DELE 1 which means delete message 1
// Note, you should not actually delete the message at this point, just mark it as deleted.
// Deletions should be handled at the QUIT event.
ASender.Thread.Connection.WriteLn('+OK message 1 deleted');
end;
procedure TfrmMain.IdPOP3Server1Exception(AThread: TIdPeerThread;
AException: Exception);
begin
// Handle any exceptions given by the thread here
end;
//before retrieving messages, client asks for a list of messages
//Server responds with a +OK followed by number of deliverable
//messages and length of messages in bytes. After this a separate
//list of each message and its length is sent to client.
//here we have only one message, but we can continue with message
//number and its length , one per line and finally a '.' character.
//Format of client command is LIST
procedure TfrmMain.IdPOP3Server1LIST(ASender: TIdCommand;
AMessageNum: Integer);
begin
// Here you return a list of available messages to the client
ASender.Thread.Connection.WriteLn('+OK 1 40');
ASender.Thread.Connection.WriteLn('1 40');
ASender.Thread.Connection.WriteLn('.');
// The trailing . line is IMPORTANT!!
end;
procedure TfrmMain.IdPOP3Server1QUIT(ASender: TIdCommand);
begin
// This event is triggered on a client QUIT (a correct disconnect)
// Here you should delete any messages that have been marked with DELE.
// NOTE: The +OK response is AUTOMATICALLY sent back to the client, and the connect dropped.
end;
procedure TfrmMain.IdPOP3Server1RETR(ASender: TIdCommand;
AMessageNum: Integer);
begin
// Client initiates retrieving each message by issuing a RETR command
// to server. Server will respond by +OK and will continue by sending
// message itself. Each message is saved in a database uppon arival
// by smtp server and is now delivered to user mail agent by pop3 server.
// Here we do not read mail from a storage but we deliver a sample
// mail from inside program. We can deliver multiple mails using
// this method. Format of RETR command is something like
// RETR 1 or RETR 2 etc.
ASender.Thread.Connection.WriteLn('+OK 40 octets');
ASender.Thread.Connection.WriteLn('From: demo@projectindy.org');
ASender.Thread.Connection.WriteLn('To: you@yourdomain.com ');
ASender.Thread.Connection.WriteLn('Subject: Hello ');
ASender.Thread.Connection.WriteLn('');
ASender.Thread.Connection.WriteLn('Hello world! This is email body.');
ASender.Thread.Connection.WriteLn('.');
end;
procedure TfrmMain.IdPOP3Server1RSET(ASender: TIdCommand);
begin
// here is where the client wishes to reset the current state
// This may be used to reset a list of pending deletes, etc.
end;
procedure TfrmMain.IdPOP3Server1STAT(ASender: TIdCommand);
begin
// here is where the client has asked for the Status of the mailbox
//When client asks for a statistic of messages server will answer
//by sending an +OK followed by number of messages and length of them
//Format of client message is STAT
ASender.Thread.Connection.WriteLn('+OK 1 40');
end;
procedure TfrmMain.IdPOP3Server1TOP(ASender: TIdCommand; AMessageNum,
ANumLines: Integer);
begin
// This is where the cleint has requested the TOP X lines of a particular
// message to be sent to them
end;
procedure TfrmMain.IdPOP3Server1UIDL(ASender: TIdCommand;
AMessageNum: Integer);
begin
// This is where the client has requested the unique identifier (UIDL) of each
// message, or a particular message to be sent to them.
end;
end.
|
В настройках TheBat указываю:
SMTP-сервер: 192.168.0.1
Почт.-сервер: 192.168.0.1
Пользователь: - вообще не понятно где его на сервере прописывать поэтому пустой
Пароль: - тоже соответственно пусто
Помогите пожалуйста, что делаю не так ?? |