Создание плагинов на DLL: SharedMemory

[BOBAH13]

Итак вот сделал пример вроде все работает.
Ну там права и т.п. учтите ок ? Просто коды личные

library Menus;

uses
  Windows;

{$R *.RES}
  
function GetID: WORD; stdcall;
begin
  Result := $1000;
end;

function GetCaption: PCHAR; stdcall;
begin
  Result := 'Menu';
end;

function GetVersion: LongInt; stdcall;
begin
  Result := MakeLong(1, 0);
end;

function GetInformation: PWCHAR; stdcall;
begin
  Result := '2008 '#169' Лихонос Владимир. All Rights Reserved.';
end;

type
  PItemMenu = ^TItemMenu;
  TItemMenu = packed record
    Text: String;
    Index: Integer;
    OnClick: Pointer;
    PrevItem: PItemMenu;
    NextItem: PItemMenu;
  end;
  
var
  FirstItem: PItemMenu;
  IsInitialize: Boolean = False;

function GetFirstItem: PItemMenu; stdcall;
begin
  Result := FirstItem;
end;

function GetLastItem: PItemMenu; stdcall;
var
  p: PItemMenu;
begin
  p := FirstItem;
  while (p <> NIL) do
  begin
    if (p^.NextItem = NIL) then
      break;
    p := p^.NextItem;
  end;
  Result := p;
end;

function AddItem(Text: String; OnClick: Pointer): PItemMenu; stdcall;
var
  p: PItemMenu;
begin
  new(p);
  p^.Text := Text;
  p^.OnClick := OnClick;
  p^.PrevItem := GetLastItem;
  p^.NextItem := NIL;
  if (p^.PrevItem = NIL) then
  begin
    FirstItem := p;
    p^.Index := 0;
  end else
  p^.Index := p^.PrevItem^.Index + 1;
  Result := p;
end;

procedure OnClickFirst(Sender: TObject);  
begin
  MessageBox(0, 'On Click Me !!!', 'Test', MB_ICONINFORMATION);
end;

procedure Initialize; stdcall;
begin
  IsInitialize := True;
  AddItem('Click Me :)', @OnClickFirst);
end;

procedure Finalize; stdcall;
var
  p: PItemMenu;
begin
  p := FirstItem;
  while (p <> NIL) do
  begin
    FirstItem := p^.NextItem;
    dispose(p);
    p := FirstItem;
  end;
  IsInitialize := False;
end;

exports
  GetID name 'GetID',
  GetCaption name 'GetCaption',
  GetVersion name 'GetVersion',
  GetInformation name 'GetInformation',
  Initialize name 'Initialize',
  Finalize name 'Finalize',
  GetFirstItem name 'GetFirstItem',
  GetLastItem name 'GetLastItem';

begin
end.

главный юнить программы

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, PlugIns;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    procedure N4Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
  public
    Plugins: TPlugins;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type
  PItemMenu = ^TItemMenu;
  TItemMenu = packed record
    Text: String;
    Index: Integer;
    OnClick: TNotifyEvent;
    PrevItem: PItemMenu;
    NextItem: PItemMenu;
  end;
  TGetFirstItem = function: PItemMenu; stdcall;
  TGetLastItem = function: PItemMenu; stdcall;

procedure TForm1.N4Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  p: PItemMenu;
  t: TMenuItem;
  i: Integer;
  GetFirstItem: TGetFirstItem;
begin
  Plugins := TPlugins.Create;
  Plugins.CheckID := $1000; // данный ид указан в длл
  i := Plugins.Add(ExtractFilePath(ParamStr(0)) + 'Menus.dll');
  Plugins.Load(i);
  Plugins.Plugin := i;
  Plugins.PlugInitialize;

  GetFirstItem := Plugins.DoFunction(i, 'GetFirstItem');
  p := GetFirstItem;

  t := TMenuItem.Create(NIL);
  t.Caption := p^.Text;
  t.OnClick := p^.OnClick;

  N2.Add(t);  
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Plugins.Free;
end;

end.

модуль PlugIns - мой личный так что... прилагается.
Да возможно Вы спросите зачем всякие GetID и т.п. таким образом я проверяю что это мой плугин, а не библиотека какая еще
stdcall - я привык, для более высокой совместимости в WinNT.

Ну как помог ?

[darkstarx]

Благодарю, что потратили на меня время. В принципе я так и сделал, только не прописывал все эти функции (GetFirst, Get(index: Integer):Pointer или там TMenuItem) в DLL, потому что библиотеку нужно писать быстро, библиотек может быть несколько и для каждой требовать, чтобы в ней были все эти обработчики для работы с меню - просто нежедательно, хлтелось, чтобы в DLL просто разместил меню и ВСЁ, пиши функционал и не парься с тем, что еще придется связывать DLL с какой-то внешней прогой.

Я, воспользовавшись вашей идеей просто сделал в проге прошаривание всех жлементов меню в проге и построение новых элементов, в точности вот как у вас, только не по структуре (то есть списку), а по дереву меню. За идею кстати Спасибо.

Но единственное, что не понравилось в моей реализации:
Передаю из DLL указатель на меню, а в проге прошариваю все это меню рекурсивно, создавая новые MenuItem, назначая им те же имена, заголовки и указатели на обработчики событий (Name, Caption, OnClick). Однако при удалении элементов меню в момент закрытия приложения (MenuItem.Free) возникает исключение непонятное, причем избежать такого эффекта можно (как неожиданно выяснил опытным путем ) изменением имен и заголовков элементов меню - не странно ли, как вы считаете? Например, имя было mCommand1, меняем на mCommand1i и все, без проблем.
Я сам удивлен был этому, всегда думал, что в Delphi не нужно заморачиваться с кодом, чтобы все работало без ошибок.
А вот почему происходят такие чудеса при просто добавлении (а не создании новых копий) элементов меню (из DLL) в меню программы - это мне вообще не понятно, матрица какая-то с агентом Смитом...

[BOBAH13]

Вот поэтому я нехочу "наоборот" замарачиваться с VCL + кто Вам мешает основные функции обработки так же положить в dll из которой все плугины черпали основы как Api Все идеально будет работать, как в примере. Вообщем решаете ?!

[mihali4]

всегда думал, что в Delphi не нужно заморачиваться с кодом

А как вы себе представляете процесс уничтожения динамически созданных компонентов? Разница-то между ними какая-то должна быть - для опознавания? Странно, что вы не получили "бяку" в процессе их создания...