﻿unit uEmailWhatsApp;

interface

uses
  System.SysUtils, System.Classes, Winapi.Windows, Winapi.ShellAPI,
  frxClass, frxExportPDF, IdHTTP, IdSMTP, IdMessage, IdAttachmentFile,
  IdSSLOpenSSL, IdExplicitTLSClientServerBase, ZDataset, 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: Integer; const Destino, 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: Integer; 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 datos, 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: Integer; 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: TZQuery;
begin
  Qry := TZQuery.Create(nil);
  try
    Qry.Connection := DM.DBjolly;
    if ConfigID > 0 then
    begin
      Qry.SQL.Text := 'SELECT * FROM config_envio WHERE id = :id';
      Qry.ParamByName('id').AsInteger := ConfigID;
    end
    else
      Qry.SQL.Text := 'SELECT * FROM config_envio ORDER BY id 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: Integer; const Destino, Asunto, Cuerpo, RutaAdjunto: 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.Add.Address := Destino;
      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;

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.

