编写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?

...全文