library DemoSvr; { Important note about DLL memory management: ShareMem must be the first unit in your library's USES clause AND your project's (select Project-View Source) USES clause if your DLL exports any procedures or functions that pass strings as parameters or function results. This applies to all strings passed to and from your DLL--even those that are nested in records and classes. ShareMem is the interface unit to the BORLNDMM.DLL shared memory manager, which must be deployed along with your DLL. To avoid using BORLNDMM.DLL, pass string information using PChar or ShortString parameters. } uses ShareMem, SysUtils, Classes, Demo in 'Demo.PAS'; {$R *.res} function CarObj:TCar; begin Result:=TCar.create; end; function BicycleObj:TBicycle; begin Result:=TBicycle.create; end; exports CarObj, BicycleObj; end.
TBicycle = class(TVehicle) public constructor create; destructor Destory; procedure ride;virtual; end; TCar = class(TVehicle) protected FEngine: TEngine; public constructor create; destructor Destory; procedure drive;virtual; end;
unit frmDemo; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type //---这里声明需要用到的DLL中对象的方法--- TVehicle = class(TObject); TCar = class(TVehicle) public procedure drive;virtual;abstract; end; TBicycle = class(TVehicle) public procedure ride;virtual;abstract; end; //---------------------------- TForm1 = class(TForm) Button1: TButton; Button2: TButton; procedure Button2Click(Sender: TObject); procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; function CarObj:TCar ;external 'DemoSvr.dll'; function BicycleObj:TBicycle ;external 'DemoSvr.dll'; implementation {$R *.dfm} procedure TForm1.Button2Click(Sender: TObject); var MyCar:TCar; begin MyCar:=CarObj; if Mycar=nil then exit; try MyCar.drive; finally MyCar.Free; end; end; procedure TForm1.Button1Click(Sender: TObject); var Bicycle:TBicycle; begin Bicycle:=BicycleObj; try Bicycle.ride; finally Bicycle.Free; end; end; end.
unit IDemo; interface type ICar = interface (IInterface) ['{ED52E264-6683-11D7-B847-001060806215}'] procedure Drive; end; IBicycle = interface (IInterface) ['{ED52E264-6683-11D7-B847-001060806216}'] procedure Ride; end; implementation end.
unit Demo; interface uses SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs,IDemo; type TEngine = class(TObject) private FCapacity: Integer; FPower: Integer; public constructor create; procedure start; procedure stop; end; TWheel = class(TObject) private FNo: Integer; FSize: Integer; FTypeName: string; procedure check; public constructor create(size:Integer;TypeName:string;No:Integer); end; TVehicle = class(TInterfacedObject) protected FColor: string; FMake: string; FTopSpeed: Integer; FWheel: TWheel; FWheels: TList; procedure SlowDown; procedure SpeedUp; procedure Start; procedure Stop; end; TBicycle = class(TVehicle,IBicycle) public constructor create; destructor Destory; procedure ride; end; TCar = class(TVehicle,ICar) protected FEngine: TEngine; public constructor create; destructor Destory; procedure drive; end; implementation { *********************************** TBicycle *********************************** } constructor TBicycle.create; var i: Integer; begin FColor:='白色'; FMake:='永久'; FTopSpeed:=20; ShowMessage(FColor+FMake+'车,最高时速:'+IntToStr(FTopSpeed)); FWheels:= TList.Create; for i:=1 to 2 do FWheels.Add(TWheel.create(21,'B型自行车车轮',i)); end; destructor TBicycle.Destory; var i: Integer; begin for i:=1 to 2 do TWheel(FWheels.Items[i]).Free; inherited; end; procedure TBicycle.ride; begin start; speedUp; showmessage('自行车车行驶中...'); SlowDown; Stop; end; { ************************************* TCar ************************************* } constructor TCar.create; var i: Integer; begin inherited create; FEngine:=TEngine.create; FColor:='黑色'; FMake:='红旗'; FTopSpeed:=200; ShowMessage(FColor+FMake+'车,最高时速:'+IntToStr(FTopSpeed)); FWheels:= TList.Create; for i:=1 to 4 do FWheels.Add(TWheel.create(36,'A型汽车车轮',i)); end; destructor TCar.Destory; var i: Integer; begin for i:=1 to 4 do TWheel(FWheels.Items[i]).Free; FEngine.Free; inherited; end; procedure TCar.drive; begin start; FEngine.start; speedUp; showmessage('汽车行驶中...'); SlowDown; FEngine.stop; Stop; end; { *********************************** TEngine ************************************ } constructor TEngine.create; begin Fcapacity:=1500; Fpower:=130; end; procedure TEngine.start; begin ShowMessage(inttostr(Fcapacity)+'cc,'+inttostr(Fpower)+'匹马力的发动机发动了!'); end; procedure TEngine.stop; begin ShowMessage('发动机关闭了'); end; { *********************************** TVehicle *********************************** } procedure TVehicle.SlowDown; begin ShowMessage('正在减速...'); end; procedure TVehicle.SpeedUp; begin ShowMessage('正在加速...'); end; procedure TVehicle.Start; begin ShowMessage('车子开始启动'); end; procedure TVehicle.Stop; begin ShowMessage('车子停下'); end; { ************************************ TWheel ************************************ } constructor TWheel.create(size:Integer;TypeName:string;No:Integer); begin FSize:=size; FTypeName:=TypeName; FNo:=No; check; end; procedure TWheel.check; begin ShowMessage('检查第'+IntToStr(FNo)+'个车轮。型号:'+FTypeName+' 大小:'+IntToStr(FSize)); end; end.
unit frmDemo; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,IDemo; type TForm1 = class(TForm) Button1: TButton; Button2: TButton; procedure Button2Click(Sender: TObject); procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; function CarObj:ICar ;external 'DemoSvr.dll'; function BicycleObj:IBicycle ;external 'DemoSvr.dll'; implementation {$R *.dfm} procedure TForm1.Button2Click(Sender: TObject); var MyCar:ICar; begin MyCar:=CarObj; MyCar.drive; Mycar:=nil; end; procedure TForm1.Button1Click(Sender: TObject); var Bicycle:IBicycle; begin Bicycle:=BicycleObj; Bicycle.ride; Bicycle:=nil; end; end.