LogMessageDlg - Erweiterung der MessageDLG-Funktion um einen Logeintrag

[Delphi-Delphin]

Hallo,

Ich war jetzt schon recht lange nicht mehr hier aktiv, hab aber immer mal nach nützlichen Funktionen gesucht.
Ich bin zwar schon vor längerer Zeit auf Lazarus umgestiegen, da es aktueller und plattformunabhängig ist, aber der Code lässt sich meistens recht gut übernehmen.

Nun möchte ich hier auch eine nützliche Funktion einbringen. Diese werde ich auch im Delphi-Treff veröffentlichen.
@Mods: Wenn das Unterforum nicht passt bitte verschieben.

Da ich für ein Forensiktool auf eine recht detaillierte Aufzeichung der Programmbedienung angewiesen bin, habe ich die normale MessageDlg-Funktion(en) um eine Erstellung von Logeinträgen erweitert.
Es sollten alle Argumentkombinationen der Originalfunktion, welche ja überladen ist enthalten sein.

Am Aufruf der Funktionen ist als erster Parameter die Eventlogkomponente dazugekommen. Danach folgen die normalen MessageDlg-Parameter und am Schluss ein optionaler Parameter, um den Logeintrag mit "false" zu deaktivieren.
Das ModalResult der Message wird als Result durchgereicht.

Delphi-Quellcode:

unit LogDialogs;
//LogMessageDlg-functions

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Dialogs, eventlog, Forms;

function LogMessageDlg(Eventlog: TEventlog; const aMsg: string; DlgType: TMsgDlgType;
            Buttons: TMsgDlgButtons; HelpCtx: Longint; LogThis: boolean=True): TModalResult; overload;
function LogMessageDlg(Eventlog: TEventlog; const aCaption, aMsg: string; DlgType: TMsgDlgType;
            Buttons: TMsgDlgButtons; HelpCtx: Longint; LogThis: boolean=True): TModalResult; overload;
function LogMessageDlg(Eventlog: TEventlog; const aCaption, aMsg: string; DlgType: TMsgDlgType;
            Buttons: TMsgDlgButtons; HelpCtx: Longint; DefaultButton: TMsgDlgBtn; LogThis: boolean=True): TModalResult; overload;
function LogMessageDlg(Eventlog: TEventlog; const aMsg: string; DlgType: TMsgDlgType;
            Buttons: TMsgDlgButtons; HelpCtx: Longint; DefaultButton: TMsgDlgBtn; LogThis: boolean=True): TModalResult; overload;
function LogMessageDlg(Eventlog: TEventlog; const aCaption, aMsg: string; DlgType: TMsgDlgType;
            Buttons: TMsgDlgButtons; const HelpKeyword: string; LogThis: boolean=True): TModalResult; overload;
function LogMessageDlgPos(Eventlog: TEventlog; const aMsg: string; DlgType: TMsgDlgType;
            Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer; LogThis: boolean=True): TModalResult; overload;
function LogMessageDlgPosHelp(Eventlog: TEventlog; const aMsg: string; DlgType: TMsgDlgType;
            Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer;
            const HelpFileName: string; LogThis: boolean=True): TModalResult; overload;

implementation

(*
function MessageDlg(const aMsg: string; DlgType: TMsgDlgType;
            Buttons: TMsgDlgButtons; HelpCtx: Longint): TModalResult; overload;
function MessageDlg(const aCaption, aMsg: string; DlgType: TMsgDlgType;
            Buttons: TMsgDlgButtons; HelpCtx: Longint): TModalResult; overload;
function MessageDlg(const aCaption, aMsg: string; DlgType: TMsgDlgType;
            Buttons: TMsgDlgButtons; HelpCtx: Longint; DefaultButton: TMsgDlgBtn): TModalResult; overload;
function MessageDlg(const aMsg: string; DlgType: TMsgDlgType;
            Buttons: TMsgDlgButtons; HelpCtx: Longint; DefaultButton: TMsgDlgBtn): TModalResult; overload;
function MessageDlg(const aCaption, aMsg: string; DlgType: TMsgDlgType;
            Buttons: TMsgDlgButtons; const HelpKeyword: string): TModalResult; overload;
function MessageDlgPos(const aMsg: string; DlgType: TMsgDlgType;
            Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer): TModalResult; overload;
function MessageDlgPosHelp(const aMsg: string; DlgType: TMsgDlgType;
            Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer;
            const HelpFileName: string): TModalResult; overload;
*)

function MsgDlgTypeToString(MsgDlgType: TMsgDlgType): string;
begin
  Case MsgDlgType of
    mtWarning: Result:='mtWarning';
    mtError: Result:='mtError';
    mtInformation: Result:='mtInformation';
    mtConfirmation: Result:='mtConfirmation';
    mtCustom: Result:='mtCustom';
  end;
end;

function MsgDlgButtonsToString(MsgDlgButtons: TMsgDlgButtons): String;
var s: String;
begin
  s := '';
  if mbYes in MsgDlgButtons
    then
      s := s + ',mbYes';
  if mbNo in MsgDlgButtons
    then
      s := s + ',mbNo';
  if mbOK in MsgDlgButtons
    then
      s := s + ',mbOK';
  if mbCancel in MsgDlgButtons
    then
      s := s + ',mbCancel';
  if mbAbort in MsgDlgButtons
    then
      s := s + ',mbAbort';
  if mbRetry in MsgDlgButtons
    then
      s := s + ',mbRetry';
  if mbIgnore in MsgDlgButtons
    then
      s := s + ',mbIgnore';
  if mbAll in MsgDlgButtons
    then
      s := s + ',mbAll';
  if mbNoToAll in MsgDlgButtons
    then
      s := s + ',mbNoToAll';
  if mbYesToAll in MsgDlgButtons
    then
      s := s + ',mbYesToAll';
  if mbHelp in MsgDlgButtons
    then
      s := s + ',mbHelp';
  if mbClose in MsgDlgButtons
    then
      s := s + ',mbClose';

  Result := '['+Copy(s,2,Length(s)-1)+']';
end;

function ModalResultToString(ModalResult: TModalResult): string;
begin
  Case ModalResult of
    0: Result:='mrNone';
    1: Result:='mrOK';
    2: Result:='mrCancel';
    3: Result:='mrAbort';
    4: Result:='mrRetry';
    5: Result:='mrIgnore';
    6: Result:='mrYes';
    7: Result:='mrNo';
    8: Result:='mrAll';
    9: Result:='mrNoToAll';
    10: Result:='mrYesToAll';
    11: Result:='mrClose';
  end;
end;

(*
  Eventlog.LogType = etCustom,etInfo,etWarning,etError,etDebug
  TMsgDlgType    = (mtWarning, mtError, mtInformation, mtConfirmation,
                    mtCustom);
  TMsgDlgBtn     = (mbYes, mbNo, mbOK, mbCancel, mbAbort, mbRetry, mbIgnore,
                    mbAll, mbNoToAll, mbYesToAll, mbHelp, mbClose);
  TMsgDlgButtons = set of TMsgDlgBtn;
*)


function LogMessageDlg(Eventlog: TEventlog; const aMsg: string; DlgType: TMsgDlgType;
            Buttons: TMsgDlgButtons; HelpCtx: Longint; LogThis: boolean=True): TModalResult; overload;
var Answer: TModalResult;
begin
  Answer := MessageDlg(aMsg, DlgType, Buttons, HelpCtx);

  if LogThis
    then
      Eventlog.Log(etInfo,'Messagetype: '+MsgDlgTypeToString(DlgType)+', Message: "'+aMsg+'", Buttons: '+MsgDlgButtonsToString(Buttons)+', Answer: '+ModalResultToString(Answer));

  Result := Answer;
end;

function LogMessageDlg(Eventlog: TEventlog; const aCaption, aMsg: string; DlgType: TMsgDlgType;
            Buttons: TMsgDlgButtons; HelpCtx: Longint; LogThis: boolean=True): TModalResult; overload;
var Answer: TModalResult;
begin
  Answer := MessageDlg(aCaption, aMsg, DlgType, Buttons, HelpCtx);

  if LogThis
    then
      Eventlog.Log(etInfo,'Messagetype: '+MsgDlgTypeToString(DlgType)+', Caption: "'+aCaption+'", Message: "'+aMsg+'", Buttons: '+MsgDlgButtonsToString(Buttons)+', Answer: '+ModalResultToString(Answer));

  Result := Answer;
end;

function LogMessageDlg(Eventlog: TEventlog; const aCaption, aMsg: string; DlgType: TMsgDlgType;
            Buttons: TMsgDlgButtons; HelpCtx: Longint; DefaultButton: TMsgDlgBtn; LogThis: boolean=True): TModalResult; overload;
var Answer: TModalResult;
begin
  Answer := MessageDlg(aCaption, aMsg, DlgType, Buttons, HelpCtx, DefaultButton);

  if LogThis
    then
      Eventlog.Log(etInfo,'Messagetype: '+MsgDlgTypeToString(DlgType)+', Caption: "'+aCaption+'", Message: "'+aMsg+'", Buttons: '+MsgDlgButtonsToString(Buttons)+', Answer: '+ModalResultToString(Answer));

  Result := Answer;
end;

function LogMessageDlg(Eventlog: TEventlog; const aMsg: string; DlgType: TMsgDlgType;
            Buttons: TMsgDlgButtons; HelpCtx: Longint; DefaultButton: TMsgDlgBtn; LogThis: boolean=True): TModalResult; overload;
var Answer: TModalResult;
begin
  Answer := MessageDlg(aMsg, DlgType, Buttons, HelpCtx, DefaultButton);

  if LogThis
    then
      Eventlog.Log(etInfo,'Messagetype: '+MsgDlgTypeToString(DlgType)+', Message: "'+aMsg+'", Buttons: '+MsgDlgButtonsToString(Buttons)+', Answer: '+ModalResultToString(Answer));

  Result := Answer;
end;

function LogMessageDlg(Eventlog: TEventlog; const aCaption, aMsg: string; DlgType: TMsgDlgType;
            Buttons: TMsgDlgButtons; const HelpKeyword: string; LogThis: boolean=True): TModalResult; overload;
var Answer: TModalResult;
begin
  Answer := MessageDlg(aCaption, aMsg, DlgType, Buttons, HelpKeyword);

  if LogThis
    then
      Eventlog.Log(etInfo,'Messagetype: '+MsgDlgTypeToString(DlgType)+', Caption: "'+aCaption+'", Message: "'+aMsg+'", Buttons: '+MsgDlgButtonsToString(Buttons)+', Answer: '+ModalResultToString(Answer));

  Result := Answer;
end;

function LogMessageDlgPos(Eventlog: TEventlog; const aMsg: string; DlgType: TMsgDlgType;
            Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer; LogThis: boolean=True): TModalResult; overload;
var Answer: TModalResult;
begin
  Answer := MessageDlgPos(aMsg, DlgType, Buttons, HelpCtx, X, Y);

  if LogThis
    then
      Eventlog.Log(etInfo,'Messagetype: '+MsgDlgTypeToString(DlgType)+', Message: "'+aMsg+'", Buttons: '+MsgDlgButtonsToString(Buttons)+', Answer: '+ModalResultToString(Answer));

  Result := Answer;
end;

function LogMessageDlgPosHelp(Eventlog: TEventlog; const aMsg: string; DlgType: TMsgDlgType;
            Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer;
            const HelpFileName: string; LogThis: boolean=True): TModalResult; overload;
var Answer: TModalResult;
begin
  Answer := MessageDlgPosHelp(aMsg, DlgType, Buttons, HelpCtx, x, y, HelpFileName);

  if LogThis
    then
      Eventlog.Log(etInfo,'Messagetype: '+MsgDlgTypeToString(DlgType)+', Message: "'+aMsg+'", Buttons: '+MsgDlgButtonsToString(Buttons)+', Answer: '+ModalResultToString(Answer));

  Result := Answer;
end;


end.

Wer Fehler oder Verbesserungen findet, einfach hier unten schreiben.

Möglicher Funtionsaufruf:

Delphi-Quellcode:

  EventLog1.Active:=True;
  LogMessageDlg(Eventlog1,'Test',mtConfirmation,[mbYes,mbNo],0);
  LogMessageDlg(Eventlog1,'Fehler','Es ist ein Fehler aufgetreten!',mtError,[mbOK],0);

Logeinträge sehen z.B. so aus:

Code:

lazarus [2017-03-13 18:11:03.057 Info] Messagetype: mtConfirmation, Message: "Test", Buttons: [mbYes,mbNo], Answer: mrNo
lazarus [2017-03-13 18:11:06.037 Info] Messagetype: mtError, Caption: "Fehler", Message: "Es ist ein Fehler aufgetreten!", Buttons: [mbOK], Answer: mrOK

mfg.

[hoika]

Hallo,
warum steht die Event-Komponente nicht hinter den Standard-Argumenten,
dann gleich noch mit = nil als Default-Parameter und man kann den Dialog auch optional ohne Logging verwenden,
indem man sogar die Event-Komponente beim Aufruf weglassen kann.
Ausserdem muss man dann nicht sämtliche Aufruf-Parameter im Programm ersetzen, sondern ändert erst mal nur den Namen der Prozedur.

[Hobbycoder]

Zitat von hoika:

Hallo,
warum steht die Event-Komponente nicht hinter den Standard-Argumenten,
dann gleich noch mit = nil als Default-Parameter und man kann den Dialog auch optional ohne Logging verwenden,
indem man sogar die Event-Komponente beim Aufruf weglassen kann.
Ausserdem muss man dann nicht sämtliche Aufruf-Parameter im Programm ersetzen, sondern ändert erst mal nur den Namen der Prozedur.

Was außerdem den Vorteil hätte, dass man sich den Parameter LogThis sparen könnte. if EventLog<>nil then ... statt if LogThis then ...

[uligerhardt]

Kleine Randbemerkung: MsgDlgTypeToString und MsgDlgButtonsToString könntest du mit System.TypInfo.GetEnumName und "for Low(...) to High(...)" vereinfachen.