AV in TControl.ScreenToClient - possible workaround
Hallvard Vassbotn
now, but:
Eric Berry wrote:
>I'm getting an AV in TControl.ScreenToClient (called from
>Controls.FindDragTarget) during the mouse idle processing (see call
>stack below). It is a timing related and hard to reproduce issue.
It looks like this is a bug in the FindControl routine in Controls.pas
(6.02):
function FindControl(Handle: HWnd): TWinControl;
begin
Result := nil;
if (Handle <> 0) then
begin
if GlobalFindAtom(PChar(ControlAtomString)) = ControlAtom then
Result := Pointer(GetProp(Handle, MakeIntAtom(ControlAtom)))
else
Result := ObjectFromHWnd(Handle);
end;
end;
The problem is that the Handle can belong to any application,
and that by chance, another application can be using the
same id as generated by the global atom Delphi uses. If
that happens, the value will be a bogous pointer and
your app will AV.
A possible workaround would be to first check that the
window handle belongs to the app before GetProp'ing
it, like this:
function FindControl(Handle: HWnd): TWinControl;
var
OwningProcess: DWORD;
begin
Result := nil;
if (Handle <> 0) then
begin
GetWindowThreadProcessID(Handle, OwningProcess);
if OwningProcess = GetCurrentProcessID then
begin
if GlobalFindAtom(PChar(ControlAtomString)) = ControlAtom then
Result := Pointer(GetProp(Handle, MakeIntAtom(ControlAtom)))
else
Result := Pointer(SendMessage(Handle, RM_GetObjectInstance, 0, 0))
end;
end;
end;
Note that this code has not been tested in any way.
This issue will be reported to Borland.
Hallvard Vassbotn
It seems this problem can even occur when the window handle
belongs to the Delphi application itself. Seems like there are
some rude applications or drivers out there.
I have written a small test application that demonstrates
the bug. Be warned that /all/ applications written in Delphi
(including Delphi itself) will crash when you run this.
Just drop a Button and a Memo on the form, then add this:
procedure TForm2.Button1Click(Sender: TObject);
var
i : integer;
Prop: integer;
begin
for i := $C000 to $FFFF do
begin
if i and $3ff = $3ff then
Memo1.Lines.Add(IntToStr(i));
Prop := GetProp(Handle, PChar(i));
if Prop = 0 then
SetProp(Handle, PChar(i), $BAADF00D)
else
Memo1.Lines.Add('Taken: ' + IntToStr(i) + ' = ' + IntToStr(Prop));
end;
end;
The following changes to Classes.pas tries to remedy this:
function ValidateObj(Obj: TObject): Pointer;
type
PPVmt = ^PVmt;
PVmt = ^TVmt;
TVmt = record
SelfPtr : TClass;
Other : array[0..17] of pointer;
end;
var
Vmt: PVmt;
begin
Result := Obj;
if Assigned(Result) then
try
Vmt := PVmt(Obj.ClassType);
Dec(Vmt);
if Obj.ClassType <> Vmt.SelfPtr then
Result := nil;
except
Result := nil;
end;
end;
function FindControl(Handle: HWnd): TWinControl;
var
OwningProcess: DWORD;
begin
Result := nil;
if (Handle <> 0) then
begin
GetWindowThreadProcessID(Handle, OwningProcess);
if OwningProcess = GetCurrentProcessID then
begin
if GlobalFindAtom(PChar(ControlAtomString)) = ControlAtom then
Result := ValidateObj(TObject(GetProp(Handle,
MakeIntAtom(ControlAtom))))
else
Result := Pointer(SendMessage(Handle, RM_GetObjectInstance, 0, 0))
end;
end;
end;
function IsDelphiHandle(Handle: HWND): Boolean;
begin
Result := False;
if (Handle <> 0) then
begin
if GlobalFindAtom(PChar(WindowAtomString)) = WindowAtom then
Result := ValidateObj(TObject(GetProp(Handle,
MakeIntAtom(WindowAtom)))) <> nil
else
Result := ObjectFromHWnd(Handle) <> nil;
end;
end;
ValidateObj is a new function that will check that the
vmt of the object is valid. Note that this codeis Delphi 6
specific.
Hallvard Vassbotn
I just wanted to post an email conversation with another party
that has experienced the bug in the wild:
Vinnie Murdico wrote to me:
Hi,
Thanks for the new info. Your patch sounds promising. I will try to
incorporate it in our product's next update. Unfortrunately, it's only one
customer getting the problem actively right now, and I need to do more tests
on our next update before I can release it (testing the normal changes we
are making), so it may be a few weeks before I can get it into their hands.
Also, since it's random, it can take a few days to a week for it to occur
for them. But I'm sure it will reappear and when it does, I will send them
our next update with the patch in it.
You may post my comments from the thread below to the newsgroup.
Thanks again for your time and assistance with this issue!
Best Regards,
Vinnie Murdico
Software with Brains, Inc.
http://www.softwarewithbrains.com
----- Original Message -----
From: "Hallvard Vassbotn" <vass...@infront.as>
To: "Vinnie Murdico" <vin...@softwarewithbrains.com>
Sent: Wednesday, March 06, 2002 4:25 AM
Subject: RE: AV in TControl.ScreenToClient - possible workaround
> Hi again Vinnie,
>
> Thanks for your reply!
>
> The fact that the problem occurs even when the mouse
> is over a combo-box that belongs to the Delphi application
> is very interesting. I think this must be due to some other
> application or driver manipulating the Delphi application's
> windows handles, calling SetProp with an id that happens to
> match the one Delphi is using.
>
> I have written a small test application that demonstrates
> the bug. Be warned that /all/ applications written in Delphi
> (including Delphi itself) will crash when you run this.
>
> Just drop a Button and a Memo on the form, then add this:
>
> procedure TForm2.Button1Click(Sender: TObject);
> var
> i : integer;
> Prop: integer;
> begin
> for i := $C000 to $FFFF do
> begin
> if i and $3ff = $3ff then
> Memo1.Lines.Add(IntToStr(i));
> Prop := GetProp(Handle, PChar(i));
> if Prop = 0 then
> SetProp(Handle, PChar(i), $BAADF00D) // Very bad performance!!
> else
> Memo1.Lines.Add('Taken: ' + IntToStr(i) + ' = ' + IntToStr(Prop));
> end;
> end;
>
> This will set all properties of the window with invalid
> pointer values.
>
> I've also found a patch to Controls that will fix this:
>
> function ValidateObj(Obj: TObject): Pointer;
> type
> PPVmt = ^PVmt;
> PVmt = ^TVmt;
> TVmt = record
> SelfPtr : TClass;
> Other : array[0..17] of pointer;
> end;
> var
> Vmt: PVmt;
> begin
> Result := Obj;
> if Assigned(Result) then
> try
> Vmt := PVmt(Obj.ClassType);
> Dec(Vmt);
> if Obj.ClassType <> Vmt.SelfPtr then
> Result := nil;
> except
> Result := nil;
> end;
> end;
>
> function FindControl(Handle: HWnd): TWinControl;
> var
> OwningProcess: DWORD;
> begin
> Result := nil;
> if (Handle <> 0) then
> begin
> GetWindowThreadProcessID(Handle, OwningProcess);
> if OwningProcess = GetCurrentProcessID then
> begin
> if GlobalFindAtom(PChar(ControlAtomString)) = ControlAtom then
> Result := ValidateObj(TObject(GetProp(Handle,
> MakeIntAtom(ControlAtom))))
> else
> Result := Pointer(SendMessage(Handle, RM_GetObjectInstance, 0, 0))
> end;
> end;
> end;
>
> function IsDelphiHandle(Handle: HWND): Boolean;
> begin
> Result := False;
> if (Handle <> 0) then
> begin
> if GlobalFindAtom(PChar(WindowAtomString)) = WindowAtom then
> Result := ValidateObj(TObject(GetProp(Handle,
> MakeIntAtom(WindowAtom)))) <> nil
> else
> Result := ObjectFromHWnd(Handle) <> nil;
> end;
> end;
>
> ValidateObj is a new function that will check that the
> vmt of the object is valid. Can you apply these changes
> and see if that helps?
>
> Also, I would like to copy our conversation to the
> .components.using newsgroup. Is that ok with you?
>
> I will report this bug and the correction to Borland.
>
> Best regards
> Hallvard Vassbotn
>
> > -----Original Message-----
> > From: Vinnie Murdico [mailto:vin...@softwarewithbrains.com]
> > Sent: 1. mars 2002 17:31
> > To: Hallvard Vassbotn
> > Subject: Re: AV in TControl.ScreenToClient - possible workaround
> >
> >
> > Hi Hallvard,
> >
> > I believe your final point is on the money.
> >
> > In my case, and a couple of other cases of developers I have been
> > corresponding with, the AV occurs in our apps when the mouse
> > moves over the
> > combo that has been opened on one of OUR app's forms. Although
> > another of
> > my customers also reported having the app AV when it was not use, just
> > minimized, so I believe both fixes are most likely warranted.
> >
> > If you have any suggestions for how to check if the object being
> > examined is
> > actually a VCL object in our own app, I'd be very interesting in hearing
> > about it.
> >
> > I am currently converting our app to D6, which is taking a little bit of
> > time due to 3rd party component changes (not all of our 3rd party
> > components
> > were "D6-ready".
> >
> > Thanks again for your input and interest in this problem.
> >
> > Sincerely,
> > Vinnie Murdico
> > Software with Brains, Inc.
> > http://www.softwarewithbrains.com
> >
> > ----- Original Message -----
> > From: "Hallvard Vassbotn" <vass...@infront.as>
> > To: "Vinnie Murdico" <vin...@softwarewithbrains.com>
> > Sent: Friday, March 01, 2002 3:59 AM
> > Subject: RE: AV in TControl.ScreenToClient - possible workaround
> >
> >
> > > Hi Vinnie,
> > >
> > > Thanks for you reply. I'm very interested in hearing back
> > > from you if the change fixes the problem for you or not.
> > >
> > > Are you saying that you see this problem when moving
> > > the mouse over combo-boxes that belong to your Delphi
> > > application? Or does it happen when moving the mouse
> > > over another application? The change only make sure
> > > that the window being examined belongs to the Delphi
> > > application, as this seemed to be the problem with
> > > at least one other report.
> > >
> > > If this change does not work for you, I'm afraid
> > > we have to employ some "dirty" hacks to work around
> > > the problem. One solution would then be to check
> > > that the pointer is a valid one and that it actually
> > > points to a VCL object.
> > >
> > > Best regards
> > > Hallvard Vassbotn
> > >
> > > > -----Original Message-----
> > > > From: Vinnie Murdico [mailto:vin...@softwarewithbrains.com]
> > > > Sent: 28. februar 2002 19:00
> > > > To: Hallvard Vassbotn
> > > > Subject: Re: AV in TControl.ScreenToClient - possible workaround
> > > >
> > > >
> > > > Thanks for your post in the newsgroup regarding this annoying
> > problem --
> > I
> > > > was delighted to see your input.
> > > >
> > > > This problem seems to be getting worse for several developers
> > > > these days. I
> > > > am going to try this solution with my customer who repeatedly
> > > > gets AVs using
> > > > the mouse over combo boxes and see if it helps. I can't dupe the
> > > > problem in
> > > > my lab, but I will test the changes internally to make sure
> > there are no
> > > > obvious side effects.
> > > >
> > > > Your help is very much appreciated. Thanks again!
> > > >
> > > > Vinnie Murdico
> > > > Software with Brains, Inc.
> > > > http://www.softwarewithbrains.com