Tecsitel_FactuGES2/Source/Base/Utiles/uEMailUtils.pas

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.