[PR] DLL - dodawanie elementów do menu

Pisałem na ten temat coprawda pod koniec roku szkolnego, ale to było dawno i nie było odzewu. Spróbuję więc może inaczej. Robię najprostszą (wydawałoby się) rzecz związaną z DLL'kami i menu, jaka mi przyszła do głowy. Mianowicie, tworzę sobie program główny, w nim wstawiam menu, a w procedurze kreacji otwieram dynamicznie biblioteczkę DLL i uruchamiam procedurkę Inicjującą wyglądającą następująco:

procedure Initialize(Form: TForm); stdcall;
var
  MenuItem: TMenuItem;
begin
  MenuItem:=TMenuItem.Create(Form);
  MenuItem.Caption:='DLL1';
  MenuItem.OnClick:=Obiekt.MenuClick;
  { add the new item to the Windows menu }
  Form.Menu.Items.Add(MenuItem);
  end;

Dla porządku wstawię może deklarację Obiektu:

type
  TObiekt = object
    procedure MenuClick(Sender: TObject);
    end;

var
  Obiekt: TObiekt;

procedure TObiekt.MenuClick(Sender: TObject);
begin
  ShowMessage('Kliknales 1');
  end;

No i wszystko działa pięknie, jak uruchomię program, to pojawia mi się menu i element listy (o nazwie DLL1), jak w niego kliknę, to pojawia mi się okienko z napisem "Kliknales 1" i jest cool. Sprawa się komplikuje, jak dodam drugą, identyczną niemal bibliotekę dynamiczną. Różnice polegają jedynie na tym, iż Caption MenuItem'a brzmi DLL2, nie DLL1, a napis w okienku "Kliknales 2", a nie "Kliknales 1". No i niby wszystko działa, menu się pojawia, mam dwa elementy menu (DLL1 i DLL2), jak kliknę w pierwszy, to pojawia mi się napis "Kliknales 1", a jak klikne drugi, to (tu zonk) również pojawia się napis "Kliknales 1". Po krótkich testach doszedłem do wniosku, że niezależnie od wszystkiego, przy kliknięciu w drugi element menu wykonuje mi się event OnClick elementu pierwszego. Jeśli pierwszemu elementowi nie przypiszę żadnego Eventa OnClick, a drugiemu przypiszę event odpowiedni, to kliknięcie na drugi element (tak jak i na pierwszy) nie spowoduje żadnego efektu.
Co jest grane? Jest to przecież najprostsza rzecz, jaką można zrobić, a tu już takie dziwadła się dzieją... Celowo zrobiłem to wszystko w prawie pustym programie, nie służącym do niczego, by uniknąć błędów i by program był najczytelniejszy, jak to tylko możliwe.

Myślę, że błąd tkwi raczej w główny programie, przy ładowniu wtyczki. Pokaż ten fragment najlepiej :)

procedure TForm1.FormCreate(Sender: TObject);
var
  Initialize: procedure(Form: TForm); stdcall;
begin
  DLL1 := LoadLibrary('Lib1.dll'); // laduj biblioteke
  DLL2 := LoadLibrary('Lib2.dll'); // laduj biblioteke
  try
    @Initialize := GetProcAddress(DLL1, 'Initialize'); // laduj procedure
    if @Initialize = nil then raise Exception.Create('Bład - nie mogę znaleźć proceudry w bibliotece!');
    Initialize(Form1); // wywolaj procedure
    @Initialize := GetProcAddress(DLL2, 'Initialize'); // laduj procedure
    if @Initialize = nil then raise Exception.Create('Bład - nie mogę znaleźć proceudry w bibliotece!');
    Initialize(Form1); // wywolaj procedure
  finally
    end;
  end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
  I: integer;
begin
  For i:=0 to MainMenu1.Items.Count-1 do MainMenu1.Items[i].Free;
  FreeLibrary(DLL1); // wreszcie zwolnij pamiec
  FreeLibrary(DLL2);
  end;

Proszę bardzo. Ale nie jestem pewny, czy to tu jest błąd, gdyż na przykład Caption elementów Menu się zgadza, ale Eventy nie...

Cóż, rzeczywiście wygląda ok... Tak samo, jak kod dll'a. Przynajmniej, na pierwszy rzut oka. Spróbuj może zrobić 2 zmienne, do których wrzucisz osobno procedury initialize z bibliotek. Chociaż, z tym też powinno być wszystko ok. Mimo wszystko spróbuj, bo czasem się zdarzają jakieś takie głupie błędy, ze niby wszystko powinno działać, a nie działa. I nie zapomnij sprawdzić też najprostszego błędu. Upewnij się, że w tej drugiej bibliotece dałeś 1, a nie 2. Może zmieniłeś i zapomniałeś skompilować, albo co (zapewne nie, ale sprawdź :) )?

// Dopisane
Jak tak patrzę, to się zastanawiam, czy nie powinieneś przypadkiem stworzyć najpierw obiektu TObiekt. Może jak go nie tworzysz, to procedury wpychają się jakoś pod jeden adres?

// Dopiasane 2
Ups... Faktycznie pomyliło mi się z klasami... [wstyd]

Próbuję, sprawdzam, ale nic :/. W razie czego tu: http://www.pilotmp3.devtown.net/testdll.zip jest spakowana wersja kodu z najprostszym programem (wszystkie pliczki, nie tylko sam kod, ale formy i takie tam, do natychmiastowego użycia). Może błąd jest gdzieś poza tym, co podałem na forum?
P.S. Tak jak już mówiłem, procedury Initialize wywoływane prawidłowo, gdyż są DLL1 i DLL2, tylko coś się kiepści z event'ami...

//Dopisane:
Hmm... Albo mi się wydaje, albo obiekty nie mają konstruktorów.. Tak czy inaczej spróbowałem zmienić TObject na class(TComponent) i stworzyć przed użyciem, ale nic nie pomogło. Dalej zachowuje się jak wcześniej...

//Dopisane jeszcze raz:
Hmm.. Jeszcze dziwniejsze rzeczy dzieją się (może to kogoś naprowadzi) jak na przykład w pierwszej DLL'ce stworzymy analogicznie dwa (DLL1 i DLL2) elementy menu, a w drugiej trzy (DLL3, DLL4 i DLL5). Wtedy przy klikaniu w DLL1 pokazuje się "Kliknales 1", przy kliknięciu w DLL2 pokazuje się "Kliknales 2", przy kliknięciu w DLL3 pokazuje się "Kliknales 1", przy kliknięciu w DLL4 pokazuje się "Kliknales 2", za to przy kliknięciu w DLL5 pokazuje się "Kliknales 5". To juz mnie całkiem rozbraja...

Ja się bawiłem tym wcześniej i nadal także nie mogę dojść co jest nie tak. Teraz mi się asunęłó, że może to procedurka Initialize - bo dwie takie procedurki w dwóch DLLach i może coś się z eventami robi...

Tak, tylko problem raczej leży gdzie indziej. Gdyż procedurki Initialize uruchamiają się prawidłowo, tylko coś z późniejszym wywoływaniem Event'ów nie działa... Zastanawiałem się, czy czasem te obiekty jakoś nie pokrywają się w pamięci, ale nie widzę powodów, by tak się miało dziać...

Przeprowadziłem kolejne testy dotyczące tego zagadnienia i doszedłem do jeszcze dziwniejszych wniosków...
Wygląda na to, że Eventy są prawidłowo przypisywane (odwoływanie się bezpośrednio do MainMenu1.Items[x].OnClick(Self) działa prawidłowo), a kliknięcie na inny element menu powoduje reakcję taką, jakby kliknięto w ogóle w inny element (Sender w Evencie również nie jest ten, co trzeba...) Co jest grane? Już niebardzo mi cokolwiek więcej do głowy przychodzi...

A moze to jest blad delphi ? ja kiedys robilem array of TNotifyEvent i [0] i [1] mialy taka sama wartosc w debuggerze(dziwna, ale w koncu to dziwna zmienna), ale nie dalo sie odalipic [0], ale od [1] w gore wszystko dziala dobrze (sprawdzalem miliony razy i bledu nigdzie nie bylo,wiec musialem sie z tym pogodzic i dziala o [1] ;) )

No tak, tylko ja nie mogę się z tym pogodzić :/. Problem polega na tym, że nie ma możliwości obejścia tego problemu...

Heh - dziwne.. - obadałem ten kod i zawsze jest "1" ... - nawet jeśli zmienie nazwy wszystkich procedur, [na wszelki wypadek] to i tak nie działa.. - dziwne.. Ale jeszcze się z tym pobawie dzisiaj..

Hmm... Podczas przeprowadzania kolejnych testów w tej sprawie zauważyłem, że jeśli któreś z MenuItem jest podmenu i ma jakieś elementy "w sobie", to przy próbie rozwinięcia pojawia się błąd "Invalid Pointer Operation" :/.

Cześć :)

Zaciekawił mnie Twój problem (ściągnołem żródła) i bawiłem sie z tym pół dnia :))
Problem naprawde po [CIACH!]...
Doszedłem do wniosku że kreowanie itemów powinno się odbywać w unicie głównym programu tzn:
instrukcje wykreowania itemu umieścić przed Initialize(form) pierwszej biblioteki, i Initialize(form) drugiej
A w procedurach onClick zostawić tylko instrukcje że ma wywołać napisy.
(..items.caption:= itd)
Dobrze że to nie plugins a biblioteka więc i tak wywołanie musi być z głównego unitu (więc po każdym wywołaniu można kreować item)

Hmm... Cały problem polega na tym, że to ma być docelowo system wtyczek :/. Ten projekt stworzyłem do testów na najprostrzej strukturze a i tak nie działa... Ale poddałeś mi pewien pomysł, może się uda... Chodzi o to, żeby była jakaś funkcja wywołana jeszcze przed inicjalizacją, która by zwracała strukturę elementów menu stworzonego na potrzeby danej wtyczki i żeby ich tworzenie odbywało się w głównym programie a w procedurce inicjującej tylko dopisać odpowiednie event'y. Spróbuję... Może się uda...

Jupi! Udało mi się znaleźć rozwiązanie, coprawda trochę okrężne i po jakichś 2 miesiącach głowienia się nad tym zrobiłem to w sposób następujący:
Stworzyłem w każdym DLL'ku funkcję QueryMenu: TStringList; i procedurkę Initialize(Form);
Oto ich przykładowy wygląd:

function QueryMenu: TStringList; stdcall;
begin
  Result:=TStringList.Create;
  Result.Add('DLL2 Submenu');
  Result.Add(' DLL3');
  Result.Add(' DLL4');
  Result.Add(' DLL5');
  end;

procedure Initialize(Form: TForm); stdcall;
var
  MenuItem: TMenuItem;
begin
  MenuItem:=Form.Menu.Items.Find('DLL2 Submenu').Find('DLL3');
  If MenuItem<>nil then MenuItem.OnClick:=Obiekt2.Menu3Click;

  MenuItem:=Form.Menu.Items.Find('DLL2 Submenu').Find('DLL4');
  If MenuItem<>nil then MenuItem.OnClick:=Obiekt2.Menu4Click;

  MenuItem:=Form.Menu.Items.Find('DLL2 Submenu').Find('DLL5');
  If MenuItem<>nil then MenuItem.OnClick:=Obiekt2.Menu5Click;
  end;

Akurat wzięte z drugiego dll'ka.
W programie głównym najpierw wywołuję funkcję QueryMenu i od razu na podstawie zwróconej struktury tworzę sobie menu:

function Level(Str: String): Integer;
var I: Integer;
begin
  I:=0;
  While Str[I+1]=' ' do I:=I+1;
  Result:=I;
  end;

function BezSpacji(Str: String): String;
begin
  Result:=Copy(Str, Level(Str)+1, Length(Str)-Level(Str));
  end;

procedure IncludeMenu(Structure: TStringList; Where: TMenuItem);
var
  I, Sp: Integer;
  MenuItemAct, MenuItemNew: TMenuItem;
begin
  MenuItemAct:=Where;
  Sp:=0;
  For I:=0 to Structure.Count-1 do begin
    While Level(Structure[I])<Sp do begin
      MenuItemAct:=MenuItemAct.Parent;
      Sp:=Sp-1;
      end;
    If Level(Structure[I])>Sp then begin
      Sp:=Sp+1;
      If (Level(Structure[I])>Sp) or (I=0) then begin
        ShowMessage('Poważny błąd w strukturze menu! Aplikacja zostaje przerwana!');
        Application.Terminate;
        end;
      MenuItemAct:=MenuItemAct.Find(BezSpacji(Structure[I-1]));
      end;
    MenuItemNew:=TMenuItem.Create(Form1);
    MenuItemNew.Caption:=BezSpacji(Structure[I]);
    MenuItemAct.Add(MenuItemNew);
    end;
  end;

...

  try
    @QueryMenu := GetProcAddress(DLL1, 'QueryMenu'); // laduj procedure
    if @QueryMenu = nil then raise Exception.Create('Bład - nie mogę znaleźć proceudry w bibliotece!');
    IncludeMenu(QueryMenu, Form1.Menu.Items); // wywolaj procedure

Po czym dopiero wywołuję procedure Initialize (w parametrze podając pointera do Formy) i ona podpina odpowiednie Eventy pod "pustą" strukturę menu. I najważniejsze w tym wszystkim jest to, że TO DZIAŁA!! :)
Oczywiście dziękuję ogromnie wszystkim za pomoc, jestem winien po [browar] .
P.S. Może napiszę jakiś artykuł o tym jak ten problem ominąć, bo chyba nie idzie zrobić tego inaczej... Z dokładnymi komentarzami co i jak i w ogóle...

Fajnie że znalazłeś :) ale i ja troche posiedziałem i podumałem

Pogrzebałem troche w kodach które ściągnołem kiedyś o wtyczkach, znalazłem i
okroiłem go sporo oraz skomentowałem dla lepszego zrozumienia ;)
Sprawdziłem - zero byków

Podaje dla przykładu:

//************** kod biblioteki *******************
library Biblioteka1;
uses
  SysUtils,Classes,Windows,Dialogs;

var
  OwnerApp: Integer;

//pobiera nazwę dla itema menu
function GetName: Pchar; far;
begin
 Result := 'DLL 1';
end;

//głowna procedura do wykonywania
procedure Komunikat; far;
begin
 showmessage('wtyczka 1');
 //itd.. itd..
end;

//inicjacja
procedure Init(Owner: Integer); far
begin
  OwnerAPP := Owner;
end;

//export
exports
 GetName, Komunikat, Init;

begin
end.

//***************** główny unit ****************************
unit MainForm;

interface

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

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    procedure LoadPlugIns;
    procedure PlugInClick(Sender: TObject);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation {$R *.DFM}

var
 Wtyczki :TList;

type
 TWtyczki = class
    Nazwa    :String;
    Adres    :Integer;
    Wskaznik :Pointer;
  end;

  GetNameFunction = function : PChar;
  Akcja = procedure;
  PlugInInit = procedure (Owner: Integer);

var
  StopSearch: Boolean;

//procedura wyszukuje w katalogu pliki o podanym rozszerzeniu (*.dll)
procedure SearchFileExt(const Dir, Ext: String; Files: TStrings);
var
 Found: TSearchRec;
  i : Integer;
  Dirs: TStrings;
  Finished : Integer;
begin
  StopSearch := False;
  Dirs := TStringList.Create;
  Finished := FindFirst(Dir + '*.*', 63, Found);
  while (Finished = 0) and not (StopSearch) do
  begin
     if (Found.Name[1] <> '.') then
     begin
       if (Found.Attr and faDirectory = faDirectory) then
       Dirs.Add(Dir + Found.Name)
       else
       if Pos(UpperCase(Ext), UpperCase(Found.Name))>0 then
       Files.Add(Dir + Found.Name);
     end;
    Finished := FindNext(Found);
  end;
  FindClose(Found);
  if not StopSearch then
  for i := 0 to Dirs.Count - 1 do
  SearchFileExt(Dirs[i], Ext, Files);
  Dirs.Free;
end;


//--------------- załadowanie bibliotek (wtyczek)
procedure TForm1.LoadPlugIns;
var
  Files: TStrings;
  i: Integer;
  TestPlugIn : TWtyczki;
  NewMenu: TMenuItem;
begin
  Files:= TStringList.Create;
  Wtyczki:= TList.Create;
  SearchFileExt(ExtractFilepath(Application.Exename) + '\', '.dll', Files);
  //pętla ładująca biblioteki (wtyczki) ...
  for i := 0 to Files.Count-1 do
  begin
    TestPlugIn:= TWtyczki.Create;
    TestPlugIn.Adres:= LoadLibrary(PChar(Files[i]));
    PlugInInit(GetProcAddress(TestPlugIn.Adres, 'Init'))(HInstance);
    TestPlugIn.Nazwa:= GetNameFunction(GetProcAddress 
                                                            (TestPlugIn.Adres, 'GetName'));
    TestPlugIn.Wskaznik:= GetProcAddress(TestPlugIn.Adres, 'Komunikat');
    Wtyczki.Add(TestPlugIn);
    //kreowanie itemów...
    NewMenu:= TMenuItem.Create(Self);
    NewMenu.Caption:= TestPlugIn.Nazwa;
    NewMenu.OnClick:= PlugInClick;
    NewMenu.Tag:= i;
    MainMenu1.Items.Add(NewMenu);
  end;
  Files.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  LoadPlugIns;
end;

//reakcja do wykonania poprzez kliknięcie na któryś item
procedure TForm1.PlugInClick(Sender: TObject);
begin
  Akcja(TWtyczki(Wtyczki[TMenuItem(Sender).Tag]).Wskaznik);
end;


procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
  i: Integer;
begin
  //zwolnienie bibliotek...
  for i := 0 to Wtyczki.Count-1 do
  FreeLibrary(TWtyczki(Wtyczki[i]).Adres);
  Wtyczki.Free;
end;

end.

Sorki ale zapomiałem wziąć kodu w klamerki delphi :/
Nie mam możliwości poprawki (niby jestem zarejestrowany) a w związku z tym pytanie:

Dwa razy się rejestrowałem i za kazdym razem nie mam mozliwości dostępu do
"Twoje konto" gdzie domyślam się mogę podać GG itd...
a widze ze 90% z was ma :( co jest grane ?

Tutaj: http://4programmers.net/article.php?id=516 możecie poczytać sobie, co się napisałem na temat tworzenia takich wtyczek... Ufff... Trochę tego jest :). A jak chodzi o problem Inter'a, to wygląda, że jesteś zarejestrowany, ale nie zalogowany... Dziwne... Masz możliwość edycji, a twój nick jest na czarno? Ja tam bym ten problem zgłosił w forum Coyote.

// Nie, to ja przykleiłem - detox