Subida de envio por e-mail (sin terminar todos los documentos).

git-svn-id: https://192.168.0.254/svn/Proyectos.Acana_FactuGES2/trunk@318 f4e31baf-9722-1c47-927c-6f952f962d4b

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.