1

Aparece o seguinte erro quando tenta executar a função de enviar e-mail:

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.

Segue o código:

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;

1 Resposta 1

1

De acordo com este artigo da Microsoft, siga os passos a seguir para resolver esse impasse.

  1. Abra o Painel de ControleProgramasProgramas Padrão.
  2. Clique sobre Definir acesso a programas e padrões do computador.
  3. Na janela Definir acesso a Programas e Padrões do Computador, clique na seta da configuração Personalizada para abrir o menu de tal categoria.
  4. Na categoria Escolha um programa de e-mail padrão, selecione o programa de e-mail que deseja utilizar, por exemplo, Microsoft Outlook e, a seguir clique em OK.

Essa configuração é guardada na seguinte chave no Registro:

HKEY_CLASSES_ROOT → mailto\shell\open\command

Para alterar esse valor programaticamente, você poderá usar a Winapi RegSetValueEx() ou utilizar as funções da classe Registry.

Exemplo 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;

Utilização:

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;

Exemplo 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;

Utilização:

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;

Para que funcione do modo esperado, você provavelmente terá que ter privilégios para fazer essa operação. Se atente também em passar a linha de argumentos de modo correto para o programa de e-mail de sua escolha.

4
  • Tem como fazer isso via delphi? fazer algo parecido no registro e tal?
    – Ramon Ruan
    20/01/2015 às 13:45
  • amigo, tem como me enviar um exemplo?
    – Ramon Ruan
    20/01/2015 às 14:06
  • Mechanic, cara, o indy utiliza algum programa padrão ou ele utiliza o envio de email via TelNet? as máquinas dos cliente estão dando este erro. é interessante mas, não tem Outlook na máquina deles. Resumindo, Indy deveria utilizar a ferramenta contida na DLL Winsock.dll e enviar os e-mails via telnet não? ou estou falando besteira? :P
    – Ramon Ruan
    20/01/2015 às 19:09
  • @RamonRuan De uma olhada sobre mAPI. Aqui têm um exemplo para Delphi.
    – stderr
    20/01/2015 às 19:27

Você deve fazer log-in para responder a esta pergunta.

Esta não é a resposta que você está procurando? Pesquise outras perguntas com a tag .