我（也）回答我自己的问题，因为我将采取另一种方法。它规定了以下要求：
- 我喜欢保留
raise 语句，就像它们最初的样子，
- 不过，我不想重建内部 RTL 机制
- 我想尽可能少地干扰 RTL 机制。
- 我希望灵活地控制链接异常
- 有时强制或默认情况下，在异常实现方面，以及
- 有时通过参数，在异常使用方面，以扩展功能。
在我的解决方案中：
- 我接受突破
Exception 字段的可见性，特别是 FAcquireInnerException。
- 我依靠 RTTI 来验证字段的对齐方式（在
ExceptionFields 中，根据 Exception）。
这里我提供了一个简洁的复制粘贴实现：
EException的构造函数展示了ExceptionFields的使用：
ExceptionFields(Self).FAcquireInnerException := True;
-- 用于任何Exception 派生的异常，它会在引发异常时触发 RTL 机制来设置InnerException。此外，如果需要，EException 可以作为自定义异常类的公共根。重新引入了一些构造函数以使用 const AcquireInnerException: Boolean = True 进行扩展，以便将控制权移交给调用者，同时为所需的链接提供默认值。
运行ExceptionFields.VerifyFieldAlignments，如果你想验证对齐方式
-
ExceptionFields 中声明的（“re-”）外部可访问字段和
-
Exception 中的（私人）同行。
如果它无法验证这一点，它将引发异常。它在EException 的类构造函数中运行。如果您不使用EException，但想保留验证，请酌情移动它。
（精简）实现：
unit Exceptions;
interface
uses
System.SysUtils;
type
EException = class (Exception)
public
class constructor Create;
constructor Create(const Msg: String; const AcquireInnerException: Boolean = True);
constructor CreateFmt(const Msg: String; const Args: array of const; const AcquireInnerException: Boolean = True); overload;
constructor CreateRes(const Msg: PResStringRec; const AcquireInnerException: Boolean = True);
constructor CreateResFmt(const Msg: PResStringRec; const Args: array of const; const AcquireInnerException: Boolean = True); overload;
end;
type
ExceptionFields = class (TObject)
{$Hints Off} // H2219
strict private
FMessage: String;
FHelpContext: Integer;
FInnerException: Exception;
FStackInfo: Pointer;
{$Hints On}
public
FAcquireInnerException: Boolean;
private
class procedure VerifyFieldAlignments;
end;
implementation
uses
System.Generics.Collections,
System.RTTI,
System.TypInfo;
{ ExceptionFields }
class procedure ExceptionFields.VerifyFieldAlignments;
procedure RaiseTypeNotFound(const ClassName: String);
begin
raise Exception.CreateFmt(
'Typ nicht gefunden: %s',
[ClassName]
);
end;
procedure RaiseFieldNotFound(const ClassName, FieldName: String);
begin
raise Exception.CreateFmt(
'Feld nicht gefunden: %s.%s',
[ClassName, FieldName]
);
end;
procedure RaiseFieldNotAligned(const LeftClassName: String; const LeftField: TPair<String, Integer>; const RightClassName: String; const RightField: TRTTIField);
begin
raise Exception.CreateFmt(
'Feld nicht ausgerichtet: %s.%s+%d (tatsächlich) vs. %s.%s+%d (erwartet)',
[
LeftClassName,
LeftField.Key,
LeftField.Value,
RightClassName,
RightField.Name,
RightField.Offset
]
);
end;
type
TMemberVisibilities = set of TMemberVisibility;
function GetDeclaredFields(const RTTIContext: TRTTIContext; const &Class: TClass; const IncludedVisibilities: TMemberVisibilities = [mvPublic, mvPublished]): TArray<TPair<String, Integer>>;
var
RTTIType: TRTTIType;
RTTIFields: TArray<TRTTIField>;
Index: NativeInt;
RTTIField: TRTTIField;
begin
RTTIType := RTTIContext.GetType(&Class);
if not Assigned(RTTIType) then
RaiseTypeNotFound(&Class.ClassName);
RTTIFields := RTTIType.GetDeclaredFields;
SetLength(Result, Length(RTTIFields));
Index := 0;
for RTTIField in RTTIFields do
if RTTIField.Visibility in IncludedVisibilities then
begin
Result[Index] := TPair<String, Integer>.Create(
RTTIField.Name,
RTTIField.Offset
);
Inc(Index);
end;
SetLength(Result, Index);
end;
const
Left: TClass = ExceptionFields;
Right: TClass = Exception;
var
RTTIContext: TRTTIContext;
DeclaredFields: TArray<TPair<String, Integer>>;
RTTIType: TRTTIType;
DeclaredField: TPair<String, Integer>;
RTTIField: TRTTIField;
begin
RTTIContext := TRTTIContext.Create;
try
DeclaredFields := GetDeclaredFields(RTTIContext, Left);
RTTIType := RTTIContext.GetType(Right);
if not Assigned(RTTIType) then
RaiseTypeNotFound(Right.ClassName);
for DeclaredField in DeclaredFields do
begin
RTTIField := RTTIType.GetField(DeclaredField.Key);
if not Assigned(RTTIField) then
RaiseFieldNotFound(Right.ClassName, DeclaredField.Key);
if DeclaredField.Value <> RTTIField.Offset then
RaiseFieldNotAligned(
Left.ClassName, DeclaredField,
RTTIType.Name, RTTIField
);
end;
finally
RTTIContext.Free;
end;
end;
{ EException }
class constructor EException.Create;
begin
inherited;
ExceptionFields.VerifyFieldAlignments;
end;
constructor EException.Create(const Msg: String;
const AcquireInnerException: Boolean);
begin
inherited Create(Msg);
ExceptionFields(Self).FAcquireInnerException := AcquireInnerException;
end;
constructor EException.CreateFmt(const Msg: String;
const Args: array of const;
const AcquireInnerException: Boolean);
begin
inherited CreateFmt(Msg, Args);
ExceptionFields(Self).FAcquireInnerException := AcquireInnerException;
end;
constructor EException.CreateRes(const Msg: PResStringRec;
const AcquireInnerException: Boolean);
begin
inherited CreateRes(Msg);
ExceptionFields(Self).FAcquireInnerException := AcquireInnerException;
end;
constructor EException.CreateResFmt(const Msg: PResStringRec;
const Args: array of const;
const AcquireInnerException: Boolean);
begin
inherited CreateResFmt(Msg, Args);
ExceptionFields(Self).FAcquireInnerException := AcquireInnerException;
end;
end.
还有一个演示：
program ExceptionsDemo;
{$AppType Console}
{$R *.res}
uses
System.SysUtils,
Exceptions in 'Exceptions.pas';
type
EDemoException = class (EException)
end;
begin
try
try
try
raise EZeroDivide.Create('Level 3');
except
raise EException.Create('Level 2', False);
end;
except
raise EDemoException.Create('Level 1');
end;
except
on E: Exception do
begin
WriteLn(E.ClassName, ': ', E.Message);
while Assigned(E.InnerException) do
begin
E := E.InnerException;
WriteLn(E.ClassName, ': ', E.Message);
end;
end;
end;
ReadLn;
end.
输出 -- 最后一行只存在于raise EException.Create('Level 2', True):
EDemoException: Level 1
EException: Level 2
EZeroDivide: Level 3
感谢所有回复者！