Home: Code Repository: Mastering Delphi 5

Project ERRORLOG

Project Structure

ERRORLOG.DPR
LOGFORM.PAS
LOGFORM.DFM

program ErrorLog;

uses
  Forms,
  LogForm in 'LogForm.pas' {FormLog};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TFormLog, FormLog);
  Application.Run;
end.

unit LogForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, AppEvnts;

type
  TFormLog = class(TForm)
    Button1: TButton;
    Button2: TButton;
    CheckBoxSilent: TCheckBox;
    ApplicationEvents1: TApplicationEvents;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure LogException (Sender: TObject; E: Exception);
  end;

var
  FormLog: TFormLog;

implementation

{$R *.DFM}

procedure TFormLog.LogException(Sender: TObject; E: Exception);
var
  Filename: string;
  LogFile: TextFile;
begin
  // prepares log file
  Filename := ChangeFileExt (Application.Exename, '.log');
  AssignFile (LogFile, Filename);
  if FileExists (FileName) then
    Append (LogFile) // open existing file
  else
    Rewrite (LogFile); // create a new one

  // write to the file and show error
  Writeln (LogFile, DateTimeToStr (Now) + ':' + E.Message);
  if not CheckBoxSilent.Checked then
    Application.ShowException (E);

  // close the file
  CloseFile (LogFile);
end;

procedure TFormLog.Button1Click(Sender: TObject);
var
  a, b, c: Integer;
begin
  a := 10;
  b := 0;
  c := a div b;
  ShowMessage (IntToStr (c));
end;

procedure TFormLog.Button2Click(Sender: TObject);
begin
  raise Exception.Create ('raise button pressed');
end;

end.

object FormLog: TFormLog
  Left = 192
  Top = 107
  Width = 182
  Height = 163
  Caption = 'ErrorLog'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 40
    Top = 16
    Width = 75
    Height = 25
    Caption = 'Div by 0'
    TabOrder = 0
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 40
    Top = 56
    Width = 75
    Height = 25
    Caption = 'raise'
    TabOrder = 1
    OnClick = Button2Click
  end
  object CheckBoxSilent: TCheckBox
    Left = 56
    Top = 104
    Width = 57
    Height = 17
    Caption = 'Silent'
    TabOrder = 2
  end
  object ApplicationEvents1: TApplicationEvents
    OnException = LogException
    Left = 120
    Top = 16
  end
end