Tratamento de erros

[TheMaker 0]

Olá,

 

Gostaria de fazer uma rotina única p/ tratamentos de erros...

Algo que permita a mensagem de erro mas que saia desse error posteriormante...

 

Algo mais ou menos assim:

 

Procedure Teste;Begin      Try      {Bloco de comandos}      Except             // Em caso de erro chamar uma procedure especifica que mostre o erro na             integra, e escape em seguida(liberando o programa p/ uso normalmente)            MostraError(Error : {Parametro})      End; End;

No caso da procedure MostraError....Que tipo de parametro eu usaria p/ mostrar o error ocorrido? Como eu posso capturar esse error, transforma-lo em mensagem e liberar o programa depois?

 

 

Espero q alguém aí possa me dar uma ajuda....

[Aroldo Zanela 0]

Colega,

 

Abaixo, exemplo usando o Firebird:

 

function TFormX.TratarErro(Mensagem: String): TDataAction;var campo: String;    i, x: byte;    flag: Boolean;begin  if Pos('must have a value', Mensagem)>0 then  begin    i           := Pos('''', Mensagem);    Mensagem[i] := '"';    x           := Pos('''', Mensagem);    campo       := Copy(Mensagem,i+1,x-i-1);    MessageDlg(campo + ': Preenchimento obrigatório. Verifique!', mtError, [mbCancel],0);  end else  if Pos('violation of PRIMARY or UNIQUE KEY', Mensagem)>0 then  begin    MessageDlg('Código ou referência já cadastrado.', mtError, [mbCancel],0);  end;  dm.Transaction.RollbackRetaining;  Result := daAbort;end;

Invocado desta forma:

 

procedure TFormX.tbCadastroPostError(DataSet: TDataSet; E: EDatabaseError;  var Action: TDataAction);begin  Action := TratarErro(E.Message);end;

[Dopi 0]

Achei em algum livro de dicas (que não me lembro o nome) essa funçao abaixo:

 

{-----------------------------------------------------------------------------}procedure _TrataErros(Sender: TObject; E: Exception);var mensagem: string;    erro : string;    Pos1, Pos2: integer;    ErrorUpStr : String;begin  erro := '';  ErrorUpStr := UpperCase(E.Message);  If Pos('IS NOT A VALID DATE', ErrorUpStr) <> 0 then     erro := 'Data Inválida. Favor corrigir'  else if Pos('MUST HAVE A VALUE', ErrorUpStr) <> 0 then   begin      Pos1:=Pos('''', E.Message);      mensagem:=E.Message;      Delete(mensagem, Pos1, 1);      Pos2:=Pos('''', mensagem);      mensagem:= copy(E.Message, Pos1 + 1, Pos2 - Pos1);      erro := 'É obrigatorio o preenchimento do Campo'+#10+#10+'"'+ mensagem +'"';   end  else If (Pos('DEADLOCK', ErrorUpStr) <> 0) or     (Pos('RECORD/KEY DELETED', ErrorUpStr) <> 0) then     erro := 'REGISTRO ALTERADO NÃO FOI LOCALIZADO.'+#10+             'Provavelmente foi apagado por outro usuário.'+#10+             'Atualize os dados de sua Tabela (CTRL+A).'  else if (Pos('KEY VIOLATION', ErrorUpStr) <> 0) or     (Pos('VIOLATION OF PRIMARY', ErrorUpStr) <> 0) then     erro := 'Registro já Incluido'+#10+'(Código duplicado).'  else if Pos('INPUT VALUE', ErrorUpStr) <> 0 then     erro := 'Campo preenchido com Valor Inválido. Favor corrigir.'  else if Pos('IS NOT A VALID TIME', ErrorUpStr) <> 0 then     erro := 'Hora inválida. Favor corrigir.'  else if Pos('MASTER HAS DETAIL RECORDS', ErrorUpStr) <> 0 then     erro := 'Proibida a Exclusão e Modificação deste Registro,'+#10+             'pois ele faz Referência a Outro(s) Registro(s)!'  else if Pos('FIELD VALUE REQUIRED', ErrorUpStr) <> 0 then   begin     Pos1:=Pos(':',E.Message);     Delete(Mensagem,Pos1,1);     Mensagem:= copy(E.Message,Pos1+2,30);     erro := 'É obrigatório o preenchimento do Campo'+#10+#10+'"'+ mensagem + '"';   end  else if Pos('RECORD LOCKED BY ANOTHER USER', ErrorUpStr) <> 0 then     erro := 'O Registro está sendo Utilizado por Outro Usuário da Rede.'+#10+             'Cancele a Operação e Aguarde a Liberação do Mesmo!'  else     erro := E.Message;  //'OCORREU O SEGUINTE ERRO: '+#10+#10+  if erro <> '' then     MessageDlg(erro,mtError,[mbOk],0);end;

Para desviar todos os erros do programa para ela:

na declaração Private do FormPrincipal  private    { Private declarations }    procedure TrataErros(Sender: TObject; E: Exception);{-----------------------------------------------------------------------------}Procedure TFormPrincipal.TrataErros(Sender: TObject; E: Exception);begin  _TrataErros(Sender, E);end;procedure TFormPrincipal.FormCreate(Sender: TObject);begin  Application.OnException := TrataErros;....

[TheMaker 0]

Valeu Galera!!! Dica é show!!

 

só uma coisa....

 

a rotina ainda termina abortando o procedimento....

 

Ex:

 

um bloco de comandos de 5 linhas...

o erro acontece na linha 3...

 

Eu gostaria q as linhas 4 e 5 fossem executadas(mesmo q haja algum erro)...

 

Se alguém souber de alguma coisa.......Valeu a moral (Aroldo e Dopi)!!!! http://forum.imasters.com.br/public/style_emoticons/default/clap.gif

[Dopi 0]

Se você for usar a rotina TrataErros demonstrada acima....

 

Procedure Teste;Begin     Try        {Bloco de comandos}     Except        { escreva os  comandos de tratamento ou limpeza aqui }        raise;    { isso irá chamar o TrataErros }     End;End;

[TheMaker 0]

Valeu Dopi!!!

 

Agora tá beleza!!!

 

Um Abraço...!

http://forum.imasters.com.br/public/style_emoticons/default/clap.gif