|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
|||
|
|||
ActionList>>SendMail
Вот есть событие есть кнопка, открывается окно (Новое письмо), вопрос в том как управлять этим окном, точнее мне туда нужно заносить информацию из edit, ну в поле кому нужно записать адрес, в поле нового письма нужно записать определенный текст. а как его туда записать, как обратиться к этому полу, прога которую я юзаю Microsoft Office Outlook 2003, и еще вопрос если у человека нет этой замечательной прги то он что работать не сможет, как сделать так чтоб открывалась стандартная виндовая форма отпраки письма?
кто не понял разъясню((( Последний раз редактировалось gatart, 29.07.2007 в 17:17. |
#2
|
|||
|
|||
АУ есть кто тут?
Я бы хотел пообщаться!!!
|
#3
|
||||
|
||||
Как отправить 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
|
||||
|
||||
Использование 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
|
||||
|
||||
Форма для модуля:
Код:
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
|
|||
|
|||
высший клас
Я прочитал и все вопросы отпали!!!
Я использую первый способ, для данного случая самый подходящий!!!, это просто класс!!! Дело в том что ту просто мини автоматизация процесса, чтоб не открывать аутлук, назал на кнопку и все отправилось, нужно генерировать одно и тоже письмо, и отправлять его на один и тот же адресс... |
#7
|
|||
|
|||
вот что в едитах
в едите лежат циферки
в тему письма нужно добавить (вася позвони (текст из edit)). вася позвони я сделал а вот текс из едита не могу... вот рабочая строчка mailto:Shoshin@ertelecom.ru?subject=Вася%20позвони %20 (Вот тут текст из edit)&Body=Доброго%20времени%20суток.%0D%0A %0D%0AВсего%20хорошего.' Последний раз редактировалось gatart, 29.07.2007 в 18:43. |
#8
|
||||
|
||||
...Вася%20позвони%20' + StringReplace(Edit1.Text,' ','%20',[rfReplaceAll]) + '&Body...
THE CRACKER IS OUT THERE |
#9
|
|||
|
|||
нет.
говорит что мол я не знаю идентификатора под названием StringReplace
|
#10
|
||||
|
||||
Добавь в раздел uses модуль SysUtils
И на будущее: в таких случаях читай хэлп, в нем написано о том, какая VCL ф-я\процедура к какому модулю относится. THE CRACKER IS OUT THERE |
#11
|
||||
|
||||
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
|
|||
|
|||
Дмитрий, спасибо за help.
Я человек не опытный, но я думаю практика нам всем поможет.
Спасибо. |