[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