Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2002.11.21;
Скачать: [xml.tar.bz2];

Вниз

Отправка и получение сообщений через MAPI   Найти похожие ветки 

 
Tomb   (2002-11-12 10:18) [0]

Помогите разобраться с отправкой сообщений через MAPI. Если использовать SimpleMAPI, то сообщение просто попадает в папку Outbox, и реально отправляется только когда из Outlooka сделать отправить/получить почту. Чтобы сообщение отсылалось сразу необходимо использовать Extended MAPI. Но как его использовать?


 
Николай Быков   (2002-11-12 10:51) [1]

Собственно сам исходничек:

unit MapiControl;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
{ Вводим новый тип события для получения Errorcode }
TMapiErrEvent = procedure(Sender: TObject; ErrCode: Integer) of object;

TMapiControl = class(TComponent)
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
private
{ Private-объявления }
FSubject: string;
FMailtext: string;
FFromName: string;
FFromAdress: string;
FTOAdr: TStrings;
FCCAdr: TStrings;
FBCCAdr: TStrings;
FAttachedFileName: TStrings;
FDisplayFileName: TStrings;
FShowDialog: Boolean;
FUseAppHandle: Boolean;
{ Error Events: }
FOnUserAbort: TNotifyEvent;
FOnMapiError: TMapiErrEvent;
FOnSuccess: TNotifyEvent;
{ +> Изменения, внесённые Eugene Mayevski [mailto:Mayevski@eldos.org]}
procedure SetToAddr(newValue : TStrings);
procedure SetCCAddr(newValue : TStrings);
procedure SetBCCAddr(newValue : TStrings);
procedure SetAttachedFileName(newValue : TStrings);
{ +< конец изменений }
protected
{ Protected-объявления }
public
{ Public-объявления }
ApplicationHandle: THandle;
procedure Sendmail();
procedure Reset();
published
{ Published-объявления }
property Subject: string read FSubject write FSubject;
property Body: string read FMailText write FMailText;
property FromName: string read FFromName write FFromName;
property FromAdress: string read FFromAdress write FFromAdress;
property Recipients: TStrings read FTOAdr write SetTOAddr;
property CopyTo: TStrings read FCCAdr write SetCCAddr;
property BlindCopyTo: TStrings read FBCCAdr write SetBCCAddr;
property AttachedFiles: TStrings read FAttachedFileName write SetAttachedFileName;
property DisplayFileName: TStrings read FDisplayFileName;
property ShowDialog: Boolean read FShowDialog write FShowDialog;
property UseAppHandle: Boolean read FUseAppHandle write FUseAppHandle;

{ события: }
property OnUserAbort: TNotifyEvent read FOnUserAbort write FOnUserAbort;
property OnMapiError: TMapiErrEvent read FOnMapiError write FOnMapiError;
property OnSuccess: TNotifyEvent read FOnSuccess write FOnSuccess;
end;


 
Николай Быков   (2002-11-12 10:52) [2]

procedure Register;

implementation

uses Mapi;

{ регистрируем компонент: }
procedure Register;
begin
RegisterComponents("expectIT", [TMapiControl]);
end;

{ TMapiControl }

constructor TMapiControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FOnUserAbort := nil;
FOnMapiError := nil;
FOnSuccess := nil;
FSubject := "";
FMailtext := "";
FFromName := "";
FFromAdress := "";
FTOAdr := TStringList.Create;
FCCAdr := TStringList.Create;
FBCCAdr := TStringList.Create;
FAttachedFileName := TStringList.Create;
FDisplayFileName := TStringList.Create;
FShowDialog := False;
ApplicationHandle := Application.Handle;
end;

{ +> Изменения, внесённые Eugene Mayevski [mailto:Mayevski@eldos.org]}
procedure TMapiControl.SetToAddr(newValue : TStrings);
begin
FToAdr.Assign(newValue);
end;



 
Николай Быков   (2002-11-12 10:53) [3]

procedure TMapiControl.SetCCAddr(newValue : TStrings);
begin
FCCAdr.Assign(newValue);
end;

procedure TMapiControl.SetBCCAddr(newValue : TStrings);
begin
FBCCAdr.Assign(newValue);
end;

procedure TMapiControl.SetAttachedFileName(newValue : TStrings);
begin
FAttachedFileName.Assign(newValue);
end;
{ +< конец изменений }

destructor TMapiControl.Destroy;
begin
FTOAdr.Free;
FCCAdr.Free;
FBCCAdr.Free;
FAttachedFileName.Free;
FDisplayFileName.Free;
inherited destroy;
end;

{ Сбрасываем все используемые поля}
procedure TMapiControl.Reset;
begin
FSubject := "";
FMailtext := "";
FFromName := "";
FFromAdress := "";
FTOAdr.Clear;
FCCAdr.Clear;
FBCCAdr.Clear;
FAttachedFileName.Clear;
FDisplayFileName.Clear;
end;

{ Эта процедура составляет и отправляет Email }
procedure TMapiControl.Sendmail;
var
MapiMessage: TMapiMessage;
MError: Cardinal;
Sender: TMapiRecipDesc;
PRecip, Recipients: PMapiRecipDesc;
PFiles, Attachments: PMapiFileDesc;
i: Integer;
AppHandle: THandle;
begin
{ Перво-наперво сохраняем Handle приложения, if not
the Component might fail to send the Email or
your calling Program gets locked up. }
AppHandle := Application.Handle;

{ Нам нужно зарезервировать память для всех получателей }
MapiMessage.nRecipCount := FTOAdr.Count + FCCAdr.Count + FBCCAdr.Count;
GetMem(Recipients, MapiMessage.nRecipCount * sizeof(TMapiRecipDesc));

try
with MapiMessage do
begin
ulReserved := 0;
{ Устанавливаем поле Subject: }
lpszSubject := PChar(Self.FSubject);

{ ... Body: }
lpszNoteText := PChar(FMailText);

lpszMessageType := nil;
lpszDateReceived := nil;
lpszConversationID := nil;
flFlags := 0;

{ и отправителя: (MAPI_ORIG) }
Sender.ulReserved := 0;
Sender.ulRecipClass := MAPI_ORIG;
Sender.lpszName := PChar(FromName);
Sender.lpszAddress := PChar(FromAdress);
Sender.ulEIDSize := 0;
Sender.lpEntryID := nil;
lpOriginator := @Sender;

PRecip := Recipients;

{ У нас много получателей письма: (MAPI_TO)
установим для каждого: }
if nRecipCount > 0 then
begin
for i := 1 to FTOAdr.Count do
begin
PRecip^.ulReserved := 0;
PRecip^.ulRecipClass := MAPI_TO;
{ lpszName should carry the Name like in the
contacts or the adress book, I will take the
email adress to keep it short: }
PRecip^.lpszName := PChar(FTOAdr.Strings[i - 1]);
{ Если Вы используете этот компонент совместно с Outlook97 или 2000
(не Express версии) , то Вам прийдётся добавить
"SMTP:" в начало каждого (email-) адреса.
}
PRecip^.lpszAddress := PChar("SMTP:" + FTOAdr.Strings[i - 1]);
PRecip^.ulEIDSize := 0;
PRecip^.lpEntryID := nil;
Inc(PRecip);
end;

{ То же самое проделываем с получателями копии письма: (CC, MAPI_CC) }
for i := 1 to FCCAdr.Count do
begin
PRecip^.ulReserved := 0;
PRecip^.ulRecipClass := MAPI_CC;
PRecip^.lpszName := PChar(FCCAdr.Strings[i - 1]);
PRecip^.lpszAddress := PChar("SMTP:" + FCCAdr.Strings[i - 1]);
PRecip^.ulEIDSize := 0;
PRecip^.lpEntryID := nil;
Inc(PRecip);
end;

{ ... тоже самое для Bcc: (BCC, MAPI_BCC) }
for i := 1 to FBCCAdr.Count do
begin
PRecip^.ulReserved := 0;
PRecip^.ulRecipClass := MAPI_BCC;
PRecip^.lpszName := PChar(FBCCAdr.Strings[i - 1]);
PRecip^.lpszAddress := PChar("SMTP:" + FBCCAdr.Strings[i - 1]);
PRecip^.ulEIDSize := 0;
PRecip^.lpEntryID := nil;
Inc(PRecip);
end;
end;
lpRecips := Recipients;

{ Теперь обработаем прикреплённые к письму файлы: }

if FAttachedFileName.Count > 0 then
begin
nFileCount := FAttachedFileName.Count;
GetMem(Attachments, MapiMessage.nFileCount * sizeof(TMapiFileDesc));

PFiles := Attachments;



 
Николай Быков   (2002-11-12 10:54) [4]

{ Во первых установим отображаемые на экране имена файлов (без пути): }
FDisplayFileName.Clear;
for i := 0 to FAttachedFileName.Count - 1 do
FDisplayFileName.Add(ExtractFileName(FAttachedFileName[i]));

if nFileCount > 0 then
begin
{ Теперь составим структурку для прикреплённого файла: }
for i := 1 to FAttachedFileName.Count do
begin
{ Устанавливаем полный путь }
Attachments^.lpszPathName := PChar(FAttachedFileName.Strings[i - 1]);
{ ... и имя, отображаемое на дисплее: }
Attachments^.lpszFileName := PChar(FDisplayFileName.Strings[i - 1]);
Attachments^.ulReserved := 0;
Attachments^.flFlags := 0;
{ Положение должно быть -1, за разьяснениями обращайтесь в WinApi Help. }
Attachments^.nPosition := Cardinal(-1);
Attachments^.lpFileType := nil;
Inc(Attachments);
end;
end;
lpFiles := PFiles;
end
else
begin
nFileCount := 0;
lpFiles := nil;
end;
end;

{ Send the Mail, silent or verbose:
Verbose means in Express a Mail is composed and shown as setup.
In non-Express versions we show the Login-Dialog for a new
session and after we have choosen the profile to use, the
composed email is shown before sending

Silent does currently not work for non-Express version. We have
no Session, no Login Dialog so the system refuses to compose a
new email. In Express Versions the email is sent in the
background.
}
if FShowDialog then
MError := MapiSendMail(0, AppHandle, MapiMessage, MAPI_DIALOG or MAPI_LOGON_UI or MAPI_NEW_SESSION, 0)
else
MError := MapiSendMail(0, AppHandle, MapiMessage, 0, 0);

{ Теперь обработаем сообщения об ошибках. В MAPI их присутствует достаточное.
количество. В этом примере я обрабатываю только два из них: USER_ABORT и SUCCESS,
относящиеся к специальным.

Сообщения, не относящиеся к специальным:
MAPI_E_AMBIGUOUS_RECIPIENT,
MAPI_E_ATTACHMENT_NOT_FOUND,
MAPI_E_ATTACHMENT_OPEN_FAILURE,
MAPI_E_BAD_RECIPTYPE,
MAPI_E_FAILURE,
MAPI_E_INSUFFICIENT_MEMORY,
MAPI_E_LOGIN_FAILURE,
MAPI_E_TEXT_TOO_LARGE,
MAPI_E_TOO_MANY_FILES,
MAPI_E_TOO_MANY_RECIPIENTS,
MAPI_E_UNKNOWN_RECIPIENT:
}

case MError of
MAPI_E_USER_ABORT:
begin
if Assigned(FOnUserAbort) then
FOnUserAbort(Self);
end;
SUCCESS_SUCCESS:
begin
if Assigned(FOnSuccess) then
FOnSuccess(Self);
end
else begin
if Assigned(FOnMapiError) then
FOnMapiError(Self, MError);
end;

end;
finally
{ В заключение освобождаем память }
FreeMem(Recipients, MapiMessage.nRecipCount * sizeof(TMapiRecipDesc));
end;
end;

{
Вопросы и замечания присылайте Коле Быкову.
}

end.


 
Николай Быков   (2002-11-12 10:55) [5]

Ф-Ф-Ф-ууууууууу. Аж употел.
Ну как?


 
Tomb   (2002-11-12 11:28) [6]

Конечно спасибо. Но опять-же, с помощью этого компонента письмо ложится в Outbox и все. Дальше его отправить нужно вручную...
В MSDN по этому поводу есть след.:

1. Call IMAPISession::GetStatusTable to access the status table.
2. Call the status table"s IMAPITable::SetColumns method to limit the column set to PR_ENTRYID and PR_RESOURCE_TYPE.
3. Build a property restriction using an SPropertyRestriction structure to match PR_RESOURCE_TYPE with MAPI_SPOOLER.
4. Call HrQueryAllRows, passing in the SPropertyRestriction structure, to retrieve the row that represents the status of the MAPI spooler.
5. Pass the PR_ENTRYID column to IMAPISession::OpenEntry to open the MAPI spooler"s status object.
6. Call the MAPI spooler"s IMAPIStatus::FlushQueues method, passing the FLUSH_NO_UI flag to suppress the user interface and either the FLUSH_DOWNLOAD or FLUSH_UPLOAD flag to flush the outgoing or incoming queues.
7. Release the status object and the status table, as well as the SRowSet structure that is allocated for the table.

Загвоздка в 5 пункте...


 
Николай Быков   (2002-11-12 11:31) [7]


> Tomb (12.11.02 11:28)

Вряд ли тебе Extended MAPI поможет. Но я что-то придумаю.


 
Николай Быков   (2002-11-12 11:34) [8]

Придумал!
Вкладка FastNet. Компонент TNMSTP.


 
Николай Быков   (2002-11-12 11:35) [9]

Или так:
unit Email;
interface
uses Windows, SusUtils, Classes;

function SendEmail(const RecipName, RecipAddress, Subject, Attachment: string): Boolean;

function IsOnline: Boolean;

implementation
uses Mapi;

function SendEmail(const RecipName, RecipAddress, Subject, Attachment: string): Boolean;
var
MapiMessage: TMapiMessage;
MapiFileDesc: TMapiFileDesc;
MapiRecipDesc: TMapiRecipDesc;
i: integer;
s: string;
begin
with MapiRecipDesc do begin
ulRecerved:= 0;
ulRecipClass:= MAPI_TO;
lpszName:= PChar(RecipName);
lpszAddress:= PChar(RecipAddress);
ulEIDSize:= 0;
lpEntryID:= nil;
end;

with MapiFileDesc do begin
ulReserved:= 0;
flFlags:= 0;
nPosition:= 0;
lpszPathName:= PChar(Attachment);
lpszFileName:= nil;
lpFileType:= nil;
end;

with MapiMessage do begin
ulReserved := 0;
lpszSubject := nil;
lpszNoteText := PChar(Subject);
lpszMessageType := nil;
lpszDateReceived := nil;
lpszConversationID := nil;
flFlags := 0;
lpOriginator := nil;
nRecipCount := 1;
lpRecips := @MapiRecipDesc;
if length(Attachment) > 0 then begin
nFileCount:= 1;
lpFiles := @MapiFileDesc;
end else begin
nFileCount:= 0;
lpFiles:= nil;
end;
end;

Result:= MapiSendMail(0, 0, MapiMessage, MAPI_DIALOG
or MAPI_LOGON_UI or MAPI_NEW_SESSION, 0) = SUCCESS_SUCCESS;
end;


function IsOnline: Boolean;
var
RASConn: TRASConn;
dwSize,dwCount: DWORD;
begin
RASConns.dwSize:= SizeOf(TRASConn);
dwSize:= SizeOf(RASConns);
Res:=RASEnumConnectionsA(@RASConns, @dwSize, @dwCount);
Result:= (Res = 0) and (dwCount > 0);
end;

end.



 
Tomb   (2002-11-12 12:37) [10]

Нет, не фурычит такая штучка. Через RAS тоже совсем не то...
И через SMTP не работает, т.к. на установлена нестандартная почтовая система, к которой просто по SMTP не подключишься. Нужно только через MAPI...


 
Николай Быков   (2002-11-12 13:11) [11]

Есть на Си:
void SendMail(void)
{
SOCKET nSMTPServerSocket;
struct sockaddr_in smtp_address;
int nConnect;
int iLength;
int iMsg = 0;
int iEnd = 0;
BYTE sBuf[4096];

char *MailMessage[] =
{
"HELO axel.ru\r\n",
"MAIL FROM:<vasya_pupkin@cool_mail.ru>\r\n", // адрес отправителя
"RCPT TO:<purpe@usa.net>\r\n", // адресок получателя
"DATA\r\n",
"Самое крутое сообщение!!!\r\n\r\n.\r\n", // тело сообщения
"QUIT\r\n",
NULL
};

nSMTPServerSocket = socket(PF_INET, SOCK_STREAM, 0);

if(nSMTPServerSocket != INVALID_SOCKET) {
smtp_address.sin_family = AF_INET;
// далее вносим в структуру IP-адрес сервера, через который пойдёт письмо
smtp_address.sin_addr.s_addr = inet_addr("212.96.192.1");
smtp_address.sin_port = htons(25);

nConnect = connect(nSMTPServerSocket, (PSOCKADDR)&smtp_address,
sizeof(smtp_address));

if(nConnect) {
}
else {
do {
iLength = recv(nSMTPServerSocket, (LPSTR)sBuf+iEnd, sizeof(sBuf)-iEnd, 0);
iEnd += iLength;
sBuf[iEnd] = "\0";
send(nSMTPServerSocket, (LPSTR)MailMessage[iMsg], strlen(MailMessage[iMsg]), 0);
iMsg++;
} while(MailMessage[iMsg]);
}

closesocket(nSMTPServerSocket);
}
}



 
Николай Быков   (2002-11-12 13:14) [12]

Вот эта штука: Николай Быков © (12.11.02 11:35) — работает. Я её из Си переводил два дня вчера. Ты ещё и перебираешь?

Вот сорц из Си:
void SendMail(void)
{
SOCKET nSMTPServerSocket;
struct sockaddr_in smtp_address;
int nConnect;
int iLength;
int iMsg = 0;
int iEnd = 0;
BYTE sBuf[4096];

char *MailMessage[] =
{
"HELO axel.ru\r\n",
"MAIL FROM:<vasya_pupkin@cool_mail.ru>\r\n", // адрес отправителя
"RCPT TO:<purpe@usa.net>\r\n", // адресок получателя
"DATA\r\n",
"Самое крутое сообщение!!!\r\n\r\n.\r\n", // тело сообщения
"QUIT\r\n",
NULL
};

nSMTPServerSocket = socket(PF_INET, SOCK_STREAM, 0);

if(nSMTPServerSocket != INVALID_SOCKET) {
smtp_address.sin_family = AF_INET;
// далее вносим в структуру IP-адрес сервера, через который пойдёт письмо
smtp_address.sin_addr.s_addr = inet_addr("212.96.192.1");
smtp_address.sin_port = htons(25);

nConnect = connect(nSMTPServerSocket, (PSOCKADDR)&smtp_address,
sizeof(smtp_address));

if(nConnect) {
}
else {
do {
iLength = recv(nSMTPServerSocket, (LPSTR)sBuf+iEnd, sizeof(sBuf)-iEnd, 0);
iEnd += iLength;
sBuf[iEnd] = "\0! ";
send(nSMTPServerSocket, (LPSTR)MailMessage[iMsg], strlen(MailMessage[iMsg]), 0);
iMsg++;
} while(MailMessage[iMsg]);
}

closesocket(nSMTPServerSocket);
}
}


 
Tomb   (2002-11-12 13:31) [13]

Ок. Бальшое спасибо. Все заработало...


 
Николай Быков   (2002-11-12 13:35) [14]


> Tomb (12.11.02 13:31)
> Ок.

Можешь не благодарить. Это я себе голубенький значок зарабатываю.



Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2002.11.21;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.51 MB
Время: 0.014 c
3-69136
dimonka
2002-10-31 00:00
2002.11.21
Update запрос с датой


1-69308
Gregory
2002-11-12 14:38
2002.11.21
Работа со стандартным компонентом броузером


1-69341
Andrey-k
2002-11-11 23:17
2002.11.21
TGrid и TDBGrid и TDBListBox - общий вопрос


1-69289
Seldon
2002-11-11 21:43
2002.11.21
RichEdit


1-69400
ctapik-net
2002-11-10 15:54
2002.11.21
Работа с ListVew





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский