Menu
▾
▴
jcl-checkins-diff
|
From: <ou...@us...> - 2006-09-12 21:39:17
|
Revision: 1764
http://svn.sourceforge.net/jcl/?rev=1764&view=rev
Author: outchy
Date: 2006-09-12 14:39:02 -0700 (Tue, 12 Sep 2006)
Log Message:
-----------
Fixed possible DEP issue
Modified Paths:
--------------
trunk/jcl/experts/debug/dialog/ClxExceptDlg.pas
trunk/jcl/experts/debug/dialog/ExceptDlg.pas
trunk/jcl/experts/debug/dialog/ExceptDlgMail.pas
Modified: trunk/jcl/experts/debug/dialog/ClxExceptDlg.pas
===================================================================
--- trunk/jcl/experts/debug/dialog/ClxExceptDlg.pas 2006-09-12 21:38:25 UTC (rev 1763)
+++ trunk/jcl/experts/debug/dialog/ClxExceptDlg.pas 2006-09-12 21:39:02 UTC (rev 1764)
@@ -198,7 +198,7 @@
TApplicationHandleExceptionAddr, SysUtilsShowExceptionAddr: Pointer;
CALLInstruction: TCALLInstruction;
CallAddress: Pointer;
- NW: DWORD;
+ OldProtect, Dummy: DWORD;
function CheckAddressForOffset(Offset: Cardinal): Boolean;
begin
@@ -224,10 +224,16 @@
Result := CheckAddressForOffset(CallOffset) or CheckAddressForOffset(CallOffsetDebug);
if Result then
begin
- CALLInstruction.Address := Integer(@HookShowException) - Integer(CallAddress) - SizeOf(CALLInstruction);
- Result := WriteProcessMemory(GetCurrentProcess, CallAddress, @CALLInstruction, SizeOf(CALLInstruction), NW);
+ Result := VirtualProtect(CallAddress, sizeof(CallInstruction), PAGE_EXECUTE_READWRITE, OldProtect);
if Result then
- FlushInstructionCache(GetCurrentProcess, CallAddress, SizeOf(CALLInstruction));
+ try
+ CALLInstruction.Address := Integer(@HookShowException) - Integer(CallAddress) - SizeOf(CALLInstruction);
+ PCALLInstruction(CallAddress)^ := CALLInstruction;
+ if Result then
+ FlushInstructionCache(GetCurrentProcess, CallAddress, SizeOf(CALLInstruction));
+ finally
+ VirtualProtect(CallAddress, sizeof(CallInstruction), OldProtect, Dummy);
+ end;
end;
end;
Modified: trunk/jcl/experts/debug/dialog/ExceptDlg.pas
===================================================================
--- trunk/jcl/experts/debug/dialog/ExceptDlg.pas 2006-09-12 21:38:25 UTC (rev 1763)
+++ trunk/jcl/experts/debug/dialog/ExceptDlg.pas 2006-09-12 21:39:02 UTC (rev 1764)
@@ -190,7 +190,7 @@
TApplicationHandleExceptionAddr, SysUtilsShowExceptionAddr: Pointer;
CALLInstruction: TCALLInstruction;
CallAddress: Pointer;
- NW: DWORD;
+ OldProtect, Dummy: DWORD;
function CheckAddressForOffset(Offset: Cardinal): Boolean;
begin
@@ -216,10 +216,16 @@
Result := CheckAddressForOffset(CallOffset) or CheckAddressForOffset(CallOffsetDebug);
if Result then
begin
- CALLInstruction.Address := Integer(@HookShowException) - Integer(CallAddress) - SizeOf(CALLInstruction);
- Result := WriteProcessMemory(GetCurrentProcess, CallAddress, @CALLInstruction, SizeOf(CALLInstruction), NW);
+ Result := VirtualProtect(CallAddress, sizeof(CallInstruction), PAGE_EXECUTE_READWRITE, OldProtect);
if Result then
- FlushInstructionCache(GetCurrentProcess, CallAddress, SizeOf(CALLInstruction));
+ try
+ CALLInstruction.Address := Integer(@HookShowException) - Integer(CallAddress) - SizeOf(CALLInstruction);
+ PCALLInstruction(CallAddress)^ := CALLInstruction;
+ if Result then
+ FlushInstructionCache(GetCurrentProcess, CallAddress, SizeOf(CALLInstruction));
+ finally
+ VirtualProtect(CallAddress, sizeof(CallInstruction), OldProtect, Dummy);
+ end;
end;
end;
Modified: trunk/jcl/experts/debug/dialog/ExceptDlgMail.pas
===================================================================
--- trunk/jcl/experts/debug/dialog/ExceptDlgMail.pas 2006-09-12 21:38:25 UTC (rev 1763)
+++ trunk/jcl/experts/debug/dialog/ExceptDlgMail.pas 2006-09-12 21:39:02 UTC (rev 1764)
@@ -195,7 +195,7 @@
TApplicationHandleExceptionAddr, SysUtilsShowExceptionAddr: Pointer;
CALLInstruction: TCALLInstruction;
CallAddress: Pointer;
- NW: DWORD;
+ OldProtect, Dummy: DWORD;
function CheckAddressForOffset(Offset: Cardinal): Boolean;
begin
@@ -221,10 +221,16 @@
Result := CheckAddressForOffset(CallOffset) or CheckAddressForOffset(CallOffsetDebug);
if Result then
begin
- CALLInstruction.Address := Integer(@HookShowException) - Integer(CallAddress) - SizeOf(CALLInstruction);
- Result := WriteProcessMemory(GetCurrentProcess, CallAddress, @CALLInstruction, SizeOf(CALLInstruction), NW);
+ Result := VirtualProtect(CallAddress, sizeof(CallInstruction), PAGE_EXECUTE_READWRITE, OldProtect);
if Result then
- FlushInstructionCache(GetCurrentProcess, CallAddress, SizeOf(CALLInstruction));
+ try
+ CALLInstruction.Address := Integer(@HookShowException) - Integer(CallAddress) - SizeOf(CALLInstruction);
+ PCALLInstruction(CallAddress)^ := CALLInstruction;
+ if Result then
+ FlushInstructionCache(GetCurrentProcess, CallAddress, SizeOf(CALLInstruction));
+ finally
+ VirtualProtect(CallAddress, sizeof(CallInstruction), OldProtect, Dummy);
+ end;
end;
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <usc...@us...> - 2007-02-10 13:01:02
|
Revision: 1916
http://svn.sourceforge.net/jcl/?rev=1916&view=rev
Author: uschuster
Date: 2007-02-10 05:01:00 -0800 (Sat, 10 Feb 2007)
Log Message:
-----------
fixed to compile without KEEP_DEPRECATED
Modified Paths:
--------------
trunk/jcl/experts/debug/dialog/ExceptDlg.Delphi32.pas
trunk/jcl/experts/debug/dialog/ExceptDlg.pas
Modified: trunk/jcl/experts/debug/dialog/ExceptDlg.Delphi32.pas
===================================================================
--- trunk/jcl/experts/debug/dialog/ExceptDlg.Delphi32.pas 2007-02-08 17:41:45 UTC (rev 1915)
+++ trunk/jcl/experts/debug/dialog/ExceptDlg.Delphi32.pas 2007-02-10 13:01:00 UTC (rev 1916)
@@ -94,7 +94,7 @@
uses
ClipBrd, Math,
- JclBase, JclFileUtils, JclHookExcept, JclPeImage, JclStrings, JclSysInfo;
+ JclBase, JclFileUtils, JclHookExcept, JclPeImage, JclStrings, JclSysInfo, JclWin32;
resourcestring
RsAppError = '%s - application error';
@@ -284,13 +284,15 @@
%if ModuleList SL: TStringList;
I: Integer;
ModuleName: TFileName;
- NtHeaders: PImageNtHeaders;
+ NtHeaders32: PImageNtHeaders32;
+ NtHeaders64: PImageNtHeaders64;
ModuleBase: Cardinal;
ImageBaseStr: string;%endif
%if ActiveControls C: TWinControl;%endif
%if OSInfo CpuInfo: TCpuInfo;
ProcessorDetails: string;%endif
%if StackList StackList: TJclStackInfoList;%endif
+ PETarget: TJclPeTarget;
begin
SL := TStringList.Create;
try
@@ -346,10 +348,20 @@
ModuleName := SL[I];
ModuleBase := Cardinal(SL.Objects[I]);
DetailsMemo.Lines.Add(Format('[%.8x] %s', [ModuleBase, ModuleName]));
- NtHeaders := PeMapImgNtHeaders(Pointer(ModuleBase));
- if (NtHeaders <> nil) and (NtHeaders^.OptionalHeader.ImageBase <> ModuleBase) then
- ImageBaseStr := Format('<%.8x> ', [NtHeaders^.OptionalHeader.ImageBase])
+ PETarget := PeMapImgTarget(Pointer(ModuleBase));
+ NtHeaders32 := nil;
+ NtHeaders64 := nil;
+ if PETarget = taWin32 then
+ NtHeaders32 := PeMapImgNtHeaders32(Pointer(ModuleBase))
else
+ if PETarget = taWin64 then
+ NtHeaders64 := PeMapImgNtHeaders64(Pointer(ModuleBase));
+ if (NtHeaders32 <> nil) and (NtHeaders32^.OptionalHeader.ImageBase <> ModuleBase) then
+ ImageBaseStr := Format('<%.8x> ', [NtHeaders32^.OptionalHeader.ImageBase])
+ else
+ if (NtHeaders64 <> nil) and (NtHeaders64^.OptionalHeader.ImageBase <> ModuleBase) then
+ ImageBaseStr := Format('<%.8x> ', [NtHeaders64^.OptionalHeader.ImageBase])
+ else
ImageBaseStr := StrRepeat(' ', 11);
if VersionResourceAvailable(ModuleName) then
with TJclFileVersionInfo.Create(ModuleName) do
Modified: trunk/jcl/experts/debug/dialog/ExceptDlg.pas
===================================================================
--- trunk/jcl/experts/debug/dialog/ExceptDlg.pas 2007-02-08 17:41:45 UTC (rev 1915)
+++ trunk/jcl/experts/debug/dialog/ExceptDlg.pas 2007-02-10 13:01:00 UTC (rev 1916)
@@ -118,7 +118,7 @@
uses
ClipBrd, Math,
- JclBase, JclFileUtils, JclHookExcept, JclPeImage, JclStrings, JclSysInfo, JclSysUtils;
+ JclBase, JclFileUtils, JclHookExcept, JclPeImage, JclStrings, JclSysInfo, JclSysUtils, JclWin32;
resourcestring
RsAppError = '%s - application error';
@@ -406,10 +406,12 @@
ModuleName: TFileName;
CpuInfo: TCpuInfo;
C: TWinControl;
- NtHeaders: PImageNtHeaders;
+ NtHeaders32: PImageNtHeaders32;
+ NtHeaders64: PImageNtHeaders64;
ModuleBase: Cardinal;
ImageBaseStr: string;
StackList: TJclStackInfoList;
+ PETarget: TJclPeTarget;
begin
SL := TStringList.Create;
try
@@ -447,10 +449,20 @@
ModuleName := SL[I];
ModuleBase := Cardinal(SL.Objects[I]);
DetailsMemo.Lines.Add(Format('[%.8x] %s', [ModuleBase, ModuleName]));
- NtHeaders := PeMapImgNtHeaders(Pointer(ModuleBase));
- if (NtHeaders <> nil) and (NtHeaders^.OptionalHeader.ImageBase <> ModuleBase) then
- ImageBaseStr := Format('<%.8x> ', [NtHeaders^.OptionalHeader.ImageBase])
+ PETarget := PeMapImgTarget(Pointer(ModuleBase));
+ NtHeaders32 := nil;
+ NtHeaders64 := nil;
+ if PETarget = taWin32 then
+ NtHeaders32 := PeMapImgNtHeaders32(Pointer(ModuleBase))
else
+ if PETarget = taWin64 then
+ NtHeaders64 := PeMapImgNtHeaders64(Pointer(ModuleBase));
+ if (NtHeaders32 <> nil) and (NtHeaders32^.OptionalHeader.ImageBase <> ModuleBase) then
+ ImageBaseStr := Format('<%.8x> ', [NtHeaders32^.OptionalHeader.ImageBase])
+ else
+ if (NtHeaders64 <> nil) and (NtHeaders64^.OptionalHeader.ImageBase <> ModuleBase) then
+ ImageBaseStr := Format('<%.8x> ', [NtHeaders64^.OptionalHeader.ImageBase])
+ else
ImageBaseStr := StrRepeat(' ', 11);
if VersionResourceAvailable(ModuleName) then
with TJclFileVersionInfo.Create(ModuleName) do
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2007-02-22 08:29:19
|
Revision: 1947
http://svn.sourceforge.net/jcl/?rev=1947&view=rev
Author: outchy
Date: 2007-02-22 00:29:11 -0800 (Thu, 22 Feb 2007)
Log Message:
-----------
Extracted runtime code of the repository expert
Introduction of CreateStdDialogs.dpr to generate standard exception dialogs: ExceptDlg.dfm ExceptDlg.pas ExceptDlgMail.dfm ExceptDlgMail.pas
Side note: regenerating ExceptDlg.pas makes examples successfully compiled.
Modified Paths:
--------------
trunk/jcl/experts/debug/dialog/ExceptDlg.dfm
trunk/jcl/experts/debug/dialog/ExceptDlg.pas
trunk/jcl/experts/debug/dialog/ExceptDlgMail.dfm
trunk/jcl/experts/debug/dialog/ExceptDlgMail.pas
trunk/jcl/experts/debug/dialog/JclOtaExcDlgRepository.pas
trunk/jcl/experts/debug/dialog/JclOtaRepositoryReg.pas
trunk/jcl/experts/debug/dialog/JclOtaRepositoryUtils.pas
trunk/jcl/experts/debug/dialog/JclOtaTemplates.pas
Added Paths:
-----------
trunk/jcl/experts/debug/dialog/CreateStdDialogs.dpr
Added: trunk/jcl/experts/debug/dialog/CreateStdDialogs.dpr
===================================================================
--- trunk/jcl/experts/debug/dialog/CreateStdDialogs.dpr (rev 0)
+++ trunk/jcl/experts/debug/dialog/CreateStdDialogs.dpr 2007-02-22 08:29:11 UTC (rev 1947)
@@ -0,0 +1,84 @@
+program CreateStdDialogs;
+
+{$APPTYPE CONSOLE}
+
+uses
+ SysUtils,
+ Classes,
+ JclBorlandTools,
+ JclOtaTemplates in 'JclOtaTemplates.pas',
+ JclOtaExcDlgRepository in 'JclOtaExcDlgRepository.pas';
+
+function LoadTemplate(const FileName: string): string;
+var
+ AFileStream: TFileStream;
+begin
+ AFileStream := TFileStream.Create(FileName, fmOpenRead, fmShareDenyWrite);
+ try
+ SetLength(Result, AFileStream.Size);
+ AFileStream.ReadBuffer(Result[1], AFileStream.Size);
+ finally
+ AFileStream.Free;
+ end;
+end;
+
+procedure SaveFile(const FileName, FileContent: string);
+var
+ AFileStream: TFileStream;
+begin
+ AFileStream := TFileStream.Create(FileName, fmOpenWrite, fmShareExclusive);
+ try
+ AFileStream.Size := 0;
+ AFileStream.Write(FileContent[1], Length(FileContent));
+ finally
+ AFileStream.Free;
+ end;
+end;
+
+var
+ Params: TJclOtaExcDlgParams;
+begin
+ try
+ Params := TJclOtaExcDlgParams.Create;
+ try
+ Params.ActivePersonality := bpDelphi32;
+ Params.FormName := 'ExceptionDialog';
+ Params.FormAncestor := 'TForm';
+ Params.ModalDialog := True;
+ Params.SendEMail := False;
+ Params.SizeableDialog := True;
+ Params.AutoScrollBars := True;
+ Params.DelayedTrace := True;
+ Params.HookDll := True;
+ Params.LogFile := True;
+ Params.LogFileName := '''filename.log''';
+ Params.OSInfo := True;
+ Params.ModuleList := True;
+ Params.ActiveControls := True;
+ Params.MainThreadOnly := False;
+ Params.TraceAllExceptions := False;
+ Params.StackList := True;
+ Params.RawData := True;
+ Params.ModuleName := True;
+ Params.ModuleOffset := True;
+ Params.CodeDetails := True;
+ Params.VirtualAddress := True;
+
+ SaveFile('ExceptDlg.pas', GetFinalSourceContent(ApplyTemplate(LoadTemplate('ExceptDlg.Delphi32.pas'), Params), 'ExceptDlg', 'ExceptionDialog', 'TForm'));
+ SaveFile('ExceptDlg.dfm', GetFinalSourceContent(ApplyTemplate(LoadTemplate('ExceptDlg.Delphi32.dfm'), Params), 'ExceptDlg', 'ExceptionDialog', 'TForm'));
+
+ Params.FormName := 'ExceptionDialogMail';
+ Params.SendEMail := True;
+ Params.EMailAddress := '''na...@do...''';
+ Params.EMailSubject := '''email subject''';
+
+ SaveFile('ExceptDlgMail.pas', GetFinalSourceContent(ApplyTemplate(LoadTemplate('ExceptDlg.Delphi32.pas'), Params), 'ExceptDlgMail', 'ExceptionDialogMail', 'TForm'));
+ SaveFile('ExceptDlgMail.dfm', GetFinalSourceContent(ApplyTemplate(LoadTemplate('ExceptDlg.Delphi32.dfm'), Params), 'ExceptDlgMail', 'ExceptionDialogMail', 'TForm'));
+ finally
+ Params.Free;
+ end;
+ except
+ on E:Exception do
+ Writeln(E.Classname, ': ', E.Message);
+ end;
+end.
Property changes on: trunk/jcl/experts/debug/dialog/CreateStdDialogs.dpr
___________________________________________________________________
Name: svn:keywords
+ URL HeadURL Author LastChangedBy Date LastChangedDate Rev Revision LastChangedRevision Id
Name: svn:eol-style
+ native
Modified: trunk/jcl/experts/debug/dialog/ExceptDlg.dfm
===================================================================
--- trunk/jcl/experts/debug/dialog/ExceptDlg.dfm 2007-02-21 22:34:14 UTC (rev 1946)
+++ trunk/jcl/experts/debug/dialog/ExceptDlg.dfm 2007-02-22 08:29:11 UTC (rev 1947)
@@ -1,9 +1,8 @@
object ExceptionDialog: TExceptionDialog
- Left = 363
- Top = 284
- ActiveControl = OkBtn
- AutoScroll = False
+ Left = 310
+ Top = 255
BorderIcons = [biSystemMenu]
+
Caption = 'ExceptionDialog'
ClientHeight = 255
ClientWidth = 432
@@ -26,14 +25,32 @@
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 13
- object Bevel1: TBevel
+ object BevelDetails: TBevel
Left = 3
Top = 91
- Width = 428
+ Width = 422
Height = 9
Anchors = [akLeft, akTop, akRight]
Shape = bsTopLine
end
+
+ object TextLabel: TMemo
+ Left = 56
+ Top = 8
+ Width = 281
+ Height = 75
+ Hint = 'Use Ctrl+C to copy the report to the clipboard'
+ Anchors = [akLeft, akTop, akRight]
+ BorderStyle = bsNone
+ Ctl3D = True
+ Lines.Strings = (
+ 'TextLabel')
+ ParentColor = True
+ ParentCtl3D = False
+ ReadOnly = True
+ TabOrder = 1
+ WantReturns = False
+ end
object OkBtn: TButton
Left = 352
Top = 4
@@ -43,13 +60,25 @@
Caption = '&OK'
Default = True
ModalResult = 1
- TabOrder = 1
+ TabOrder = 2
end
+ object DetailsBtn: TButton
+ Left = 352
+ Top = 60
+ Width = 75
+ Height = 25
+ Hint = 'Show or hide additional information|'
+ Anchors = [akTop, akRight]
+ Caption = '&Details'
+ Enabled = False
+ TabOrder = 3
+ OnClick = DetailsBtnClick
+ end
object DetailsMemo: TMemo
Left = 4
Top = 101
- Width = 424
- Height = 150
+ Width = 421
+ Height = 147
Anchors = [akLeft, akTop, akRight, akBottom]
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
@@ -60,37 +89,8 @@
ParentFont = False
ReadOnly = True
ScrollBars = ssBoth
- TabOrder = 3
+ TabOrder = 4
WantReturns = False
WordWrap = False
end
- object DetailsBtn: TButton
- Left = 352
- Top = 60
- Width = 75
- Height = 25
- Hint = 'Show or hide additional information|'
- Anchors = [akTop, akRight]
- Caption = '&Details'
- Enabled = False
- TabOrder = 2
- OnClick = DetailsBtnClick
- end
- object TextLabel: TMemo
- Left = 56
- Top = 8
- Width = 281
- Height = 75
- Hint = 'Use Ctrl+C to copy the report to the clipboard'
- Anchors = [akLeft, akTop, akRight]
- BorderStyle = bsNone
- Ctl3D = True
- Lines.Strings = (
- 'TextLabel')
- ParentColor = True
- ParentCtl3D = False
- ReadOnly = True
- TabOrder = 0
- WantReturns = False
- end
end
Modified: trunk/jcl/experts/debug/dialog/ExceptDlg.pas
===================================================================
--- trunk/jcl/experts/debug/dialog/ExceptDlg.pas 2007-02-21 22:34:14 UTC (rev 1946)
+++ trunk/jcl/experts/debug/dialog/ExceptDlg.pas 2007-02-22 08:29:11 UTC (rev 1947)
@@ -1,74 +1,49 @@
-{**************************************************************************************************}
-{ }
-{ Project JEDI Code Library (JCL) }
-{ }
-{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
-{ you may not use this file except in compliance with the License. You may obtain a copy of the }
-{ License at http://www.mozilla.org/MPL/ }
-{ }
-{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
-{ ANY KIND, either express or implied. See the License for the specific language governing rights }
-{ and limitations under the License. }
-{ }
-{ The Original Code is ExceptDlg.pas. }
-{ }
-{ The Initial Developer of the Original Code is Petr Vones. }
-{ Portions created by Petr Vones are Copyright (C) of Petr Vones. }
-{ }
-{**************************************************************************************************}
-{ }
-{ Sample Application exception dialog replacement }
-{ }
-{ Last modified: $Date$ }
-{ }
-{**************************************************************************************************}
+{****************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License }
+{ Version 1.1 (the "License"); you may not use this file except in }
+{ compliance with the License. You may obtain a copy of the License at }
+{ http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, }
+{ WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License }
+{ for the specific language governing rights and limitations under the }
+{ License. }
+{ }
+{ The Original Code is ExceptDlg.pas. }
+{ }
+{ The Initial Developer of the Original Code is Petr Vones. }
+{ Portions created by Petr Vones are Copyright (C) of Petr Vones. }
+{ }
+{****************************************************************************}
+{ }
+{ Last modified: $Date$ }
+{ }
+{****************************************************************************}
unit ExceptDlg;
-{$I jcl.inc}
-
interface
uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- StdCtrls, ExtCtrls, JclDebug;
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
+ Dialogs, StdCtrls, ExtCtrls,
+ JclSysUtils, JclDebug;
const
UM_CREATEDETAILS = WM_USER + $100;
- ReportToLogEnabled = $00000001; // TExceptionDialog.Tag property
- DisableTextScrollbar = $00000002; // TExceptionDialog.Tag property
-
type
- TSimpleExceptionLog = class (TObject)
- private
- FLogFileHandle: THandle;
- FLogFileName: string;
- FLogWasEmpty: Boolean;
- function GetLogOpen: Boolean;
- protected
- function CreateDefaultFileName: string;
- public
- constructor Create(const ALogFileName: string = '');
- destructor Destroy; override;
- procedure CloseLog;
- procedure OpenLog;
- procedure Write(const Text: string; Indent: Integer = 0); overload;
- procedure Write(Strings: TStrings; Indent: Integer = 0); overload;
- procedure WriteStamp(SeparatorLen: Integer = 0);
- property LogFileName: string read FLogFileName;
- property LogOpen: Boolean read GetLogOpen;
- end;
-
- TExcDialogSystemInfo = (siStackList, siOsInfo, siModuleList, siActiveControls);
- TExcDialogSystemInfos = set of TExcDialogSystemInfo;
-
TExceptionDialog = class(TForm)
+
+ TextLabel: TMemo;
OkBtn: TButton;
- DetailsMemo: TMemo;
DetailsBtn: TButton;
- Bevel1: TBevel;
- TextLabel: TMemo;
+ BevelDetails: TBevel;
+ DetailsMemo: TMemo;
+
procedure FormPaint(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
@@ -77,22 +52,22 @@
procedure FormDestroy(Sender: TObject);
procedure FormResize(Sender: TObject);
private
+ private
FDetailsVisible: Boolean;
FIsMainThead: Boolean;
FLastActiveControl: TWinControl;
FNonDetailsHeight: Integer;
FFullHeight: Integer;
- FSimpleLog: TSimpleExceptionLog;
- procedure CreateDetails;
- function GetReportAsText: string;
+ FSimpleLog: TJclSimpleLog;
procedure ReportToLog;
+ function GetReportAsText: string;
procedure SetDetailsVisible(const Value: Boolean);
procedure UMCreateDetails(var Message: TMessage); message UM_CREATEDETAILS;
protected
procedure AfterCreateDetails; dynamic;
procedure BeforeCreateDetails; dynamic;
- procedure CreateDetailInfo; dynamic;
- procedure CreateReport(const SystemInfo: TExcDialogSystemInfos);
+ procedure CreateDetails; dynamic;
+ procedure CreateReport;
function ReportMaxColumns: Integer; virtual;
function ReportNewBlockDelimiterChar: Char; virtual;
procedure NextDetailBlock;
@@ -102,9 +77,10 @@
class procedure ExceptionHandler(Sender: TObject; E: Exception);
class procedure ExceptionThreadHandler(Thread: TJclDebugThread);
class procedure ShowException(E: Exception; Thread: TJclDebugThread);
- property DetailsVisible: Boolean read FDetailsVisible write SetDetailsVisible;
+ property DetailsVisible: Boolean read FDetailsVisible
+ write SetDetailsVisible;
property ReportAsText: string read GetReportAsText;
- property SimpleLog: TSimpleExceptionLog read FSimpleLog;
+ property SimpleLog: TJclSimpleLog read FSimpleLog;
end;
TExceptionDialogClass = class of TExceptionDialog;
@@ -114,11 +90,11 @@
implementation
-{$R *.DFM}
+{$R *.dfm}
uses
ClipBrd, Math,
- JclBase, JclFileUtils, JclHookExcept, JclPeImage, JclStrings, JclSysInfo, JclSysUtils, JclWin32;
+ JclBase, JclFileUtils, JclHookExcept, JclPeImage, JclStrings, JclSysInfo, JclWin32;
resourcestring
RsAppError = '%s - application error';
@@ -127,7 +103,8 @@
RsStackList = 'Stack list, generated %s';
RsModulesList = 'List of loaded modules:';
RsOSVersion = 'System : %s %s, Version: %d.%d, Build: %x, "%s"';
- RsProcessor = 'Processor: %s, %s, %d MHz %s%s';
+ RsProcessor = 'Processor: %s, %s, %d MHz';
+ RsMemory = 'Memory: %d; free %d';
RsScreenRes = 'Display : %dx%d pixels, %d bpp';
RsActiveControl = 'Active Controls hierarchy:';
RsThread = 'Thread: %s';
@@ -136,29 +113,30 @@
var
ExceptionDialog: TExceptionDialog;
-//==================================================================================================
+//============================================================================
// Helper routines
-//==================================================================================================
+//============================================================================
-function GetBPP: Integer;
+// SortModulesListByAddressCompare
+// sorts module by address
+function SortModulesListByAddressCompare(List: TStringList;
+ Index1, Index2: Integer): Integer;
var
- DC: HDC;
+ Addr1, Addr2: Cardinal;
begin
- DC := GetDC(0);
- Result := GetDeviceCaps(DC, BITSPIXEL) * GetDeviceCaps(DC, PLANES);
- ReleaseDC(0, DC);
+ Addr1 := Cardinal(List.Objects[Index1]);
+ Addr2 := Cardinal(List.Objects[Index2]);
+ if Addr1 > Addr2 then
+ Result := 1
+ else if Addr1 < Addr2 then
+ Result := -1
+ else
+ Result := 0;
end;
-//--------------------------------------------------------------------------------------------------
-
-function SortModulesListByAddressCompare(List: TStringList; Index1, Index2: Integer): Integer;
-begin
- Result := Integer(List.Objects[Index1]) - Integer(List.Objects[Index2]);
-end;
-
-//==================================================================================================
+//============================================================================
// TApplication.HandleException method code hooking for exceptions from DLLs
-//==================================================================================================
+//============================================================================
// We need to catch the last line of TApplication.HandleException method:
// [...]
@@ -168,13 +146,14 @@
procedure HookShowException(ExceptObject: TObject; ExceptAddr: Pointer);
begin
- if JclValidateModuleAddress(ExceptAddr) and (ExceptObject.InstanceSize >= Exception.InstanceSize) then
+ if JclValidateModuleAddress(ExceptAddr)
+ and (ExceptObject.InstanceSize >= Exception.InstanceSize) then
TExceptionDialog.ExceptionHandler(nil, Exception(ExceptObject))
else
SysUtils.ShowException(ExceptObject, ExceptAddr);
end;
-//--------------------------------------------------------------------------------------------------
+//----------------------------------------------------------------------------
function HookTApplicationHandleException: Boolean;
const
@@ -190,7 +169,7 @@
TApplicationHandleExceptionAddr, SysUtilsShowExceptionAddr: Pointer;
CALLInstruction: TCALLInstruction;
CallAddress: Pointer;
- OldProtect, Dummy: DWORD;
+ WrittenBytes: Cardinal;
function CheckAddressForOffset(Offset: Cardinal): Boolean;
begin
@@ -207,7 +186,7 @@
end;
except
Result := False;
- end;
+ end;
end;
begin
@@ -216,171 +195,55 @@
Result := CheckAddressForOffset(CallOffset) or CheckAddressForOffset(CallOffsetDebug);
if Result then
begin
- Result := VirtualProtect(CallAddress, sizeof(CallInstruction), PAGE_EXECUTE_READWRITE, OldProtect);
- if Result then
- try
- CALLInstruction.Address := Integer(@HookShowException) - Integer(CallAddress) - SizeOf(CALLInstruction);
- PCALLInstruction(CallAddress)^ := CALLInstruction;
- if Result then
- FlushInstructionCache(GetCurrentProcess, CallAddress, SizeOf(CALLInstruction));
- finally
- VirtualProtect(CallAddress, sizeof(CallInstruction), OldProtect, Dummy);
- end;
+ CALLInstruction.Address := Integer(@HookShowException) - Integer(CallAddress) - SizeOf(CALLInstruction);
+ Result := WriteProtectedMemory(CallAddress, @CallInstruction, SizeOf(CallInstruction), WrittenBytes);
end;
end;
-//==================================================================================================
-// TSimpleExceptionLog
-//==================================================================================================
+//============================================================================
+// Exception dialog with Send
+//============================================================================
-procedure TSimpleExceptionLog.CloseLog;
-begin
- if LogOpen then
- begin
- CloseHandle(FLogFileHandle);
- FLogFileHandle := INVALID_HANDLE_VALUE;
- FLogWasEmpty := False;
- end;
-end;
+var
+ ExceptionShowing: Boolean;
-//--------------------------------------------------------------------------------------------------
+//=== { TExceptionDialog } ===============================================
-constructor TSimpleExceptionLog.Create(const ALogFileName: string);
+procedure TExceptionDialog.AfterCreateDetails;
begin
- if ALogFileName = '' then
- FLogFileName := CreateDefaultFileName
- else
- FLogFileName := ALogFileName;
- FLogFileHandle := INVALID_HANDLE_VALUE;
-end;
-//--------------------------------------------------------------------------------------------------
-
-function TSimpleExceptionLog.CreateDefaultFileName: string;
-begin
- Result := PathExtractFileDirFixed(ParamStr(0)) + PathExtractFileNameNoExt(ParamStr(0)) + '_Err.log';
end;
-//--------------------------------------------------------------------------------------------------
+//----------------------------------------------------------------------------
-destructor TSimpleExceptionLog.Destroy;
+procedure TExceptionDialog.BeforeCreateDetails;
begin
- CloseLog;
- inherited;
-end;
-//--------------------------------------------------------------------------------------------------
-
-function TSimpleExceptionLog.GetLogOpen: Boolean;
-begin
- Result := FLogFileHandle <> INVALID_HANDLE_VALUE;
end;
-//--------------------------------------------------------------------------------------------------
+//----------------------------------------------------------------------------
-procedure TSimpleExceptionLog.OpenLog;
+function TExceptionDialog.ReportMaxColumns: Integer;
begin
- if not LogOpen then
- begin
- FLogFileHandle := CreateFile(PChar(FLogFileName), GENERIC_WRITE, FILE_SHARE_READ, nil,
- OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
- if LogOpen then
- FLogWasEmpty := SetFilePointer(FLogFileHandle, 0, nil, FILE_END) = 0;
- end
- else
- FLogWasEmpty := False;
+ Result := 78;
end;
-//--------------------------------------------------------------------------------------------------
-procedure TSimpleExceptionLog.Write(const Text: string; Indent: Integer);
-var
- S: string;
- SL: TStringList;
- I: Integer;
-begin
- if LogOpen then
- begin
- SL := TStringList.Create;
- try
- SL.Text := Text;
- for I := 0 to SL.Count - 1 do
- begin
- S := StringOfChar(' ', Indent) + StrEnsureSuffix(AnsiCrLf, TrimRight(SL[I]));
- FileWrite(Integer(FLogFileHandle), Pointer(S)^, Length(S));
- end;
- finally
- SL.Free;
- end;
- end;
-end;
+//----------------------------------------------------------------------------
-//--------------------------------------------------------------------------------------------------
-
-procedure TSimpleExceptionLog.Write(Strings: TStrings; Indent: Integer);
-var
- I: Integer;
-begin
- for I := 0 to Strings.Count - 1 do
- Write(Strings[I], Indent);
-end;
-
-//--------------------------------------------------------------------------------------------------
-
-procedure TSimpleExceptionLog.WriteStamp(SeparatorLen: Integer);
-begin
- if SeparatorLen = 0 then
- SeparatorLen := 100;
- SeparatorLen := Max(SeparatorLen, 20);
- OpenLog;
- if not FLogWasEmpty then
- Write(AnsiCrLf);
- Write(StrRepeat('=', SeparatorLen));
- Write(Format('= %-*s =', [SeparatorLen - 4, DateTimeToStr(Now)]));
- Write(StrRepeat('=', SeparatorLen));
-end;
-
-//==================================================================================================
-// Exception dialog
-//==================================================================================================
-
-var
- ExceptionShowing: Boolean;
-
-{ TExceptionDialog }
-
-procedure TExceptionDialog.AfterCreateDetails;
-begin
-end;
-
-//--------------------------------------------------------------------------------------------------
-
-procedure TExceptionDialog.BeforeCreateDetails;
-begin
-end;
-
-//--------------------------------------------------------------------------------------------------
-
procedure TExceptionDialog.CopyReportToClipboard;
begin
ClipBoard.AsText := ReportAsText;
end;
-//--------------------------------------------------------------------------------------------------
+//----------------------------------------------------------------------------
-procedure TExceptionDialog.CreateDetailInfo;
-begin
- CreateReport([siStackList, siOsInfo, siModuleList, siActiveControls]);
-end;
-
-//--------------------------------------------------------------------------------------------------
-
procedure TExceptionDialog.CreateDetails;
begin
Screen.Cursor := crHourGlass;
DetailsMemo.Lines.BeginUpdate;
try
- CreateDetailInfo;
+ CreateReport;
ReportToLog;
DetailsMemo.SelStart := 0;
SendMessage(DetailsMemo.Handle, EM_SCROLLCARET, 0, 0);
@@ -394,53 +257,69 @@
end;
end;
-//--------------------------------------------------------------------------------------------------
+//----------------------------------------------------------------------------
-procedure TExceptionDialog.CreateReport(const SystemInfo: TExcDialogSystemInfos);
-const
- MMXText: array[Boolean] of PChar = ('', 'MMX');
- FDIVText: array[Boolean] of PChar = (' [FDIV Bug]', '');
+procedure TExceptionDialog.CreateReport;
var
SL: TStringList;
I: Integer;
ModuleName: TFileName;
- CpuInfo: TCpuInfo;
- C: TWinControl;
NtHeaders32: PImageNtHeaders32;
NtHeaders64: PImageNtHeaders64;
ModuleBase: Cardinal;
ImageBaseStr: string;
+ C: TWinControl;
+ CpuInfo: TCpuInfo;
+ ProcessorDetails: string;
StackList: TJclStackInfoList;
PETarget: TJclPeTarget;
begin
SL := TStringList.Create;
try
// Stack list
- if siStackList in SystemInfo then
+ StackList := JclLastExceptStackList;
+ if Assigned(StackList) then
begin
- StackList := JclLastExceptStackList;
- if Assigned(StackList) then
- begin
- DetailsMemo.Lines.Add(Format(RsStackList, [DateTimeToStr(StackList.TimeStamp)]));
- StackList.AddToStrings(DetailsMemo.Lines, False, True, True);
- NextDetailBlock;
- end;
+ DetailsMemo.Lines.Add(Format(RsStackList, [DateTimeToStr(StackList.TimeStamp)]));
+ StackList.AddToStrings(DetailsMemo.Lines, True, True, True, True);
+ NextDetailBlock;
end;
+
+
// System and OS information
- if siOsInfo in SystemInfo then
+ DetailsMemo.Lines.Add(Format(RsOSVersion, [GetWindowsVersionString, NtProductTypeString,
+ Win32MajorVersion, Win32MinorVersion, Win32BuildNumber, Win32CSDVersion]));
+ GetCpuInfo(CpuInfo);
+ with CpuInfo do
begin
- DetailsMemo.Lines.Add(Format(RsOSVersion, [GetWindowsVersionString, NtProductTypeString,
- Win32MajorVersion, Win32MinorVersion, Win32BuildNumber, Win32CSDVersion]));
- GetCpuInfo(CpuInfo);
- with CpuInfo do
- DetailsMemo.Lines.Add(Format(RsProcessor, [Manufacturer, CpuName,
- RoundFrequency(FrequencyInfo.NormFreq),
- MMXText[MMX], FDIVText[IsFDIVOK]]));
- DetailsMemo.Lines.Add(Format(RsScreenRes, [Screen.Width, Screen.Height, GetBPP]));
- NextDetailBlock;
+ ProcessorDetails := Format(RsProcessor, [Manufacturer, CpuName,
+ RoundFrequency(FrequencyInfo.NormFreq)]);
+ if not IsFDIVOK then
+ ProcessorDetails := ProcessorDetails + ' [FDIV Bug]';
+ if ExMMX then
+ ProcessorDetails := ProcessorDetails + ' MMXex'
+ else if MMX then
+ ProcessorDetails := ProcessorDetails + ' MMX';
+ if SSE > 0 then
+ ProcessorDetails := Format('%s SSE%d', [ProcessorDetails, SSE]);
+ if Ex3DNow then
+ ProcessorDetails := ProcessorDetails + ' 3DNow!ex'
+ else if _3DNow then
+ ProcessorDetails := ProcessorDetails + ' 3DNow!';
+ if Is64Bits then
+ ProcessorDetails := ProcessorDetails + ' 64 bits';
+ if DEPCapable then
+ ProcessorDetails := ProcessorDetails + ' DEP';
end;
+ DetailsMemo.Lines.Add(ProcessorDetails);
+ DetailsMemo.Lines.Add(Format(RsMemory, [GetTotalPhysicalMemory div 1024 div 1024,
+ GetFreePhysicalMemory div 1024 div 1024]));
+ DetailsMemo.Lines.Add(Format(RsScreenRes, [Screen.Width, Screen.Height, GetBPP]));
+ NextDetailBlock;
+
+
// Modules list
- if (siModuleList in SystemInfo) and LoadedModulesList(SL, GetCurrentProcessId) then
+ if LoadedModulesList(SL, GetCurrentProcessId) then
begin
DetailsMemo.Lines.Add(RsModulesList);
SL.CustomSort(SortModulesListByAddressCompare);
@@ -478,8 +357,10 @@
end;
NextDetailBlock;
end;
+
+
// Active controls
- if (siActiveControls in SystemInfo) and (FLastActiveControl <> nil) then
+ if (FLastActiveControl <> nil) then
begin
DetailsMemo.Lines.Add(RsActiveControl);
C := FLastActiveControl;
@@ -490,6 +371,7 @@
end;
NextDetailBlock;
end;
+
finally
SL.Free;
end;
@@ -508,7 +390,7 @@
begin
if ExceptionShowing then
Application.ShowException(E)
- else
+ else if Assigned(E) and not IsIgnoredException(E.ClassType) then
begin
ExceptionShowing := True;
try
@@ -540,7 +422,7 @@
procedure TExceptionDialog.FormCreate(Sender: TObject);
begin
- FSimpleLog := TSimpleExceptionLog.Create;
+ FSimpleLog := TJclSimpleLog.Create('filename.log');
FFullHeight := ClientHeight;
DetailsVisible := False;
Caption := Format(RsAppError, [Application.Title]);
@@ -588,7 +470,7 @@
if FIsMainThead and (GetWindowThreadProcessId(Handle, nil) = MainThreadID) then
PostMessage(Handle, UM_CREATEDETAILS, 0, 0)
else
- CreateDetails;
+ CreateReport;
end;
//--------------------------------------------------------------------------------------------------
@@ -607,13 +489,6 @@
//--------------------------------------------------------------------------------------------------
-function TExceptionDialog.ReportMaxCo...
[truncated message content] |
|
From: <sch...@us...> - 2007-04-23 09:32:21
|
Revision: 2001
http://svn.sourceforge.net/jcl/?rev=2001&view=rev
Author: schuettecarsten
Date: 2007-04-23 02:30:21 -0700 (Mon, 23 Apr 2007)
Log Message:
-----------
Fixed bug in ExceptDlg when Linker has removed TApplication.HandleException
Modified Paths:
--------------
trunk/jcl/experts/debug/dialog/ExceptDlg.Delphi32.pas
trunk/jcl/experts/debug/dialog/ExceptDlg.pas
Modified: trunk/jcl/experts/debug/dialog/ExceptDlg.Delphi32.pas
===================================================================
--- trunk/jcl/experts/debug/dialog/ExceptDlg.Delphi32.pas 2007-04-20 17:01:29 UTC (rev 2000)
+++ trunk/jcl/experts/debug/dialog/ExceptDlg.Delphi32.pas 2007-04-23 09:30:21 UTC (rev 2001)
@@ -195,12 +195,17 @@
begin
TApplicationHandleExceptionAddr := PeMapImgResolvePackageThunk(@TApplication.HandleException);
SysUtilsShowExceptionAddr := PeMapImgResolvePackageThunk(@SysUtils.ShowException);
- Result := CheckAddressForOffset(CallOffset) or CheckAddressForOffset(CallOffsetDebug);
- if Result then
+ if Assigned(TApplicationHandleExceptionAddr) and Assigned(SysUtilsShowExceptionAddr) then
begin
- CALLInstruction.Address := Integer(@HookShowException) - Integer(CallAddress) - SizeOf(CALLInstruction);
- Result := WriteProtectedMemory(CallAddress, @CallInstruction, SizeOf(CallInstruction), WrittenBytes);
- end;
+ Result := CheckAddressForOffset(CallOffset) or CheckAddressForOffset(CallOffsetDebug);
+ if Result then
+ begin
+ CALLInstruction.Address := Integer(@HookShowException) - Integer(CallAddress) - SizeOf(CALLInstruction);
+ Result := WriteProtectedMemory(CallAddress, @CallInstruction, SizeOf(CallInstruction), WrittenBytes);
+ end;
+ end
+ else
+ Result := False;
end;
//============================================================================
Modified: trunk/jcl/experts/debug/dialog/ExceptDlg.pas
===================================================================
--- trunk/jcl/experts/debug/dialog/ExceptDlg.pas 2007-04-20 17:01:29 UTC (rev 2000)
+++ trunk/jcl/experts/debug/dialog/ExceptDlg.pas 2007-04-23 09:30:21 UTC (rev 2001)
@@ -194,11 +194,14 @@
begin
TApplicationHandleExceptionAddr := PeMapImgResolvePackageThunk(@TApplication.HandleException);
SysUtilsShowExceptionAddr := PeMapImgResolvePackageThunk(@SysUtils.ShowException);
- Result := CheckAddressForOffset(CallOffset) or CheckAddressForOffset(CallOffsetDebug);
- if Result then
+ if Assigned(TApplicationHandleExceptionAddr) and Assigned(SysUtilsShowExceptionAddr) then
begin
- CALLInstruction.Address := Integer(@HookShowException) - Integer(CallAddress) - SizeOf(CALLInstruction);
- Result := WriteProtectedMemory(CallAddress, @CallInstruction, SizeOf(CallInstruction), WrittenBytes);
+ Result := CheckAddressForOffset(CallOffset) or CheckAddressForOffset(CallOffsetDebug);
+ if Result then
+ begin
+ CALLInstruction.Address := Integer(@HookShowException) - Integer(CallAddress) - SizeOf(CALLInstruction);
+ Result := WriteProtectedMemory(CallAddress, @CallInstruction, SizeOf(CallInstruction), WrittenBytes);
+ end;
end;
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <sch...@us...> - 2007-04-26 16:23:06
|
Revision: 2003
http://svn.sourceforge.net/jcl/?rev=2003&view=rev
Author: schuettecarsten
Date: 2007-04-26 09:23:00 -0700 (Thu, 26 Apr 2007)
Log Message:
-----------
Added lost "AutoScroll=False" in dfm files (lost in Rev 1947)
Fixed compiler warning, added changes from Rev 2001 also to ExceptDlgMail.pas
Revision Links:
--------------
http://svn.sourceforge.net/jcl/?rev=1947&view=rev
http://svn.sourceforge.net/jcl/?rev=2001&view=rev
Modified Paths:
--------------
trunk/jcl/experts/debug/dialog/ExceptDlg.Delphi32.dfm
trunk/jcl/experts/debug/dialog/ExceptDlg.dfm
trunk/jcl/experts/debug/dialog/ExceptDlg.pas
trunk/jcl/experts/debug/dialog/ExceptDlgMail.dfm
trunk/jcl/experts/debug/dialog/ExceptDlgMail.pas
Modified: trunk/jcl/experts/debug/dialog/ExceptDlg.Delphi32.dfm
===================================================================
--- trunk/jcl/experts/debug/dialog/ExceptDlg.Delphi32.dfm 2007-04-23 15:56:38 UTC (rev 2002)
+++ trunk/jcl/experts/debug/dialog/ExceptDlg.Delphi32.dfm 2007-04-26 16:23:00 UTC (rev 2003)
@@ -1,6 +1,7 @@
object %FORMNAME%: T%FORMNAME%
Left = 310
Top = 255
+ AutoScroll = False
BorderIcons = [biSystemMenu]
%ifnot SizeableDialog BorderStyle = bsDialog%endif
Caption = '%FORMNAME%'
Modified: trunk/jcl/experts/debug/dialog/ExceptDlg.dfm
===================================================================
--- trunk/jcl/experts/debug/dialog/ExceptDlg.dfm 2007-04-23 15:56:38 UTC (rev 2002)
+++ trunk/jcl/experts/debug/dialog/ExceptDlg.dfm 2007-04-26 16:23:00 UTC (rev 2003)
@@ -1,6 +1,7 @@
object ExceptionDialog: TExceptionDialog
Left = 310
Top = 255
+ AutoScroll = False
BorderIcons = [biSystemMenu]
Caption = 'ExceptionDialog'
Modified: trunk/jcl/experts/debug/dialog/ExceptDlg.pas
===================================================================
--- trunk/jcl/experts/debug/dialog/ExceptDlg.pas 2007-04-23 15:56:38 UTC (rev 2002)
+++ trunk/jcl/experts/debug/dialog/ExceptDlg.pas 2007-04-26 16:23:00 UTC (rev 2003)
@@ -202,7 +202,9 @@
CALLInstruction.Address := Integer(@HookShowException) - Integer(CallAddress) - SizeOf(CALLInstruction);
Result := WriteProtectedMemory(CallAddress, @CallInstruction, SizeOf(CallInstruction), WrittenBytes);
end;
- end;
+ end
+ else
+ Result := False;
end;
//============================================================================
Modified: trunk/jcl/experts/debug/dialog/ExceptDlgMail.dfm
===================================================================
--- trunk/jcl/experts/debug/dialog/ExceptDlgMail.dfm 2007-04-23 15:56:38 UTC (rev 2002)
+++ trunk/jcl/experts/debug/dialog/ExceptDlgMail.dfm 2007-04-26 16:23:00 UTC (rev 2003)
@@ -1,6 +1,7 @@
object ExceptionDialogMail: TExceptionDialogMail
Left = 310
Top = 255
+ AutoScroll = False
BorderIcons = [biSystemMenu]
Caption = 'ExceptionDialogMail'
Modified: trunk/jcl/experts/debug/dialog/ExceptDlgMail.pas
===================================================================
--- trunk/jcl/experts/debug/dialog/ExceptDlgMail.pas 2007-04-23 15:56:38 UTC (rev 2002)
+++ trunk/jcl/experts/debug/dialog/ExceptDlgMail.pas 2007-04-26 16:23:00 UTC (rev 2003)
@@ -194,12 +194,17 @@
begin
TApplicationHandleExceptionAddr := PeMapImgResolvePackageThunk(@TApplication.HandleException);
SysUtilsShowExceptionAddr := PeMapImgResolvePackageThunk(@SysUtils.ShowException);
- Result := CheckAddressForOffset(CallOffset) or CheckAddressForOffset(CallOffsetDebug);
- if Result then
+ if Assigned(TApplicationHandleExceptionAddr) and Assigned(SysUtilsShowExceptionAddr) then
begin
- CALLInstruction.Address := Integer(@HookShowException) - Integer(CallAddress) - SizeOf(CALLInstruction);
- Result := WriteProtectedMemory(CallAddress, @CallInstruction, SizeOf(CallInstruction), WrittenBytes);
- end;
+ Result := CheckAddressForOffset(CallOffset) or CheckAddressForOffset(CallOffsetDebug);
+ if Result then
+ begin
+ CALLInstruction.Address := Integer(@HookShowException) - Integer(CallAddress) - SizeOf(CALLInstruction);
+ Result := WriteProtectedMemory(CallAddress, @CallInstruction, SizeOf(CallInstruction), WrittenBytes);
+ end;
+ end
+ else
+ Result := False;
end;
//============================================================================
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <sch...@us...> - 2007-05-23 09:32:26
|
Revision: 2014
http://svn.sourceforge.net/jcl/?rev=2014&view=rev
Author: schuettecarsten
Date: 2007-05-23 02:32:18 -0700 (Wed, 23 May 2007)
Log Message:
-----------
ExceptDlg now uses AppEvnts to add itself to TApplication.OnException.
Modified Paths:
--------------
trunk/jcl/experts/debug/dialog/ExceptDlg.Delphi32.pas
trunk/jcl/experts/debug/dialog/ExceptDlg.pas
trunk/jcl/experts/debug/dialog/ExceptDlgMail.pas
Modified: trunk/jcl/experts/debug/dialog/ExceptDlg.Delphi32.pas
===================================================================
--- trunk/jcl/experts/debug/dialog/ExceptDlg.Delphi32.pas 2007-05-22 19:58:20 UTC (rev 2013)
+++ trunk/jcl/experts/debug/dialog/ExceptDlg.Delphi32.pas 2007-05-23 09:32:18 UTC (rev 2014)
@@ -29,7 +29,7 @@
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
- Dialogs, StdCtrls, ExtCtrls,
+ Dialogs, StdCtrls, ExtCtrls, AppEvnts,
JclSysUtils,%if SendEMail JclMapi,%endif JclDebug;
const
@@ -665,29 +665,39 @@
// Exception handler initialization code
//==================================================================================================
+var
+ AppEvents: TApplicationEvents = nil;
+
procedure InitializeHandler;
begin
-%repeatline IgnoredExceptionsCount AddIgnoredException(%IgnoredExceptions);
-%if TraceEAbort RemoveIgnoredException(EAbort);%endif
-%if TraceAllExceptions JclStackTrackingOptions := JclStackTrackingOptions + [stTraceAllExceptions];%endif
-%if RawData JclStackTrackingOptions := JclStackTrackingOptions + [stRawMode];%endif
-%if HookDll JclStackTrackingOptions := JclStackTrackingOptions + [stStaticModuleList];%endif
-%if DelayedTrace JclStackTrackingOptions := JclStackTrackingOptions + [stDelayedTrace];%endif
- JclDebugThreadList.OnSyncException := T%FORMNAME%.ExceptionThreadHandler;
- JclStartExceptionTracking;
-%if HookDll if HookTApplicationHandleException then
- JclTrackExceptionsFromLibraries;%endif
- Application.OnException := T%FORMNAME%.ExceptionHandler;
+ if AppEvents = nil then
+ begin
+ AppEvents := TApplicationEvents.Create(nil);
+ AppEvents.OnException := T%FORMNAME%.ExceptionHandler;
+%repeatline IgnoredExceptionsCount AddIgnoredException(%IgnoredExceptions);
+%if TraceEAbort RemoveIgnoredException(EAbort);%endif
+%if TraceAllExceptions JclStackTrackingOptions := JclStackTrackingOptions + [stTraceAllExceptions];%endif
+%if RawData JclStackTrackingOptions := JclStackTrackingOptions + [stRawMode];%endif
+%if HookDll JclStackTrackingOptions := JclStackTrackingOptions + [stStaticModuleList];%endif
+%if DelayedTrace JclStackTrackingOptions := JclStackTrackingOptions + [stDelayedTrace];%endif
+ JclDebugThreadList.OnSyncException := T%FORMNAME%.ExceptionThreadHandler;
+ JclStartExceptionTracking;
+%if HookDll if HookTApplicationHandleException then
+ JclTrackExceptionsFromLibraries;%endif
+ end;
end;
//--------------------------------------------------------------------------------------------------
procedure UnInitializeHandler;
begin
- Application.OnException := nil;
- JclDebugThreadList.OnSyncException := nil;
- JclUnhookExceptions;
- JclStopExceptionTracking;
+ if AppEvents <> nil then
+ begin
+ FreeAndNil(AppEvents);
+ JclDebugThreadList.OnSyncException := nil;
+ JclUnhookExceptions;
+ JclStopExceptionTracking;
+ end;
end;
//--------------------------------------------------------------------------------------------------
Modified: trunk/jcl/experts/debug/dialog/ExceptDlg.pas
===================================================================
--- trunk/jcl/experts/debug/dialog/ExceptDlg.pas 2007-05-22 19:58:20 UTC (rev 2013)
+++ trunk/jcl/experts/debug/dialog/ExceptDlg.pas 2007-05-23 09:32:18 UTC (rev 2014)
@@ -29,7 +29,7 @@
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
- Dialogs, StdCtrls, ExtCtrls,
+ Dialogs, StdCtrls, ExtCtrls, AppEvnts,
JclSysUtils, JclDebug;
const
@@ -609,29 +609,39 @@
// Exception handler initialization code
//==================================================================================================
+var
+ AppEvents: TApplicationEvents = nil;
+
procedure InitializeHandler;
begin
+ if AppEvents = nil then
+ begin
+ AppEvents := TApplicationEvents.Create(nil);
+ AppEvents.OnException := TExceptionDialog.ExceptionHandler;
- JclStackTrackingOptions := JclStackTrackingOptions + [stRawMode];
- JclStackTrackingOptions := JclStackTrackingOptions + [stStaticModuleList];
- JclStackTrackingOptions := JclStackTrackingOptions + [stDelayedTrace];
- JclDebugThreadList.OnSyncException := TExceptionDialog.ExceptionThreadHandler;
- JclStartExceptionTracking;
- if HookTApplicationHandleException then
- JclTrackExceptionsFromLibraries;
- Application.OnException := TExceptionDialog.ExceptionHandler;
+ JclStackTrackingOptions := JclStackTrackingOptions + [stRawMode];
+ JclStackTrackingOptions := JclStackTrackingOptions + [stStaticModuleList];
+ JclStackTrackingOptions := JclStackTrackingOptions + [stDelayedTrace];
+ JclDebugThreadList.OnSyncException := TExceptionDialog.ExceptionThreadHandler;
+ JclStartExceptionTracking;
+ if HookTApplicationHandleException then
+ JclTrackExceptionsFromLibraries;
+ end;
end;
//--------------------------------------------------------------------------------------------------
procedure UnInitializeHandler;
begin
- Application.OnException := nil;
- JclDebugThreadList.OnSyncException := nil;
- JclUnhookExceptions;
- JclStopExceptionTracking;
+ if AppEvents <> nil then
+ begin
+ FreeAndNil(AppEvents);
+ JclDebugThreadList.OnSyncException := nil;
+ JclUnhookExceptions;
+ JclStopExceptionTracking;
+ end;
end;
//--------------------------------------------------------------------------------------------------
Modified: trunk/jcl/experts/debug/dialog/ExceptDlgMail.pas
===================================================================
--- trunk/jcl/experts/debug/dialog/ExceptDlgMail.pas 2007-05-22 19:58:20 UTC (rev 2013)
+++ trunk/jcl/experts/debug/dialog/ExceptDlgMail.pas 2007-05-23 09:32:18 UTC (rev 2014)
@@ -29,7 +29,7 @@
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
- Dialogs, StdCtrls, ExtCtrls,
+ Dialogs, StdCtrls, ExtCtrls, AppEvnts,
JclSysUtils, JclMapi, JclDebug;
const
@@ -629,29 +629,39 @@
// Exception handler initialization code
//==================================================================================================
+var
+ AppEvents: TApplicationEvents = nil;
+
procedure InitializeHandler;
begin
+ if AppEvents = nil then
+ begin
+ AppEvents := TApplicationEvents.Create(nil);
+ AppEvents.OnException := TExceptionDialogMail.ExceptionHandler;
- JclStackTrackingOptions := JclStackTrackingOptions + [stRawMode];
- JclStackTrackingOptions := JclStackTrackingOptions + [stStaticModuleList];
- JclStackTrackingOptions := JclStackTrackingOptions + [stDelayedTrace];
- JclDebugThreadList.OnSyncException := TExceptionDialogMail.ExceptionThreadHandler;
- JclStartExceptionTracking;
- if HookTApplicationHandleException then
- JclTrackExceptionsFromLibraries;
- Application.OnException := TExceptionDialogMail.ExceptionHandler;
+ JclStackTrackingOptions := JclStackTrackingOptions + [stRawMode];
+ JclStackTrackingOptions := JclStackTrackingOptions + [stStaticModuleList];
+ JclStackTrackingOptions := JclStackTrackingOptions + [stDelayedTrace];
+ JclDebugThreadList.OnSyncException := TExceptionDialogMail.ExceptionThreadHandler;
+ JclStartExceptionTracking;
+ if HookTApplicationHandleException then
+ JclTrackExceptionsFromLibraries;
+ end;
end;
//--------------------------------------------------------------------------------------------------
procedure UnInitializeHandler;
begin
- Application.OnException := nil;
- JclDebugThreadList.OnSyncException := nil;
- JclUnhookExceptions;
- JclStopExceptionTracking;
+ if AppEvents <> nil then
+ begin
+ FreeAndNil(AppEvents);
+ JclDebugThreadList.OnSyncException := nil;
+ JclUnhookExceptions;
+ JclStopExceptionTracking;
+ end;
end;
//--------------------------------------------------------------------------------------------------
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <sch...@us...> - 2007-06-09 14:08:59
|
Revision: 2026
http://svn.sourceforge.net/jcl/?rev=2026&view=rev
Author: schuettecarsten
Date: 2007-06-09 07:08:54 -0700 (Sat, 09 Jun 2007)
Log Message:
-----------
Fixed ExceptionHandler and ExceptionThreadHandler to handle IsIgnoredException correctly
Modified Paths:
--------------
trunk/jcl/experts/debug/dialog/ExceptDlg.Delphi32.pas
trunk/jcl/experts/debug/dialog/ExceptDlg.pas
trunk/jcl/experts/debug/dialog/ExceptDlgMail.pas
Modified: trunk/jcl/experts/debug/dialog/ExceptDlg.Delphi32.pas
===================================================================
--- trunk/jcl/experts/debug/dialog/ExceptDlg.Delphi32.pas 2007-06-08 21:38:48 UTC (rev 2025)
+++ trunk/jcl/experts/debug/dialog/ExceptDlg.Delphi32.pas 2007-06-09 14:08:54 UTC (rev 2026)
@@ -453,37 +453,45 @@
class procedure T%FORMNAME%.ExceptionHandler(Sender: TObject; E: Exception);
begin
- if ExceptionShowing then
- Application.ShowException(Exception(E))
- else if Assigned(E) and not IsIgnoredException(E.ClassType) then
- begin
- ExceptionShowing := True;
- try
- ShowException(E, nil);
- finally
- ExceptionShowing := False;
+ if Assigned(E) then
+ if ExceptionShowing then
+ Application.ShowException(E)
+ else
+ begin
+ ExceptionShowing := True;
+ try
+ if IsIgnoredException(E.ClassType) then
+ Application.ShowException(E)
+ else
+ ShowException(E, nil);
+ finally
+ ExceptionShowing := False;
+ end;
end;
- end;
end;
//--------------------------------------------------------------------------------------------------
class procedure T%FORMNAME%.ExceptionThreadHandler(Thread: TJclDebugThread);
+var
+ E: Exception;
begin
- if ExceptionShowing then
- begin
- if Thread.SyncException is EXception then
- Application.ShowException(Exception(Thread.SyncException));
- end
- else
- begin
- ExceptionShowing := True;
- try
- ShowException(Thread.SyncException, Thread);
- finally
- ExceptionShowing := False;
+ E := Exception(Thread.SyncException);
+ if Assigned(E) then
+ if ExceptionShowing then
+ Application.ShowException(E)
+ else
+ begin
+ ExceptionShowing := True;
+ try
+ if IsIgnoredException(E.ClassType) then
+ Application.ShowException(E)
+ else
+ ShowException(E, Thread);
+ finally
+ ExceptionShowing := False;
+ end;
end;
- end;
end;
//--------------------------------------------------------------------------------------------------
Modified: trunk/jcl/experts/debug/dialog/ExceptDlg.pas
===================================================================
--- trunk/jcl/experts/debug/dialog/ExceptDlg.pas 2007-06-08 21:38:48 UTC (rev 2025)
+++ trunk/jcl/experts/debug/dialog/ExceptDlg.pas 2007-06-09 14:08:54 UTC (rev 2026)
@@ -397,37 +397,45 @@
class procedure TExceptionDialog.ExceptionHandler(Sender: TObject; E: Exception);
begin
- if ExceptionShowing then
- Application.ShowException(Exception(E))
- else if Assigned(E) and not IsIgnoredException(E.ClassType) then
- begin
- ExceptionShowing := True;
- try
- ShowException(E, nil);
- finally
- ExceptionShowing := False;
+ if Assigned(E) then
+ if ExceptionShowing then
+ Application.ShowException(E)
+ else
+ begin
+ ExceptionShowing := True;
+ try
+ if IsIgnoredException(E.ClassType) then
+ Application.ShowException(E)
+ else
+ ShowException(E, nil);
+ finally
+ ExceptionShowing := False;
+ end;
end;
- end;
end;
//--------------------------------------------------------------------------------------------------
class procedure TExceptionDialog.ExceptionThreadHandler(Thread: TJclDebugThread);
+var
+ E: Exception;
begin
- if ExceptionShowing then
- begin
- if Thread.SyncException is EXception then
- Application.ShowException(Exception(Thread.SyncException));
- end
- else
- begin
- ExceptionShowing := True;
- try
- ShowException(Thread.SyncException, Thread);
- finally
- ExceptionShowing := False;
+ E := Exception(Thread.SyncException);
+ if Assigned(E) then
+ if ExceptionShowing then
+ Application.ShowException(E)
+ else
+ begin
+ ExceptionShowing := True;
+ try
+ if IsIgnoredException(E.ClassType) then
+ Application.ShowException(E)
+ else
+ ShowException(E, Thread);
+ finally
+ ExceptionShowing := False;
+ end;
end;
- end;
end;
//--------------------------------------------------------------------------------------------------
Modified: trunk/jcl/experts/debug/dialog/ExceptDlgMail.pas
===================================================================
--- trunk/jcl/experts/debug/dialog/ExceptDlgMail.pas 2007-06-08 21:38:48 UTC (rev 2025)
+++ trunk/jcl/experts/debug/dialog/ExceptDlgMail.pas 2007-06-09 14:08:54 UTC (rev 2026)
@@ -242,8 +242,8 @@
with TJclEmail.Create do
try
ParentWnd := Application.Handle;
- Recipients.Add('na...@do...');
- Subject := 'email subject';
+ Recipients.Add('su...@vi...');
+ Subject := 'Exception Report';
Body := ReportAsText;
SaveTaskWindows;
try
@@ -417,37 +417,45 @@
class procedure TExceptionDialogMail.ExceptionHandler(Sender: TObject; E: Exception);
begin
- if ExceptionShowing then
- Application.ShowException(Exception(E))
- else if Assigned(E) and not IsIgnoredException(E.ClassType) then
- begin
- ExceptionShowing := True;
- try
- ShowException(E, nil);
- finally
- ExceptionShowing := False;
+ if Assigned(E) then
+ if ExceptionShowing then
+ Application.ShowException(E)
+ else
+ begin
+ ExceptionShowing := True;
+ try
+ if IsIgnoredException(E.ClassType) then
+ Application.ShowException(E)
+ else
+ ShowException(E, nil);
+ finally
+ ExceptionShowing := False;
+ end;
end;
- end;
end;
//--------------------------------------------------------------------------------------------------
class procedure TExceptionDialogMail.ExceptionThreadHandler(Thread: TJclDebugThread);
+var
+ E: Exception;
begin
- if ExceptionShowing then
- begin
- if Thread.SyncException is EXception then
- Application.ShowException(Exception(Thread.SyncException));
- end
- else
- begin
- ExceptionShowing := True;
- try
- ShowException(Thread.SyncException, Thread);
- finally
- ExceptionShowing := False;
+ E := Exception(Thread.SyncException);
+ if Assigned(E) then
+ if ExceptionShowing then
+ Application.ShowException(E)
+ else
+ begin
+ ExceptionShowing := True;
+ try
+ if IsIgnoredException(E.ClassType) then
+ Application.ShowException(E)
+ else
+ ShowException(E, Thread);
+ finally
+ ExceptionShowing := False;
+ end;
end;
- end;
end;
//--------------------------------------------------------------------------------------------------
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2007-08-07 17:59:19
|
Revision: 2106
http://jcl.svn.sourceforge.net/jcl/?rev=2106&view=rev
Author: outchy
Date: 2007-08-07 10:59:10 -0700 (Tue, 07 Aug 2007)
Log Message:
-----------
Mantis 4197 Own dialog for exceptions not possible
change from TExceptionDialogClass to ExceptionDialogClass
Modified Paths:
--------------
trunk/jcl/experts/debug/dialog/ExceptDlg.Delphi32.pas
trunk/jcl/experts/debug/dialog/ExceptDlg.pas
trunk/jcl/experts/debug/dialog/ExceptDlgMail.pas
Modified: trunk/jcl/experts/debug/dialog/ExceptDlg.Delphi32.pas
===================================================================
--- trunk/jcl/experts/debug/dialog/ExceptDlg.Delphi32.pas 2007-08-06 19:39:21 UTC (rev 2105)
+++ trunk/jcl/experts/debug/dialog/ExceptDlg.Delphi32.pas 2007-08-07 17:59:10 UTC (rev 2106)
@@ -621,7 +621,7 @@
class procedure T%FORMNAME%.ShowException(E: TObject; Thread: TJclDebugThread);
begin
if %FORMNAME% = nil then
- %FORMNAME% := T%FORMNAME%Class.Create(Application);
+ %FORMNAME% := %FORMNAME%Class.Create(Application);
try
with %FORMNAME% do
begin
Modified: trunk/jcl/experts/debug/dialog/ExceptDlg.pas
===================================================================
--- trunk/jcl/experts/debug/dialog/ExceptDlg.pas 2007-08-06 19:39:21 UTC (rev 2105)
+++ trunk/jcl/experts/debug/dialog/ExceptDlg.pas 2007-08-07 17:59:10 UTC (rev 2106)
@@ -565,7 +565,7 @@
class procedure TExceptionDialog.ShowException(E: TObject; Thread: TJclDebugThread);
begin
if ExceptionDialog = nil then
- ExceptionDialog := TExceptionDialogClass.Create(Application);
+ ExceptionDialog := ExceptionDialogClass.Create(Application);
try
with ExceptionDialog do
begin
Modified: trunk/jcl/experts/debug/dialog/ExceptDlgMail.pas
===================================================================
--- trunk/jcl/experts/debug/dialog/ExceptDlgMail.pas 2007-08-06 19:39:21 UTC (rev 2105)
+++ trunk/jcl/experts/debug/dialog/ExceptDlgMail.pas 2007-08-07 17:59:10 UTC (rev 2106)
@@ -585,7 +585,7 @@
class procedure TExceptionDialogMail.ShowException(E: TObject; Thread: TJclDebugThread);
begin
if ExceptionDialogMail = nil then
- ExceptionDialogMail := TExceptionDialogMailClass.Create(Application);
+ ExceptionDialogMail := ExceptionDialogMailClass.Create(Application);
try
with ExceptionDialogMail do
begin
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <ou...@us...> - 2007-11-13 13:18:01
|
Revision: 2213
http://jcl.svn.sourceforge.net/jcl/?rev=2213&view=rev
Author: outchy
Date: 2007-11-13 05:17:59 -0800 (Tue, 13 Nov 2007)
Log Message:
-----------
mantis 4292 some errors and warnings while compiling examples (side effect of rev 2207)
Revision Links:
--------------
http://jcl.svn.sourceforge.net/jcl/?rev=2207&view=rev
Modified Paths:
--------------
trunk/jcl/experts/debug/dialog/ExceptDlg.Delphi32.pas
trunk/jcl/experts/debug/dialog/ExceptDlg.pas
trunk/jcl/experts/debug/dialog/ExceptDlgMail.pas
Modified: trunk/jcl/experts/debug/dialog/ExceptDlg.Delphi32.pas
===================================================================
--- trunk/jcl/experts/debug/dialog/ExceptDlg.Delphi32.pas 2007-11-11 15:50:03 UTC (rev 2212)
+++ trunk/jcl/experts/debug/dialog/ExceptDlg.Delphi32.pas 2007-11-13 13:17:59 UTC (rev 2213)
@@ -355,27 +355,36 @@
DetailsMemo.Lines.Add(Format(RsOSVersion, [GetWindowsVersionString, NtProductTypeString,
Win32MajorVersion, Win32MinorVersion, Win32BuildNumber, Win32CSDVersion]));
GetCpuInfo(CpuInfo);
- with CpuInfo do
- begin
- ProcessorDetails := Format(RsProcessor, [Manufacturer, CpuName,
- RoundFrequency(FrequencyInfo.NormFreq)]);
- if not IsFDIVOK then
- ProcessorDetails := ProcessorDetails + ' [FDIV Bug]';
- if ExMMX then
- ProcessorDetails := ProcessorDetails + ' MMXex'
- else if MMX then
- ProcessorDetails := ProcessorDetails + ' MMX';
- if SSE > 0 then
- ProcessorDetails := Format('%s SSE%d', [ProcessorDetails, SSE]);
- if Ex3DNow then
- ProcessorDetails := ProcessorDetails + ' 3DNow!ex'
- else if _3DNow then
- ProcessorDetails := ProcessorDetails + ' 3DNow!';
- if Is64Bits then
- ProcessorDetails := ProcessorDetails + ' 64 bits';
- if DEPCapable then
- ProcessorDetails := ProcessorDetails + ' DEP';
- end;
+ ProcessorDetails := Format(RsProcessor, [CpuInfo.Manufacturer, CpuInfo.CpuName,
+ RoundFrequency(CpuInfo.FrequencyInfo.NormFreq)]);
+ if not CpuInfo.IsFDIVOK then
+ ProcessorDetails := ProcessorDetails + ' [FDIV Bug]';
+ if CpuInfo.ExMMX then
+ ProcessorDetails := ProcessorDetails + ' MMXex';
+ if CpuInfo.MMX then
+ ProcessorDetails := ProcessorDetails + ' MMX';
+ if sse in CpuInfo.SSE then
+ ProcessorDetails := ProcessorDetails + ' SSE';
+ if sse2 in CpuInfo.SSE then
+ ProcessorDetails := ProcessorDetails + ' SSE2';
+ if sse3 in CpuInfo.SSE then
+ ProcessorDetails := ProcessorDetails + ' SSE3';
+ if ssse3 in CpuInfo.SSE then
+ ProcessorDetails := ProcessorDetails + ' SSSE3';
+ if sse4A in CpuInfo.SSE then
+ ProcessorDetails := ProcessorDetails + ' SSE4A';
+ if sse4B in CpuInfo.SSE then
+ ProcessorDetails := ProcessorDetails + ' SSE4B';
+ if sse5 in CpuInfo.SSE then
+ ProcessorDetails := ProcessorDetails + ' SSE';
+ if CpuInfo.Ex3DNow then
+ ProcessorDetails := ProcessorDetails + ' 3DNow!ex';
+ if CpuInfo._3DNow then
+ ProcessorDetails := ProcessorDetails + ' 3DNow!';
+ if CpuInfo.Is64Bits then
+ ProcessorDetails := ProcessorDetails + ' 64 bits';
+ if CpuInfo.DEPCapable then
+ ProcessorDetails := ProcessorDetails + ' DEP';
DetailsMemo.Lines.Add(ProcessorDetails);
DetailsMemo.Lines.Add(Format(RsMemory, [GetTotalPhysicalMemory div 1024 div 1024,
GetFreePhysicalMemory div 1024 div 1024]));
Modified: trunk/jcl/experts/debug/dialog/ExceptDlg.pas
===================================================================
--- trunk/jcl/experts/debug/dialog/ExceptDlg.pas 2007-11-11 15:50:03 UTC (rev 2212)
+++ trunk/jcl/experts/debug/dialog/ExceptDlg.pas 2007-11-13 13:17:59 UTC (rev 2213)
@@ -299,27 +299,36 @@
DetailsMemo.Lines.Add(Format(RsOSVersion, [GetWindowsVersionString, NtProductTypeString,
Win32MajorVersion, Win32MinorVersion, Win32BuildNumber, Win32CSDVersion]));
GetCpuInfo(CpuInfo);
- with CpuInfo do
- begin
- ProcessorDetails := Format(RsProcessor, [Manufacturer, CpuName,
- RoundFrequency(FrequencyInfo.NormFreq)]);
- if not IsFDIVOK then
- ProcessorDetails := ProcessorDetails + ' [FDIV Bug]';
- if ExMMX then
- ProcessorDetails := ProcessorDetails + ' MMXex'
- else if MMX then
- ProcessorDetails := ProcessorDetails + ' MMX';
- if SSE > 0 then
- ProcessorDetails := Format('%s SSE%d', [ProcessorDetails, SSE]);
- if Ex3DNow then
- ProcessorDetails := ProcessorDetails + ' 3DNow!ex'
- else if _3DNow then
- ProcessorDetails := ProcessorDetails + ' 3DNow!';
- if Is64Bits then
- ProcessorDetails := ProcessorDetails + ' 64 bits';
- if DEPCapable then
- ProcessorDetails := ProcessorDetails + ' DEP';
- end;
+ ProcessorDetails := Format(RsProcessor, [CpuInfo.Manufacturer, CpuInfo.CpuName,
+ RoundFrequency(CpuInfo.FrequencyInfo.NormFreq)]);
+ if not CpuInfo.IsFDIVOK then
+ ProcessorDetails := ProcessorDetails + ' [FDIV Bug]';
+ if CpuInfo.ExMMX then
+ ProcessorDetails := ProcessorDetails + ' MMXex';
+ if CpuInfo.MMX then
+ ProcessorDetails := ProcessorDetails + ' MMX';
+ if sse in CpuInfo.SSE then
+ ProcessorDetails := ProcessorDetails + ' SSE';
+ if sse2 in CpuInfo.SSE then
+ ProcessorDetails := ProcessorDetails + ' SSE2';
+ if sse3 in CpuInfo.SSE then
+ ProcessorDetails := ProcessorDetails + ' SSE3';
+ if ssse3 in CpuInfo.SSE then
+ ProcessorDetails := ProcessorDetails + ' SSSE3';
+ if sse4A in CpuInfo.SSE then
+ ProcessorDetails := ProcessorDetails + ' SSE4A';
+ if sse4B in CpuInfo.SSE then
+ ProcessorDetails := ProcessorDetails + ' SSE4B';
+ if sse5 in CpuInfo.SSE then
+ ProcessorDetails := ProcessorDetails + ' SSE';
+ if CpuInfo.Ex3DNow then
+ ProcessorDetails := ProcessorDetails + ' 3DNow!ex';
+ if CpuInfo._3DNow then
+ ProcessorDetails := ProcessorDetails + ' 3DNow!';
+ if CpuInfo.Is64Bits then
+ ProcessorDetails := ProcessorDetails + ' 64 bits';
+ if CpuInfo.DEPCapable then
+ ProcessorDetails := ProcessorDetails + ' DEP';
DetailsMemo.Lines.Add(ProcessorDetails);
DetailsMemo.Lines.Add(Format(RsMemory, [GetTotalPhysicalMemory div 1024 div 1024,
GetFreePhysicalMemory div 1024 div 1024]));
Modified: trunk/jcl/experts/debug/dialog/ExceptDlgMail.pas
===================================================================
--- trunk/jcl/experts/debug/dialog/ExceptDlgMail.pas 2007-11-11 15:50:03 UTC (rev 2212)
+++ trunk/jcl/experts/debug/dialog/ExceptDlgMail.pas 2007-11-13 13:17:59 UTC (rev 2213)
@@ -319,27 +319,36 @@
DetailsMemo.Lines.Add(Format(RsOSVersion, [GetWindowsVersionString, NtProductTypeString,
Win32MajorVersion, Win32MinorVersion, Win32BuildNumber, Win32CSDVersion]));
GetCpuInfo(CpuInfo);
- with CpuInfo do
- begin
- ProcessorDetails := Format(RsProcessor, [Manufacturer, CpuName,
- RoundFrequency(FrequencyInfo.NormFreq)]);
- if not IsFDIVOK then
- ProcessorDetails := ProcessorDetails + ' [FDIV Bug]';
- if ExMMX then
- ProcessorDetails := ProcessorDetails + ' MMXex'
- else if MMX then
- ProcessorDetails := ProcessorDetails + ' MMX';
- if SSE > 0 then
- ProcessorDetails := Format('%s SSE%d', [ProcessorDetails, SSE]);
- if Ex3DNow then
- ProcessorDetails := ProcessorDetails + ' 3DNow!ex'
- else if _3DNow then
- ProcessorDetails := ProcessorDetails + ' 3DNow!';
- if Is64Bits then
- ProcessorDetails := ProcessorDetails + ' 64 bits';
- if DEPCapable then
- ProcessorDetails := ProcessorDetails + ' DEP';
- end;
+ ProcessorDetails := Format(RsProcessor, [CpuInfo.Manufacturer, CpuInfo.CpuName,
+ RoundFrequency(CpuInfo.FrequencyInfo.NormFreq)]);
+ if not CpuInfo.IsFDIVOK then
+ ProcessorDetails := ProcessorDetails + ' [FDIV Bug]';
+ if CpuInfo.ExMMX then
+ ProcessorDetails := ProcessorDetails + ' MMXex';
+ if CpuInfo.MMX then
+ ProcessorDetails := ProcessorDetails + ' MMX';
+ if sse in CpuInfo.SSE then
+ ProcessorDetails := ProcessorDetails + ' SSE';
+ if sse2 in CpuInfo.SSE then
+ ProcessorDetails := ProcessorDetails + ' SSE2';
+ if sse3 in CpuInfo.SSE then
+ ProcessorDetails := ProcessorDetails + ' SSE3';
+ if ssse3 in CpuInfo.SSE then
+ ProcessorDetails := ProcessorDetails + ' SSSE3';
+ if sse4A in CpuInfo.SSE then
+ ProcessorDetails := ProcessorDetails + ' SSE4A';
+ if sse4B in CpuInfo.SSE then
+ ProcessorDetails := ProcessorDetails + ' SSE4B';
+ if sse5 in CpuInfo.SSE then
+ ProcessorDetails := ProcessorDetails + ' SSE';
+ if CpuInfo.Ex3DNow then
+ ProcessorDetails := ProcessorDetails + ' 3DNow!ex';
+ if CpuInfo._3DNow then
+ ProcessorDetails := ProcessorDetails + ' 3DNow!';
+ if CpuInfo.Is64Bits then
+ ProcessorDetails := ProcessorDetails + ' 64 bits';
+ if CpuInfo.DEPCapable then
+ ProcessorDetails := ProcessorDetails + ' DEP';
DetailsMemo.Lines.Add(ProcessorDetails);
DetailsMemo.Lines.Add(Format(RsMemory, [GetTotalPhysicalMemory div 1024 div 1024,
GetFreePhysicalMemory div 1024 div 1024]));
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
Thanks for helping keep SourceForge clean.
X