| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Указатель на виртуальную функцию. Помогите.

DevilDevil ©   (2007-08-02 11:08:00) 

Задача на самом деле шире...
Однако постепенно убирая из своего кода лишнее пришёл к следующему:

[code]
type
  TClass1 = class
    procedure AnotherVirtual; virtual;
    procedure SomeFunc; virtual;
  end;

procedure TClass1.AnotherVirtual;
begin end;

procedure TClass1.SomeFunc;
begin
  ShowMessage('это функция TClass1');
end;

function GetProc(CLS : TClass; ProcOffs : integer) : pointer;
var
  I : integer;
begin
  Result := ppointer(integer(pointer(CLS)^) + ProcOffs)^;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 ProcOffs : integer;
 P1, P2 : pointer;
begin

 asm
   mov ProcOffs, VMTOFFSET TClass1.SomeFunc
 end;

 P1 := @TClass1.SomeFunc;  
 P2 := GetProc(TClass1, ProcOffs);

 {asm
    call P2
 end; }

 Caption := IntToStr(Integer(P1)) + '     ' + IntToStr(Integer(P2));
end;
[/code]

В чём собственно ошибка?
- По идее, P1 должен быть равен P2, а не равен!

Причём ProcOffs всегда вычисляется корректно, - сейчас 4; если в объявлении, функции поменять местами, то 0.

Предположение одно: ошибка в функции [code]GetProc()[/code]. Как ни старался, всё приводило к AccesViolation.

Заранее спасибо.

---

DevilDevil   (2007-08-02 18:52:00) [1]

эээ . на вопрос уже получен ответ:
http://www.delphimaster.ru/cgi-bin/forum.pl?id=1186043128&n=0

---

DevilDevil   (2007-08-02 12:23:00) [2]

извиняюсь, не туда написал

---

DevilDevil   (2007-08-02 11:10:00) [3]

хммм...

1) извинюсь, теги не обработались
2) текуший GetProc - это очередной тест. "Рабочая" функция выглядит так:

function GetProc(CLS : TClass; ProcOffs : integer) : pointer;
begin
 Result := pointer(integer(pointer(CLS)^) + ProcOffs);
end;

---

Наверх