Create a Menu from XML-File

Problem/Question/Abstract:

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.

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 not found!', 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;



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 )

{***************************************************}
{                                                   }
{ 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.

<?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 hinzuf�gen" 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 l�schen" VISIBLE="1" ID="DeleteMarkedNews" SHORTCUT="None" CHECKED="0"></ENTRY>
                        <ENTRY CAPTION="Seperator" VISIBLE="1"></ENTRY>
                        <ENTRY CAPTION="Film hinzuf�gen" VISIBLE="1" ID="AddMPG" SHORTCUT="None" CHECKED="0"></ENTRY>
                        <ENTRY CAPTION="markierten Film l�schen" 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="�ber" VISIBLE="1" ID="About" SHORTCUT="None" CHECKED="0"></ENTRY>
        </ENTRY>

</MENU>



The first Node should be <MENU> ... </MENU>

There you can the use <ENTRY ...></ENTRY>. 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