diff --git a/Source/Base/Utiles/uEMailUtils.pas b/Source/Base/Utiles/uEMailUtils.pas new file mode 100644 index 00000000..149e9cf1 --- /dev/null +++ b/Source/Base/Utiles/uEMailUtils.pas @@ -0,0 +1,156 @@ +unit uEMailUtils; + +interface + +function IsValidEmail(const Value: string): boolean; +function SendMailMAPI(const Subject, Body, FileName, SenderName, SenderEMail, + RecepientName, RecepientEMail: String) : boolean; + +implementation + +uses + Windows, SysUtils, MAPI, Forms, Dialogs; + +function IsValidEmail(const Value: string): boolean; + function CheckAllowed(const s: string): boolean; + var + i: integer; + begin + Result:= false; + for i:= 1 to Length(s) do + begin + // illegal char in s -> no valid address + if not (s[i] in ['a'..'z','A'..'Z','0'..'9','_','-','.']) then + Exit; + end; + Result:= true; + end; +var + i: integer; + namePart, serverPart: string; +begin // of IsValidEmail + Result:= false; + i:= Pos('@', Value); + if (i = 0) or (pos('..', Value) > 0) then + Exit; + namePart:= Copy(Value, 1, i - 1); + serverPart:= Copy(Value, i + 1, Length(Value)); + if (Length(namePart) = 0) // @ or name missing + or ((Length(serverPart) < 4)) // name or server missing or + then Exit; // too short + i:= Pos('.', serverPart); + // must have dot and at least 3 places from end + if (i < 2) or (i > (Length(serverPart) - 2)) then + Exit; + Result:= CheckAllowed(namePart) and CheckAllowed(serverPart); +end; + +function SendMailMAPI(const Subject, Body, FileName, SenderName, SenderEMail, + RecepientName, RecepientEMail: String) : Boolean; +var + message: TMapiMessage; + lpSender, + lpRecepient: TMapiRecipDesc; + FileAttach: TMapiFileDesc; + SM: TFNMapiSendMail; + MAPIModule: HModule; + ErrorCode : Integer; +begin + FillChar(message, SizeOf(message), 0); + with message do + begin + if (Subject<>'') then + begin + lpszSubject := PChar(Subject) + end; + if (Body<>'') then + begin + lpszNoteText := PChar(Body) + end; + if (SenderEMail<>'') then + begin + lpSender.ulRecipClass := MAPI_ORIG; + if (SenderName='') then + begin + lpSender.lpszName := PChar(SenderEMail) + end + else + begin + lpSender.lpszName := PChar(SenderName) + end; + lpSender.lpszAddress := PChar('SMTP:'+SenderEMail); + lpSender.ulReserved := 0; + lpSender.ulEIDSize := 0; + lpSender.lpEntryID := nil; + lpOriginator := @lpSender; + end; + if (RecepientEMail<>'') then + begin + lpRecepient.ulRecipClass := MAPI_TO; + if (RecepientName='') then + begin + lpRecepient.lpszName := PChar(RecepientEMail) + end + else + begin + lpRecepient.lpszName := PChar(RecepientName) + end; + lpRecepient.lpszAddress := PChar('SMTP:'+RecepientEMail); + lpRecepient.ulReserved := 0; + lpRecepient.ulEIDSize := 0; + lpRecepient.lpEntryID := nil; + nRecipCount := 1; + lpRecips := @lpRecepient; + end + else + begin + lpRecips := nil + end; + if (FileName='') then + begin + nFileCount := 0; + lpFiles := nil; + end + else + begin + FillChar(FileAttach, SizeOf(FileAttach), 0); + FileAttach.nPosition := Cardinal($FFFFFFFF); + FileAttach.lpszPathName := PChar(FileName); + nFileCount := 1; + lpFiles := @FileAttach; + end; + end; + MAPIModule := LoadLibrary(PChar(MAPIDLL)); + if MAPIModule=0 then + begin + ErrorCode := -1 + end + else + begin + try + @SM := GetProcAddress(MAPIModule, 'MAPISendMail'); + if @SM<>nil then + begin + ErrorCode := SM(0, Application.Handle, message, MAPI_DIALOG or MAPI_LOGON_UI, 0); + end + else + begin + ErrorCode := 1 + end; + + finally + FreeLibrary(MAPIModule); + end; + end; + + if ErrorCode <> 0 then + begin + MessageDlg('Error sending mail (' + IntToStr(ErrorCode) + ').', mtError, [mbOk], 0); + Result := False; + end + else + Result := True; +end; + + +end.