1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
|
unit SendMail;
interface
uses
Classes,dialogs;
type
TMAPIMail = class(TComponent)
private
FLastError: Integer;
FSubject: string;
FBody: string;
FSenderName: string;
FSenderAddress: string;
FRecipients: TStrings;
FAttachments: TStrings;
FAttachmentNames: TStrings;
FEditDialog: Boolean;
FResolveNames: Boolean;
FRequestReceipt: Boolean;
procedure SetRecipients(Value: TStrings);
procedure SetAttachments(Value: TStrings);
procedure SetAttachmentNames(Value: TStrings);
protected
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function Send: Boolean;
property LastError: Integer read FLastError;
published
property Subject: string read FSubject write FSubject;
property Body: string read FBody write FBody;
property Recipients: TStrings read FRecipients write SetRecipients;
property Attachments: TStrings read FAttachments write SetAttachments;
property AttachmentNames: TStrings read FAttachmentNames write SetAttachmentNames;
property EditDialog: Boolean read FEditDialog write FEditDialog;
property ResolveNames: Boolean read FResolveNames write FResolveNames;
property RequestReceipt: Boolean read FRequestReceipt write FRequestReceipt;
property SenderName: string read FSenderName write FSenderName;
property SenderAddress: string read FSenderAddress write FSenderAddress;
end;
function SendEMailByMAPI(SenderName, SenderAddress, Subject, Body: string; Recipients, Attachments, AttachmentNames: TStrings; WithOpenMessage, ResolveNames, NeedReceipt: Boolean; intMAPISession: Integer): Integer;
function MAPIErrorDescription(intErrorCode: Integer): string;
procedure Register;
implementation
uses Windows, SysUtils, MAPI, Registry, Forms;
procedure Register;
begin
RegisterComponents('SMComponents', [TMAPIMail]);
end;
function MAPIErrorDescription(intErrorCode: Integer): string;
begin
case intErrorCode of
MAPI_E_USER_ABORT: Result := 'User cancelled request';
MAPI_E_FAILURE: Result := 'General MAPI failure';
MAPI_E_LOGON_FAILURE: Result := 'Logon failure';
MAPI_E_DISK_FULL: Result := 'Disk full';
MAPI_E_INSUFFICIENT_MEMORY: Result := 'Insufficient memory';
MAPI_E_ACCESS_DENIED: Result := 'Access denied';
MAPI_E_TOO_MANY_SESSIONS: Result := 'Too many sessions';
MAPI_E_TOO_MANY_FILES: Result := 'Too many files open';
MAPI_E_TOO_MANY_RECIPIENTS: Result := 'Too many recipients';
MAPI_E_ATTACHMENT_NOT_FOUND: Result := 'Attachment not found';
MAPI_E_ATTACHMENT_OPEN_FAILURE: Result := 'Failed to open attachment';
MAPI_E_ATTACHMENT_WRITE_FAILURE: Result := 'Failed to write attachment';
MAPI_E_UNKNOWN_RECIPIENT: Result := 'Unknown recipient';
MAPI_E_BAD_RECIPTYPE: Result := 'Invalid recipient type';
MAPI_E_NO_MESSAGES: Result := 'No messages';
MAPI_E_INVALID_MESSAGE: Result := 'Invalid message';
MAPI_E_TEXT_TOO_LARGE: Result := 'Text too large.';
MAPI_E_INVALID_SESSION: Result := 'Invalid session';
MAPI_E_TYPE_NOT_SUPPORTED: Result := 'Type not supported';
MAPI_E_AMBIGUOUS_RECIPIENT: Result := 'Ambiguous recipient';
MAPI_E_MESSAGE_IN_USE: Result := 'Message in use';
MAPI_E_NETWORK_FAILURE: Result := 'Network failure';
MAPI_E_INVALID_EDITFIELDS: Result := 'Invalid edit fields';
MAPI_E_INVALID_RECIPS: Result := 'Invalid recipients';
MAPI_E_NOT_SUPPORTED: Result := 'Not supported';
else
Result := 'Unknown Error Code: ' + IntToStr(intErrorCode);
end;
end;
function GetDefaultLogon(var strDefaultLogon: string): Boolean;
const
KEYNAME1 = 'Software\Microsoft\Windows Messaging Subsystem\Profiles';
KEYNAME2 = 'Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles';
VALUESTR = 'DefaultProfile';
begin
Result := False;
strDefaultLogon := '';
with TRegistry.Create do
try
RootKey := HKEY_CURRENT_USER;
if OpenKey(KEYNAME1, False) then
begin
try
strDefaultLogon := ReadString(VALUESTR);
Result := True;
except
end;
CloseKey;
end
else
if OpenKey(KEYNAME2, False) then
begin
try
strDefaultLogon := ReadString(VALUESTR);
Result := True;
except
end;
CloseKey;
end
else
finally
Free;
end;
end;
function SendEMailByMAPI(SenderName, SenderAddress, Subject, Body: string; Recipients, Attachments, AttachmentNames: TStrings; WithOpenMessage, ResolveNames, NeedReceipt: Boolean; intMAPISession: Integer): Integer;
const
RECIP_MAX = MaxInt div SizeOf(TMapiRecipDesc);
ATTACH_MAX = MaxInt div SizeOf(TMapiFileDesc);
type
TRecipAccessArray = array [0..(RECIP_MAX - 1)] of TMapiRecipDesc;
TlpRecipArray = ^TRecipAccessArray;
TAttachAccessArray = array [0..(ATTACH_MAX - 1)] of TMapiFileDesc;
TlpAttachArray = ^TAttachAccessArray;
TszRecipName = array[0..256] of Char;
TlpszRecipName = ^TszRecipName;
TszPathName = array[0..256] of Char;
TlpszPathname = ^TszPathname;
TszFileName = array[0..256] of Char;
TlpszFileName = ^TszFileName;
var
i: Integer;
Message: TMapiMessage;
lpRecipArray: TlpRecipArray;
lpAttachArray: TlpAttachArray;
function CheckRecipient(strRecipient: string): Integer;
var
lpRecip: PMapiRecipDesc;
begin
try
Result := MapiResolveName(0, 0, PChar(strRecipient), 0, 0, lpRecip);
if (Result in [MAPI_E_AMBIGUOUS_RECIPIENT,
MAPI_E_UNKNOWN_RECIPIENT]) then
Result := MapiResolveName(0, 0, PChar(strRecipient), MAPI_DIALOG, 0, lpRecip);
if Result = SUCCESS_SUCCESS then
begin
strRecipient := StrPas(lpRecip^.lpszName);
with lpRecipArray^[i] do
begin
lpszName := StrCopy(new(TlpszRecipName)^, lpRecip^.lpszName);
if lpRecip^.lpszAddress = nil then
lpszAddress := StrCopy(new(TlpszRecipName)^, lpRecip^.lpszName)
else
lpszAddress := StrCopy(new(TlpszRecipName)^, lpRecip^.lpszAddress);
ulEIDSize := lpRecip^.ulEIDSize;
lpEntryID := lpRecip^.lpEntryID;
MapiFreeBuffer(lpRecip);
end
end;
finally
end;
end;
function SendMess: Integer;
const
arrMAPIFlag: array[Boolean] of Word = (0, MAPI_DIALOG);
arrReceipt: array[Boolean] of Word = (0, MAPI_RECEIPT_REQUESTED);
arrLogon: array[Boolean] of Word = (0, MAPI_LOGON_UI or MAPI_NEW_SESSION);
begin
try
Result := MAPISendMail(0, Application.Handle, Message,
arrReceipt[NeedReceipt] or
arrMAPIFlag[WithOpenMessage] or
MAPI_LOGON_UI or
arrLogon[intMAPISession = 0],
0);
finally
end;
end;
var
lpSender: TMapiRecipDesc;
strDefaultProfile, s: string;
begin
FillChar(Message, SizeOf(Message), 0);
with Message do
begin
strDefaultProfile := '';
if GetDefaultLogon(strDefaultProfile) then
begin
try
Result := MapiLogOn(0, PChar(strDefaultProfile), nil, MAPI_NEW_SESSION, 0, @intMAPISession);
finally
if (Result <> SUCCESS_SUCCESS) then
begin
intMAPISession := 0;
raise Exception.CreateFmt('MAPI Error %d: %s', [Result, MAPIErrorDescription(Result)]);
end;
end
end;
if (SenderAddress <> '') then
begin
lpSender.ulRecipClass := MAPI_ORIG;
if (SenderName <> '') then
lpSender.lpszName := PChar(SenderAddress)
else
lpSender.lpszName := PChar(SenderName);
lpSender.lpszAddress := PChar(SenderAddress);
lpSender.ulReserved := 0;
lpSender.ulEIDSize := 0;
lpSender.lpEntryID := nil;
lpOriginator := @lpSender;
end;
lpszSubject := PChar(Subject);
lpszNoteText := PChar(Body);
if Assigned(Attachments) and (Attachments.Count > 0) then
begin
nFileCount := Attachments.Count;
lpAttachArray := TlpAttachArray(StrAlloc(nFileCount*SizeOf(TMapiFileDesc)));
FillChar(lpAttachArray^, StrBufSize(PChar(lpAttachArray)), 0);
for i := 0 to nFileCount-1 do
begin
lpAttachArray^[i].nPosition := Cardinal(-1); lpAttachArray^[i].lpszPathName := StrPCopy(new(TlpszPathname)^, Attachments[i]);
if i < AttachmentNames.Count then
lpAttachArray^[i].lpszFileName := StrPCopy(new(TlpszFileName)^, AttachmentNames[i])
else
lpAttachArray^[i].lpszFileName := StrPCopy(new(TlpszFileName)^, ExtractFileName(Attachments[i]));
end;
lpFiles := @lpAttachArray^
end
else
nFileCount := 0;
end;
if Assigned(Recipients) and (Recipients.Count > 0) then
begin
lpRecipArray := TlpRecipArray(StrAlloc(Recipients.Count*SizeOf(TMapiRecipDesc)));
FillChar(lpRecipArray^, StrBufSize(PChar(lpRecipArray)), 0);
for i := 0 to Recipients.Count-1 do
begin
s := Recipients[i];
if (UpperCase(Copy(s, 1, 3)) = 'CC:') then
begin
lpRecipArray^[i].ulRecipClass := MAPI_CC;
Delete(s, 1, 3);
end
else
if (UpperCase(Copy(s, 1, 4)) = 'BCC:') then
begin
lpRecipArray^[i].ulRecipClass := MAPI_BCC;
Delete(s, 1, 4);
end
else
lpRecipArray^[i].ulRecipClass := MAPI_TO;
if ResolveNames then
CheckRecipient(s)
else
begin
lpRecipArray^[i].lpszName := StrCopy(new(TlpszRecipName)^, PChar(s));
lpRecipArray^[i].lpszAddress := StrCopy(new(TlpszRecipName)^, PChar(s));
end;
end;
Message.nRecipCount := Recipients.Count;
Message.lpRecips := @lpRecipArray^;
end
else
Message.nRecipCount := 0;
Result := SendMess;
if Assigned(Attachments) and (Message.nFileCount > 0) then
begin
for i := 0 to Message.nFileCount-1 do
begin
Dispose(lpAttachArray^[i].lpszPathname);
Dispose(lpAttachArray^[i].lpszFileName);
end;
StrDispose(PChar(lpAttachArray));
end;
if Assigned(Recipients) and (Recipients.Count > 0) then
begin
for i := 0 to Message.nRecipCount-1 do
begin
if Assigned(lpRecipArray^[i].lpszName) then
Dispose(lpRecipArray^[i].lpszName);
if Assigned(lpRecipArray^[i].lpszAddress) then
Dispose(lpRecipArray^[i].lpszAddress);
end;
StrDispose(PChar(lpRecipArray));
end;
if intMAPISession <> 0 then
try
MapiLogOff(intMAPISession, 0, 0, 0);
except
end;
end;
constructor TMAPIMail.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
EditDialog := True;
FRecipients := TStringList.Create;
FAttachments := TStringList.Create;
FAttachmentNames := TStringList.Create;
end;
destructor TMAPIMail.Destroy;
begin
FRecipients.Free;
Attachments.Free;
AttachmentNames.Free;
inherited Destroy;
end;
procedure TMAPIMail.SetRecipients(Value: TStrings);
begin
FRecipients.Assign(Value)
end;
procedure TMAPIMail.SetAttachments(Value: TStrings);
begin
Attachments.Assign(Value)
end;
procedure TMAPIMail.SetAttachmentNames(Value: TStrings);
begin
AttachmentNames.Assign(Value)
end;
function TMAPIMail.Send: Boolean;
begin
FLastError := SendEMailByMAPI(SenderName, SenderAddress, Subject, Body, Recipients, Attachments, AttachmentNames, EditDialog, ResolveNames, RequestReceipt, 0);
Result := (LastError = SUCCESS_SUCCESS);
end;
end.
|
raiguen hat folgendes geschrieben: