delphi - ¿Por qué obtengo violaciones de acceso cuando el nombre de clase de un control es muy, muy largo?

delphi-2010 buffer-overflow

Question

Subclasé un control en orden para poder agregar algunos campos que necesito, pero ahora cuando lo creo en tiempo de ejecución obtengo una Access Violation . Lamentablemente, esta Infracción de acceso no ocurre en el lugar donde estoy creando el control, e incluso aquellos que estoy creando con todas las opciones de depuración habilitadas (incluyendo "Build with Debug DCU''s"), el seguimiento de la pila no me ayuda en absoluto. !

En mi intento de reproducir el error intenté crear una aplicación de consola, pero aparentemente este error solo aparece en una aplicación de Formularios, ¡y solo si mi control se muestra realmente en un formulario!

Aquí están los pasos para reproducir el error. Cree una nueva aplicación de formularios VCL, suelte un solo botón, haga doble clic para crear el controlador OnClick y escriba esto:

type TWinControl<T,K,W> = class(TWinControl);
procedure TForm3.Button1Click(Sender: TObject);
begin
with TWinControl<TWinControl, TWinControl, TWinControl>.Create(Self) do
begin
Parent := Self;
end;
end;

Esto genera sucesivamente la Infracción de acceso, cada vez que lo intento. Solo probé esto en Delphi 2010 ya que es la única versión que tengo en esta computadora.

Las preguntas serían:

• ¿Es este un error conocido en Delphi''s Generics?
• ¿Hay una solución para esto?

Editar

Aquí está el enlace al informe de http://qc.embarcadero.com/wc/qcmain.aspx?d=112101 calidad: http://qc.embarcadero.com/wc/qcmain.aspx?d=112101

Answer 1

En primer lugar, esto no tiene nada que ver con los genéricos, pero es mucho más probable que se manifieste cuando se utilizan genéricos. Resulta que hay un error de desbordamiento de búfer en TControl.CreateParams . Si observa el código, notará que llena una estructura TCreateParams y, especialmente importante, rellena el TCreateParams.WinClassName con el nombre de la clase actual ( ClassName ). Lamentablemente, WinClassName es un búfer de longitud fija de solo 64 , pero debe incluir el terminador NULL; ¡De manera efectiva, un ClassName 64 largo ClassName ese buffer!

Se puede probar con este código:

TLongWinControlClassName4567890123456789012345678901234567891234 = class(TWinControl)
end;
procedure TForm3.Button1Click(Sender: TObject);
begin
with TLongWinControlClassName4567890123456789012345678901234567891234.Create(Self) do
begin
Parent := Self;
end;
end;

Ese nombre de clase tiene exactamente 64 caracteres de largo. ¡Hazlo un personaje más corto y el error desaparecerá!

Es mucho más probable que esto suceda cuando se usan genéricos debido a la forma en que Delphi construye ClassName : incluye el nombre de la unidad donde se declara el tipo de parámetro, más un punto, luego el nombre del tipo de parámetro. Por ejemplo, la TWinControl<TWinControl, TWinControl, TWinControl> tiene el siguiente ClassName:

TWinControl<Controls.TWinControl,Controls.TWinControl,Controls.TWinControl>

Eso es 75 caracteres de largo, más del límite 63 .

Solución

Adopté un mensaje de error simple de la clase potencialmente generadora de errores. Algo así, del constructor:

constructor TWinControl<T, K, W>.Create(aOwner: TComponent);
begin
{$IFOPT D+}
if Length(ClassName) > 63 then raise Exception.Create(''The resulting ClassName is too long: '' + ClassName);
{$ENDIF}
inherited;
end;

Al menos esto muestra un mensaje de error decente sobre el que uno puede actuar inmediatamente.

Más tarde Editar, True Workaround

La solución anterior (generar un error) funciona bien para una clase no genérica que tiene un nombre realmente largo; Uno muy probablemente podría acortarlo, hacerlo 63 caracteres o menos. Ese no es el caso con los tipos genéricos: me encontré con este problema con un descendiente TWinControl que tomó 2 parámetros de tipo, por lo que era de la forma:

TMyControlName<Type1, Type2>

El nombre de clase gnerate para un tipo concreto basado en este tipo genérico toma la forma:

TMyControlName<UnitName1.Type1,UnitName2.Type2>

por lo que incluye 5 identificadores (2x identificador de unidad + 3x tipo identificador) + 5 símbolos ( <.,.> ); La longitud promedio de esos 5 identificadores debe ser inferior a 12 caracteres cada uno, o la longitud total es superior a 63: 5x12 + 5 = 65. Usar solo 11-12 caracteres por identificador es muy poco y va en contra de las mejores prácticas (es decir: ¡utilice nombres descriptivos largos porque las pulsaciones de teclas son gratuitas!). Nuevamente, en mi caso, simplemente no pude hacer mis identificadores tan cortos.

Teniendo en cuenta cómo no siempre es posible acortar ClassName , pensé en intentar eliminar la causa del problema (el desbordamiento del búfer). Lamentablemente, es muy difícil porque el error se origina en TWinControl.CreateParams , en la parte inferior de la jerarquía CreateParams . No podemos llamar inherited porque CreateParams se usa a lo largo de la cadena de herencia para crear los parámetros de creación de ventana. No llamarlo requeriría duplicar todo el código en la base TWinControl.CreateParams todo el código en las clases intermedias; Tampoco sería muy portátil, ya que cualquiera de esos códigos podría cambiar con versiones futuras de la VCL (o una versión futura de controles de terceros que podríamos estar subclasificando).

La siguiente solución no impide que TWinControl.CreateParams desborde el búfer, pero lo hace inofensivo y luego (cuando vuelve la llamada inherited ) soluciona el problema. Estoy usando un nuevo registro (por lo que tengo control sobre el diseño) que incluye el TCreateParams original pero lo TCreateParams con mucho espacio para que desborde TWinControl.CreateParams . TWinControl.CreateParams desborda todo lo que desea, luego leo el texto completo y lo hago para que se ajuste a los límites originales del registro, asegurándose también de que el nombre abreviado resultante sea razonablemente único. Incluyo el HASH del ClassName original en el WndName para ayudar con el problema de la exclusividad:

type
TWrappedCreateParamsRecord = record
Orignial: TCreateParams;
SpaceForCreateParamsToSafelyOverflow: array[0..2047] of Char;
end;
procedure TExtraExtraLongWinControlDescendantClassName_0123456789_0123456789_0123456789_0123456789.CreateParams(var Params: TCreateParams);
var Wrapp: TWrappedCreateParamsRecord;
Hashcode: Integer;
HashStr: string;
begin
// Do I need to take special care?
if Length(ClassName) >= Length(Params.WinClassName) then
begin
// Letting the code go through will cause an Access Violation because of the
// Buffer Overflow in TWinControl.CreateParams; Yet we do need to let the
// inherited call go through, or else parent classes don''t get the chance
// to manipulate the Params structure. Since we can''t fix the root cause (we
// can''t stop TWinControl.CreateParams from overflowing), let''s make sure the
// overflow will be harmless.
ZeroMemory(@Wrapp, SizeOf(Wrapp));
Move(Params, Wrapp.Orignial, SizeOf(TCreateParams));
// Call the original CreateParams; It''ll still overflow, but it''ll probably be hurmless since we just
// padded the orginal data structure with a substantial ammount of space.
inherited CreateParams(Wrapp.Orignial);
// The data needs to move back into the "Params" structure, but before we can do that
// we should FIX the overflown buffer. We can''t simply trunc it to 64, and we don''t want
// the overhead of keeping track of all the variants of this class we might encounter.
// Note: Think of GENERIC classes, where you write this code once, but there might
// be many-many different ClassNames at runtime!
//
// My idea is to FIX this by keeping as much of the original name as possible, but
// including the HASH value of the full name into the window name; If the HASH function
// is any good then the resulting name as a very high probability of being Unique. We''ll
// use the default Hash function used for Delphi''s generics.
HashCode := TEqualityComparer<string>.Default.GetHashCode(PChar(@Wrapp.Orignial.WinClassName));
HashStr := IntToHex(HashCode, 8);
Move(HashStr[1], Wrapp.Orignial.WinClassName[High(Wrapp.Orignial.WinClassName)-8], 8*SizeOf(Char));
Wrapp.Orignial.WinClassName[High(Wrapp.Orignial.WinClassName)] := #0;
// Move the TCreateParams record back were we''ve got it from
Move(Wrapp.Orignial, Params, SizeOf(TCreateParams));
end
else
inherited;
end;