unit uEmailWhatsApp;

interface

uses
  System.SysUtils, System.Classes, Winapi.Windows, Winapi.ShellAPI,
  frxClass, frxExportPDF, IdHTTP, IdSMTP, IdMessage, IdAttachmentFile,
  IdSSLOpenSSL, IdExplicitTLSClientServerBase, FireDAC.Comp.Client, Data.DB, IdText;

// Exporta un informe FastReport abierto a un archivo PDF temporal.
// Devuelve la ruta absoluta del archivo generado.
function ExportarInformeAPDF(frReport: TfrxReport; const NombreBase: string): string;

// Envía un email con archivo adjunto usando la configuración de la base de datos para un perfil específico.
function EnviarEmail(const ConfigID: string; const Destino, Asunto, Cuerpo, RutaAdjunto, Copia: string; out ErrorMsg: string): Boolean;
function EnviarEmailsIndividuales(const ConfigID: string; const ListaDestinos, Asunto, Cuerpo, RutaAdjunto: string; out ErrorMsg: string): Boolean;

// Abre el navegador (WhatsApp Web / App) con el número y texto preconfigurado.
procedure AbrirWhatsAppWeb(const Telefono, Mensaje: string);

// Envía un mensaje automáticamente por WhatsApp a través de CallMeBot API.
function EnviarWhatsAppAPI(const Telefono, Mensaje, ApiKey: string; out ErrorMsg: string): Boolean;

// Lee la configuración actual desde la base de datos para un perfil específico.
procedure LeerConfiguracion(const ConfigID: string; out SmtpHost: string; out SmtpPuerto: Integer;
  out SmtpSSL: Boolean; out SmtpUsuario, SmtpPassword, SmtpNombre: string;
  out WaModo: Integer; out WaTelefono, WaApiKey: string;
  out TplEmailAsunto, TplEmailCuerpo, TplWaMensaje: string;
  out FirmaHTML: string);

implementation

uses uDM, IdURI;

// Clase auxiliar para interceptar la verificación SSL.
// Al devolver True en OnVerifyPeer, evitamos que el motor CAPI de OpenSSL
// abra el diálogo de selección de certificados de Windows.
type
  TSSLVerifyHelper = class
  public
    function OnVerifyPeer(Certificate: TIdX509; AOk: Boolean;
      ADepth, AError: Integer): Boolean;
  end;

function TSSLVerifyHelper.OnVerifyPeer(Certificate: TIdX509; AOk: Boolean;
  ADepth, AError: Integer): Boolean;
begin
  Result := True; // Aceptar siempre; no se necesita verificar el certificado del servidor
end;

procedure LeerConfiguracion(const ConfigID: string; out SmtpHost: string; out SmtpPuerto: Integer;
  out SmtpSSL: Boolean; out SmtpUsuario, SmtpPassword, SmtpNombre: string;
  out WaModo: Integer; out WaTelefono, WaApiKey: string;
  out TplEmailAsunto, TplEmailCuerpo, TplWaMensaje: string;
  out FirmaHTML: string);
var
  Qry: TFDQuery;
begin
  Qry := TFDQuery.Create(nil);
  try
    Qry.Connection := DM.FDConnection;
    if ConfigID <> '' then
    begin
      Qry.SQL.Text := 'SELECT * FROM ge_config_envio WHERE id = :id';
      Qry.ParamByName('id').DataType := ftString;
      Qry.ParamByName('id').AsString := ConfigID;
    end
    else
      Qry.SQL.Text := 'SELECT * FROM ge_config_envio ORDER BY created_at LIMIT 1';
      
    Qry.Open;
    if not Qry.IsEmpty then
    begin
      SmtpHost := Qry.FieldByName('smtp_host').AsString;
      SmtpPuerto := Qry.FieldByName('smtp_puerto').AsInteger;
      SmtpSSL := Qry.FieldByName('smtp_ssl').AsInteger = 1;
      SmtpUsuario := Qry.FieldByName('smtp_usuario').AsString;
      SmtpPassword := Qry.FieldByName('smtp_password').AsString;
      SmtpNombre := Qry.FieldByName('smtp_nombre').AsString;

      WaModo := Qry.FieldByName('wa_modo').AsInteger;
      WaTelefono := Qry.FieldByName('wa_telefono').AsString;
      WaApiKey := Qry.FieldByName('wa_apikey').AsString;

      TplEmailAsunto := Qry.FieldByName('tpl_email_asunto').AsString;
      TplEmailCuerpo := Qry.FieldByName('tpl_email_cuerpo').AsString;
      TplWaMensaje := Qry.FieldByName('tpl_wa_mensaje').AsString;

      // Leer firma HTML (campo puede que no exista aun; capturamos el error)
      try
        FirmaHTML := Qry.FieldByName('firma_html').AsString;
      except
        FirmaHTML := '';
      end;
    end
    else
    begin
      SmtpHost := ''; SmtpPuerto := 587; SmtpSSL := True;
      SmtpUsuario := ''; SmtpPassword := ''; SmtpNombre := '';
      WaModo := 0; WaTelefono := ''; WaApiKey := '';
      TplEmailAsunto := ''; TplEmailCuerpo := ''; TplWaMensaje := ''; FirmaHTML := '';
    end;
  finally
    Qry.Free;
  end;
end;

function ExportarInformeAPDF(frReport: TfrxReport; const NombreBase: string): string;
var
  PDFExport: TfrxPDFExport;
  TempPath, FileName: string;
begin
  TempPath := IncludeTrailingPathDelimiter(GetEnvironmentVariable('TEMP'));
  FileName := TempPath + NombreBase + '_' + FormatDateTime('yyyymmdd_hhnnss', Now) + '.pdf';

  PDFExport := TfrxPDFExport.Create(nil);
  try
    PDFExport.ShowDialog := False;
    PDFExport.FileName := FileName;
    PDFExport.Background := True;
    // Opciones para optimizar PDF si es necesario
    
    frReport.PrepareReport(True);
    frReport.Export(PDFExport);
    
    Result := FileName;
  finally
    PDFExport.Free;
  end;
end;

function EnviarEmail(const ConfigID: string; const Destino, Asunto, Cuerpo, RutaAdjunto, Copia: string; out ErrorMsg: string): Boolean;
var
  Smtp: TIdSMTP;
  Msg: TIdMessage;
  SSLHandler: TIdSSLIOHandlerSocketOpenSSL;
  SSLHelper: TSSLVerifyHelper;
  SmtpHost, SmtpUsuario, SmtpPassword, SmtpNombre: string;
  SmtpPuerto, WaModo: Integer;
  SmtpSSL: Boolean;
  WaTelefono, WaApiKey, Tpl1, Tpl2, Tpl3, FirmaHTML: string;
  CuerpoHTML: string;
  TieneHTML: Boolean;
begin
  Result := False;
  ErrorMsg := '';

  LeerConfiguracion(ConfigID, SmtpHost, SmtpPuerto, SmtpSSL, SmtpUsuario, SmtpPassword, SmtpNombre,
    WaModo, WaTelefono, WaApiKey, Tpl1, Tpl2, Tpl3, FirmaHTML);

  // Determinar si el mensaje sera HTML
  TieneHTML := (Trim(FirmaHTML) <> '');
  if TieneHTML then
  begin
    // Escapar el cuerpo en texto plano y envolverlo en HTML
    CuerpoHTML := StringReplace(Cuerpo, '&', '&amp;', [rfReplaceAll]);
    CuerpoHTML := StringReplace(CuerpoHTML, '<', '&lt;', [rfReplaceAll]);
    CuerpoHTML := StringReplace(CuerpoHTML, '>', '&gt;', [rfReplaceAll]);
    CuerpoHTML := StringReplace(CuerpoHTML, #13#10, '<br>', [rfReplaceAll]);
    CuerpoHTML := StringReplace(CuerpoHTML, #10, '<br>', [rfReplaceAll]);
  end;

  if Trim(SmtpHost) = '' then
  begin
    ErrorMsg := 'El servidor SMTP no está configurado.';
    Exit;
  end;

  Smtp := TIdSMTP.Create(nil);
  Msg := TIdMessage.Create(nil);
  SSLHandler := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
  SSLHelper := TSSLVerifyHelper.Create;
  try
    try
      // Configurar SMTP
      Smtp.Host := SmtpHost;
      Smtp.Port := SmtpPuerto;
      Smtp.Username := SmtpUsuario;
      Smtp.Password := SmtpPassword;
      
      if SmtpSSL then
      begin
        // TLS 1.2 explicito: evita el error "Protocol field is empty" de sslvSSLv23
        SSLHandler.SSLOptions.Method := sslvTLSv1_2;
        SSLHandler.SSLOptions.Mode := sslmClient;
        
        // Desactivar verificacion de servidor (no necesitamos la CA store)
        SSLHandler.SSLOptions.VerifyMode := [];
        SSLHandler.SSLOptions.VerifyDepth := 0;
        
        // Sin certificados de cliente propios
        SSLHandler.SSLOptions.CertFile := '';
        SSLHandler.SSLOptions.KeyFile := '';
        SSLHandler.SSLOptions.RootCertFile := '';
        
        // OnVerifyPeer intercepta el handshake SSL antes de que el motor CAPI
        // de OpenSSL tenga oportunidad de abrir el dialogo de Windows.
        SSLHandler.OnVerifyPeer := SSLHelper.OnVerifyPeer;
        
        Smtp.IOHandler := SSLHandler;
        
        if SmtpPuerto = 465 then
          Smtp.UseTLS := utUseImplicitTLS
        else
          Smtp.UseTLS := utUseExplicitTLS;
      end;

      // Configurar Mensaje
      Msg.From.Address := SmtpUsuario;
      if Trim(SmtpNombre) <> '' then
        Msg.From.Name := SmtpNombre;
      
      Msg.Recipients.EMailAddresses := Trim(Destino);
      if Trim(Copia) <> '' then
        Msg.BccList.EMailAddresses := Trim(Copia);
      Msg.Subject := Asunto;
      
      if TieneHTML then
      begin
        if (Trim(RutaAdjunto) <> '') and FileExists(RutaAdjunto) then
        begin
          // Con adjunto: multipart/mixed  →  un único TIdText HTML + fichero adjunto
          // (NO mezclar text/plain + text/html: Outlook los muestra ambos como adjuntos)
          Msg.ContentType := 'multipart/mixed';
          with TIdText.Create(Msg.MessageParts) do
          begin
            Body.Text :=
              '<!DOCTYPE html><html><head><meta charset="UTF-8"></head><body>' +
              '<p>' + CuerpoHTML + '</p>' +
              '<br><hr style="border:none;border-top:1px solid #ccc;margin:10px 0">' +
              FirmaHTML +
              '</body></html>';
            ContentType     := 'text/html; charset=UTF-8';
            ContentTransfer := 'quoted-printable';
            // Forzar disposición inline para que Outlook no lo trate como adjunto
            ExtraHeaders.Values['Content-Disposition'] := 'inline';
          end;
          TIdAttachmentFile.Create(Msg.MessageParts, RutaAdjunto);
        end
        else
        begin
          // Sin adjunto: mensaje HTML directo (sin multipart)
          Msg.ContentType := 'text/html; charset=UTF-8';
          Msg.Body.Text :=
            '<!DOCTYPE html><html><head><meta charset="UTF-8"></head><body>' +
            '<p>' + CuerpoHTML + '</p>' +
            '<br><hr style="border:none;border-top:1px solid #ccc;margin:10px 0">' +
            FirmaHTML +
            '</body></html>';
        end;
      end
      else if (Trim(RutaAdjunto) <> '') and FileExists(RutaAdjunto) then
      begin
        // Sin firma pero con adjunto: multipart/mixed con cuerpo texto plano
        with TIdText.Create(Msg.MessageParts) do
        begin
          Body.Text := Cuerpo;
          ContentType := 'text/plain; charset=UTF-8';
          ExtraHeaders.Values['Content-Disposition'] := 'inline';
        end;
        TIdAttachmentFile.Create(Msg.MessageParts, RutaAdjunto);
      end
      else
        // Sin firma ni adjunto: mensaje texto plano simple
        Msg.Body.Text := Cuerpo;

      // Conectar y enviar
      try
        Smtp.Connect;
        try
          Smtp.Send(Msg);
          Result := True;
        finally
          try
            if Smtp.Connected then
              Smtp.Disconnect;
          except
            // Silenciamos errores de desconexión (como el EOF protocol violation)
            // que suelen ocurrir después de haber enviado el correo con éxito.
          end;
        end;
      except
        on E: Exception do
        begin
          // Si el mensaje se envió con éxito (Result=True) pero falló al desconectar, no informamos error
          if not Result then
            ErrorMsg := 'Error al enviar email: ' + E.Message;
        end;
      end;
    except
      on E: Exception do
      begin
        ErrorMsg := 'Error inesperado: ' + E.Message;
      end;
    end;
  finally
    SSLHelper.Free;
    SSLHandler.Free;
    Msg.Free;
    Smtp.Free;
  end;
end;

function EnviarEmailsIndividuales(const ConfigID: string; const ListaDestinos, Asunto, Cuerpo, RutaAdjunto: string; out ErrorMsg: string): Boolean;
var
  LSmtp: TIdSMTP;
  LMsg: TIdMessage;
  LSSLHandler: TIdSSLIOHandlerSocketOpenSSL;
  LSSLHelper: TSSLVerifyHelper;
  LSmtpHost, LSmtpUsuario, LSmtpPassword, LSmtpNombre: string;
  LSmtpPuerto, LWaModo: Integer;
  LSmtpSSL: Boolean;
  LWaTelefono, LWaApiKey, LTpl1, LTpl2, LTpl3, LFirmaHTML: string;
  LCuerpoHTML: string;
  LTieneHTML: Boolean;
  LDestinos: TStringList;
  Li: Integer;
  LSuccessCount: Integer;
begin
  Result := False;
  ErrorMsg := '';
  LSuccessCount := 0;

  LeerConfiguracion(ConfigID, LSmtpHost, LSmtpPuerto, LSmtpSSL, LSmtpUsuario, LSmtpPassword, LSmtpNombre,
    LWaModo, LWaTelefono, LWaApiKey, LTpl1, LTpl2, LTpl3, LFirmaHTML);

  if Trim(LSmtpHost) = '' then
  begin
    ErrorMsg := 'El servidor SMTP no está configurado.';
    Exit;
  end;

  LTieneHTML := (Trim(LFirmaHTML) <> '');
  if LTieneHTML then
  begin
    LCuerpoHTML := StringReplace(Cuerpo, '&', '&amp;', [rfReplaceAll]);
    LCuerpoHTML := StringReplace(LCuerpoHTML, '<', '&lt;', [rfReplaceAll]);
    LCuerpoHTML := StringReplace(LCuerpoHTML, '>', '&gt;', [rfReplaceAll]);
    LCuerpoHTML := StringReplace(LCuerpoHTML, #13#10, '<br>', [rfReplaceAll]);
    LCuerpoHTML := StringReplace(LCuerpoHTML, #10, '<br>', [rfReplaceAll]);
  end;

  LDestinos := TStringList.Create;
  LSmtp := TIdSMTP.Create(nil);
  LMsg := TIdMessage.Create(nil);
  LSSLHandler := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
  LSSLHelper := TSSLVerifyHelper.Create;
  try
    // Separar destinatarios (acepta ; o ,)
    LDestinos.Delimiter := ';';
    LDestinos.StrictDelimiter := True;
    LDestinos.DelimitedText := StringReplace(ListaDestinos, ',', ';', [rfReplaceAll]);

    // Limpiar espacios de cada email
    for Li := LDestinos.Count - 1 downto 0 do
    begin
      LDestinos[Li] := Trim(LDestinos[Li]);
      if LDestinos[Li] = '' then LDestinos.Delete(Li);
    end;

    if LDestinos.Count = 0 then
    begin
      ErrorMsg := 'No hay destinatarios válidos.';
      Exit;
    end;

    // Configurar SMTP
    LSmtp.Host := LSmtpHost;
    LSmtp.Port := LSmtpPuerto;
    LSmtp.Username := LSmtpUsuario;
    LSmtp.Password := LSmtpPassword;
    if LSmtpSSL then
    begin
      LSSLHandler.SSLOptions.Method := sslvTLSv1_2;
      LSSLHandler.SSLOptions.Mode := sslmClient;
      LSSLHandler.SSLOptions.VerifyMode := [];
      LSSLHandler.OnVerifyPeer := LSSLHelper.OnVerifyPeer;
      LSmtp.IOHandler := LSSLHandler;
      
      if LSmtpPuerto = 465 then
        LSmtp.UseTLS := utUseImplicitTLS
      else
        LSmtp.UseTLS := utUseExplicitTLS;
    end;

    try
      LSmtp.Connect;
      try
        for Li := 0 to LDestinos.Count - 1 do
        begin
          LMsg.Clear;
          LMsg.From.Address := LSmtpUsuario;
          if Trim(LSmtpNombre) <> '' then LMsg.From.Name := LSmtpNombre;
          LMsg.Subject := Asunto;
          LMsg.Recipients.EMailAddresses := LDestinos[Li];

          if LTieneHTML then
          begin
            if (Trim(RutaAdjunto) <> '') and FileExists(RutaAdjunto) then
            begin
              LMsg.ContentType := 'multipart/mixed';
              with TIdText.Create(LMsg.MessageParts) do
              begin
                Body.Text := '<!DOCTYPE html><html><body><p>' + LCuerpoHTML + '</p><br><hr>' + LFirmaHTML + '</body></html>';
                ContentType := 'text/html; charset=UTF-8';
                ContentTransfer := 'quoted-printable';
                ExtraHeaders.Values['Content-Disposition'] := 'inline';
              end;
              TIdAttachmentFile.Create(LMsg.MessageParts, RutaAdjunto);
            end
            else
            begin
              LMsg.ContentType := 'text/html; charset=UTF-8';
              LMsg.Body.Text := '<!DOCTYPE html><html><body><p>' + LCuerpoHTML + '</p><br><hr>' + LFirmaHTML + '</body></html>';
            end;
          end
          else if (Trim(RutaAdjunto) <> '') and FileExists(RutaAdjunto) then
          begin
            with TIdText.Create(LMsg.MessageParts) do
            begin
              Body.Text := Cuerpo;
              ContentType := 'text/plain; charset=UTF-8';
              ExtraHeaders.Values['Content-Disposition'] := 'inline';
            end;
            TIdAttachmentFile.Create(LMsg.MessageParts, RutaAdjunto);
          end
          else
            LMsg.Body.Text := Cuerpo;

          try
            LSmtp.Send(LMsg);
            Inc(LSuccessCount);
          except
            on E: Exception do ErrorMsg := ErrorMsg + ' Error en ' + LDestinos[Li] + ': ' + E.Message + '; ';
          end;
        end;
        Result := LSuccessCount > 0;
        if LSuccessCount < LDestinos.Count then
          ErrorMsg := Format('Enviados %d de %d. ', [LSuccessCount, LDestinos.Count]) + ErrorMsg;
      finally
        if LSmtp.Connected then LSmtp.Disconnect;
      end;
    except
      on E: Exception do ErrorMsg := 'Error de conexión: ' + E.Message;
    end;
  finally
    LDestinos.Free; LSSLHelper.Free; LSSLHandler.Free; LMsg.Free; LSmtp.Free;
  end;
end;


procedure AbrirWhatsAppWeb(const Telefono, Mensaje: string);
var
  Url, TelLimpio: string;
begin
  // Limpiar teléfono de espacios o signos +
  TelLimpio := StringReplace(Telefono, ' ', '', [rfReplaceAll]);
  TelLimpio := StringReplace(TelLimpio, '+', '', [rfReplaceAll]);
  
  // Codificar URL para el texto
  Url := 'https://wa.me/' + TelLimpio + '?text=' + TIdURI.URLEncode(Mensaje);
  
  ShellExecute(0, 'open', PChar(Url), nil, nil, SW_SHOWNORMAL);
end;

function EnviarWhatsAppAPI(const Telefono, Mensaje, ApiKey: string; out ErrorMsg: string): Boolean;
var
  IdHTTP: TIdHTTP;
  Url, TelLimpio: string;
begin
  Result := False;
  ErrorMsg := '';
  
  TelLimpio := StringReplace(Telefono, ' ', '', [rfReplaceAll]);

  if Pos('+', TelLimpio) <> 1 then
    TelLimpio := '+' + TelLimpio; // CallMeBot suele preferir el + 

  Url := 'https://api.callmebot.com/whatsapp.php?phone=' + TelLimpio +
         '&text=' + TIdURI.URLEncode(Mensaje) +
         '&apikey=' + ApiKey;

  IdHTTP := TIdHTTP.Create(nil);
  try
    try
      IdHTTP.Get(Url);
      Result := True;
    except
      on E: Exception do
      begin
        ErrorMsg := 'Error al contactar API WhatsApp: ' + E.Message;
      end;
    end;
  finally
    IdHTTP.Free;
  end;
end;

end.