[meneo]

Добрый день!

По производственной необходимости возникла следующая потребность:
Есть основная прога, написанная на Delphi.
Есть длл, написанная на Delphi
Есть внешняя программа, подключающая длл.

Необходимо, чтобы при вызове функции длл из внешней программы, эта длл вызывала функции программы.

Если бы длл подключала основная прога, то решение было бы простым: предать в длл указатели на функции и процедуры основной проги.

Можно ли как-то в длл, подключенную внешней прогой, передать указатели на функции основной проги.

Спасибо!

[Bargest]

Каждая программа работает в своем виртуальном адресном пространстве. Поэтому заставить одну программу вызывать функции другой не так просто: в виртуальной памяти 1й проги функций 2й попросту нет.
Если DLL пишется самостоятельно, можно заставть ее отправлять сообщения окну основной проги (через SendMessage), а основную прогу на них реагировать должным образом. Для этих целей хорошо подходят сообщения с номерами WM_USER и далее. Обратную связь можно реализовать также: в ДЛЛ создать невидимое окно, и через него отправлять результат.
Иначе решения будут сложнее. Например, скопировать код нужных функций в память другого процесса (через WriteProcessMemory) и вызывать их там, дописав в DLL-ку адреса скопированных функций. Но этот способ очень труден, поскольку в копируемых функциях нельзя использовать относительные адреса для работы с глобальными переменными и вызова других функций (поскольку глобальных переменных основной проги в новой вирт. памяти нет, а функции может понадобиться копировать в разные места памяти), и с абсолютными надо быть предельно осторожным (нужно релоцировать). Можно фактически использовать только относительные адреса внутри одной функции, об адресах других (включая WinAPI) узнавать уже внутри нового адресного пространства.

[meneo]

спасибо

начал делать и наткнулся на ошибку

в теле основной проги:


const
MY_MESSAGE = WM_USER + 4242;

procedure MessageReceiver(var msg: TMessage); message MY_MESSAGE;

procedure TMainMTCForm.MessageReceiver(var msg: TMessage);
var
txt: PChar;
begin
txt := PChar(msg.lParam);
msg.Result := 1;
ShowMessage(txt);
end;

в теле дллки:

const MY_MESSAGE = WM_USER + 4242;

var h:HWND; txt: string;
h := findwindow('TMainMTCForm', nil);
if h<>0 then
begin
//setwindowtext(h,'Окно By me')
txt := 'Hello World';
SendMessage(h, MY_MESSAGE, 0, DWORD(PChar(txt)));
end else
ShowMessage('fail');


выдает ошибку access violation.

при этом, если вместо SendMessage использую откомментированный setwindowtext, все работает.

[Bargest]

1) Лучше все-таки WM_USER, WM_USER+1, +2,...
2) Строки в делфи - указатели на строки. При приеме будет ошибка, потому что по передаваемому адресу (а передается таким образом именно адрес) ничего не лежит.
Так что отправка строки превращается в ад. Для этих целей можно попробовать WM_COPYDATA (у меня в свое время не получилось), либо выделить в памяти главного процесса удаленно нужное число байт, скопировать туда строку (с нулем на конце) и передать адрес через SendMessage. Пока что для теста лучше отправлять просто числа. Отправлять прямо в сообщении можно до 8 байт (4 в wparam, 4 в lparam).

[meneo]

с числами все работает!
Спасибо!

[angvelem]

Сообщение от Bargest

1)...Так что отправка строки превращается в ад...

Ну почему же, нормально передаются строки. Для этого удобно использовать record. Заполняешь record и передаёшь указатель на него. При приёме делаешь приведение типов к record-у и без проблем достаешь строку.
Да, маленькое замечание. При использовании PostMessage возможна потеря передаваемых данных.

Сообщение от Bargest

Отправлять прямо в сообщении можно до 8 байт (4 в wparam, 4 в lparam).

И опять же, упаковка данных в record.

[Bargest]

ДЛЛ и обработчик сообщений окна в разных адресных пространствах. Указатель ничего не даст. Надо все равно копировать и содержимое "ручками".
Если ж речь про WM_CopyData - может быть, я так и не понял толком, как с ней работать, когда пытался. Тогда нашел решение проще для своей задачи.
Или я чего-то не понимаю.

[angvelem]

Передавал и не раз, и разное адресное пространство при этом не помеха.

[Bargest]

Что-то не пойму. Опиши, пожалуйста, как именно. Самому интересно стало.

[angvelem]

Так я уже описал.

[Bargest]

Тэкс. Допустим, есть процесс A и процесс B с разными адресными пространствами.
Процесс A заполняет структуру, где лежит та же строка. И передает ее адрес (в своем адресном пространстве) окну из процесса B.
Процесс B принимает адрес структуры (в пространстве A). Чтобы считать, что лежит по этому адресу, нужно использовать ReadProcessMemory, т.к. в текущем пространстве (B) по переданному адресу ничего нет (почти то же, что случай с AV у ТС при передаче адреса строки).
Вот этот момент я и не пойму.

[angvelem]

Если я правильно понял, то нужно что-то подобное:

program

Код:

program Test;

uses
  Windows, Messages;

type
  PMyRecord     = ^TMyRecord;
  TMyRecord	= record
    Name	: String;
  end;

  TSetMessage	= procedure; stdcall;

const
  MY_MESSAGE	= WM_USER + 4242;
  szAppName     = 'MainForm';
  szCaptionName = 'test';

var
  Window        : HWND;
  Msg           : TMsg;
  WndClass      : TWndClassEX;
  SizeX, SizeY  : Integer;
  hDll		: HMODULE;
  hBtn		: HWND;

  SetMessage	: TSetMessage;

const
  cctrl         = 'comctl32.dll';

procedure InitCommonControls; external cctrl name 'InitCommonControls';

//---------------------------------------------------------

procedure InitApp(Wnd : HWND);
begin
  hDLL := LoadLibrary(PChar('mydll.dll'));
  if hDLL = 0 then
    Exit;

  @SetMessage := GetProcAddress(hDLL, 'SetMessage');
  if Addr(SetMessage) = NIL then
    Exit;

  hBtn := CreateWindow('BUTTON', 'Жми', WS_CHILD or WS_VISIBLE, 280, 400, 80, 25, Wnd, 100, hInstance, NIL);
end;

//---------------------------------------------------------

procedure DeInitApp(Wnd : HWND);
begin
  DestroyWindow(hBtn);

  if hDll <> 0 then
    FreeLibrary(hDLL);
end;

//---------------------------------------------------------

function MainProc(Wnd : HWND; Msg : Integer;  wParam, lParam : Longint) : Integer; stdcall;
begin
  Result := 0;

  case Msg of
    WM_CREATE :
    begin
      InitApp(Wnd);
    end;

    MY_MESSAGE :
    begin
      with PMyRecord(lParam)^ do
        MessageBox(Wnd, PChar(Name), '', MB_OK);
    end;

    WM_COMMAND :
    case LOWORD(wParam) of
      100 :
      if hDll <> 0 then
        SetMessage;
    end;
    
    WM_CLOSE :
    begin
      DestroyWindow(Wnd);
    end;

    WM_DESTROY :
    begin
      DeInitApp(Wnd);
      PostQuitMessage(0);
      Exit;
    end;
  end;
  Result := DefWindowProc(Wnd, Msg, wParam, lParam);
end;

//---------------------------------------------------------

begin
  SizeX := 640;
  SizeY := 480;

  FillChar(WndClass, SizeOf(TWndClassEx), 0);
  WndClass.cbSize        := SizeOf(TWndClassEx);
  WndClass.style         := CS_HREDRAW or CS_VREDRAW;
  WndClass.lpfnWndProc   := @MainProc;
  WndClass.cbClsExtra    := 0;
  WndClass.cbWndExtra    := 0;
  WndClass.hInstance     := hInstance;
  WndClass.hCursor       := LoadCursor(0, IDC_ARROW);
  WndClass.hbrBackGround := GetSysColorBrush(COLOR_BTNFACE);
  WndClass.lpszClassName := szAppName;

  if RegisterClassEx(WndClass) = 0 then
    Halt(255);

  Window := CreateWindowEx(0, szAppName, szCaptionName,
                           WS_DLGFRAME or WS_SYSMENU or WS_MINIMIZEBOX,
                           0, 0, SizeX, SizeY, 0, 0, hInstance, NIL);

  InitCommonControls;
  ShowWindow(Window, SW_SHOW);

  while(GetMessage(Msg, 0, 0, 0)) do
  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;
  Halt(Msg.wParam);
end.

library

Код:

library mydll;

uses
  Windows, Messages;

const
  MY_MESSAGE	= WM_USER + 4242;

type
  TMyRecord	= record
    Name	: String;
  end;

procedure SetMessage;
var
  h  : HWND;
  mr : TMyRecord;
begin
  h := FindWindow('MainForm', NIL);
  if h <> 0 then
  begin
    mr.Name := 'Hello World';
    SendMessage(h, MY_MESSAGE, 0, DWORD(@mr));
  end
  else
    MessageBox(0, 'fail', 'Error', MB_OK);
end;

exports
  SetMessage;

begin
end.

[meneo]

Да, опишите, подробнее, пжл )
Потому как я понял, что sendmessage для меня не решение, поскольку передавать различные структурированные данные, а потом их обрабатывать будет серьезной проблемой, если только не передавать указатели на данные типа record.

вообще изначально вся эта заварушка внешняя прога->dll->основная прога возникла вот почему.
основная задача звучит так: есть приложение со встроенным языком (как раз внешняя программа), которое может вызывать процедуры внешних dll.
Я хочу написать dll основная функция которой - расширение интерфейса.

Загвоздка возникла, когда я в dll добавил форму.
При вызове экспортированной процедуры, которая исполняла код:
Form1:=TForm.Create (или TForm1.CreateParented(h), где h было и хендлом окна внешней проги и хендлом окна exe-приложения, написанного на делфи)
Form1.Show();
появлялось это окно и повисало. Внешнее приложение продолжало работать. (стоит отметить, что ShowModal() работает нормально, но мне не подходит).

Может Вы что-то с этой проблемой можете посоветовать?

Заранее Вам признателен.

[meneo]

спасибо за пример, но боюсь что у Вас будет такая же ошибка, если у Вас будет отдельно запущенна программа тест, и какая-нидь другая программа, которая подключает длл и с помощью нее отправляет сообщение окну программы тест.

[angvelem]

Я привёл рабочий пример. Нужна ещё одна программка, получающая сообщение?