VPF::Почта не выходит наружу - Форум программистов

sonechko

Дата 14.5.2007, 09:47 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 7
Регистрация: 16.4.2007

Репутация: нет
Всего: нет

Программа, почему то, отправляет почту только на адресса внутри сети. Наружу почта не выходит.
Адресса для отправки берутся с ListBox.
Причем если не используя ListBox указывать адресс получателя то все уходит нормально. Вот исходник:

Код


unit SendForm;

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, Menus,
  StdCtrls, Dialogs, Buttons, Messages, ExtCtrls, ComCtrls,
  IdComponent, IdTCPConnection, IdTCPClient,
  IdMessageClient, IdSMTP, IdBaseComponent, IdMessage;

type
  TMainForm = class(TForm)
    Panel2: TPanel;
    reMessageText: TRichEdit;
    Panel1: TPanel;
    Label1: TLabel;
    eName: TEdit;
    Splitter1: TSplitter;
    ListLog: TListBox;
    Label2: TLabel;
    eSubject: TEdit;
    Label3: TLabel;
    BbtnAddToList: TButton;
    ListAddr: TListBox;
    BtnRemove: TButton;
    BtnFind: TButton;
    Label5: TLabel;
    eFrom: TEdit;
    BtnSendAll: TButton;
    MailMessage: TIdMessage;
    Mail: TIdSMTP;
    DateTimePicker1: TDateTimePicker;
    Label4: TLabel;
    Button1: TButton;
    Button2: TButton;
    OpenDialog1: TOpenDialog;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure BtnSendAllClick(Sender: TObject);
    procedure BbtnAddToListClick(Sender: TObject);
    procedure BtnRemoveClick(Sender: TObject);
    procedure BtnFindClick(Sender: TObject);
    procedure MailConnected(Sender: TObject);
    procedure MailDisconnected(Sender: TObject);
    procedure MailStatus(axSender: TObject; const axStatus: TIdStatus;
      const asStatusText: String);
    procedure MailWorkBegin(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCountMax: Integer);
    procedure MailWorkEnd(Sender: TObject; AWorkMode: TWorkMode);
    procedure Button2Click(Sender: TObject);
  private
    FileName: string;
  end;

var
  MainForm: TMainForm;

implementation

uses Variants;

{$R *.DFM}

procedure TMainForm.FormCreate(Sender: TObject);
begin
  // load the list of addresses
  FileName := ChangeFileExt (Application.ExeName, '.txt');
  ListAddr.Items.LoadFromFile (FileName);
  ListLog.Items.Add ('Addresses: ' + IntToStr (
  ListAddr.Items.Count));
  // select the first item
  ListAddr.ItemIndex := 0;
end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  // save the list of addresses
  ListAddr.Items.SaveToFile (FileName);
end;

const
  BccInMsg = 30;

procedure TMainForm.BtnSendAllClick(Sender: TObject);
var
  i: integer;
  curSendTo, curDir: string;
  ADate,Idate: string ;
  FDate: TDateTime;
  nItem: Integer;
  Res: Word;
  att: TIdAttachment;
  sAttName: string;
  sLocalFileName: string;
  srRec: TSearchRec;
  sSearchDir:string;



begin
          
   
  // connect
  Mail.Host := 'serv';
  Mail.Port :=25;
  Mail.Username := 'address';
  Mail.Password := 'address';
  Mail.AuthenticationType := atLogin;
  Mail.Connect;
   try
     // set the fixed part of the header
     showmessage('подключился');
     MailMessage.From.Name := '[email protected]';
     MailMessage.Subject := 'Vipiska';

     MailMessage.Body.SetText (
      reMessageText.Lines.GetText);
     MailMessage.Body.Insert (0, 'Добрый день');
     nItem := 0;
    while nItem < ListAddr.Items.Count do
      begin
        FDate:=DateTimePicker1.DateTime;
        DateTimeToString(Idate,'YYYYMMDD', FDate );
           if nItem = 0 then
               ADate:='Kirovograd'  ;
           if nItem = 1 then
               ADate:='Vinnitsa' ;
          
        sSearchDir := 'E:\TinyCB\MAil\' + Adate + '\In\' + Idate+'\';

       if FindFirst( sSearchDir + '*.*' , faAnyFile, srRec) = 0 then
          try // finally

           repeat
            if (srRec.Name = '') or (srRec.Name[1] = '.') then
               // пропуск специальных имен вида '.' или '..'
                 continue;
               // получаем имя файла с полным путем
               sLocalFileName := sSearchDir + srRec.Name;
               att := TIdAttachment.Create( MailMessage.MessageParts, sLocalFileName);
              until FindNext(srRec) <> 0;

         finally FindClose(srRec);
        end;

            // show the current selection
            ListAddr.ItemIndex := nItem;
            Application.ProcessMessages;

            MailMessage.Body [0] := 'Добрый день ' + ListAddr.Items [nItem];
           MailMessage.Recipients.EMailAddresses := ListAddr.Items [nItem];

             showmessage('на адресс '+ListAddr.Items[nItem]+sLocalFileName);
            Mail.Send(MailMessage);

            Windows.DeleteFile( PChar(att.FileName) ); // удаляем ненужный уже файл
            FreeAndNil( att ); // убираем вложение перед следующей отправкой
            Inc (nItem);
        end;
       finally // we're done
    Mail.Disconnect;
  end;
end;

procedure TMainForm.BbtnAddToListClick(Sender: TObject);
begin
  ListAddr.ItemIndex :=
    ListAddr.Items.Add (eName.Text);
end;

procedure TMainForm.BtnRemoveClick(Sender: TObject);
begin
  // copy the item to the name edit box and remove it
  eName.Text := ListAddr.Items [ListAddr.ItemIndex];
  ListAddr.Items.Delete (ListAddr.ItemIndex);
end;

procedure TMainForm.BtnFindClick(Sender: TObject);
var
  I: Integer;
begin
  for I := 0 to ListAddr.Items.Count - 1 do
    if Pos (eName.Text, ListAddr.Items [I]) > 0 then
    begin
      ListAddr.ItemIndex := I;
      Break;
    end;
  Beep;
end;

procedure TMainForm.MailConnected(Sender: TObject);
begin
  ListLog.Items.Add ('Connected to host');
end;

procedure TMainForm.MailDisconnected(Sender: TObject);
begin
  ListLog.Items.Add ('Disconnected from host');
end;

procedure TMainForm.MailStatus(axSender: TObject;
  const axStatus: TIdStatus; const asStatusText: String);
begin
  ListLog.Items.Add (asStatusText);
end;

procedure TMainForm.MailWorkBegin(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCountMax: Integer);
begin
  ListLog.Items.Add ('Sending to: ' +
    MailMessage.Recipients.EMailAddresses);
end;

procedure TMainForm.MailWorkEnd(Sender: TObject; AWorkMode: TWorkMode);
begin
  ListLog.Items.Add ('Done');
end;

procedure TMainForm.Button2Click(Sender: TObject);
begin
Close;
end;

end.

Помогите пожалуйста разобраться! Немогу понять что я делаю не так

Matematik

Дата 14.5.2007, 10:30 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1027
Регистрация: 11.3.2006

Репутация: 24
Всего: 50

почтовиком (Outloo TheBat etc) через этот же сервер почта уходит?

sonechko

Дата 14.5.2007, 11:00 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 7
Регистрация: 16.4.2007

Репутация: нет
Всего: нет

Matematik,
да

Matematik

Дата 14.5.2007, 11:12 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1027
Регистрация: 11.3.2006

Репутация: 24
Всего: 50

Ошибку какую-нить выдает? или уходит в никуда

Добавлено через 1 минуту и 59 секунд

Код


 MailMessage.From.Name := '[email protected]';

Задавать надо адрес, а не имя
IdMessage1.From.Text
или
IdMessage1.From.Address

sonechko

Дата 14.5.2007, 14:09 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 7
Регистрация: 16.4.2007

Репутация: нет
Всего: нет

Matematik,
Ты гений!!!

Matematik

Дата 14.5.2007, 14:33 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1027
Регистрация: 11.3.2006

Репутация: 24
Всего: 50

sonechko, я не гений, это ты не внимателен. Очень кстати распространенная ошибка

Snowy

Дата 14.5.2007, 14:42 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 53
Всего: 484

[offtop]
- Милый, ты у меня такой умный, такой умный, просто гениальный!
- Да неее..., я нормальный, просто ты - дура smile

[/offtop]

Matematik

Дата 14.5.2007, 15:37 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1027
Регистрация: 11.3.2006

Репутация: 24
Всего: 50

[OFFTOPIC]
что значит Модератор: Сообщение скрыто.?
[/OFFTOPIC]

Snowy

Дата 14.5.2007, 16:01 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 53
Всего: 484

Это значит, что прочитать его могут только (ко)модераторы smile

Добавлено через 3 минуты и 11 секунд
Открыл smile

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Сети \| Следующая тема »