[firebase-br] Fb2.5 migrando de MDO para DbExpress
Mário Reis
mariodosreyx em gmail.com
Dom Jul 1 13:09:51 -03 2012
Viva pessoal,
Tinha este código que usava com sucesso no tratamento/tradução de erros do FB
só que com o DBExpress n~~ao dá para usar e não acho nada na NET pista etc
para me ajudar a substitu-lo:
If (E is EMDOFirebirdError) then
begin
With EMDOFirebirdError(E) do
Case EMDOFirebirdError(E).MDOErrorCode of
xcept: // xcept = 335544517 ;
begin
StrNomes(sEMSg,MyStrNomes);
If MyStrNomes.Count>0 Then
begin
sEMSg:=MyStrNomes[0]; sIdx:=MyStrNomes[1]; sTbl:=MyStrNomes
[2];
sIdx:=StringReplace(sIdx,'At procedure','pelo procedimento: ',
[rfIgnoreCase]);
sIdx:=StringReplace(sIdx,'line',' linha',[rfIgnoreCase]);
sIdx:=StringReplace(sIdx,'col','coluna',[rfIgnoreCase]);
//
sTbl:=StringReplace(sTbl,'At procedure',' ao chamar o
procedimento: ',[rfIgnoreCase]);
sTbl:=StringReplace(sTbl,'At trigger',' disparada pelo
gatilho: ',[rfIgnoreCase]);
sTbl:=StringReplace(sTbl,'line',' linha',[rfIgnoreCase]);
sTbl:=StringReplace(sTbl,'col','coluna',[rfIgnoreCase]);
if (sEMSg<>'') And (sIdx<>'') And (sTbl<>'')Then
begin
sUnit := 'Server/Proc: ' + sIdx;
sProcName := 'Server/Trigger: ' + sTbl;
sEMSg := sEMsg + CRLF + 'Excepção levantada no
Servidor, '+sIdx+' '+
sTbl;
end ;
end
Else
begin
sEMSg:=Copy(E.message,20,LastDelimiter
('required',E.message)-36);
end;
Msg(inttostr(xcept), cUser, sUnit, sLineNo, sProcName,
[sEMSg,sIdx,sTbl]);
end;
no_dup: // no_dup = 335544349 ;
begin
ShowMessage('Restrição de Integridade Referencial.'+CRLF+
' Chave única!'+CRLF+
'Não são permitidos registos duplicados para uma
chave única.') ;
end;
unique_key_violation: // unique_key_violation = 335544665 ;
begin
sS:=Copy(sEMsg,65,54);
sname:=DataSet.Name;
TirarNomeTbl_Idx(sS,sIdx,sname );
sCAmpo := Ver_IdxFields(sname,sIdx,DataSet as TMDODataSet) ;
Msg(inttostr(unique_key_violation),cUser,sUnit,sLineNo,sProcName,
[sCampo,sname,sIdx,sname]);
end;
//123456789|123456789|123456789|123456789|123456789|123456789|12345
6789|1234567890
//Operation violates CHECK constraint <string> on view or table
<string>
check_constraint: //check_constraint = 335544558 ;
begin
sCheck:='';sTbl:='';
sEMsg:=Copy(E.Message,36,LastDelimiter(CRLF,E.Message)-37);
TirarNomeTbl_Idx(sEMsg,sCheck,sTbl);
Msg(inttostr(check_constraint),cUser,sUnit,sLineNo,sProcName,
[sCheck,sTbl]);
end;
not_valid: // not_valid = 335544347 ; // Campo obrigatório
begin
Campo := Copy(sEMsg, 32, pos(',', sEMsg) - 32); // Pega o
nome do campo na mensagem de erro
Field := DataSet.FieldDefs.Find(Campo); // Localiza o
campo nas definições do DataSet
if Field <> nil then // Se o campo
for localizado...
sCampo:=DataSet.FieldByName
(Campo).DisplayLabel // .DisplayName
else // O campo
não foi encontrado...
sCampo:= Campo ;
Msg(inttostr(not_valid),cUser,sUnit,sLineNo,sProcName,
[sCampo,'*** Desconhecido ***']);
end;
foreign_key: // foreign_key = 335544466 ; // Não Ref.
begin
sCheck:='';sTbl:='';
sEMsg:=Copy(E.Message,32,LastDelimiter(CRLF,E.Message)-34);
sCheck:=Copy(sEMsg,1,Pos('" na tabela ',sEMsg)-1);
sTbl:=Copy(sEMsg,Pos('" na tabela ',sEMsg)+13,100);
TirarNomeTbl_Idx(sEMsg,sCheck,sTbl);
sCampo := Ver_IdxFields(sTbl,sCheck,DataSet as TMDODataSet) ;
Msg(inttostr(foreign_key),cUser,sUnit,sLineNo,sProcName,
[sCheck,sTbl,sCampo]);
end;
primary_key_ref: // primary_key_ref = 335544530 ; // Ref. não
apaga
begin
ShowMessage('Restrição de Integridade Referencial. Valor de
Campo Referenciado não pode apagar....') ;
end;
deadlock: // deadlock = 335544336 ;
begin
Msg(inttostr(deadlock),cUser,sUnit,sLineNo,sProcName,
[E.Message]);
If MessageDlg('Continuar ou tentar mais tarde?', mtConfirmation,
[mbYes, mbNo], 0) <> mrYes then
DataModule3.MDOTtrGAcra.Rollback ;
end;
record_lock: // record_lock = 335544476 ;
begin
ShowMessage('Registo em Utilização tente mais tarde.') ;
end;
relation_lock: // relation_lock = 335544475 ;
begin
ShowMessage('Ficheiro Alocado tente mais tarde.') ;
end;
Else
ShowMessage('Erro: '+E.Message);
End; // Case
end
else
begin
ShowMessage('Erro ao escrever a Tabela:' +#13#13 + E.Message);
Action := daAbort;
end;
Result := EMDOFirebirdError(E).MDOErrorCode ;
MyStrNomes.Free;
Alguém pode dar uma ajuda?
Abraço
Mais detalhes sobre a lista de discussão lista