Delphi не выводить сообщение об ошибке

---

Перехват ошибок SQL на Delphi в ADOConnection

Перехват ошибок SQL на Delphi при работе с компонентом ADO

Механизм, как «запретить — разрешить» выводить сообщение об ошибке подключения программы на Delphi через SQL через компонент TADOConnection.

Типичная обработка ошибки заключается в том, чтобы обрамить блоки кода в конструкции try..except или try..finally. Однако, многие попросту не делают этого, так как им недосуг или обработка исключений оставляется «на потом».

Чтобы не выводить сообщения об ошибке можно написать такой код, используя конструкцию «try-finally»:

procedure TAnswerList.Update(ADO : TADOQuery);
begin
with ADO do
begin
if Active then Close;
SQL.Text:=concat('UPDATE ANSWER_LIST SET ',
'NAME = "', self.Name, ', ',
'NOMER_ID = "', IntToStr(self.Nomer), ', ',
'CREDITOR_ID = "', IntToStr(self.CreditorId), ' ',
'WHERE ID = ' + IntToStr(self.id));
try
ExecSQL;
finally
end;
end;
end;

Чтобы грамотно вывести сообщение об ошибке можно использовать другую конструкцию:

procedure TAnswerList.Update(ADO : TADOQuery);
begin
with ADO do
begin
if Active then Close;
SQL.Text:=concat('UPDATE ANSWER_LIST SET ',
'NAME = "', self.Name, ', ',
'NOMER_ID = "', IntToStr(self.Nomer), ', ',
'CREDITOR_ID = "', IntToStr(self.CreditorId), ' ',
'WHERE ID = ' + IntToStr(self.id));
try
ExecSQL;
except
On E:Exception Do
begin
ShowMessage(concat('Update answer list failure. ',e.Message,#13#10,SQL.Text));
Exit;
end;
end;
end;

Как вариант, Вы можете использовать свойство Application.OnException, которое является глобальным обработчиком событий приложения. 

Для этого предлагается оформить обработку исключений в отдельный компонент.

unit sExceptionsCatcher;


{***} interface {***}

uses Classes, SysUtils, JPEG;

type
  TsExceptionsCatcher = class(TComponent)
  private
    FEnabled: boolean;
    FGenerateScreenshot: boolean;
    FJPEGScreenshot: boolean;
    FJpegQuality: TJPEGQualityRange;
    FCollectInfo: boolean;
    Fn: TFilename;
    procedure SetEnabled(const Value: boolean);
    { Private declarations }
  protected
    { Protected declarations }
    procedure EnableCatcher;
    procedure DisableCatcher;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Catcher(Sender: TObject; E: Exception);
  published
    { Published declarations }
    property Enabled: boolean read FEnabled write SetEnabled
                      default False;
  end;

procedure Register;

{***} implementation {***}

uses Windows, Forms, Dialogs, Graphics;

procedure Register;
begin
  RegisterComponents('Catch Exceptions', [TsExceptionsCatcher]);
end;

{ TsExceptionsCatcher }
constructor TsExceptionsCatcher.Create(AOwner: TComponent);
begin
  inherited;
end;

destructor TsExceptionsCatcher.Destroy;
begin
  DisableCatcher;
  inherited;
end;

procedure TsExceptionsCatcher.SetEnabled(const Value: boolean);
begin
  FEnabled := Value;
  if Enabled then EnableCatcher else DisableCatcher;
end;

procedure TsExceptionsCatcher.DisableCatcher;
begin
  Application.OnException := nil;
end;

procedure TsExceptionsCatcher.EnableCatcher;
begin
  Application.OnException := Catcher;
end;

procedure TsExceptionsCatcher.Catcher(Sender: TObject; E: Exception);
begin
  {TODO: Write some exception handling code}
end;

end.

Реализация функций 

// скриншот активного окна
procedure TsExceptionsCatcher.DoGenerateScreenshot;
var bmp: TBitmap;
    jpg: TJPEGImage;
begin
  bmp := Screen.ActiveForm.GetFormImage;
  begin
    jpg := TJPEGImage.Create;
    jpg.CompressionQuality := 100;
    jpg.Assign(bmp);
    jpg.SaveToFile(fn+'.jpg');
    FreeAndNil(jpg);
  end;
  FreeAndNil(bmp);
end;

// отчет, в котором будут указаны имя компьютера и имя текущего пользователя
function TsExceptionsCatcher.CollectUserName: string;
var
  uname: pchar;
  unsiz: cardinal;
begin
  uname := StrAlloc(255);
  unsiz := 254;
  GetUserName(uname,unsiz);
  if (unsiz > 0) then
    Result := string(uname) else
    Result := 'n/a';
  StrDispose(uname);
end;

function TsExceptionsCatcher.CollectComputerName: string;
var
  cname: pchar;
  cnsiz: cardinal;
begin
  cname := StrAlloc(MAX_COMPUTERNAME_LENGTH + 1);
  cnsiz := MAX_COMPUTERNAME_LENGTH + 1;
  GetComputerName(cname,cnsiz);
  if (cnsiz > 0) then
    Result := string(cname) else
    Result := 'n/a';
  StrDispose(cname);
end;

// Процедура создает объект класса TStringList, наполняет его информацией, которую надо записать и сохраняет в файл, 
// с именем, аналогичном имени файла со скриншотом
procedure TsExceptionsCatcher.DoCollectInfo(E: Exception);
var sl: TStringList;
begin
  sl := tstringlist.Create;
  sl.add('--- This report is created by automated '+
         'reporting system.');
  sl.add('Computer name is: ['+ComputerName+']');
  sl.add('User name is: ['+UserName+']');
  sl.add('--- End of report ----------------------'+
         '-----------------');
  sl.SaveToFile(Fn+'.txt');
end;

Дата публикации: 2015-05-12 10:36:28

← →
Ануфрий
 
(2007-08-03 19:30)
[0]

---

← →
Dib@zol ©
 
(2007-08-03 19:32)
[1]

А может просто не делить на ноль??? Или это просто такой пример?

---

← →
Ануфрий
 
(2007-08-03 19:35)
[2]

Это пример.

---

← →
Anatoly Podgoretsky ©
 
(2007-08-03 19:39)
[3]

---

← →
Ануфрий
 
(2007-08-03 19:42)
[4]

---

← →
Dib@zol ©
 
(2007-08-03 19:43)
[5]

---

← →
Anatoly Podgoretsky ©
 
(2007-08-03 19:45)
[6]

---

← →
Anatoly Podgoretsky ©
 
(2007-08-03 19:46)
[7]

---

← →
Ануфрий
 
(2007-08-03 19:49)
[8]

Dib@zol
Спасибо, работает. Хотя я всегда думал, что finally также «поглощает» ошибки, как except, только в отличие от последнего вызывается всегда, даже если ошибок нет. И вроде бы так и работало… Может просто не разу ошибок не попадалось внутри try finally end;

---

← →
Ануфрий
 
(2007-08-03 19:52)
[9]

---

← →
Ануфрий
 
(2007-08-03 19:56)
[10]

Посмотрел старый код. Раньше у меня тоже было try finally end. И никогда ошибки на экран не выдавались.

---

← →
Zagaevskiy ©
 
(2007-08-03 19:57)
[11]

Может ошибок там не было?

---

← →
Инс ©
 
(2007-08-03 19:57)
[12]

> Тогда наверное проще заменить на

В данном конкретном случае можно, но вообще лучше 1-й вариант.

---

← →
{RASkov} ©
 
(2007-08-03 19:58)
[13]

---

← →
Инс ©
 
(2007-08-03 19:58)
[14]

> [10] Ануфрий   (03.08.07 19:56)

Почитай Рихтера, у него отлично механизм исключений расписан.

---

← →
Anatoly Podgoretsky ©
 
(2007-08-03 20:01)
[15]

---

← →
Anatoly Podgoretsky ©
 
(2007-08-03 20:08)
[16]

---

← →
Ануфрий
 
(2007-08-03 20:10)
[17]

---

← →
Anatoly Podgoretsky ©
 
(2007-08-03 20:23)
[18]

---

At the moment I have a Delphi form running and upon losing connection to its Database/loss of network, it re-establishes and carries on.

The service is on a timer and each minute, it pops up with message box saying failure to connected to db on network [ip address]. This is at the start of the timer, a stored proc is ran.

I have all errors writing to a log file on the service local machine, is there a way I can suppress the message box appearing as I don’t need it to appear all the time? by message box it is a windows exception box not a showMessageBox(). It automatically pops up when the exception hits but it will continuously hit whilst the machine boots up and re-establishes connection to the network.

The code I have is as follows

    (*Call db Procedure*)
            try
              db.SQL.Clear;
              db.SQL.Add('call dbProc();');
              db.ExecSQL;
            except
              On E : Exception Do
              begin
                If E.ClassName = 'EIBInterBaseError' Then
                  begin
                    WriteToLog('Network Error : An error has occured whilst trying to communicate with the db outside the'
                          + ' loop to catch up , please see user guide V.1.0.2.145',2);
                    reconnectdb;
                  end
                  else if E.ClassName = 'EADOError' then
                  begin
                    WriteToLog('Network Error : An error has occured whilst trying to communicate with the db outside the'
                          + ' loop to catch up , please see user guide V.1.0.2.145',2);
                    reconnectDB;
                  end;
                end;
            end;

---

Интенсив по Python: Работа с API и фреймворками 24-26 ИЮНЯ 2022. Знаете Python, но хотите расширить свои навыки?
Slurm подготовили для вас особенный продукт! Оставить заявку по ссылке — https://slurm.club/3MeqNEk

---

Online-курс Java с оплатой после трудоустройства. Каждый выпускник получает предложение о работе

И зарплату на 30% выше ожидаемой, подробнее на сайте академии, ссылка — ttps://clck.ru/fCrQw

---