Truco Delphi - Enviar emails usando el servicio Gmail de Google

En el truco de hoy os voy a enseñar como podéis enviar correos electrónicos desde vuestra aplicación Delphi mediante vuestra cuenta Gmail.

Para ello vamos a hacer uso de los componentes Indy disponibles en cualquier versión de RAD Studio (en el truco se utiliza la versión XE8 pero está testeado en XE5 también).

Vamos a crearnos una función SendGMail con el siguiente código:

  
procedure SendGmail(pUsuario, pPassword, pAsunto, pCuerpo, pDestino : string);
var
  Smtp : TidSMTP;
  ManejadorSSL : TidSSLIOHandlerSocketOpenSSL;
  Mensaje: TIdMessage;
begin
  ManejadorSSL := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
  with ManejadorSSL do
  begin
   Destination := 'smtp.gmail.com:587';
   Host := 'smtp.gmail.com';
   MaxLineAction := maException;
   Port := 587;
   SSLOptions.Method := sslvTLSv1;
   SSLOptions.Mode := sslmUnassigned;
   SSLOptions.VerifyMode := [];
   SSlOptions.VerifyDepth := 0;
  end;

  Smtp := TIdSMTP.Create( nil );

  with Smtp do
  begin
    IoHandler := ManejadorSSL;
    Host := 'smtp.gmail.com';
    Port := 25;
    Username := pUsuario;
    Password := pPassword;
    UseTLS := utUseExplicitTLS;
  end;

  Mensaje := TIdMessage.Create(nil);
  with Mensaje do
  begin
    Clear;
    Subject := pAsunto;
    Body.Text := pCuerpo;
    Recipients.Add;
    Recipients.Items[0].Address := pDestino;
  end;

  Smtp.Connect;
  if smtp.Connected then
  begin
    smtp.Send(Mensaje);
    smtp.Disconnect;
  end;

  FreeAndNil(Smtp);
  FreeAndNil(Mensaje);
  FreeAndNil(ManejadorSSL);

end;
 

Y ya está, solamente tendremos que llamar a esta función con los parámetros relativos a nuestra cuenta para enviar nuestro correo.

En lugar de crear los objetos dinámicamente, podéis pegar objetos directamente desde la paleta de componentes en vuestro formulario y ahorraros el create; si lo hacéis dinámicamente no olvidéis incluir en el uses las referencias necesarias:

 uses
  [...] IdMessage, IdIOHandler, IdIOHandlerSocket, IdIOHandlerStack,
  IdSSL, IdSSLOpenSSL, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, IdExplicitTLSClientServerBase, IdMessageClient, IdSMTPBase,
  IdSMTP,IdAttachmentFile,IdGlobal;
 

Observaréis que falta la opción de adjuntar algún archivo, pero eso lo vamos a dejar para futuros trucos.

Si tienes cualquier duda o comentario recuerda que puedes exponerlo aquí o bien mediante nuestro twitter y facebook.

Leer más

Truco Delphi - MessageBox organizados y personalizados.

Si eres, o has sido, programador Delphi, seguramente te has encontrado muchas aplicaciones donde se utiliza la función Showmessage, MessageBox o Messagedlg o incluso todas a la vez de manera desorganizada y no unificada.

En este truco/post os voy a mostrar como organizar vuestros mensajes de aplicación en una única unidad y como personalizarlos con vuestros propios iconos sin necesidad de crear formularios específicos para ellos.

Mi recomendación es que utilicéis siempre MessageBox, por dos motivos:

1. MessageBox es una función de la Api de Windows, por tanto, los textos de los botones estarán localizados al idioma del sistema.
2. Permite una mayor personalización y control de los mensajes mostrados.

En toda aplicación suelen utilizarse, al menos, tres tipos de mensajes de diálogo con el usuario; Mensajes de error, mensajes de aviso y mensajes de pregunta.

Mi recomendación es que os creéis una unidad donde agrupéis todos esos mensajes de manera que podáis utilizarlos en toda la aplicación, por ejemplo algo así:

unit UDialogos;

interface

uses Windows;

procedure MensajeError(owner: HWND; p_texto :string);
procedure MensajeAviso(owner: HWND; p_texto :string);
function Pregunta(owner: HWND; p_texto, p_titulo: string) : boolean;

implementation

procedure MensajeError(owner: HWND; p_texto :string);
begin
  MessageBox(owner, pchar(p_texto), 'Error',
               MB_ICONERROR or MB_OK or MB_TASKMODAL)
end;

procedure MensajeAviso(owner: HWND; p_texto :string);
begin
  MessageBox(owner, pchar(p_texto),'Aviso',
               MB_ICONINFORMATION or MB_OK or MB_TASKMODAL )
end;

function Pregunta(owner: HWND; p_texto, p_titulo: string) : boolean;
begin
  result := MessageBox(owner, pchar(p_texto), pchar(p_titulo),
               MB_ICONQUESTION or MB_YESNO or MB_TASKMODAL) = IDYES
end;

end.

De esta manera tendremos todos los mensajes localizados en una unidad de nuestra aplicación y a nuestra disposición para cuando los necesitemos.

Es importante utilizar correctamente el parámetro "owner" de esas funciones y pasárles siempre el "Handle" del formulario que llama a la función ("Self.Handle") para que los diálogos sepan delante de quién deben mostrarse.

Si no os gustan los iconos por defecto que muestra Windows, siempre podéis utilizar los vuestros utilizando "MB_USERICON", pero en este caso deberéis utilizar la función MessageBoxIndirect.

Supongamos que tenemos un icono en los recursos de nuestra aplicación llamado 'ICONICO' y que queremos mostrarlo en un mensaje de dialogo concreto, escribiríamos lo siguiente:

  
procedure MensajePersonalizado(owner: HWND; p_texto, p_titulo :string);
var
  flags : uint;
  MsgPars: TMsgBoxParams;
begin
  flags := MB_USERICON or MB_OK or MB_DEFBUTTON1 or MB_TASKMODAL;

  //Establecemos los parámetros
  with MsgPars do
  begin
    cbSize := SizeOf(MsgPars);
    hwndOwner := owner;
    hInstance := Sysinit.hInstance;
    lpszText := PChar(p_texto);
    lpszCaption := pchar(p_titulo );
    dwStyle := flags;
    lpszIcon := 'ICONICO'; //Nuestro icono en los recursos
    dwContextHelpId := 0;
    lpfnMsgBoxCallback := nil;
    dwLanguageId := LANG_NEUTRAL;
  end;

  MessageBoxIndirect(MsgPars);

end;

Una última consideración sobre utilizar MB_OKCANCEL o MB_YESNO. Cualquier flag que incluya OK y/o CANCEL responderá a las teclas "Intro" para el OK y "Escape" para el CANCEL, es decir, si utilizáis MB_YESNO, "intro" y "escape" no funcionarán, si utilizáis MB_OKCANCEL, si que lo harán.

Si tienes cualquier duda o comentario recuerda que puedes exponerlo aquí o bien mediante nuestro twitter y facebook.

Leer más

Truco Delphi - Ocultar icono de nuestra aplicación en barra de tareas

Hoy toca un truco rápido, fácil y para toda la familia que consiste en ocultar el icono de nuestra aplicación de la barra de tareas en Delphi.

¿Para que sirve esto? Bueno, eso depende; imaginad que necesitáis hacer una aplicación iconizada en el área de notificaciones (Al lado del reloj) y que queréis que cuando se muestre no aparezca el icono en la barra de tareas (igual que el reloj de Windows por ejemplo).

Para ello solamente tendremos que anular la función CreateParams de la clase TForm para codificar nosotros mismos lo que necesitamos de la siguiente manera:

 
TfrmPrincipal = class(TForm)
  private
    { Private declarations }
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  public
    { Public declarations }
  end;

procedure TfrmPrincipal.CreateParams(var Params: TCreateParams);
begin
  inherited;
  Params.ExStyle := Params.ExStyle and not WS_EX_APPWINDOW;
  Params.WndParent := Application.Handle;
end;

Si tienes cualquier duda o comentario recuerda que puedes exponerlo aquí o bien mediante nuestro twitter y facebook.

Leer más

Truco Delphi - Alternar colores de filas en DBGrid

Hoy os presento un pequeño truco que hará que vuestros DBGrids luzcan mucho mejor añadiendo unas pocas lineas de código.

Lo que tratamos de conseguir es que nuestro DBGrid presente las filas con colores alternos y además que la fila seleccionada se resalte también de manera alterna.

Para conseguir este objetivo debemos escribir la función GridDrawColumnCell como sigue:

procedure TfrmPrincipal.GridDrawColumnCell(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
const
  RowColors: array[Boolean] of TColor = (clSilver, clWhite);
  RowSelectedColors: array[Boolean] of TColor = (clHotLight, clHighlight);
var
  OddRow: Boolean;
begin
  if (Sender is TDBGrid) then
  begin
    OddRow := Odd(TDBGrid(Sender).DataSource.DataSet.RecNo);
    if (gdSelected in State) then
      TDBGrid(Sender).Canvas.Brush.Color := RowSelectedColors[OddRow]
    else
      TDBGrid(Sender).Canvas.Brush.Color := RowColors[OddRow];
    TDBGrid(Sender).DefaultDrawColumnCell(Rect, DataCol, Column, State);
  end;
end;

Este procedimiento lo podemos poner en el formulario donde esté el DBGrid o bien en una unidad aparte y luego importarla con el comando Uses. Si incluimos el procedimiento en el formulario, es importante hacerlo como procedimiento de clase:

 TfrmPrincipal = class(TForm)

    { Otros métodos y propiedades del formulario }

    procedure GridDrawColumnCell(Sender: TObject; const Rect: TRect;
                                 DataCol: Integer; Column: TColumn; State: TGridDrawState);
  private
    { Private declarations }

  public
    { Public declarations }
  end;

De esta manera podremos seleccionar el DBGrid y asignar el procedimiento al evento OnDrawColumnCell.

Si tienes cualquier duda o comentario recuerda que puedes exponerlo aquí o bien mediante nuestro twitter y facebook.

Leer más

Truco Delphi - Prevenir la ejecución de más de una instancia de nuestra aplicación (I)

Hace ya bastante tiempo que no posteo, pero eso no quiere decir que me haya olvidado de vosotros.
Como no dispongo de mucho tiempo para continuar con el curso de Lazarus y postear de forma asidua los artículos que tenía previstos, voy a empezar a postear pequeños tips y códigos de ejemplo para resolver pequeños problemas que me surgen en el día a día.

Hoy quiero mostraros como hacer que vuestra aplicación no se ejecute más de una vez, pero, en lugar de manteniendo la instancia más antigua, haciendo que la nueva instancia tome el control, es decir, que la nueva ejecución sustituya a la antigua.

Para ello nos vamos a basar en el procedimiento de WinApi GetCurrentProcessId, que nos dará el id de proceso del programa que estamos ejecutando y en el objeto TApplication para obtener el ExeName que será el que buscaremos.

Básicamente lo que pretendemos es terminar cualquier proceso que se llame como el nuestro, pero que no sea el nuestro :D


Añadimos el siguiente código en el evento OnCreate de nuestro formulario principal.

procedure TfrmPrincipal.FormCreate(Sender: TObject);
begin
  FProcessID := GetCurrentProcessId;
  FExeName   := ExtractFileName(Application.ExeName);
  
  CerrarInstancias;
end;

Este es el código que recorrerá todos los procesos de Windows y eliminará las instancias que existan de nuestra aplicación excepto la actual.

procedure TfrmPrincipal.CerrarInstancias;
const
  PROCESS_TERMINATE = $0001;
var
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
begin
  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
  ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);


  while Integer(ContinueLoop) <> 0 do
  begin

      if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
          UpperCase(FExeName)) or
          (UpperCase(FProcessEntry32.szExeFile) =
          UpperCase(FExeName)))  and
         (FProcessEntry32.th32ProcessID <> FProcessID)
      then
      begin
        TerminateProcess(OpenProcess(PROCESS_TERMINATE,
                                    BOOL(0),
                                    FProcessEntry32.th32ProcessID),
                                    0);
      end;

       ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
  end;
  CloseHandle(FSnapshotHandle);

end;

Mas adelante pondré otras maneras de prevenir la ejecución de más de una instancia de nuestras aplicaciones.

Leer más