Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > Интернет и сети
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 29.07.2007, 17:15
gatart gatart вне форума
Прохожий
 
Регистрация: 14.01.2007
Сообщения: 26
Репутация: 10
По умолчанию ActionList>>SendMail

Вот есть событие есть кнопка, открывается окно (Новое письмо), вопрос в том как управлять этим окном, точнее мне туда нужно заносить информацию из edit, ну в поле кому нужно записать адрес, в поле нового письма нужно записать определенный текст. а как его туда записать, как обратиться к этому полу, прога которую я юзаю Microsoft Office Outlook 2003, и еще вопрос если у человека нет этой замечательной прги то он что работать не сможет, как сделать так чтоб открывалась стандартная виндовая форма отпраки письма?

кто не понял разъясню(((

Последний раз редактировалось gatart, 29.07.2007 в 17:17.
Ответить с цитированием
  #2  
Старый 29.07.2007, 17:49
gatart gatart вне форума
Прохожий
 
Регистрация: 14.01.2007
Сообщения: 26
Репутация: 10
По умолчанию АУ есть кто тут?

Я бы хотел пообщаться!!!
Ответить с цитированием
  #3  
Старый 29.07.2007, 17:53
Аватар для 4kusNick
4kusNick 4kusNick вне форума
Местный
 
Регистрация: 06.09.2006
Адрес: Россия, Санкт-Петербург
Сообщения: 444
Репутация: 550
По умолчанию

Как отправить Email?

Cущствуют следующие возможности:

1) Вызвать почтовую программу по умолчанию с заполненными полями - не позволяет автоматизировать работу, не позволяет постать письмо с аттачментом, но исключительно удобно в окнах About.

2) Использовать MAPI - несколько устаревший способ, но вполне работоспособный

3) Использовать SMTP - там все просто, однако посылка не напрямую, требуется наличие SMTP сервера, например сервера провайдера.

4) Использовать COM интерфейс Outlook - там тоже все просто, но нужно наличие установленного и полностью подключенного Outlook

6) Вот ещё вариант: Send e-mails via WinSock API.


1) http://delphi-faq.zoxt.net/a70.htm

2) http://delphi-faq.zoxt.net/a68.htm
http://sources.ru/delphi/delphi_send...via_mapi.shtml
http://forum.sources.ru/index.php?showtopic=80362

3) http://articles.org.ru/docum/email.php
http://sources.ru/delphi/internet/au...ng_email.shtml

4) http://articles.org.ru/docum/email.php
http://sources.ru/delphi/delphi_send...tachment.shtml

5) http://www.swissdelphicenter.ch/torr...de.php?id=2134



Еще можно юзать Indy
__________________
THE CRACKER IS OUT THERE
Ответить с цитированием
  #4  
Старый 29.07.2007, 18:01
Аватар для 4kusNick
4kusNick 4kusNick вне форума
Местный
 
Регистрация: 06.09.2006
Адрес: Россия, Санкт-Петербург
Сообщения: 444
Репутация: 550
По умолчанию

Использование SMTP Relay Server - отсылка письма напрямую минуя любые промежуточные сервера (пример взят из библиотеки Indy). Для отсылки письма с использованием компонентов Indy. Пример для Delphi 7 (скорее всего будет работать и в Delphi 6), для Kylix 3 нужны небольшие исправления для перевода в CLX приложение (сама функциональность та же).

Пример модуля:

Код:
unit fMain;
{©Drkb v.3(2007): www.drkb.ru, 
®Vit (Vitaly Nevzorov) - nevzorov@yahoo.com}
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;
   procedure btnExitClick(Sender: TObject);
   procedure btnSendMailClick(Sender: TObject);
public
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
if not assigned(fmailServers) then fMailServers := TStringList.Create;
fmailServers.clear;
Result := true;
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');
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;
   fMailServers.Duplicates := dupIgnore;
   Result := true;
   end
else
   begin
   Msg('No response from 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');
   MessageDlg('Error resolving domain: ' + e.message, mtInformation, [mbOK], 0);
   Result := false;
   end;
end;
end;
end;

// Used in DNS preferance sorting
procedure TfrmMain.LockControls;
var i : integer;
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
Result := false;
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
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
MessageDlg('Cannot proceed due to the following errors:'+#13+#10+ ErrString, mtInformation, [mbOK], 0);
Result := False;
end;
end;
procedure TfrmMain.Msg(aMessage: String);
begin
sbMain.SimpleText := aMessage;
application.ProcessMessages;
end;
end.
__________________
THE CRACKER IS OUT THERE
Ответить с цитированием
  #5  
Старый 29.07.2007, 18:02
Аватар для 4kusNick
4kusNick 4kusNick вне форума
Местный
 
Регистрация: 06.09.2006
Адрес: Россия, Санкт-Петербург
Сообщения: 444
Репутация: 550
По умолчанию

Форма для модуля:

Код:
object frmMain: TfrmMain
Left = 243
Top = 129
Width = 448
Height = 398
Caption = 'INDY - SMTP Relay Demo'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
   Left = 7
   Top = 8
   Width = 311
   Height = 26
   Caption = 
     'Demonstrates sending mail directly to a users mailbox on a remot' +
     'e mailserver - this negates the need for a local SMTP server'
   Font.Charset = DEFAULT_CHARSET
   Font.Color = clGray
   Font.Height = -11
   Font.Name = 'MS Sans Serif'
   Font.Style = []
   ParentFont = False
   WordWrap = True
end
object Label2: TLabel
   Left = 8
   Top = 64
   Width = 111
   Height = 13
   Caption = 'DNS server IP address:'
end
object Label3: TLabel
   Left = 8
   Top = 123
   Width = 104
   Height = 13
   Caption = 'Sender email address:'
end
object Label4: TLabel
   Left = 288
   Top = 64
   Width = 49
   Height = 13
   Caption = 'Required !'
   Font.Charset = DEFAULT_CHARSET
   Font.Color = clGray
   Font.Height = -11
   Font.Name = 'MS Sans Serif'
   Font.Style = []
   ParentFont = False
end
object Label5: TLabel
   Left = 8
   Top = 150
   Width = 115
   Height = 13
   Caption = 'Recipient email address:'
end
object Label6: TLabel
   Left = 8
   Top = 177
   Width = 72
   Height = 13
   Caption = 'Subject of mail:'
end
object Label7: TLabel
   Left = 8
   Top = 204
   Width = 66
   Height = 13
   Caption = 'Message text:'
end
object Label8: TLabel
   Left = 8
   Top = 91
   Width = 95
   Height = 13
   Caption = 'DNS server timeout:'
end
object Label9: TLabel
   Left = 336
   Top = 124
   Width = 49
   Height = 13
   Caption = 'Required !'
   Font.Charset = DEFAULT_CHARSET
   Font.Color = clGray
   Font.Height = -11
   Font.Name = 'MS Sans Serif'
   Font.Style = []
   ParentFont = False
end
object Label10: TLabel
   Left = 336
   Top = 148
   Width = 49
   Height = 13
   Caption = 'Required !'
   Font.Charset = DEFAULT_CHARSET
   Font.Color = clGray
   Font.Height = -11
   Font.Name = 'MS Sans Serif'
   Font.Style = []
   ParentFont = False
end
object sbMain: TStatusBar
   Left = 0
   Top = 352
   Width = 440
   Height = 19
   Panels = <>
end
object edtDNS: TEdit
   Left = 128
   Top = 60
   Width = 153
   Height = 21
   TabOrder = 1
end

object edtSender: TEdit
   Left = 128
   Top = 119
   Width = 205
   Height = 21
   TabOrder = 2
end
object edtRecipient: TEdit
   Left = 128
   Top = 146
   Width = 205
   Height = 21
   TabOrder = 3
end
object edtSubject: TEdit
   Left = 128
   Top = 173
   Width = 205
   Height = 21
   TabOrder = 4
end
object mmoMessageText: TMemo
   Left = 128
   Top = 200
   Width = 205
   Height = 113
   TabOrder = 5
end
object btnSendMail: TButton
   Left = 258
   Top = 321
   Width = 75
   Height = 25
   Caption = 'Send mail !'
   TabOrder = 6
   OnClick = btnSendMailClick
end
object btnExit: TButton
   Left = 356
   Top = 8
   Width = 75
   Height = 25
   Caption = 'E&xit'
   TabOrder = 7
   OnClick = btnExitClick
end
object edtTimeOut: TEdit
   Left = 128
   Top = 87
   Width = 61
   Height = 21
   TabOrder = 8
   Text = '5000'
end
object IdMessage: TIdMessage
   AttachmentEncoding = 'MIME'
   BccList = <>
   CCList = <>
   Encoding = meMIME
   Recipients = <>
   ReplyTo = <>
   Left = 12
   Top = 236
end
object IdDNSResolver: TIdDNSResolver
   Port = 53
   ReceiveTimeout = 60
   QueryRecords = []
   Left = 12
   Top = 268
end
object IdSMTP: TIdSMTP
   MaxLineAction = maException
   ReadTimeout = 0
   Port = 25
   AuthenticationType = atNone
   Left = 12
   Top = 204
end
object IdAntiFreeze: TIdAntiFreeze
   Left = 12
   Top = 300
end
end
__________________
THE CRACKER IS OUT THERE
Ответить с цитированием
  #6  
Старый 29.07.2007, 18:02
gatart gatart вне форума
Прохожий
 
Регистрация: 14.01.2007
Сообщения: 26
Репутация: 10
По умолчанию высший клас

Я прочитал и все вопросы отпали!!!
Я использую первый способ, для данного случая самый подходящий!!!, это просто класс!!!
Дело в том что ту просто мини автоматизация процесса, чтоб не открывать аутлук, назал на кнопку и все отправилось, нужно генерировать одно и тоже письмо, и отправлять его на один и тот же адресс...
Ответить с цитированием
  #7  
Старый 29.07.2007, 18:36
gatart gatart вне форума
Прохожий
 
Регистрация: 14.01.2007
Сообщения: 26
Репутация: 10
По умолчанию вот что в едитах

в едите лежат циферки
в тему письма нужно добавить (вася позвони (текст из edit)).
вася позвони я сделал а вот текс из едита не могу...

вот рабочая строчка
mailto:Shoshin@ertelecom.ru?subject=Вася%20позвони %20 (Вот тут текст из edit)&Body=Доброго%20времени%20суток.%0D%0A %0D%0AВсего%20хорошего.'

Последний раз редактировалось gatart, 29.07.2007 в 18:43.
Ответить с цитированием
  #8  
Старый 29.07.2007, 20:22
Аватар для 4kusNick
4kusNick 4kusNick вне форума
Местный
 
Регистрация: 06.09.2006
Адрес: Россия, Санкт-Петербург
Сообщения: 444
Репутация: 550
По умолчанию

...Вася%20позвони%20' + StringReplace(Edit1.Text,' ','%20',[rfReplaceAll]) + '&Body...
__________________
THE CRACKER IS OUT THERE
Ответить с цитированием
  #9  
Старый 29.07.2007, 20:59
gatart gatart вне форума
Прохожий
 
Регистрация: 14.01.2007
Сообщения: 26
Репутация: 10
По умолчанию нет.

говорит что мол я не знаю идентификатора под названием StringReplace
Ответить с цитированием
  #10  
Старый 29.07.2007, 21:05
Аватар для 4kusNick
4kusNick 4kusNick вне форума
Местный
 
Регистрация: 06.09.2006
Адрес: Россия, Санкт-Петербург
Сообщения: 444
Репутация: 550
По умолчанию

Добавь в раздел uses модуль SysUtils

И на будущее: в таких случаях читай хэлп, в нем написано о том, какая VCL ф-я\процедура к какому модулю относится.
__________________
THE CRACKER IS OUT THERE
Ответить с цитированием
  #11  
Старый 29.07.2007, 21:25
Аватар для 4kusNick
4kusNick 4kusNick вне форума
Местный
 
Регистрация: 06.09.2006
Адрес: Россия, Санкт-Петербург
Сообщения: 444
Репутация: 550
По умолчанию

gatart,
чтобы компилятор не писал о не совместимости типов String и PAnsiChar, делай так:

PChar('mailto:Shoshin@ertelecom.ru?subject=Вася%20 позвони%20' + StringReplace(Edit1.Text,' ','%20',[rfReplaceAll]) + '&Body=Доброго%20времени%20суток.%0D%0A %0D%0AВсего%20хорошего.')

или

PAnsiChar('mailto:Shoshin@ertelecom.ru?subject=Вас я%20позвони%20' + StringReplace(Edit1.Text,' ','%20',[rfReplaceAll]) + '&Body=Доброго%20времени%20суток.%0D%0A %0D%0AВсего%20хорошего.')
__________________
THE CRACKER IS OUT THERE
Ответить с цитированием
  #12  
Старый 29.07.2007, 21:27
gatart gatart вне форума
Прохожий
 
Регистрация: 14.01.2007
Сообщения: 26
Репутация: 10
По умолчанию Дмитрий, спасибо за help.

Я человек не опытный, но я думаю практика нам всем поможет.
Спасибо.
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 22:10.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter