Tweet

Trecho de código do componente TDcCaptureErro.

Este componente não está totalmente pronto, mas dá pra aproveitar grande parte de seu código.
Na verdade o único bug que ele tem é na função que detecta se há ou não acesso a internet no computador onde o erro acontece.
Em banda larga via rede (lan) ou proxy funciona, mas linha discada de vez em quando não detecta.

Disponibilizei o componente para todos. Vejam minha seção Downalods.

procedure TDcCaptureErro.Execute(Sender: TObject; E: Exception);
var
 Arquivo: TextFile;
 NomeAlias: TStringList;
 NomeBDECFG: TRegistry;
 fFor: Integer;
 fTpObjeto: string;
 function ReplaceStr(Caracter: string; Quantidade: Integer): string;
 var
   I: Integer;
 begin
   Result := '';
   for I := 0 to Quantidade - 1 do
     Result := Result + Caracter;
 end;
begin
 if (FAtivo) and not (csDesigning in ComponentState) then
 begin
   if (Sender.ClassName <> TForm.ClassName) then
     fTpObjeto := Sender.ClassName
   else
     fTpObjeto := TForm(Sender).Parent.Name;
   if not DirectoryExists(FDiretorioErro) then
     ForceDirectories(FDiretorioErro);
   AssignFile(Arquivo, FDiretorioErro + FNomeArqErro);
   ReWrite(Arquivo);
   Append(Arquivo);
   try
     FErro := E.Message;
     WriteLn(Arquivo, 'Relatório de erros gerado pelo Sistema.');
     WriteLn(Arquivo, ReplaceStr('-', 50));
     WriteLn(Arquivo, 'Descrição do erro..: ' + E.Message);
     WriteLn(Arquivo, 'Código erro Windows: ' + IntToStr(IOResult));
     WriteLn(Arquivo, 'Sistema............: ' + TApplication(Sender).ExeName);
     WriteLn(Arquivo, 'Empresa............: ' + FCliente);
     WriteLn(Arquivo, 'Usuário ativo......: ' + FUsuario);
     WriteLn(Arquivo, 'DATA/HORA: ' + DateToStr(Date) + ' - ' +
       TimeToStr(Time));
     WriteLn(Arquivo, ReplaceStr('-', 50));
     WriteLn(Arquivo, 'Informações sobre banco de dados');
     WriteLn(Arquivo, 'ALIASES ATIVOS');
     NomeAlias := TStringList.Create;
     Session.GetAliasNames(NomeAlias);
     for fFor := 0 to NomeAlias.Count - 1 do
     begin
       WriteLn(Arquivo, ReplaceStr(' ', 20) + '> ' + NomeAlias[fFor]);
     end;
     NomeAlias.Free;
     NomeBDECFG := TRegistry.Create;
     NomeBDECFG.RootKey := HKEY_LOCAL_MACHINE;
     if NomeBDECFG.RegistryConnect('') then
     begin
       if NomeBDECFG.OpenKey('SOFTWARE\BORLAND\DATABASE ENGINE', False) then
       begin
         WriteLn(Arquivo, 'CFG ativo : ' +
           NomeBDECFG.ReadString('CONFIGFILE01'));
       end;
     end;
     NomeBDECFG.CloseKey;
     NomeBDECFG.Free;
     WriteLn(Arquivo, 'Erro chamado pelo objeto : ' + TComponent(Sender).Name);
     WriteLn(Arquivo, 'Erro gerado pelo form : ' + TComponent(Sender).Owner.Name);
     WriteLn(Arquivo, 'Caption do Form: ' + TForm(TComponent(Sender).Owner).Caption);
     FEmpresa.FConexao.FAnexo := FDiretorioErro + FNomeArqErro;
   finally
     CloseFile(Arquivo);
   end;
   ChamaForm(Sender);
 end;
end;