我今天在这里,因为我尝试使用Delphi 5和RTLUnwind来捕捉程序的每个例外都会遇到麻烦。
问题是它遇到了错误,但它在...之后立即关闭了我的程序 当我尝试调试时,会出现访问冲突。
以下是此捕获的完整代码:
unit ExceptLog;
interface
implementation
uses SysUtils, Windows, U_Test, Dialogs;
type
PCardinal = ^Cardinal;
PtrUInt = cardinal;
PPtrUInt = ^PtrUInt;
PExceptionRecord = ^TExceptionRecord;
TExceptionRecord =
record
ExceptionCode : LongWord;
ExceptionFlags : LongWord;
OuterException : PExceptionRecord;
ExceptionAddress : Pointer;
NumberParameters : Longint;
case {IsOsException:} Boolean of
True : (ExceptionInformation : array [0..14] of Longint);
False : (ExceptAddr: Pointer; ExceptObject: Pointer);
end;
var
// Declaration for Delphi 5
oldRTLUnwindProc: procedure; stdcall;
RTLUnWindProc: pointer;
procedure MyRtlUnwind; stdcall;
var
s : string;
PER : PExceptionRecord;
E: Exception;
begin
asm
mov eax, dword ptr [EBP+8+13*4]
mov PER, eax
end;
if PER^.ExceptionFlags and 1=1 then
begin
try
E := Exception(PER^.ExceptObject);
if (E is Exception) then
begin
s:= 'Delphi exception, type : ' + E.ClassName + ', message: ' + E.Message;
OutputDebugString(PChar(s));
_MessageDlg(s, mtInformation, [mbOk], 0);
end;
except
end;
end;
asm
mov esp, ebp
pop ebp
jmp oldRTLUnwindProc // here come the access violation
end;
end;
{--------------------------------------------------------------------------------------------------}
procedure PatchCodePtrUInt(Code: PPtrUInt; Value: PtrUInt);
var RestoreProtection, Ignore: DWORD;
begin
if VirtualProtect(Code, SizeOf(Code^), PAGE_EXECUTE_READWRITE, RestoreProtection) then
begin
Code^ := Value;
VirtualProtect(Code, SizeOf(Code^), RestoreProtection, Ignore);
FlushInstructionCache(GetCurrentProcess, Code, SizeOf(Code^));
end;
end;
{--------------------------------------------------------------------------------------------------}
procedure Patch(P: PAnsiChar);
var
i: Integer;
addr: PAnsiChar;
begin
for i:= 0 to 31 do
begin
if (PCardinal(P)^ = $6850006a) and (PWord(P+8)^ = $E852) then
begin
inc(P, 10);
if PInteger(P)^<0 then
begin
addr := P+4+PInteger(P)^;
if PWord(addr)^=$25FF then
begin
PatchCodePtrUInt(Pointer(addr+2),cardinal(@RTLUnwindProc));
exit;
end;
end;
end else
inc(P);
end;
end;
{--------------------------------------------------------------------------------------------------}
procedure PatchCallRtlUnWind;
asm
mov eax,offset System.@HandleAnyException+200
call Patch
end;
{--------------------------------------------------------------------------------------------------}
procedure InitExceptionLogging;
begin
oldRTLUnWindProc := RTLUnwindProc;
RTLUnwindProc := @MyRtlUnwind;
PatchCallRtlUnWind;
end;
{--------------------------------------------------------------------------------------------------}
initialization
InitExceptionLogging;
end.
我不是Delphi 5的专家(我的企业使用过),我希望有人能够帮助我。
祝你好运!
P.S:U_Test只是一个包含&#34; _MessageDlg&#34;创建和显示对话框消息的函数。