Форум: "Прочее";
Текущий архив: 2007.10.07;
Скачать: [xml.tar.bz2];
Вниз
Динамическое создание меню по XML-файлу Найти похожие ветки
← →
de. (2007-09-07 10:01) [0]Есть ли еще примеры, помимо DW, очень нужно немогу разобраться…
← →
clickmaker © (2007-09-07 10:10) [1]а что такое DW?
← →
de. (2007-09-07 10:11) [2]
> clickmaker © (07.09.07 10:10) [1]
Delphi World
← →
Eraser © (2007-09-07 10:13) [3]
> de. (07.09.07 10:01)
А в чем там проблема? Рекурсивно проходишь всё xml дерево, при этом параллельно добавляя пункты в меню.
← →
Kerk © (2007-09-07 10:14) [4]В кладовке посмотри, вроде было
← →
de. (2007-09-07 10:32) [5]
> Kerk © (07.09.07 10:14) [4]
Ок.
> Eraser © (07.09.07 10:13) [3]
По большому счету задача немного другая:
Необходимо создавать тот или иной элемент меню, по мере появления в папке плагинов файлов dll (могут быть формы отсчеты и т.д.)
Как поступить не знаю может к каждой dll еще кидать xml файл, т.е. например такая пара файлов будет определять меню и форму которая вызывается. Можно сделать так ./plugins/ тут пара файлов например dForm1.dll и xForm1.xml
Это все должно динамически загружаться и выгружатся...
Как это реализовать, нужное создать какуюто одну процедуру, которая бы вызывала динамически каждую из dll...
← →
novill © (2007-09-07 10:34) [6]Я разработал для своих нужд пару лет назад.
Там все просто:
1. Определяешь стуртуру xml (минимально необходимые признаки: имя пункта, имя процедуры обработчика события OnClick или наличие подменю, остальное - по вкусу)
2. Реализуешь работу с таким xml файлом. (добавить , удалить элемент, заполнить параметры)
3. Реализуешь обход дерева xml и перенос параметров в пункты меню.
Код бесплатно не дам, на вопросы отвечу. На каком моменте не получается?
← →
clickmaker © (2007-09-07 10:41) [7]
> [5] de. (07.09.07 10:32)
на каждую DLL - свой пункт меню? Так почему просто не создавать их по числу DLL в папке?
Caption - берется из предопределеного ресурса в DLL, например. Или возвращается функцией, GetPluginInfo, скажем.
Вообще, имена функций должны быть универсальными, чтобы GetProcAddress их дергать
← →
de. (2007-09-07 10:52) [8]
> novill © (07.09.07 10:34) [6]
Пока еще не вник в структуру реализации (Меню по XML из примера DW),
но работающим этот пример сделал.
Т.е. получается, что есть какойто проект на Delphi, например Project1.exe, есть некий XML файл меню, например Menu.xml, запускаем проект все пашет разделы и подразделы меню создаются...
Этот пример реализован на те процедуры которые определены в проекте, т.е. если мы захочем написать какуюнить процедуру или функцию, нам необходимо будет переписать проект и XML файл (да и честно говаря тогда XML файл и ненужен будет, элемент меню который вызывает написанную напи процедуру или функцию, можно будет добавить и в проекте.)
Мнеже необходимо проект не трогать, а лиш менять сам XML файл и подкидывать нужные dll.
Т.е. есть есть проект и к "каждому" элементу меню этого проэкта есть dll которая содержет форму или еще чтото.
Получается для того чтобы нам добавить/убрать форму/функцию, процедуру нам не нужно пудет трогать сам проект...
Этакая динамическая машина...
Вот это я и хочу реализовать. Кто что подскажет, скажет.? (Сорри за Error...)
← →
de. (2007-09-07 10:56) [9]
> clickmaker © (07.09.07 10:41) [7]
>
> > [5] de. (07.09.07 10:32)
>
> на каждую DLL - свой пункт меню? Так почему просто не создавать
> их по числу DLL в папке?
Вот вот... :-)
на счет универсальности это правельно, но разные формы будут выполнять разные задачи, и также принимать и передовать разные параметры...
← →
clickmaker © (2007-09-07 11:00) [10]
> но разные формы будут выполнять разные задачи, и также принимать
> и передовать разные параметры
ну вся функциональность должна быть зашита в самой DLL - это понятно. Параметры вызова функции из DLL должны быть формализованы. В идеале - универсальная структура, покрывающая все возможные варианты данных. А их наверняка какое-то конечное число.
Т.е. exe вообще ничего не знает, с каким именно плагином он щас работает. Его задача - по максимуму заполнить эту структуру и дернуть функцию. А плагин сам разбирается, что с этим добром делать.
Другой вариант - функция обратного вызова из DLL. Когда она сама запрашивает данные из экзе по мере надобности. Но опять-таки в виде универсальной структуры, наподобии сообщений Windows
← →
novill © (2007-09-07 11:03) [11]> [8] de. (07.09.07 10:52)
если мы захочем написать какуюнить процедуру или функцию, нам необходимо будет переписать проект
нет. в хмл надо указать имя длл и имя вызываемой функции, а в парсилке прописать импорт функции.
← →
novill © (2007-09-07 11:06) [12]> [10] clickmaker © (07.09.07 11:00)
+1
Передача парамертов должна быть универсальная. Или если у тебя точно известны все варианты типов функций и количества параметров, то можно в хмл хранить еще и тип функции и создавать соответствующую :)
← →
de. (2007-09-07 11:11) [13]Привиду иходный текст из DW используется 2 компонента на главной форме это: TMainMenu и TXMLDocument, компаненты помоему стандартные....
{
The following procedure allows you to build a menu from an XML file.
Special feature: You only need to specify the Name of the procedure which then
will be attached to a OnClick handler.
Note that the procedure must be declared as public.
}
{
Mit folgender Prozedur kann man aus einem XML-File ein Menu
erstellen lassen (einfach im OnCreate aufrufen).
Besonderes Feature: Im XML-File gebt ihr nur den Namen der Prozedur an,
die dem OnClick-Ereignis zugewiesen werden soll.
Die einzige Einschrankung besteht darin, dass diese Prozedur
published sein muss.
Bindet einfach diese Prozedur in euer Hauptformular ein:
}
procedure TMainForm.CreateMenuFromXMLFile;
function Get_Int(S: string): Integer;
begin
Result := 0;
try
Result := StrToInt(S);
except
end;
end;
procedure AddRecursive(Parent: TMenuItem; Item: IXMLNode);
var
I: Integer;
Node: TMenuItem;
Child: IXMLNode;
Address: TMethod;
begin
Node := TMenuItem.Create(Parent);
if (Uppercase(Item.Attributes["CAPTION"]) <> "SEPERATOR") then
begin
Node.Caption := Item.Attributes["CAPTION"];
if (Uppercase(Item.Attributes["ID"]) <> "NONE") then
begin
Address.Code := MethodAddress(Item.Attributes["ID"]);
Address.Data := Self;
if (Item.ChildNodes.Count - 1 < 0) then
Node.OnClick := TNotifyEvent(Address);
end;
if (Uppercase(Item.Attributes["SHORTCUT"]) <> "NONE") then
Node.ShortCut := TextToShortCut(Item.Attributes["SHORTCUT"]);
Node.Checked := (Item.Attributes["CHECKED"] = "1");
end
else
Node.Caption := "-";
Node.Visible := (Item.Attributes["VISIBLE"] = "1");
if Parent <> nil then
Parent.Add(Node)
else
MainMenu.Items.Add(Node);
for I := 0 to Item.ChildNodes.Count - 1 do
begin
Child := item.ChildNodes[i];
if (Child.NodeName = "ENTRY") then
AddRecursive(Node, Child);
end;
end;
var
Root: IXMLMENUType;
Parent: TMenuItem;
I: Integer;
Child: IXMLNode;
begin
XMLDocument.FileName := ExtractFilePath(Application.ExeName) + XMLFile;
if not FileExists(XMLDocument.FileName) then
begin
MessageDlg("Menu-XML-Document nicht gefunden!", mtError, [mbOK], 0);
Halt;
end;
XMLDocument.Active := True;
Screen.Cursor := crHourglass;
try
Root := GetXMLMenu(XMLDocument);
Parent := nil;
for I := 0 to Root.ChildNodes.Count - 1 do
begin
Child := Root.ChildNodes[i];
if (Child.NodeName = "ENTRY") then
AddRecursive(Parent, Child);
end;
finally
Screen.Cursor := crDefault;
end;
end;
← →
de. (2007-09-07 11:11) [14]
{----------------------------------------------------------
You also need the encapsulation of the XML-File.
( Save it as unit and add it to your program.
Created with Delphi6 -> New -> XML Data Binding Wizard )
-----------------------------------------------------------}
{----------------------------------------------------------
Naturlich braucht man auch die Kapselung des XML-Files
(Als Unit speichern und ins Programm einbinden.
Die Datei wurde mit Delphi 6 -> Neu -> XML-Datenbindung erstellt):
-----------------------------------------------------------}
{***************************************************}
{ }
{ Delphi XML-Datenbindung }
{ }
{ Erzeugt am: 27.06.2002 13:25:01 }
{ }
{***************************************************}
unit XMLMenuTranslation;
interface
uses xmldom, XMLDoc, XMLIntf;
type
{ Forward-Deklarationen }
IXMLMENUType = interface;
IXMLENTRYType = interface;
{ IXMLMENUType }
IXMLMENUType = interface(IXMLNode)
["{8F36F5E2-834F-41D9-918F-9B1A441C9074}"]
{ Zugriff auf Eigenschaften }
function Get_ENTRY: IXMLENTRYType;
{ Methoden & Eigenschaften }
property ENTRY: IXMLENTRYType read Get_ENTRY;
end;
{ IXMLENTRYType }
IXMLENTRYType = interface(IXMLNode)
["{AD85CD05-725E-40F8-A8D7-D6EC05FD4360}"]
{ Zugriff auf Eigenschaften }
function Get_CAPTION: WideString;
function Get_VISIBLE: Integer;
function Get_ID: Integer;
function Get_ENTRY: IXMLENTRYType;
procedure Set_CAPTION(Value: WideString);
procedure Set_VISIBLE(Value: Integer);
procedure Set_ID(Value: Integer);
{ Methoden & Eigenschaften }
property Caption: WideString read Get_CAPTION write Set_CAPTION;
property Visible: Integer read Get_VISIBLE write Set_VISIBLE;
property ID: Integer read Get_ID write Set_ID;
property ENTRY: IXMLENTRYType read Get_ENTRY;
end;
{ Forward-Deklarationen }
TXMLMENUType = class;
TXMLENTRYType = class;
{ TXMLMENUType }
TXMLMENUType = class(TXMLNode, IXMLMENUType)
protected
{ IXMLMENUType }
function Get_ENTRY: IXMLENTRYType;
public
procedure AfterConstruction; override;
end;
{ TXMLENTRYType }
TXMLENTRYType = class(TXMLNode, IXMLENTRYType)
protected
{ IXMLENTRYType }
function Get_CAPTION: WideString;
function Get_VISIBLE: Integer;
function Get_ID: Integer;
function Get_ENTRY: IXMLENTRYType;
procedure Set_CAPTION(Value: WideString);
procedure Set_VISIBLE(Value: Integer);
procedure Set_ID(Value: Integer);
public
procedure AfterConstruction; override;
end;
{ Globale Funktionen }
function GetXMLMENU(Doc: IXMLDocument): IXMLMENUType;
function LoadMENU(const FileName: WideString): IXMLMENUType;
function NewMENU: IXMLMENUType;
implementation
{ Globale Funktionen }
function GetXMLMENU(Doc: IXMLDocument): IXMLMENUType;
begin
Result := Doc.GetDocBinding("MENU", TXMLMENUType) as IXMLMENUType;
end;
function LoadMENU(const FileName: WideString): IXMLMENUType;
begin
Result := LoadXMLDocument(FileName).GetDocBinding("MENU", TXMLMENUType) as IXMLMENUType;
end;
function NewMENU: IXMLMENUType;
begin
Result := NewXMLDocument.GetDocBinding("MENU", TXMLMENUType) as IXMLMENUType;
end;
{ TXMLMENUType }
procedure TXMLMENUType.AfterConstruction;
begin
RegisterChildNode("ENTRY", TXMLENTRYType);
inherited;
end;
function TXMLMENUType.Get_ENTRY: IXMLENTRYType;
begin
Result := ChildNodes["ENTRY"] as IXMLENTRYType;
end;
{ TXMLENTRYType }
procedure TXMLENTRYType.AfterConstruction;
begin
RegisterChildNode("ENTRY", TXMLENTRYType);
inherited;
end;
function TXMLENTRYType.Get_CAPTION: WideString;
begin
Result := ChildNodes["CAPTION"].Text;
end;
procedure TXMLENTRYType.Set_CAPTION(Value: WideString);
begin
ChildNodes["CAPTION"].NodeValue := Value;
end;
function TXMLENTRYType.Get_VISIBLE: Integer;
begin
Result := ChildNodes["VISIBLE"].NodeValue;
end;
procedure TXMLENTRYType.Set_VISIBLE(Value: Integer);
begin
ChildNodes["VISIBLE"].NodeValue := Value;
end;
function TXMLENTRYType.Get_ID: Integer;
begin
Result := ChildNodes["ID"].NodeValue;
end;
procedure TXMLENTRYType.Set_ID(Value: Integer);
begin
ChildNodes["ID"].NodeValue := Value;
end;
function TXMLENTRYType.Get_ENTRY: IXMLENTRYType;
begin
Result := ChildNodes["ENTRY"] as IXMLENTRYType;
end;
end.
{---------------------------------------------------------------------
Finally, I"ll show you an example for the XML-File.
The Procedure Name is assigned to the ID which then will be called.
---------------------------------------------------------------------}
{---------------------------------------------------------------------
Als Beispiel fur das XML-File hier noch eines aus
einem meiner Programme.
In ID steht der Name der Prozedur, die man als OnClick aufrufen will
- denkt auch daran, dass diese Prozedur unbedingt als published
deklariert sein muss, sonst liefert MethodAddress() Nil zuruck.
----------------------------------------------------------------------}
← →
de. (2007-09-07 11:12) [15]Сам XML файл...
<?xml version="1.0" encoding="ISO-8859-1"?>
<MENU>
<ENTRY CAPTION="Datei" VISIBLE="1" ID="None" SHORTCUT="None" CHECKED="0">
<ENTRY CAPTION="Beenden" VISIBLE="1" ID="CloseProgram" SHORTCUT="Strg+X" CHECKED="0"></ENTRY>
</ENTRY>
<ENTRY CAPTION="Anzeige" VISIBLE="1" ID="None" SHORTCUT="None" CHECKED="0">
<ENTRY CAPTION="Toolbar" VISIBLE="1" ID="ShowToolbar" SHORTCUT="None" CHECKED="1"></ENTRY>
<ENTRY CAPTION="Seperator" VISIBLE="1"></ENTRY>
<ENTRY CAPTION="Optionen" VISIBLE="1" ID="ShowOptionen" SHORTCUT="Strg+O" CHECKED="0"></ENTRY>
</ENTRY>
<ENTRY CAPTION="News" VISIBLE="1" ID="None" SHORTCUT="None" CHECKED="0">
<ENTRY CAPTION="Refresh" VISIBLE="1" ID="RefreshAll" SHORTCUT="F5" CHECKED="0"></ENTRY>
<ENTRY CAPTION="Seperator" VISIBLE="1"></ENTRY>
<ENTRY CAPTION="Administration" VISIBLE="1" ID="None" SHORTCUT="None" CHECKED="0">
<ENTRY CAPTION="neue Nachricht hinzufugen" VISIBLE="1" ID="NewMarkedNews" SHORTCUT="Strg+N" CHECKED="0"></ENTRY>
<ENTRY CAPTION="markierte Nachricht bearbeiten" VISIBLE="1" ID="EditMarkedNews" SHORTCUT="Strg+E" CHECKED="0"></ENTRY>
<ENTRY CAPTION="markierte Nachricht loschen" VISIBLE="1" ID="DeleteMarkedNews" SHORTCUT="None" CHECKED="0"></ENTRY>
<ENTRY CAPTION="Seperator" VISIBLE="1"></ENTRY>
<ENTRY CAPTION="Film hinzufugen" VISIBLE="1" ID="AddMPG" SHORTCUT="None" CHECKED="0"></ENTRY>
<ENTRY CAPTION="markierten Film loschen" VISIBLE="1" ID="DeleteMPG" SHORTCUT="None" CHECKED="0"></ENTRY>
</ENTRY>
</ENTRY>
<ENTRY CAPTION="Hilfe" VISIBLE="1" ID="None" SHORTCUT="None" CHECKED="0">
<ENTRY CAPTION="LogView" VISIBLE="1" ID="ShowLog" SHORTCUT="Strg+L" CHECKED="0"></ENTRY>
<ENTRY CAPTION="eMail schreiben" VISIBLE="1" ID="WriteEMail" SHORTCUT="None" CHECKED="0"></ENTRY>
<ENTRY CAPTION="Seperator" VISIBLE="1"></ENTRY>
<ENTRY CAPTION="Uber" VISIBLE="1" ID="About" SHORTCUT="None" CHECKED="0"></ENTRY>
</ENTRY>
</MENU>
← →
de. (2007-09-07 11:14) [16]Пример заработал... Ток я вот вот этот кусок кода..
XMLDocument.FileName := ExtractFilePath(Application.ExeName) + XMLFile;
if not FileExists(XMLDocument.FileName) then
begin
MessageDlg("Menu-XML-Document nicht gefunden!", mtError, [mbOK], 0);
Halt;
end;
Закоментировал.... И указатл путь к файлу напрямую через компонент...
← →
de. (2007-09-07 11:24) [17]Да...
(с) Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch
Проект Delphi World © Выпуск 2002 - 2004
Автор проекта: ___Nikolay
Вот наверное собственно теперь, после прояснения ситуации, будет вопрос (проблема..):
Необходимо написать вот эту самую функцию или процедуру которая бы "выцмыкивала" эти dll.
Параметры передоваться собственно будут такие, это: Application, и что-то, что-то (наши дополнительные передаваемые параметры например для вызова какогонить лицевого счета абонента на карточку абонентов) и отдавать наверное будем только "SendMassage"- на выгрузку dll из проекта....
Вот что необходимо, читаю задачу сложной потому и прошу помаши...
Не кто меня на это не подталкивал мне просто самому стало Оочень интересно...
← →
novill © (2007-09-07 11:25) [18]ну, ты молодец :) Дальше будет проще ;)
← →
novill © (2007-09-07 11:29) [19]> "выцмыкивала"
Ну, в DW примеров нет что ли по работе с длл? Кстати, про особенонсти работы длл со строками не забудь.
← →
de. (2007-09-07 11:43) [20]
> novill © (07.09.07 11:29) [19]
Со строками конечно... PChar.
Код динамического вызова dll как правело пишется под конкретную dll...
Например какая нить форма логин...
...
fLibLogin = имя нашей dll из XML....
...
(* Load dll *)
hLogin:= LoadLibrary(PChar(fLibLogin));
if hLogin>= 32 then
begin
@dPrInitLogin:= GetProcAddress(hLogin, "dPrInitLogin");
@dFnCreateLogin:= GetProcAddress(hLogin, "dFnCreateLogin");
@dPrDoneLogin:= GetProcAddress(hLogin, "dPrDoneLogin");
if (Addr(@dPrInitLogin)<> nil)and (Addr(@dFnCreateLogin)<> nil)and
(Addr(@dPrDoneLogin)<> nil) then
begin
dPrInitLogin(Integer(Application));
dFnCreateLogin(...Какойто параметр...)
end
else
begin
//
end;
end
else
begin
//
end;
(* Load dll *)
← →
de. (2007-09-07 11:55) [21]Приведу примерчик из эдного своего поекта...
Может кто поможет модернизировать процедуру вызова dll, в процедуру вызова "разных" dll.
unit uMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
const
lLogin= "dll\Login\dLogin.dll";
tDFound= "DLL ÍÅ ÍÀÉÄÅÍÀ !";
tFFound= "ÎÄÍÀ ÈÇ ÔÓÍÊÖÈÉ DLL, ÍÅ ÍÀÉÄÅÍÀ !";
tCErr= "ÎØÈÁÊÀ ÑÎÇÄÀÍÈÅ ÔÎÐÌÛ !";
mHdErr= "ÄÈÀËÎÃ [ ÎØÈÁÊÀ ]";
wms= WM_USER+ 199;
type
TfrmMain = class(TForm)
procedure FormActivate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
hLogin: THandle;
dPrInitLogin: procedure(App: Integer); stdcall; //Инициализация
dFnCreateLogin: function(Tp: Integer; Cp: PChar; Lb: PChar;
ValUsr: PChar; ValPass: PChar): Boolean; stdcall; //Созданеи формы
dPrDoneLogin: procedure; stdcall; //"Выгрузка" Возврат Application
dPrCloseLogin: procedure; stdcall; // Закрытие наверно эт.. не обязательно..
procedure GetWMS(var M: TMessage); message wms; // реакция на сообщение (выгрузка dll...)
end;
var
frmMain: TfrmMain;
implementation
uses uInits;
{$R *.dfm}
procedure TfrmMain.GetWMS(var M: TMessage);
begin
dPrDoneLogin; // Возврат Application
FreeLibrary(hLogin);
end;
procedure TfrmMain.FormActivate(Sender: TObject);
begin
hLogin:= LoadLibrary(PChar(lLogin));
if hLogin >= 32 then
begin
@dPrInitLogin := GetProcAddress(hLogin, PChar("dPrInitLogin"));
@dFnCreateLogin := GetProcAddress(hLogin, PChar("dFnCreateLogin"));
@dPrDoneLogin := GetProcAddress(hLogin, PChar("dPrDoneLogin"));
@dPrCloseLogin := GetProcAddress(hLogin, PChar("dPrCloseLogin"));
if (Addr(@dPrInitLogin)<> nil)and (Addr(@dFnCreateLogin)<> nil)and
(Addr(@dPrDoneLogin)<> nil)and (Addr(@dPrCloseLogin)<> nil) then
begin
dPrInitLogin(Integer(Application));
if not dFnCreateLogin(0, "", "", "", "") then
begin
MessageBox(Handle, PChar(tCErr), PChar(mHdErr), MB_OK);
Close;
end;
end
else
begin
MessageBox(Handle, PChar(tFFound), PChar(mHdErr), MB_OK);
Close;
end;
end
else
begin
MessageBox(Handle, PChar(tDFound), PChar(mHdErr), MB_OK);
Close;
end;
end;
end.
← →
clickmaker © (2007-09-07 11:58) [22]
> [21] de. (07.09.07 11:55)
а что делает именно эта ДЛЛ?
← →
de. (2007-09-07 11:59) [23]Сама dll (1)
library dLogin;
uses
SysUtils,
Classes,
uLogin in "uLogin.pas" {frmLogin},
Forms {Usr};
var
dApp: Integer;
{$R *.res}
procedure dPrInitLogin(App: Integer); stdcall;
begin
dApp:= Integer(Application);
Application:= TApplication(App);
end;
function dFnCreateLogin(Tp: Integer; Cp, Lb, Usr, Pwd: PChar): Boolean; stdcall;
begin
Result:= True;
try
TfrmLogin.Create(Application, Tp, Cp, Lb, Usr, Pwd);
except
Result:= False;
end;
end;
procedure dPrDoneLogin; stdcall;
begin
Application:= TApplication(dApp);
end;
procedure dPrCloseLogin; stdcall;
begin
frmLogin.Close;
end;
exports
dPrInitLogin,
dFnCreateLogin,
dPrDoneLogin,
dPrCloseLogin;
begin
end.
← →
de. (2007-09-07 12:01) [24](2)
unit uLogin;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls, IniFiles;
const
cCp= "ÄÈÀËÎÃ-[ËÎÃÈÍ]";
cLb= "ÂÂÅÄÈÒÅ ÏÎËÜÇÎÂÀÒÅË&szl ig; È ÏÀÐÎËÜ:";
minLenUsr= 2;
minLenPass= 3;
wms= WM_USER+ 199;
W= 25;
H= 50;
type
TfrmLogin = class(TForm)
BtnOK: TSpeedButton;
BtnCancel: TSpeedButton;
GrpBx: TGroupBox;
EdtUser: TEdit;
EdtPassword: TEdit;
Img1: TImage;
Image1: TImage;
procedure FormCreate(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormDestroy(Sender: TObject);
procedure BtnOKClick(Sender: TObject);
procedure BtnCancelClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
constructor Create(AOwner: TComponent; Tp: Integer; Cp, Lb,
Usr, Pwd: PChar); overload; {Ïåðåïèñûâàå&ig rave;
ìåòîä Create, ÷òîáû äîáàâèòü ðÿä ïîðàìåòðîâ.}
end;
var
frmLogin: TfrmLogin;
TpLogin: Integer;
implementation
{$R *.dfm}
constructor TfrmLogin.Create(AOwner: TComponent; Tp: Integer; Cp, Lb,
Usr, Pwd: PChar);
begin
inherited Create(AOwner); {Óíàñëåäóåì Create(AOwner).}
TpLogin:= Tp; {Ïðèñâàåâàåì "îáùåé" ïåðåìåíîé, ïåðåäàííûé òèï ôîðìû Login.}
case TpLogin of {Âûáîð.}
0:
begin
if Length(Trim(StrPas(Cp)))= 0 then
Caption:= cCp
else
Caption:= Cp;
if Length(Trim(StrPas(Lb)))= 0 then
GrpBx.Caption:= cLb
else
GrpBx.Caption:= Lb;
EdtUser.Text:= Usr;
EdtPassword.Text:= Pwd;
end;
end
end;
procedure TfrmLogin.FormCreate(Sender: TObject);
begin
end;
procedure TfrmLogin.FormActivate(Sender: TObject);
begin
//
end;
procedure TfrmLogin.FormClose(Sender: TObject; var Action: TCloseAction);
begin
frmLogin.Free;
frmLogin:= nil;
end;
procedure TfrmLogin.FormDestroy(Sender: TObject);
begin
PostMessage(Application.MainForm.Handle, wms, 0, 1);
if TpLogin= 0 then
PostMessage(Application.MainForm.Handle, WM_QUIT, 0, 1);
end;
procedure TfrmLogin.BtnOKClick(Sender: TObject);
begin
end;
procedure TfrmLogin.BtnCancelClick(Sender: TObject);
begin
end;
end.
← →
clickmaker © (2007-09-07 12:02) [25]
> [23] de. (07.09.07 11:59)
все равно непонятно, что она делает? логинится куда-то? а зачем? кто это соединение потом будет использовать? и где обработка результатов логина?
← →
de. (2007-09-07 12:07) [26]
> clickmaker © (07.09.07 11:58) [22]
Вызывает форму Входа в программу.. (ну это не важно такой формы всерано не быдет по клику меню...) это так пример динамического вызова dll , не обходимо создать универсальную процедуру динамического вызова dll...
← →
clickmaker © (2007-09-07 12:12) [27]
> [26] de. (07.09.07 12:07)
ну, если по минимуму... то DLL должна содержать 2 функции: GetPluginInfo - информация о плагине (для того, чтобы в меню отобразить хотя бы) и ExecutePlugin - вызывается по клику меню.
У второй параметр типа
type TPluginData = packed record
App: TApplication;
что-то еще
...
end;
Возможно, кстати, и сами данные передавать в виде XML - одной строки.
← →
de. (2007-09-07 12:12) [28]Сейчас налобаю, чистый пример приведу, чтоб всем понятно было в моих коракулях не разбирались...
← →
clickmaker © (2007-09-07 12:18) [29]фишка в том, что плагин надо как можно более обособить от экзе-хозяина. Например, если он работает с некоей базой (о типе которой основное приложение может даже не знать), то все операции по логину, селект/инсерт и т.д. должны быть реализованы именно в самой длл.
← →
de. (2007-09-07 12:59) [30]ВОТ ШЕДЕВР!!!.... даже на обед не пошел.. ;-)))
Короче это будет шаблончик, который нам необходимо будет модернизировать...
Кому не обходимы исходники в rar архиве (без exe) давайте адреса....
И так главная форма MDIForm (frmMain):
unit uMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus;
type
TfrmMain = class(TForm)
mm: TMainMenu;
mmProgram: TMenuItem;
mmProgramExit: TMenuItem;
mmProgramCard: TMenuItem;
mmProgramSprt: TMenuItem;
procedure mmProgramExitClick(Sender: TObject);
procedure mmProgramCardClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
hCard: THandle; //Указатель на dll.
dPrInitCard: procedure(App: Integer); stdcall; //Инициализация dll.
dFnCreateCard: function(Text: PChar): Boolean; stdcall; //Функция создания формы. Сдесь наверное не обойдется без RTTI.
dPrDoneCard: procedure; stdcall; //Возвращаем dll ее Application.
procedure GetMessage(var M: TMessage); message WM_USER + 1; {Пользовательские
сообщения.}
end;
const
lCard = "./dCard.dll"; //Путь к dll с формой.
var
frmMain: TfrmMain;
implementation
{$R *.dfm}
procedure TfrmMain.GetMessage(var M: TMessage); {Пользовательские
сообщения.}
begin
ShowMessage("Полученно сообщение на выгрузку dll...");
dPrDoneCard; // Возвращаем dll ее Application.
FreeLibrary(hCard); //Выгружаем dll.
end;
procedure TfrmMain.mmProgramExitClick(Sender: TObject);
begin
Close; //Закрываем проект.
end;
procedure TfrmMain.mmProgramCardClick(Sender: TObject);
begin
hCard := LoadLibrary(PChar(lCard)); //Загружаем dll.
if hCard >= 32 then //Если существует, тогда:
begin
//Получаем адреса функций.
@dPrInitCard := GetProcAddress(hCard, PChar("dPrInitCard"));
@dFnCreateCard := GetProcAddress(hCard, PChar("dFnCreateCard"));
@dPrDoneCard := GetProcAddress(hCard, PChar("dPrDoneCard"));
//Если адреса не пустые, тогда:
if (Addr(@dPrInitCard)<> nil)and (Addr(@dFnCreateCard)<> nil)and
(Addr(@dPrDoneCard)<> nil) then
begin
dPrInitCard(Integer(Application)); //Инициализируем dll.
if not dFnCreateCard("Тестовая строка") then
begin
//Ошибка создания карточки...
end;
end
else
begin
//Не найдена точка входа в одну из функций или процедуру dll...
end;
end
else
begin
//dll не найдена
end;
end;
end.
← →
de. (2007-09-07 13:03) [31]Дочерняя форма в dll MDIChild (frmCard):
library dCard;
uses
SysUtils,
Classes,
uCard in "uCard.pas" {frmCard},
Forms;
var
dApp: Integer;
{$R *.res}
procedure dPrInitCard(App: Integer); stdcall;
begin
dApp:= Integer(Application);
Application:= TApplication(App);
end;
function dFnCreateCard(Text: PChar): Boolean; stdcall;
begin
Result:= True;
try
TfrmCard.Create(Application, Text);
except
Result:= False;
end;
end;
procedure dPrDoneCard; stdcall;
begin
Application:= TApplication(dApp);
end;
exports
dPrInitCard,
dFnCreateCard,
dPrDoneCard;
begin
end.
unit uCard;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TfrmCard = class(TForm)
lbTest: TLabel;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
constructor Create(AOwner: TComponent; Text: PChar); overload;
end;
var
frmCard: TfrmCard;
implementation
{$R *.dfm}
constructor TfrmCard.Create(AOwner: TComponent; Text: PChar);
begin
inherited Create(AOwner);
lbTest.Caption := Text;
end;
procedure TfrmCard.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
frmCard := nil;
PostMessage(Application.MainForm.Handle, WM_USER + 1, 0, 0);
end;
procedure TfrmCard.FormDestroy(Sender: TObject);
begin
//PostMessage()
//frmDll := nil;
end;
end.
← →
de. (2007-09-10 11:19) [32]Универсальный модуль по вызову dll почти готов. Хочу разобратся с
de. (07.09.07 11:11) [14]
немогу понять всего смысла этого модуля... Кто бы мог разъяснить.?
← →
clickmaker © (2007-09-10 11:31) [33]
> немогу понять всего смысла этого модуля
а зачем он тебе?
TXMLDocument должно хватить
← →
de. (2007-09-10 11:40) [34]
> clickmaker © (10.09.07 11:31) [33]
Ну а зачем тогда автор использует этот модуль.?
Какие задачи он несет.?
По моему тоже TXMLDocument должно хватить на реализацию поставленной задачи...
Или же автор написав этот модуль[14]обошел какие-то грабли...?
← →
clickmaker © (2007-09-10 11:42) [35]
> Ну а зачем тогда автор использует этот модуль.?
да честно говоря, лень разбираться... с одним TXMLDocument за 10 минут обход дерева + составление меню пишется
← →
de. (2007-09-10 13:59) [36]Ток увидал... 8-)
Каспирский реализовавает теже принципы....
- <!-- Kaspersky Internet Security 6.0
-->
- <NU2MENU>
- <MENU ID="Programs">
<MITEM TYPE="POPUP" DISABLED="@Not(@FileExists(@GetProgramDrive()\Programs\avp6\*.*))" MENUID="avp6">Kaspersky Internet Security 6.0</MITEM>
</MENU>
- <MENU ID="avp6">
<MITEM TYPE="ITEM" CMD="RUN" FUNC="@GetProgramDrive()\Programs\avp6\avp.exe -gui -bl">Start</MITEM>
</MENU>
</NU2MENU>
Страницы: 1 вся ветка
Форум: "Прочее";
Текущий архив: 2007.10.07;
Скачать: [xml.tar.bz2];
Память: 0.61 MB
Время: 0.05 c
