现在的样子（20100202）_20100202format2010-10-10-优快云博客

现在的样子（20100202）

（uses 导航界面与业务模块完全分开）
（uses 代码中如何实现界面的导航）
（uses 如何处理包内单元的相互引用关系）
（uses 使用包后关闭窗体时退出的异常）

{*******************************************************}
{                                                       }
{       导航窗体                                        }
{    本窗体作为测试时用的导航窗体                       }
{    功能包括：bpl,dll的导入，同时显示插件信息          }
{    导入插件后能调用bpl内的窗体，使用dll内的函数       }
{                                                       }
{       Created by cai at 20100202                      }
{                                                       }
{*******************************************************}

unit UnitNavigation;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Buttons, StdCtrls, ExtCtrls, Menus, DB, ADODB, ActiveX;

const
WM_Form = WM_USER + 100;

type
TfrmNavigation = class(TForm)
    pnl1: TPanel;
    spl1: TSplitter;
    mmo1: TMemo;
    pm1: TPopupMenu;
    mniLoadPlugin: TMenuItem;
    mniCreateForm: TMenuItem;
    OpenDialog1: TOpenDialog;
    mniPostFormCreateMsg: TMenuItem;
    //接收处理窗体创建消息
    procedure HandleMsg(var Msg: TMessage); message WM_Form;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure mniCreateFormClick(Sender: TObject);
    procedure mniLoadPluginClick(Sender: TObject);
    procedure mniPostFormCreateMsgClick(Sender: TObject);
private
    { Private declarations }
    //插件管理类
    PkgList: TList;
    DllList: TList;
    //根据入参(窗体名)创建新窗体
    procedure CreateForm(str: string);
    //根据路径导入插件
    procedure LoadPlugin(Plugin: string);
public
    { Public declarations }
end;

var
frmNavigation: TfrmNavigation;

implementation

{$R *.dfm}
uses Contnrs, UnitPlugin;

procedure TfrmNavigation.CreateForm(str: string);
var
frm: TCustomForm;
frmclass: TPersistentClass;
begin
try
    frmclass := GetClass(str);
    if frmclass <> nil then
    begin
      frm := TComponentclass(frmclass).Create(nil) as TCustomForm;
      frm.Show;     //注意在窗体的close事件中释放内存哦。
    end
    else
      mmo1.Lines.Add('caicai say: The Class ' + QuotedStr(str) +
        ' is not exist, please chack and find again');
except
    on E: Exception do
      mmo1.Lines.Add(E.Message);
end;
end;

procedure TfrmNavigation.HandleMsg(var Msg: TMessage);
var
Wp,Lp:string;
begin
Wp := string(Msg.WParam);
Lp := string(Msg.LParam);
mmo1.Lines.Add(Format('%s,%d,%s,%s',[TimeToStr(Now), Msg.Msg, Wp, Lp]));
CreateForm(Wp);
end;

procedure TfrmNavigation.FormCreate(Sender: TObject);
begin
PkgList := TList.Create;
DllList := TList.Create;
end;

procedure TfrmNavigation.FormDestroy(Sender: TObject);
var
i: Integer;
begin
for i := PkgList.Count - 1 downto 0 do
TPackage(PkgList[i]).Destroy; //将显示调用unLoadpackage
for i := DllList.Count - 1 downto 0 do
TDLL(PkgList[i]).Destroy; //将显示调用FreeLibrary

PkgList.Free;
DllList.Free;
end;

procedure TfrmNavigation.mniCreateFormClick(Sender: TObject);
var
Value: string;
begin
if InputQuery('New Form', 'What is the new form Class ?', Value) then
CreateForm(Value);
end;

procedure TfrmNavigation.mniLoadPluginClick(Sender: TObject);
var
i: Integer;
begin
if OpenDialog1.Execute then
begin
for i := 0 to OpenDialog1.Files.Count - 1 do
LoadPlugin(OpenDialog1.Files[i]);
end;
end;

procedure TfrmNavigation.LoadPlugin(Plugin: string);
var
ext: string;
begin
ext := ExtractFileExt(Plugin);
if SameText(ext, '.bpl') then
begin
    PkgList.Add(TPackage.Create(Plugin));
    mmo1.Lines.Add(Format('%s/n%s',[TimeToStr(Now), ExtractFileName(Plugin)]));
    mmo1.Lines.Add('------ContainsUnitList:-------');
    mmo1.Lines.AddStrings(TPackage(PkgList[PkgList.Count - 1]).ContainsUnit);
    mmo1.Lines.Add('------DcpBpiNameList:-------');
    mmo1.Lines.AddStrings(TPackage(PkgList[PkgList.Count - 1]).DcpBpiName);
    mmo1.Lines.Add('------RequiresPackageList:---------');
    mmo1.Lines.AddStrings(TPackage(PkgList[PkgList.Count - 1]).RequiresPackage);
end
else begin
    DllList.Add(TDLL.Create(Plugin));
end;
end;

procedure TfrmNavigation.mniPostFormCreateMsgClick(Sender: TObject);
var
wp,lp: string;
begin
if InputQuery('New Form','What is the new form Class ?', wp) then
begin
    lp := 'aaa';
    SendMessage(Handle,WM_Form,Integer(wp),Integer(lp));
   // PostMessage(Handle,WM_Form,Integer(wp),Integer(lp));   //注意post send的区别
end;
end;

end.

{*******************************************************}
{                                                       }
{       数据库备份单元                                  }
{                                                       }
{       Created by cai at 20100205                      }
{                                                       }
{*******************************************************}

unit UnitDatabaseBackup;

interface

.......

implementation

.......

procedure TDatabaseBackupForm.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
Action := caFree;
end;

initialization
RegisterClass(TDatabaseBackupForm);

finalization
UnRegisterClass(TDatabaseBackupForm);
end;

经少量测试下面两个版本都可以，我不知道他们在使用上有什么区别
{*******************************************************}
{                                                       }
{       公共数据连接单元（版本一）                      }
{                                                       }
{       Created by cai at 20100202                      }
{                                                       }
{*******************************************************}

unit UnitDataModule;

interface

uses
SysUtils, Classes, DB, ADODB;

type
TDataModule1 = class(TDataModule)
    con1: TADOConnection;
private
    { Private declarations }
public
    { Public declarations }
end;

var
DataModule1: TDataModule1;

implementation

{$R *.dfm}

initialization
// CoInitialize(nil);
DataModule1 := TDataModule1.Create(nil);
finalization
DataModule1.Free;
// CoUninitialize;

end.

{*******************************************************}
{                                                       }
{       公共数据连接单元（版本二）                      }
{                                                       }
{       Created by cai at 20100202                      }
{                                                       }
{*******************************************************}

unit UnitDataModule;

interface

uses
SysUtils, Classes, DB, ADODB, ActiveX;

type
TDataModule1 = class(TDataModule)
    con1: TADOConnection;
private
    { Private declarations }
public
    { Public declarations }
end;

var
DataModule1: TDataModule1;

implementation

{$R *.dfm}

initialization
CoInitialize(nil);
DataModule1 := TDataModule1.Create(nil);
finalization
DataModule1.Free;
CoUninitialize;

end.