Fórum Capturar Qualquer Erro e Gravar (DICA) #273563

22/03/2005

0

Delphi

Disponibilizo aqui uma dica:

A função abaixo permite que a msg de qualquer erro seja capturada automaticamente pelo sistema e gravada em um arquivo JPEG.

Declare em Uses : ImgList, Jpeg, ExtCtrls, StdCtrls.

procedure TForm1.Notificar_Erro(Sender: TObject; E: Exception);
var
  img_erro : TBitmap;
  Jpg      : TJPEGImage;
  msg      : TForm;
begin
  msg             := TForm.Create(Self);
  msg.Caption     := ´Notificação de Erro´;
  msg.Position    := poScreenCenter;
  msg.BorderStyle := bsDialog;

  with Extctrls.TImage.Create(msg) do begin
    Name   := ´Img´;
    Parent := msg;
    Picture.Icon.Handle := LoadIcon(0, IDI_ERROR);
    Top  := 20;
    Left := 20;
  end;

  with StdCtrls.TMemo.Create(msg) do begin
    Name        := ´txt_msg´;
    Parent      := msg;
    BorderStyle := bsNone;
    ReadOnly    := True;

    Color   := msg.Color;
    Top     := 20;
    Left    := 60;
    Height  := msg.Height - 90;
    Width   := msg.Width - 90;

    Lines.Clear;
    Lines.Add(´----------------------------------------------------------------------´);
    Lines.Add(´Notificação de Erro Desconhecido Sendo Executada e Gravada ! ! !´);
    Lines.Add(E.ClassName);
    Lines.Add(E.Message);
    Lines.Add(ExtractFilePath(Application.ExeName) + ´Erro_´ + Self.Name + ´.jpeg´);
    Lines.Add(´----------------------------------------------------------------------´);
    Lines.Add(´ Contate o Suporte. ´);
    Lines.Add(´----------------------------------------------------------------------´);
  end;

  with Buttons.TBitBtn.Create(msg) do begin
    Name    := ´Btn´;
    Parent  := msg;
    Kind    := bkOK;
    Top     := Trunc(msg.Height) - 65;
    Left    := Trunc(msg.Width / 2) - 40;
  end;

  msg.Show;
  msg.Repaint;

  Repaint;
  img_erro := TBitmap.Create;
  img_erro := CaptureScreenRect(Bounds(0, 0, Screen.Width, Screen.Height));
  Jpg      := TJPEGImage.Create;
  Jpg.Assign(img_erro);
  Jpg.SaveToFile(ExtractFilePath(Application.ExeName) + ´Erro_´ + Self.Name + ´.jpeg´);
  img_erro.Free;
  Jpg.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnException := Notificar_Erro;
end;

function CaptureScreenRect(ARect: TRect): TBitmap;
var
  ScreenDC: HDC;
begin
   Result := TBitmap.Create;
   with Result, ARect do begin
     Width  := Right - Left;
     Height := Bottom - Top;
     ScreenDC := GetDC(0);
     try
       BitBlt(Canvas.Handle, 0, 0, Width, Height, ScreenDC, Left, Top, SRCCOPY);
     finally
       ReleaseDC(0, ScreenDC);
     end;
   end;
end;



Isaque

Isaque

Responder

Posts

22/03/2005

Marco Salles

Ja Fou Testar.... :) :) :)


Responder

Gostei + 0

22/03/2005

Marco Salles

1)Tive que Inserir Um TBitButton no aolicativo , senão o compilador não reconhece a classe

2)Provoquei Um Erro , e apos receber a mensagem , não ta fechando quando eu clico no TbitButton :cry: :cry: :cry: :cry: :cry:


Responder

Gostei + 0

22/03/2005

Isaque

O BitBnt da tela de erro ainda não está com a função para fechar a msg de notificação, mas isso não impede a finalidade do código.


Responder

Gostei + 0

22/03/2005

Marco Salles

O BitBnt da tela de erro ainda não está com a função para fechar a msg de notificação, mas isso não impede a finalidade do código.


Claro que não:

Mas agora vamos dar uma função Para fechar a mensagem

Escrevemos :

TCountBit = Class(TBitBtn)
  constructor Create (AOwner: TComponent); override;
  destructor Destroy; override;
 end;

Com seu Respectivos Construtores:

constructor TCountBit.Create(AOwner: TComponent);
begin
  inherited;
end;

destructor TCountBit.Destroy;
begin
  inherited;
end;


Escrevemos ainda o Construtor

Procedure GerarBit(msg:TForm);
Begin
 with TCountBit.Create (msg) do
   begin
    Name    := ´Btn´;
    Parent  := msg;
    Kind    := bkOK;
    Top     := Trunc(msg.Height) - 65;
    Left    := Trunc(msg.Width / 2) - 40;
    OnClick :=Form1.BitClick;
   end;
end;


com seu evento OnClick

procedure TForm1.BitClick(sender:TObject);
begin
beep;
Tform(Form1.Components[0]).Close;
end;


Não podemos deixar de Escrever na Definição do Form :

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Notificar_Erro(Sender: TObject; E: Exception);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure BitClick(sender:TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

TCountBit = Class(TBitBtn)
  constructor Create (AOwner: TComponent); override;
  destructor Destroy; override;
 end;


Agora Modificamos o Código Para :

procedure TForm1.Notificar_Erro(Sender: TObject; E: Exception); 
var 
  img_erro : TBitmap; 
  Jpg      : TJPEGImage; 
  msg      : TForm; 
begin 
  msg := TForm.Create(Self); 
  msg.Caption     := ´Notificação de Erro´; 
  msg.Position    := poScreenCenter; 
  msg.BorderStyle := bsDialog; 
  msg.ComponentIndex:=0; // Por definição..Usaremos este numero para Fechar
                    
  with Extctrls.TImage.Create(msg) do begin 
    Name   := ´Img´; 
    Parent := msg; 
    Picture.Icon.Handle := LoadIcon(0, IDI_ERROR); 
    Top  := 20; 
    Left := 20; 
  end; 

  with StdCtrls.TMemo.Create(msg) do begin 
    Name        := ´txt_msg´; 
    Parent      := msg; 
    BorderStyle := bsNone; 
    ReadOnly    := True; 

    Color   := msg.Color; 
    Top     := 20; 
    Left    := 60; 
    Height  := msg.Height - 90; 
    Width   := msg.Width - 90; 

    Lines.Clear; 
    Lines.Add(´----------------------------------------------------------------------´); 
    Lines.Add(´Notificação de Erro Desconhecido Sendo Executada e Gravada ! ! !´); 
    Lines.Add(E.ClassName); 
    Lines.Add(E.Message); 
    Lines.Add(ExtractFilePath(Application.ExeName) + ´Erro_´ + Self.Name + ´.jpeg´); 
    Lines.Add(´----------------------------------------------------------------------´); 
    Lines.Add(´ Contate o Suporte. ´); 
    Lines.Add(´----------------------------------------------------------------------´); 
  end; 


//Mudamos Tudo aqui Para Uma Chamada ao Método GerarBit(msg);

GerarBit(msg);

// Note Bem Que Coloquei entre Parentesis o Codigo Antigo

 { with Buttons.TBitBtn.Create(msg) do begin 
    Name    := ´Btn´; 
    Parent  := msg; 
    Kind    := bkOK; 
    Top     := Trunc(msg.Height) - 65; 
    Left    := Trunc(msg.Width / 2) - 40; 
  end; }

  msg.Show; 
  msg.Repaint; 

  Repaint; 
  img_erro := TBitmap.Create; 
  img_erro := CaptureScreenRect(Bounds(0, 0, Screen.Width, Screen.Height)); 
  Jpg      := TJPEGImage.Create; 
  Jpg.Assign(img_erro); 
  Jpg.SaveToFile(ExtractFilePath(Application.ExeName) + ´Erro_´ + Self.Name + ´.jpeg´); 
  img_erro.Free; 
  Jpg.Free; 
end; 

procedure TForm1.FormCreate(Sender: TObject); 
begin 
  Application.OnException := Notificar_Erro; 
end; 

function CaptureScreenRect(ARect: TRect): TBitmap; 
var 
  ScreenDC: HDC; 
begin 
   Result := TBitmap.Create; 
   with Result, ARect do begin 
     Width  := Right - Left; 
     Height := Bottom - Top; 
     ScreenDC := GetDC(0); 
     try 
       BitBlt(Canvas.Handle, 0, 0, Width, Height, ScreenDC, Left, Top, SRCCOPY); 
     finally 
       ReleaseDC(0, ScreenDC); 
     end; 
   end; 
end;



Responder

Gostei + 0

Utilizamos cookies para fornecer uma melhor experiência para nossos usuários, consulte nossa política de privacidade.

Aceitar