MessageBox und Timer(Messages)

[himitsu]

Mein Problem ist eigentlich recht einfach (denk ich mal)

Ich erstelle per MessageBoxEx eine Nachricht (innerhalb einer Fehlerbehandlung).
Nun hab ich leider mitbekommen, daß vermutlich die MessageLoop dieses Fensters auch andere Nachrichten abarbeitet.

Genauer gesagt handelt es sich bei mir um TimerNachrichten (TTimer).


Problematisch hattes es sich ergeben, daß ein Fehler innerhalb von onCreate (TForm) ergab und dieser per MessageBoxEx angezeigt werden sollte.
Nun war zu diesem Zeitpunkt natürlich die Form noch nicht vollständig initialisiert.
Aber dennoch wird wären der Anzeige dieser MessageBox die Timerprozedur aufgerufen und es kommt zu "netten" Fehlern mit einer unschönen Wirkung, dessen Ursache ich jetzt seit fast 2 Monaten gesucht hab.


Nun die Frage: Wie kann ich eine Meldung ausgeben, ohne daß eine Nachrichtenbehandlung (von "fremden" Nachrichten) auftritt?



Zusatz:
Ideal wäre es auch noch, wenn wärend der Anzeige auch noch eventuell vorhandene andere Threads im entsprechenden Prozess mit angehalten werden.

[Bernhard Geyer]

Für den Timer in diesem Formular würde ich ihn erst am Ende des onCreate-Events starten.

[himitsu]

In diesem Fall wäre diese Lösung (erst am Ende Timer antivieren) möglich ... war mir ja auch schon engefallen.

Allerdings handelt es sich um eine globale Fehlerbehandlung, welche unabhängig von diesem Formular/Timer, eigentlich sogar von dem ganzen Projekt ist.

Und demnach sollte es halt auch funktionieren, selbst wenn ein aktiver Timer, oder igendwas vergleichbares, irgendwo existiert


[add]
Es ist halt so, daß es sich um eine spezielle Fehlerbehandlung geht, welcher noch vor dem MemoryManager und der "normalen" Exceptionbehandlung greift.
Also bevor der MM und die Excetions initialisiert, nachdem sie freigegeben wurden, oder wenn in diesen ein Fehler aufritt.
Darum auch ohne VCL ... wenn ich die VCL nutzen könnte, bestünden schon Möglichkeiten zumindestens die VCL-Timer zu blocken -.-''

[alzaimar]

Wieso zeigst Du nicht einfach ein nichtmodales Fenster (.Show) und kümmerst dich selbst um die Botschaftsverarbeitung?

[SirThornberry]

die einzige Möglichkeit wird sein die Fehleranzeige in einenen eigenen Thread zu bringen. Denn die Nachrichtenschleife bezieht sich auf alle Nachrichtenbehandlungen im gleichen Thread wo sie ausgeführt wird. Es gilt also: Es wird keine oder alle Nachrichten verarbeitet. Außer du schreibst dir selbst die Nachrichtenschleife und verwirfst alle Messages die nicht zu deiner Box gehören was aber eher unschön ist.

Ich würde einfach einen Thread erstellen, diesem einen Pointer auf eine Bool-Variable übergeben und im Thread dann die Messagebox anzeigen. Wenn die Messagebox weggeklickt/bestätigt etc. wird so setzt du die Boolvariable welche im Hauptthread ständig geprüft wird. Und wenn die Boolvariable gesetzt ist gehts weiter.

[himitsu]

Speziell geht es um diese Funktionen.

BasicMessage sollte halt den aktuellen Thread sperren (solange angezeigt wird)
und bei BasicError muß alles stoppen.

Zum BasicError ist mir jetzt eingefallen, daß ich dort auch alle zum Prozess gehörenden Timer löschen und andere Threads pausieren lassen könnte (diese werden ja eh nicht mehr benötigt )


Hab aber gehofft, daß es 'ne "einfachere Möglichkeit gibt, ls das Fenser komplett selber zu machen (es sollte ja vorallem im selben Stil wie das "normale" Fehlerfenster erscheinen, was beim selbermachen nicht mehr so leicht is -.-''

Delphi-Quellcode:

Function  BasicMessage(ResStringRec: PResStringRec): Boolean;                          Overload;
Function  BasicMessage(ResStringRec: PResStringRec; P: PAnsiChar): Boolean;            Overload;
Function  BasicMessage(ResStringRec: PResStringRec; P: PWideChar): Boolean;            Overload;
Function  BasicMessage(ResStringRec: PResStringRec; Const Param: TFileNameA): Boolean; Overload;
Function  BasicMessage(ResStringRec: PResStringRec; Const Param: TFileNameW): Boolean; Overload;
Procedure BasicError  (ResStringRec: PResStringRec);                                   Overload;
Procedure BasicError  (ResStringRec: PResStringRec; P: PAnsiChar);                     Overload;
Procedure BasicError  (ResStringRec: PResStringRec; P: PWideChar);                     Overload;
Procedure BasicError  (ResStringRec: PResStringRec; Const Param: TFileNameA);          Overload;
Procedure BasicError  (ResStringRec: PResStringRec; Const Param: TFileNameW);          Overload;



// die jeweiligen Funktionen mit PWideChar sind die Hauptfunktionen

  Procedure SystemHalt;
    Begin
      If Pointer(GetPropA(GlobalUCCMessageWindow, 'LogData')) <> nil Then Begin
        LogWrite(SystemLogModule, lSystemHalt or slFatalError, @System.ExitCode, SizeOf(LongInt));
        FinalizeLogging;
      End;
      {$IFDEF UseODS} OutputDebugStringA('SystemHalt'); {$ENDIF}
      System.Halt;
    End;

  Function BasicMessage(ResStringRec: PResStringRec): Boolean;
    Const PW: PWideChar = nil;
    Begin  Result := BasicMessage(ResStringRec, PW);  End;

  Function BasicMessage(ResStringRec: PResStringRec; P: PAnsiChar): Boolean;
    Var Buffer: Array[0..2047] of WideChar;
      i: Integer;

    Begin
      If P <> nil Then Begin
        i := Min(MultiByteToWideChar(0, 0, P, InvalidValue, nil, 0), High(Buffer));
        MultiByteToWideChar(0, 0, P, InvalidValue, @Buffer, i + 1);
        Buffer[i] := #0;
      End Else Buffer[0] := #0;
      Result := BasicMessage(ResStringRec, PWideChar(@Buffer));
    End;

  Function BasicMessage(ResStringRec: PResStringRec; P: PWideChar): Boolean;
    Var Buffer: Array[0..2047] of WideChar;
      FileName: TFileNameW;
      i, i2, i3: Integer;

    Begin
      If ResStringRec^.Identifier <= $0000FFFF Then
        i := LoadStringW(FindResourceHInstance(ResStringRec^.Module^), ResStringRec^.Identifier, Buffer, SizeOf(Buffer))
      Else Begin
        i := 0;
        While (i < High(Buffer)) and (PWideCharArray(ResStringRec^.Identifier)^[i] <> #0) do Inc(i);
        Internal_CopyMem(@Buffer, Pointer(ResStringRec^.Identifier), (i + 1) * 2);
      End;
      If P <> nil Then Begin
        i2 := 0;
        While (i2 <= High(Buffer)) and (PWideCharArray(P)^[i2] <> #0) do Inc(i2);
        i3 := i - 1;
        While (i3 >= 0) and (Buffer[i3] <> #0)
          and ((Buffer[i3] <> '%') or (Buffer[i3 + 1] <> 's')) do Dec(i3);
        If i3 >= 0 Then Begin
          If i2 > SizeOf(Buffer) - i3 Then i2 := SizeOf(Buffer) - i3;
          Internal_CopyMem(@Buffer[i3 + 2], @Buffer[i3 + i2], (i - i3 - 1) * 2);
          Internal_CopyMem(P, @Buffer[i3], i2 * 2);
        End;
      End;
      {$IFDEF DebugMode} LogWrite(ExceptionsData^.LogModule, lBasicMessage or slWarning, PWideChar(@Buffer)); {$ENDIF}
      {$IFDEF UseODS} OutputDebugStringW(@Buffer); {$ENDIF}
      GetModuleFileNameW(HInstance, @FileName, MAX_PATH);
      Result := MessageBoxExW(0, @Buffer, @FileName, MB_YESNO or MB_ICONWARNING or MB_DEFBUTTON2 or MB_TASKMODAL or scLanguageBMParam, scLanguageID) = idYes;
    End;

  Function BasicMessage(ResStringRec: PResStringRec; Const Param: TFileNameA): Boolean;
    Var ParamW: TFileNameW;

    Begin
      MultiByteToWideChar(0, 0, @Param, InvalidValue, @ParamW, MAX_PATH);
      Result := BasicMessage(ResStringRec, ParamW);
    End;

  Function BasicMessage(ResStringRec: PResStringRec; Const Param: TFileNameW): Boolean;
    Begin  Result := BasicMessage(ResStringRec, PWideChar(@Param));  End;

  Procedure BasicError(ResStringRec: PResStringRec);
    Const PW: PWideChar = nil;
    Begin  BasicError(ResStringRec, PW);  End;

  Procedure BasicError(ResStringRec: PResStringRec; P: PAnsiChar);
    Var Buffer: Array[0..2047] of WideChar;
      i: Integer;

    Begin
      If P <> nil Then Begin
        i := Min(MultiByteToWideChar(0, 0, P, InvalidValue, nil, 0), High(Buffer));
        MultiByteToWideChar(0, 0, P, InvalidValue, @Buffer, i + 1);
        Buffer[i] := #0;
      End Else Buffer[0] := #0;
      BasicError(ResStringRec, PWideChar(@Buffer));
    End;

  Procedure BasicError(ResStringRec: PResStringRec; P: PWideChar);
    Var Buffer: Array[0..2047] of WideChar;
      FileName: TFileNameW;
      i, i2, i3: Integer;

    Begin
      If ResStringRec^.Identifier <= $0000FFFF Then
        i := LoadStringW(FindResourceHInstance(ResStringRec^.Module^), ResStringRec^.Identifier, Buffer, SizeOf(Buffer))
      Else Begin
        i := 0;
        While (i < High(Buffer)) and (PWideCharArray(ResStringRec^.Identifier)^[i] <> #0) do Inc(i);
        Internal_CopyMem(@Buffer, Pointer(ResStringRec^.Identifier), (i + 1) * 2);
      End;
      If P <> nil Then Begin
        i2 := 0;
        While (i2 <= High(Buffer)) and (PWideCharArray(P)^[i2] <> #0) do Inc(i2);
        i3 := i - 1;
        While (i3 >= 0) and (Buffer[i3] <> #0)
          and ((Buffer[i3] <> '%') or (Buffer[i3 + 1] <> 's')) do Dec(i3);
        If i3 >= 0 Then Begin
          If i2 > SizeOf(Buffer) - i3 Then i2 := SizeOf(Buffer) - i3;
          Internal_CopyMem(@Buffer[i3 + 2], @Buffer[i3 + i2], (i - i3 - 1) * 2);
          Internal_CopyMem(P, @Buffer[i3], i2 * 2);
        End;
      End;
      {$IFDEF DebugMode} LogWrite(ExceptionsData^.LogModule, lBasicError or slError, PWideChar(@Buffer)); {$ENDIF}
      {$IFDEF UseODS} OutputDebugStringW(@Buffer); {$ENDIF}
      GetModuleFileNameW(HInstance, @FileName, MAX_PATH);
      MessageBoxExW(0, @Buffer, @FileName, MB_OK or MB_ICONERROR or MB_TASKMODAL or scLanguageBMParam, scLanguageID);
      SystemHalt;
    End;

  Procedure BasicError(ResStringRec: PResStringRec; Const Param: TFileNameA);
    Var ParamW: TFileNameW;

    Begin
      MultiByteToWideChar(0, 0, @Param, InvalidValue, @ParamW, MAX_PATH);
      BasicError(ResStringRec, ParamW);
    End;

  Procedure BasicError(ResStringRec: PResStringRec; Const Param: TFileNameW);
    Begin  BasicError(ResStringRec, PWideChar(@Param));  End;

[add]
das mit dem eigenem thread hab ich noch nicht bedacht

[add2]
bei BasicMessage wäre es wie schon erähnt nicht schön, wenn da Messages verloren gingen.

[SirThornberry]

So, hier mal der Source wie ichs gemeint habe:

Delphi-Quellcode:

type
  TThreadWaitStruct = record
    Finished  : Boolean;
    Critical  : TCriticalSection;
    ErrorMsg  : String;
  end;
  PThreadWaitStruct = ^TThreadWaitStruct;


function GThreadFunc(Parameter: PThreadWaitStruct): Integer;
begin
  //Critical Section jetzt schon entern damit die Schleife im Hauptthread
  //beim Enter wartet und nicht 100% CPU auslastet
  Parameter.Critical.Enter;
  MessageBox(0, PChar(Parameter.ErrorMsg), 'Der Fehler', MB_OK or MB_ICONINFORMATION);
  Parameter.Finished  := True;
  Parameter.Critical.Leave;
end;

procedure ShowError(AErrorMsg: String);
var
  lThreadID : Cardinal;
  lStruct   : TThreadWaitStruct;
  lFinished : Boolean;
begin
  lStruct.Finished  := False;
  lStruct.Critical  := TCriticalSection.Create;
  lStruct.ErrorMsg  := AErrorMsg;
  BeginThread(nil, 0, @GThreadFunc, @lStruct, 0, lThreadID);

  repeat
    lStruct.Critical.Enter;
    lFinished := lStruct.Finished;
    lStruct.Critical.Leave;
  until lFinished;

  lStruct.Critical.Free;
end;

Man ruft also einfach "ShowError" auf und übergibt den anzuzeigenden Fehler.