Error sending e-mail by Indy 10

Question

The following error appears when trying to execute the send email function:

Não há um programa padrão de e-mail associado para realizar a ação solicitada. instale um programa de e-mail ou, caso já exista um instalado, crie uma associação no painel de controle Programas Padrão.

Follows the code:

procedure TfrmEnviaEmail.btnEnviarClick(Sender: TObject);
var
    i: integer;
  IdAttachmentFile1 : TIdAttachmentFile;
  IdUserPassProvider: TIdUserPassProvider;
  idSASLLogin: TIdSASLLogin;
begin
  IdSMTP1.ConnectTimeout := 30000;
  IdSMTP1.ReadTimeout := 30000;
    try
//      cancelar:= false;
        Screen.Cursor:= crHourGlass;
        btnEnviar.Enabled:= false;

    if cbDominio.ItemIndex = 0 then    //anibaltec
    begin
      IdSMTP1.Host := 'anibaltec.com.br';
    end;
    if cbDominio.ItemIndex = 1 then    //gmail
    begin
      IdSMTP1.Host := 'smtp.gmail.com';
    end;
    if cbDominio.ItemIndex = 2 then    //hotmail
    begin
      IdSMTP1.Host := 'smtp.live.com';
    end;
    if cbDominio.ItemIndex = 3 then    //yahoo
    begin
      IdSMTP1.Host := 'smtp.mail.yahoo.com';
    end;
    if cbDominio.ItemIndex = 4 then    //tef.net
    begin
      IdSMTP1.Host := 'tef.net.br';
    end;

    IdMessage1.Clear;
    IdMessage1.MessageParts.Clear;
    IdMessage1.IsEncoded := True;
    IdMessage1.CharSet := 'iso-8859-1';
    IdMessage1.Encoding := MeMIME;
    IdMessage1.ConvertPreamble := True;
    IdMessage1.Priority := mpNormal;
    IdMessage1.Date := Now;
    IdMessage1.From.Address := edtEmailDest.Text;
        IdMessage1.Subject := EdtAssunto.Text;
    IdMessage1.Body.Text := 'Este e-mail e um e-mail automatico, por favor nao responde-lo. Segue em anexo o relatório.';
    IdMessage1.ContentType := 'multipart/mixed';
    IdMessage1.Recipients.EMailAddresses := EdtPara.Text;

    //recebimento de confirmação
    IdMessage1.Headers.Add('Disposition-Notification-To: '+edtEmailDest.Text);
    IdMessage1.ReceiptRecipient.Address := edtEmailDest.Text;
    IdMessage1.ReceiptRecipient.User := edtEmailDest.Text;
    IdMessage1.ReceiptRecipient.Text := IdMessage1.From.Text;

    if ListBox1.Items.Count > 0 then
        begin
            for i:= 0 to ListBox1.Items.Count - 1 do
      begin
        if FileExists(ListBox1.Items[i]) then
        begin
          IdAttachmentFile1 := TIdAttachmentFile.Create(IdMessage1.MessageParts, ListBox1.Items[i]);

          if ExtractFileExt(ListBox1.Items[i]) = 'ini' then
            IdAttachmentFile1.ContentType := 'application/txt;'
          else
            IdAttachmentFile1.ContentType := 'application/'+ExtractFileExt(ListBox1.Items[i])+';';

          IdAttachmentFile1.FileName := ExtractFileName(ListBox1.Items[i]);
        end;
            end;
    end;

    with idSMTP1 do
    begin
      try
        Port := 587;
        IOHandler := IdSSLIOHandlerSocketOpenSSL1;
        UseTLS := utNoTLSSupport;
//        UseTLS := utUseExplicitTLS;
//        IdSSLIOHandlerSocketOpenSSL1.SSLOptions.Method := sslvTLSv1;
        IdSSLIOHandlerSocketOpenSSL1.PassThrough := true;
      except
        on E: Exception do
        begin
          IOHandler := TIdIOHandler.MakeDefaultIOHandler( nil );
          UseTLS := utNoTLSSupport;
        end;
      end;
    end;
    if not IdSMTP1.Connected then
    begin
      try
        IdSMTP1.AuthType := satDefault;
        IdSMTP1.Username := edtEmailDest.Text;
        IdSMTP1.Password := edtSenhaDest.Text;
        IdSMTP1.ReadTimeout := 10000;

        IdSMTP1.Connect;
        IdSMTP1.Authenticate;
      except
        on e: Exception do frmprincipal.EscreveLog(caminholog, 'Aplicativo não conseguiu se comunicar com o servidor de e-mail! Erro: '+e.Message);
      end;
    end;

    IdSMTP1.Send(IdMessage1);

    if ListBox1.Items.Count > 0 then
        begin
            for i:= 0 to ListBox1.Items.Count - 1 do
      begin
        if FileExists(ListBox1.Items[i]) then
        begin
          try
            if IdSMTP1.Connected then
            begin
              frmPrincipal.EscreveLog(caminholog, 'Email enviado com sucesso. ' +
                'Relatório '+ListBox1.Items[i]+' em anexo');
            end;
          except
             on e: Exception do frmPrincipal.EscreveLog(caminholog,
                'Servidor de Email ('+IdSMTP1.Host+') não foi conectado');
          end;
        end;
      end;
    end;
  finally
    if IdSMTP1.Connected then
    begin
      frmPrincipal.StatusBar1.Panels[0].Text := 'Email enviado com sucesso.';
      frmprincipal.EscreveLog(caminholog, 'Email enviado com sucesso.');
    end
    else
    begin
      frmprincipal.EscreveLog(caminholog, 'Aplicativo não conseguiu se comunicar com o servidor de e-mail!');
    end;
    Screen.Cursor:= crDefault;
    IdSMTP1.Disconnect;
    btnEnviar.Enabled:= true;
    ListBox1.Clear;
    Close;
  end;
end;

Answer 1

According to this article from Microsoft, follow the steps below to resolve this impasse.

1. Open the Control Panel → Programs → Programas Padrão.
2. Click on Set access to programs and computer patterns.
3. In the window Set Access to Programs and Computer Standards, click on the configuration arrow Personalized to open the menu of such a category.
4. In the category Choose a standard email program, select the email program you want to use, for example, Microsoft Outlook and then click on OK.

---

This setting is stored in the following key in the Registry:

HKEY_CLASSES_ROOT → mailto\shell\open\command

To change this value programmatically, you can use the Winapi RegSetValueEx() or use class functions Registry.

Example 1 - Regsetvalueex()

function RegSetValue(Key: HKEY; SubKey, NomeDoValor, Valor: String): Boolean;
Var
  phk: HKEY;
begin
Result := False;
if RegOpenKeyEx(Key, pchar(SubKey), 0, KEY_SET_VALUE, phk) = 0 then begin
  Result := RegSetValueEx(phk, PChar(NomeDoValor), 0, REG_SZ, PChar(Valor), (Length(Valor) + 1) * SizeOf(Char)) = 0;
  RegCloseKey(phk);
end;
end;

Utilizing:

procedure TForm1.Button2Click(Sender: TObject);
const
 EMAIL_PROGRAM_SYNTAX = 'C:\Path\Do\Programa\De\Email -c /e "%1"';
begin
if RegSetValue(HKEY_CLASSES_ROOT, 'mailto\shell\open\command', '', EMAIL_PROGRAM_SYNTAX) then
  ShowMessage('Operação Feita com sucesso!')
else
  ShowMessage('Erro na operação! Você tem privilégios para fazer isso?');
end;

Example 2 - Registry

// Inclua em Uses: Registry;
function RegSetValue2(Key: HKEY; SubKey, NomeDoValor, Valor: string): Boolean;
Var
 Reg: TRegistry;
begin
Result := false;
Try
  Reg := TRegistry.Create;
  Reg.RootKey := Key;

  if (Reg.KeyExists(SubKey) and (Reg.OpenKey(SubKey, True))) then begin
    Reg.WriteString(NomeDoValor, Valor);
    result := True;
  end;
  Reg.CloseKey;

Finally
  Reg.Free;
End;
end;

Utilizing:

procedure TForm1.Button1Click(Sender: TObject);
const
 EMAIL_PROGRAM_SYNTAX = 'C:\Path\Do\Programa\De\Email -c /e "%1"';
begin
if RegSetValue2(HKEY_CLASSES_ROOT, 'mailto\shell\open\command', '', EMAIL_PROGRAM_SYNTAX) then
  ShowMessage('Operação Feita com sucesso!')
else
  ShowMessage('Erro na operação! Você tem privilégios para fazer isso?');
end;

In order for it to work as expected, you will probably have to have privileges to perform this operation. Also consider passing the line of arguments correctly to the e-mail program of your choice.