<pre>
<code><font size=2 face="Courier New"><b>unit </b>Asserts;
<i>{$A+,B-,C-,D-,E-,F-,G+,H+,I-,J+,K-,L-,M-,N+,O+,P+,Q-,R-,S-,T-,U+,V+,W-,X+,Y-,Z1}
<br>
</i><b>interface
<br>
type
</b>TAssertionBehaviour = (abIgnore, abHalt, abDebug, abUserChoice, abDelphi);
<br>
<b>procedure </b>InitChoiceAssert(Behaviour: TAssertionBehaviour);
<b>procedure </b>DoneChoiceAssert;
<br>
<b>implementation
<br>
uses
</b>Windows, SysConst, SysUtils;
<br>
<b>type
</b>TAssertErrorProc = <b>procedure</b>(<b>const Message</b>, FileName: <b>String</b>; LineNumber: Integer; ErrorAddr: Pointer);
<br>
<b>var
</b>AssertionBehaviour: TAssertionBehaviour;
OldAssertErrorProc: TAssertErrorProc;
<br>
<b>function </b>GetUserChoice(<b>const Message</b>, Filename: <b>string</b>; LineNumber: Integer; ErrorAddr: Pointer): TAssertionBehaviour;
<b>const
</b>cNewLine = #13#10;
cUserChoiceMsg = '%s' + cNewLine +
'(%s, Zeile %d, Adresse $%x)' + cNewLine +
cNewLine +
'Wollen Sie die Anwendung beenden ("Abbrechen",' + cNewLine +
'debuggen ("Wiederholen" oder die Assertion ignorieren?';
<b>var
</b>Choice: Integer;
S: <b>string</b>;
<b>begin
</b>S := Format(cUserChoiceMsg,
[<b>Message</b>, Filename, LineNumber, Pred(Integer(ErrorAddr))]);
Choice := Windows.MessageBox(GetForegroundWindow, PChar(S), PChar(SAssertionFailed),
MB_ABORTRETRYIGNORE <b>or </b>MB_ICONERROR);
<b>case </b>Choice <b>of
</b>IDABORT:
Result := abHalt;
IDRETRY:
Result := abDebug;
<b>else </b><i>//IDIGNORE:
</i>Result := abIgnore;
<b>end</b>;
<b>end</b>;
<br>
<b>function </b>AssertAddr: PChar;
<b>asm </b><i>// get address of _Assert in System.pas
</i>MOV EAX,OFFSET System.@Assert
<b>end</b>;
<br>
<b>procedure </b>Patch(Addr: PChar);
<b>type </b><i>// patch at Addr to INT 3; CALL EDX
</i>PBreakpoint = ^TBreakpoint;
TBreakpoint = <b>packed record
</b>INT3: Byte;
CALL_EDX: Word;
<b>end</b>;
<b>var
</b>Protect: DWord;
<b>begin
if </b>VirtualProtect(Addr, SizeOf(TBreakpoint), PAGE_READWRITE, @Protect) <b>then
begin
</b>PBreakpoint(Addr).INT3 := $CC;
PBreakpoint(Addr).CALL_EDX := $D2FF;
VirtualProtect(Addr, SizeOf(TBreakpoint), Protect, <b>nil</b>);
FlushInstructionCache(GetCurrentProcess, Addr, SizeOf(TBreakpoint));
<b>end</b>;
<b>end</b>;
<br>
<b>procedure </b>Unpatch(Addr: PChar);
<b>type </b><i>// patch at Addr CALL _Assert, we restore so above patch
</i>PCall = ^TCall;
TCall = <b>packed record
</b>OpCode: Byte;
Offset: Integer;
<b>end</b>;
<b>var
</b>Protect: DWord;
<b>begin
if </b>VirtualProtect(Addr, SizeOf(TCall), PAGE_READWRITE, @Protect) <b>then
begin
</b>PCall(Addr).OpCode := $E8;
PCall(Addr).Offset := AssertAddr - Addr - SizeOf(TCall);
VirtualProtect(Addr, SizeOf(TCall), Protect, <b>nil</b>);
FlushInstructionCache(GetCurrentProcess, Addr, SizeOf(TCall));
<b>end</b>;
<b>end</b>;
</font>
</code></pre>


<code><font size=2 face="Courier New"><b>unit </b>Asserts;
<i>{$A+,B-,C-,D-,E-,F-,G+,H+,I-,J+,K-,L-,M-,N+,O+,P+,Q-,R-,S-,T-,U+,V+,W-,X+,Y-,Z1}
<br>
</i><b>interface
<br>
type
</b>TAssertionBehaviour = (abIgnore, abHalt, abDebug, abUserChoice, abDelphi);
<br>
<b>procedure </b>InitChoiceAssert(Behaviour: TAssertionBehaviour);
<b>procedure </b>DoneChoiceAssert;
<br>
<b>implementation
<br>
uses
</b>Windows, SysConst, SysUtils;
<br>
<b>type
</b>TAssertErrorProc = <b>procedure</b>(<b>const Message</b>, FileName: <b>String</b>; LineNumber: Integer; ErrorAddr: Pointer);
<br>
<b>var
</b>AssertionBehaviour: TAssertionBehaviour;
OldAssertErrorProc: TAssertErrorProc;
<br>
<b>function </b>GetUserChoice(<b>const Message</b>, Filename: <b>string</b>; LineNumber: Integer; ErrorAddr: Pointer): TAssertionBehaviour;
<b>const
</b>cNewLine = #13#10;
cUserChoiceMsg = '%s' + cNewLine +
'(%s, Zeile %d, Adresse $%x)' + cNewLine +
cNewLine +
'Wollen Sie die Anwendung beenden ("Abbrechen",' + cNewLine +
'debuggen ("Wiederholen" oder die Assertion ignorieren?';
<b>var
</b>Choice: Integer;
S: <b>string</b>;
<b>begin
</b>S := Format(cUserChoiceMsg,
[<b>Message</b>, Filename, LineNumber, Pred(Integer(ErrorAddr))]);
Choice := Windows.MessageBox(GetForegroundWindow, PChar(S), PChar(SAssertionFailed),
MB_ABORTRETRYIGNORE <b>or </b>MB_ICONERROR);
<b>case </b>Choice <b>of
</b>IDABORT:
Result := abHalt;
IDRETRY:
Result := abDebug;
<b>else </b><i>//IDIGNORE:
</i>Result := abIgnore;
<b>end</b>;
<b>end</b>;
<br>
<b>function </b>AssertAddr: PChar;
<b>asm </b><i>// get address of _Assert in System.pas
</i>MOV EAX,OFFSET System.@Assert
<b>end</b>;
<br>
<b>procedure </b>Patch(Addr: PChar);
<b>type </b><i>// patch at Addr to INT 3; CALL EDX
</i>PBreakpoint = ^TBreakpoint;
TBreakpoint = <b>packed record
</b>INT3: Byte;
CALL_EDX: Word;
<b>end</b>;
<b>var
</b>Protect: DWord;
<b>begin
if </b>VirtualProtect(Addr, SizeOf(TBreakpoint), PAGE_READWRITE, @Protect) <b>then
begin
</b>PBreakpoint(Addr).INT3 := $CC;
PBreakpoint(Addr).CALL_EDX := $D2FF;
VirtualProtect(Addr, SizeOf(TBreakpoint), Protect, <b>nil</b>);
FlushInstructionCache(GetCurrentProcess, Addr, SizeOf(TBreakpoint));
<b>end</b>;
<b>end</b>;
<br>
<b>procedure </b>Unpatch(Addr: PChar);
<b>type </b><i>// patch at Addr CALL _Assert, we restore so above patch
</i>PCall = ^TCall;
TCall = <b>packed record
</b>OpCode: Byte;
Offset: Integer;
<b>end</b>;
<b>var
</b>Protect: DWord;
<b>begin
if </b>VirtualProtect(Addr, SizeOf(TCall), PAGE_READWRITE, @Protect) <b>then
begin
</b>PCall(Addr).OpCode := $E8;
PCall(Addr).Offset := AssertAddr - Addr - SizeOf(TCall);
VirtualProtect(Addr, SizeOf(TCall), Protect, <b>nil</b>);
FlushInstructionCache(GetCurrentProcess, Addr, SizeOf(TCall));
<b>end</b>;
<b>end</b>;
</font>
</code></pre>


Comment