插件

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, Menus, ExtCtrls, RemoteMethod
  ,DBClient, DB;

type
  PNode = ^TNode;
 
  TNode = record
    id: string;
    cn: string;
    tw: string;
    en: string;
    dll: string;
    classname: WideString;
    dsc: string;
    pid: string;
  end;

  TSetDLLApplication = procedure (App: TApplication); stdcall;
  TRunForm = procedure (app: TApplication;aclassname:WideString);stdcall;

  Tf_main = class(TForm)
    MainMenu1: TMainMenu;
    StatusBar1: TStatusBar;
    TreeView1: TTreeView;
    cdsMenu: TClientDataSet;
    Splitter1: TSplitter;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    procedure TreeChange(Sender: TObject; Node: TTreeNode);
    procedure CreateTree(Query: TClientDataSet; tree: TTreeView);
    procedure DisposeTree(Tree: TTreeView);
    procedure LoadDLL(const dll, aclassname: string);
  public
    { Public declarations }
  end;

var
  f_main: Tf_main;

implementation

{$R *.dfm}

{ Tf_main }

procedure Tf_main.CreateTree(Query: TClientDataSet; tree: TTreeView);
var
  List: TStringList;
  Node: TTreeNode;
  Index: Integer;
  P: PNode;
begin
  Query.Close;
  Query.Open;
  Tree.Items.BeginUpdate;
  try
    Tree.Items.Clear;
    List := TStringList.Create;
    try
      List.Sorted := True;
      Query.First;
      while not Query.Eof do
      begin
        P := new(PNode);
        P^.id := Query.fieldbyname('id').AsString;
        P^.cn := Query.fieldbyname('cn').AsString;
        p^.tw := Query.fieldbyname('tw').AsString;
        p^.en := Query.fieldbyname('en').AsString;
        p^.dll := Query.fieldbyname('dll').AsString;
        p^.classname := Query.fieldbyname('classname').AsString;
        p^.dsc := Query.fieldbyname('dsc').AsString;
        P^.pid := Query.fieldbyname('pid').AsString;
        if Query.FieldByName('pid').AsInteger = 0 then
          Node := Tree.Items.AddChild(nil, Query.FieldByName('cn').AsString)
        else
        begin
          Index := List.IndexOf(Query.FieldByName('pid').AsString);
          Node := Tree.Items.AddChild(TTreeNode(List.Objects[Index]),
            Query.FieldByName('cn').AsString);
        end;
        Node.Data := P;
        List.AddObject(Query.FieldByName('id').AsString, Node);
        Query.Next;
      end;
    finally
      List.Free;
    end;
  finally
    Tree.Items.EndUpdate;
  end;
end;

procedure Tf_main.TreeChange(Sender: TObject; Node: TTreeNode);
begin
  if (pnode(Node.Data)^.dll > '') and (pnode(Node.Data)^.classname > '') then
    LoadDLL(pnode(Node.Data)^.dll, pnode(Node.Data)^.classname);
end;

procedure Tf_main.FormCreate(Sender: TObject);
begin
  cdsMenu.Data := RemoteMethod.GetData('select * from t_menu');
  if not cdsMenu.IsEmpty then
  begin
    CreateTree(cdsMenu, TreeView1);
    cdsMenu.Close;
    TreeView1.OnChange := TreeChange;
  end;
end;

procedure Tf_main.DisposeTree(Tree: TTreeView);
var
  node: TTreeNode;
begin
  node := Tree.Items.GetFirstNode;
  while node <> nil do
  begin
    Dispose(PNode(node.Data));
    node := node.GetNext;
  end;
end;

procedure Tf_main.FormDestroy(Sender: TObject);
begin
  DisposeTree(TreeView1);
end;

procedure Tf_main.LoadDLL(const dll, aclassname: string);
var
  h: THandle;
  p1: TSetDLLApplication;
  p2: TRunForm;
begin
  h := 0;
  try
    h := LoadLibrary(PAnsiChar(dll));
    @p1 := GetProcAddress(h, PAnsiChar('SetDllApplication'));
    p1(Application);

    h := LoadLibrary(PAnsiChar(DLL));
    @p2 := GetProcAddress(h, PAnsiChar('RunForm'));
    p2(Application,aclassname);
  finally
    if h <> 0 then
      FreeLibrary(h);
  end;
end;

end.

 

library tool;

uses
  ShareMem,
  SysUtils,
  Forms,
  Windows,
  Classes,
  Controls,
  RemoteMethod in '..\RemoteMethod.pas',
  mdi in '..\mdi.pas' {f_mdi},
  nav in '..\nav.pas' {f_nav},
  menu in 'menu.pas' {f_menu};

{$R *.res}

var
  DllApplication: TApplication;

procedure DLLENtryPoint(dwReason: DWord); register;
begin
  case dwReason of
   // DLL_PROCESS_ATTACH:
   //   TfLDMDLPublic.DLLDMPublicCreate;
    DLL_PROCESS_DETACH:
    begin
      Application := DllApplication;
    //  if Assigned(fLDMDLPublic) then
  //    begin
   //     fLDMDLPublic.Free;
   //     fLDMDLPublic := nil;
   //   end;
    end;
  end;
end;

procedure SetDllApplication(AppHwnd: HWND); stdcall;
begin
  Application.Handle := AppHwnd;
end;

procedure RunForm(app:TApplication;aclassname: WideString); stdcall;
begin
  Application := app;
  if UpperCase(aclassname) = 'TF_MENU' then
  begin
    Application.CreateForm(Tf_menu, f_menu);
  end;
end;

exports
  SetDllApplication,
  RunForm;

begin
  DllApplication := Application;
  DllProc := @DLLENtryPoint;
  DLLENtryPoint(DLL_PROCESS_ATTACH);
end.