编写com过程中遇到问题,先谢谢

tangboyong 项目总监  2003-12-11 09:41:42
///接口部分
unit Project1_TLB;

interface

uses ActiveX, Classes, Graphics, StdVCL, Variants, Windows;

const
Project1MajorVersion = 1;
Project1MinorVersion = 0;

LIBID_Project1: TGUID = '{EF8B229C-E541-48F0-8AEA-91A03F092EE3}';

IID_Imyclass: TGUID = '{B556AF83-C053-4B5A-8E87-ED5BB756006D}';
CLASS_myclass: TGUID = '{5A6750DE-9340-4A49-96AE-3D346FF941B7}';
type

Imyclass = interface;
myclass = Imyclass;
Imyclass = interface(IUnknown)
['{B556AF83-C053-4B5A-8E87-ED5BB756006D}']
function setvalue(Value: Integer): HResult; stdcall;
function getvalue: Integer; stdcall;
procedure close;stdcall;
end;



Comyclass = class
class function Create: Imyclass;
class function CreateRemote(const MachineName: string): Imyclass;
end;

implementation

uses ComObj;

class function Comyclass.Create: Imyclass;
begin
Result := CreateComObject(CLASS_myclass) as Imyclass;
end;

class function Comyclass.CreateRemote(const MachineName: string): Imyclass;
begin
Result := CreateRemoteComObject(MachineName, CLASS_myclass) as Imyclass;
end;

end.


///////////////////////接口实现

unit Unit2;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
Windows, ActiveX, Classes, ComObj, Project1_TLB, StdVcl;

type
Tmyclass = class(TTypedComObject, Imyclass)
protected
value:Integer;
function getvalue: Integer; stdcall;
function setvalue(Value: Integer): HResult; stdcall;
procedure close;stdcall;
public
destructor destroy;override;
end;

implementation

uses ComServ;

destructor Tmyclass.destroy;

begin

inherited;

end;

procedure Tmyclass.close ;

begin

////////////////

end;

function Tmyclass.getvalue: Integer;

begin

result:=self.value ;

end;

function Tmyclass.setvalue(Value: Integer): HResult;

begin

self.value :=value;

end;

initialization
TTypedComObjectFactory.Create(ComServer, Tmyclass, Class_myclass,
ciMultiInstance, tmApartment);
end.

///////////////////////////////////////////////////
接口引用
///////////////////

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,Project1_tlb,comobj, StdCtrls;

type
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
interfaceclass:Imyclass;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

begin

interfaceclass:=CreateComObject(class_myclass) as imyclass;

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
interfaceclass.setvalue(strtoint(edit1.Text ));
edit1.Text :='' ;
edit1.Text :=inttostr(interfaceclass.getvalue);
//interfaceclass.close;
showmessage('ok');
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
//interfaceclass.close;
showmessage('close');
end;

end.
/////////////////////////////////////////////////////////////////
运行程序,设计功能可以达到
但是在我关闭form1的时候,给出如下提示:

there are still com objects in this application one or more clients may have references to these objects ,so manually closing this application
may cause those client applications to fail,are you sure close this application?






...全文
4 点赞 收藏 1
写回复
1 条回复
切换为时间正序
请发表友善的回复…
发表回复
tangboyong 2003-12-11
这个真是麻烦,说的是我的com不能关闭,其他客户要调用
郁闷,如何解决?谢谢
回复
发动态
发帖子
网络通信/分布式开发
创建于2007-08-02

1565

社区成员

Delphi 网络通信/分布式开发
申请成为版主
社区公告
暂无公告