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:
|
function R_sendmailmapi(fto: string; fCC: string; fsubject: string; ftext: string; fattachment: string): string;
const
RECIP_MAX = MaxInt div SizeOf(TMapiRecipDesc);
ATTACH_MAX = MaxInt div SizeOf(TMapiFileDesc);
type
{array of structures for TO, CC, and BCC }
TRecipAccessArray = array[0..(RECIP_MAX - 1)] of TMapiRecipDesc;
TlpRecipArray = ^TRecipAccessArray;
{array of structures for attachments }
TAttachAccessArray = array[0..(ATTACH_MAX - 1)] of TMapiFileDesc;
TlpAttachArray = ^TAttachAccessArray;
var
lppMapiMessage: MapiMessage; // main message info pointer
hSession: ULONG;
lppMapiFileDesc: MapiFileDesc; // attachment info pointer
flFlags: ULONG;
lparrayRecips: TlpRecipArray;
lppMapiRecipDesc: TMapiRecipDesc; // recipient info pointer
lparrayAttachments: TlpAttachArray;
err: ULONG;
AnyStr: AnsiChar;
{PChar;}
nAttachments,
nRecipients: Cardinal;
dataok: boolean;
trecipients, recipient: string;
recipno: integer;
{Outlook:Outlook2000.TOutlook2000.Application;}
{OlSecurityManager1: TOlSecurityManager;}
Atemp: string;
begin
try
nattachments := 0;
dataok := true;
recipno := 0;
if fattachment <> '' then
begin
if not fileexists(fattachment) then
begin
Result := 'attachment not found';
dataok := false;
end;
nAttachments := 1;
if length(rwAttachment) > 0 then
nAttachments := 2;
{21/10/2004}
end;
if dataok then
begin
nRecipients := 0;
if fto <> '' then
begin
nRecipients := nrecipients + 1;
trecipients := fto;
while pos(';', trecipients) > 0 do
begin
trecipients := copy(trecipients, pos(';', trecipients) + 1, 99999);
Inc(nRecipients);
end;
end;
if fCC <> '' then
begin
nRecipients := nrecipients + 1;
trecipients := fCC;
while pos(';', trecipients) > 0 do
begin
trecipients := copy(trecipients, pos(';', trecipients) + 1, 99999);
Inc(nRecipients);
end;
end;
FillChar(lppMapiRecipDesc, SizeOf(TMapiRecipDesc), 0);
lparrayRecips := TlpRecipArray(StrAlloc(nRecipients * SizeOf(TMapiRecipDesc)));
FillChar(lparrayRecips^, StrBufSize(PChar(lparrayRecips)), 0);
lparrayAttachments := TlpAttachArray(StrAlloc(nAttachments * SizeOf(TMapiFileDesc)));
FillChar(lparrayAttachments^, StrBufSize(PChar(lparrayAttachments)), 0);
{ check to see if there is file to attach }
if fattachment <> '' then
begin
{ info about Attachment}
lparrayAttachments^[0].ulReserved := 0;
lparrayAttachments^[0].flFlags := 0;
lparrayAttachments^[0].nPosition := ULONG($FFFFFFFF);
AnyStr := StrAlloc(length(fattachment) + 1);
StrPCopy(AnyStr, fattachment);
lparrayAttachments^[0].lpszPathName := AnyStr;
AnyStr := nil;
StrDispose(AnyStr);
AnyStr := StrAlloc(length(ExtractFileName(fattachment)) + 1);
StrPCopy(AnyStr, ExtractFileName(fattachment));
lparrayAttachments^[0].lpszFileName := AnyStr;
AnyStr := nil;
StrDispose(AnyStr);
lparrayAttachments^[0].lpFileType := nil;
if length(rwAttachment) > 0 then
begin
{21/10/2004}
lparrayAttachments^[1].ulReserved := 0;
lparrayAttachments^[1].flFlags := 0;
lparrayAttachments^[1].nPosition := ULONG($FFFFFFFF);
AnyStr := StrAlloc(length(rwAttachment) + 1);
StrPCopy(AnyStr, rwAttachment);
lparrayAttachments^[1].lpszPathName := AnyStr;
AnyStr := nil;
StrDispose(AnyStr);
AnyStr := StrAlloc(length(ExtractFileName(rwAttachment)) + 1);
StrPCopy(AnyStr, ExtractFileName(rwAttachment));
lparrayAttachments^[1].lpszFileName := AnyStr;
AnyStr := nil;
StrDispose(AnyStr);
lparrayAttachments^[1].lpFileType := nil;
end;
end;
{ info about recipient }
trecipients := fto + ';';
while pos(';', trecipients) > 0 do
begin
recipient := copy(trecipients, 1, pos(';', trecipients) - 1);
trecipients := copy(trecipients, pos(';', trecipients) + 1, 99999);
lparrayRecips^[recipno].ulReserved := 0;
lparrayRecips^[recipno].ulRecipClass := MAPI_TO;
AnyStr := StrAlloc(length(recipient) + 1);
strPcopy(Anystr, recipient);
lparrayRecips^[recipno].lpszName := AnyStr;
lparrayRecips^[recipno].lpszAddress := nil;
lparrayRecips^[recipno].ulEIDSize := 0;
lparrayRecips^[recipno].lpEntryID := nil;
AnyStr := nil;
StrDispose(AnyStr);
recipno := recipno + 1;
end;
{ info about CC }
if fCC <> '' then
begin
trecipients := fCC + ';';
while pos(';', trecipients) > 0 do
begin
recipient := copy(trecipients, 1, pos(';', trecipients) - 1);
trecipients := copy(trecipients, pos(';', trecipients) + 1, 99999);
AnyStr := StrAlloc(length(fCC) + 1);
StrPCopy(AnyStr, fCC);
lparrayRecips^[recipno].ulReserved := 0;
lparrayRecips^[recipno].ulRecipClass := MAPI_CC;
lparrayRecips^[recipno].lpszName := anystr;
lparrayRecips^[recipno].lpszAddress := nil;
lparrayRecips^[recipno].ulEIDSize := 0;
lparrayRecips^[recipno].lpEntryID := nil;
AnyStr := nil;
StrDispose(AnyStr);
recipno := recipno + 1;
end;
end;
{ main structure that is used to send the message }
lppMapiMessage.ulReserved := ULONG(0);
lppMapiMessage.lpszSubject := PChar(fSubject);
lppMapiMessage.lpszNoteText := PChar(fText);
lppMapiMessage.lpszMessageType := nil;
lppMapiMessage.lpszDateReceived := nil;
lppMapiMessage.lpszConversationID := nil;
lppMapiMessage.flFlags := ULONG(0);
{lppMapiMessage.flFlags := MAPI_RECEIPT_REQUESTED;}
lppMapiMessage.lpOriginator := nil;
lppMapiMessage.nRecipCount := nRecipients;
lppMapiMessage.lpRecips := @lparrayRecips^;
lppMapiMessage.nFileCount := nAttachments;
lppMapiMessage.lpFiles := @lparrayAttachments^;
err := MAPISendMail(0, 0, lppMapiMessage, 0, 0);
if err <> SUCCESS_SUCCESS then
Result := 'mapi error ' + inttostr(err);
{jbsendmail:= 'mapi error ' + inttostr(err);}
end;
finally
end;
end;
|