Author: Benjamin Heil
How can you build up the content of e.g. a TMainMenu from a XML-File?
Perhaps you have a program which also includes an administration part for a
database, but only some users should be able to see and use this administration
part. Why don't create a XML-File, which contains the menu of the program. When the
program starts, it builds its menu from this XML-File. And only the people who
should be able to see and use the administration part get the XML-File which
contains it, all other users have a file without this part.
This way it's very hard for hackers to get into the administration part.
And when you even encrypt your XML-File, it should nearly unpossible.
But how can we do this?
Answer:
A special feature of the code below: You only need to specify the Name of the
procedure which then
will be attached to a OnClick handler (but all this procedures MUST be public)
At first, insert this code in your mainform and add a TMainMenu (without any
content) and a TXMLDocument to your form.
1 procedure TMainForm.CreateMenuFromXMLFile;
2
3 function Get_Int(S: string): Integer;
4 begin
5 Result := 0;
6 try
7 Result := StrToInt(S);
8 except
9 end;
10 end;
11
12 procedure AddRecursive(Parent: TMenuItem; Item: IXMLNode);
13 var
14 I: Integer;
15 Node: TMenuItem;
16 Child: IXMLNode;
17 Address: TMethod;
18 begin
19 Node := TMenuItem.Create(Parent);
20 if (Uppercase(Item.Attributes['CAPTION']) <> 'SEPERATOR') then
21 begin
22 Node.Caption := Item.Attributes['CAPTION'];
23 if (Uppercase(Item.Attributes['ID']) <> 'NONE') then
24 begin
25 Address.Code := MethodAddress(Item.Attributes['ID']);
26 Address.Data := Self;
27 if (Item.ChildNodes.Count - 1 < 0) then
28 Node.OnClick := TNotifyEvent(Address);
29 end;
30 if (Uppercase(Item.Attributes['SHORTCUT']) <> 'NONE') then
31 Node.ShortCut := TextToShortCut(Item.Attributes['SHORTCUT']);
32 Node.Checked := (Item.Attributes['CHECKED'] = '1');
33 end
34 else
35 Node.Caption := '-';
36 Node.Visible := (Item.Attributes['VISIBLE'] = '1');
37 if Parent <> nil then
38 Parent.Add(Node)
39 else
40 MainMenu.Items.Add(Node);
41
42 for I := 0 to Item.ChildNodes.Count - 1 do
43 begin
44 Child := item.ChildNodes[i];
45 if (Child.NodeName = 'ENTRY') then
46 AddRecursive(Node, Child);
47 end;
48 end;
49
50 var
51 Root: IXMLMENUType;
52 Parent: TMenuItem;
53 I: Integer;
54 Child: IXMLNode;
55 begin
56 XMLDocument.FileName := ExtractFilePath(Application.ExeName) + XMLFile;
57 if not FileExists(XMLDocument.FileName) then
58 begin
59 MessageDlg('Menu-XML-Document not found!', mtError, [mbOK], 0);
60 Halt;
61 end;
62 XMLDocument.Active := True;
63
64 Screen.Cursor := crHourglass;
65 try
66 Root := GetXMLMenu(XMLDocument);
67 Parent := nil;
68
69 for I := 0 to Root.ChildNodes.Count - 1 do
70 begin
71 Child := Root.ChildNodes[i];
72 if (Child.NodeName = 'ENTRY') then
73 AddRecursive(Parent, Child);
74 end;
75 finally
76 Screen.Cursor := crDefault;
77 end;
78 end;
This was the first step.
You also need the encapsulation of the XML-File.
( Save the code below as unit and add it to your program.
Created with Delphi6 -> New -> XML Data Binding Wizard )
79
80 {***************************************************}
81 { }
82 { Delphi XML-Datenbindung }
83 { }
84 { Erzeugt am: 27.06.2002 13:25:01 }
85 { }
86 {***************************************************}
87
88 unit XMLMenuTranslation;
89
90 interface
91
92 uses xmldom, XMLDoc, XMLIntf;
93
94 type
95
96 { Forward-Deklarationen }
97
98 IXMLMENUType = interface;
99 IXMLENTRYType = interface;
100
101 { IXMLMENUType }
102
103 IXMLMENUType = interface(IXMLNode)
104 ['{8F36F5E2-834F-41D9-918F-9B1A441C9074}']
105 { Zugriff auf Eigenschaften }
106 function Get_ENTRY: IXMLENTRYType;
107 { Methoden & Eigenschaften }
108 property ENTRY: IXMLENTRYType read Get_ENTRY;
109 end;
110
111 { IXMLENTRYType }
112
113 IXMLENTRYType = interface(IXMLNode)
114 ['{AD85CD05-725E-40F8-A8D7-D6EC05FD4360}']
115 { Zugriff auf Eigenschaften }
116 function Get_CAPTION: WideString;
117 function Get_VISIBLE: Integer;
118 function Get_ID: Integer;
119 function Get_ENTRY: IXMLENTRYType;
120 procedure Set_CAPTION(Value: WideString);
121 procedure Set_VISIBLE(Value: Integer);
122 procedure Set_ID(Value: Integer);
123 { Methoden & Eigenschaften }
124 property Caption: WideString read Get_CAPTION write Set_CAPTION;
125 property Visible: Integer read Get_VISIBLE write Set_VISIBLE;
126 property ID: Integer read Get_ID write Set_ID;
127 property ENTRY: IXMLENTRYType read Get_ENTRY;
128 end;
129
130 { Forward-Deklarationen }
131
132 TXMLMENUType = class;
133 TXMLENTRYType = class;
134
135 { TXMLMENUType }
136
137 TXMLMENUType = class(TXMLNode, IXMLMENUType)
138 protected
139 { IXMLMENUType }
140 function Get_ENTRY: IXMLENTRYType;
141 public
142 procedure AfterConstruction; override;
143 end;
144
145 { TXMLENTRYType }
146
147 TXMLENTRYType = class(TXMLNode, IXMLENTRYType)
148 protected
149 { IXMLENTRYType }
150 function Get_CAPTION: WideString;
151 function Get_VISIBLE: Integer;
152 function Get_ID: Integer;
153 function Get_ENTRY: IXMLENTRYType;
154 procedure Set_CAPTION(Value: WideString);
155 procedure Set_VISIBLE(Value: Integer);
156 procedure Set_ID(Value: Integer);
157 public
158 procedure AfterConstruction; override;
159 end;
160
161 { Globale Funktionen }
162
163 function GetXMLMENU(Doc: IXMLDocument): IXMLMENUType;
164 function LoadMENU(const FileName: WideString): IXMLMENUType;
165 function NewMENU: IXMLMENUType;
166
167 implementation
168
169 { Globale Funktionen }
170
171 function GetXMLMENU(Doc: IXMLDocument): IXMLMENUType;
172 begin
173 Result := Doc.GetDocBinding('MENU', TXMLMENUType) as IXMLMENUType;
174 end;
175
176 function LoadMENU(const FileName: WideString): IXMLMENUType;
177 begin
178 Result := LoadXMLDocument(FileName).GetDocBinding('MENU', TXMLMENUType) as
179 IXMLMENUType;
180 end;
181
182 function NewMENU: IXMLMENUType;
183 begin
184 Result := NewXMLDocument.GetDocBinding('MENU', TXMLMENUType) as IXMLMENUType;
185 end;
186
187 { TXMLMENUType }
188
189 procedure TXMLMENUType.AfterConstruction;
190 begin
191 RegisterChildNode('ENTRY', TXMLENTRYType);
192 inherited;
193 end;
194
195 function TXMLMENUType.Get_ENTRY: IXMLENTRYType;
196 begin
197 Result := ChildNodes['ENTRY'] as IXMLENTRYType;
198 end;
199
200 { TXMLENTRYType }
201
202 procedure TXMLENTRYType.AfterConstruction;
203 begin
204 RegisterChildNode('ENTRY', TXMLENTRYType);
205 inherited;
206 end;
207
208 function TXMLENTRYType.Get_CAPTION: WideString;
209 begin
210 Result := ChildNodes['CAPTION'].Text;
211 end;
212
213 procedure TXMLENTRYType.Set_CAPTION(Value: WideString);
214 begin
215 ChildNodes['CAPTION'].NodeValue := Value;
216 end;
217
218 function TXMLENTRYType.Get_VISIBLE: Integer;
219 begin
220 Result := ChildNodes['VISIBLE'].NodeValue;
221 end;
222
223 procedure TXMLENTRYType.Set_VISIBLE(Value: Integer);
224 begin
225 ChildNodes['VISIBLE'].NodeValue := Value;
226 end;
227
228 function TXMLENTRYType.Get_ID: Integer;
229 begin
230 Result := ChildNodes['ID'].NodeValue;
231 end;
232
233 procedure TXMLENTRYType.Set_ID(Value: Integer);
234 begin
235 ChildNodes['ID'].NodeValue := Value;
236 end;
237
238 function TXMLENTRYType.Get_ENTRY: IXMLENTRYType;
239 begin
240 Result := ChildNodes['ENTRY'] as IXMLENTRYType;
241 end;
242
243 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.
244
245 <?xml version="1.0" encoding="ISO-8859-1"?>
246 <MENU>
247 <ENTRY CAPTION="Datei" VISIBLE="1" ID="None" SHORTCUT="None" CHECKED="0">
248 <ENTRY CAPTION="Beenden" VISIBLE="1" ID="CloseProgram" SHORTCUT="Strg+X"
249 CHECKED="0"></ENTRY>
250 </ENTRY>
251
252 <ENTRY CAPTION="Anzeige" VISIBLE="1" ID="None" SHORTCUT="None" CHECKED="0">
253 <ENTRY CAPTION="Toolbar" VISIBLE="1" ID="ShowToolbar" SHORTCUT="None"
254 CHECKED="1"></ENTRY>
255 <ENTRY CAPTION="Seperator" VISIBLE="1"></ENTRY>
256 <ENTRY CAPTION="Optionen" VISIBLE="1" ID="ShowOptionen" SHORTCUT="Strg+O"
257 CHECKED="0"></ENTRY>
258 </ENTRY>
259
260 <ENTRY CAPTION="News" VISIBLE="1" ID="None" SHORTCUT="None" CHECKED="0">
261 <ENTRY CAPTION="Refresh" VISIBLE="1" ID="RefreshAll" SHORTCUT="F5"
262 CHECKED="0"></ENTRY>
263 <ENTRY CAPTION="Seperator" VISIBLE="1"></ENTRY>
264 <ENTRY CAPTION="Administration" VISIBLE="1" ID="None" SHORTCUT="None"
265 CHECKED="0">
266 <ENTRY CAPTION="neue Nachricht hinzufügen" VISIBLE="1" ID="NewMarkedNews"
267 SHORTCUT="Strg+N" CHECKED="0"></ENTRY>
268 <ENTRY CAPTION="markierte Nachricht bearbeiten" VISIBLE="1" ID="EditMarkedNews"
269 SHORTCUT="Strg+E" CHECKED="0"></ENTRY>
270 <ENTRY CAPTION="markierte Nachricht löschen" VISIBLE="1" ID="DeleteMarkedNews"
271 SHORTCUT="None" CHECKED="0"></ENTRY>
272 <ENTRY CAPTION="Seperator" VISIBLE="1"></ENTRY>
273 <ENTRY CAPTION="Film hinzufügen" VISIBLE="1" ID="AddMPG" SHORTCUT="None"
274 CHECKED="0"></ENTRY>
275 <ENTRY CAPTION="markierten Film löschen" VISIBLE="1" ID="DeleteMPG"
276 SHORTCUT="None" CHECKED="0"></ENTRY>
277 </ENTRY>
278 </ENTRY>
279
280 <ENTRY CAPTION="Hilfe" VISIBLE="1" ID="None" SHORTCUT="None" CHECKED="0">
281 <ENTRY CAPTION="LogView" VISIBLE="1" ID="ShowLog" SHORTCUT="Strg+L"
282 CHECKED="0"></ENTRY>
283 <ENTRY CAPTION="eMail schreiben" VISIBLE="1" ID="WriteEMail" SHORTCUT="None"
284 CHECKED="0"></ENTRY>
285 <ENTRY CAPTION="Seperator" VISIBLE="1"></ENTRY>
286 <ENTRY CAPTION="Über" VISIBLE="1" ID="About" SHORTCUT="None" CHECKED="0"></ENTRY>
287 </ENTRY>
288
289 </MENU>
The first Node should be
There you can the use . When you write another entry before the
Entry-Endtag, this will be a submenu item.
The parameters for ENTRY are:
CAPTION - this is the string which is displayed in the Menu. If this string is
"Seperator", a Seperator will be insert
VISIBLE - when zero, the MenuItem will be generated but not displayed
ID - this is None for nothing or the Name of the procedure to call when the Item is
clicked (BUT BE CAREFUL: THIS PROCEDURE MUST BE PUBLIC!)
SHORTCUT - None for nothing or e.g. Ctrl+X (read the Delphi-Help for
'TextToShortCut' to understand this)
CHECKED - when not zero, the MenuItem will be checked
|
