com问题(在线等待)(100分)

C

cl_zhx

Unregistered / Unconfirmed
GUEST, unregistred user!
我刚刚开始学习com,今天学写了个com服务器端
和一个客户端,服务器端可以运行,在运行客户端时服务器端也可以起动
但是出现“内存锁定”的提示而无法运行客户端的方法,
请高手帮助
多谢
 
希望能讲清楚你的写com的过程~!
 
/
unit ServMain;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Grids, DBGrids, DB, ExtCtrls, DBCtrls, DBTables;

type
TForm1 = class(TForm)
Table1: TTable;
DBNavigator1: TDBNavigator;
DataSource1: TDataSource;
DBGrid1: TDBGrid;
Memo1: TMemo;
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

uses TOleAnimalPas;

{$R *.dfm}

end.




uses
Windows, Messages, SysUtils, Variants, Graphics, Controls, Forms,
Dialogs, StdCtrls, Grids, DBGrids, DB, ExtCtrls, DBCtrls, DBTables


,ComObj, ActiveX, AxCtrls, Classes, OleAnimalserver_TLB, StdVcl;

type
TOleAnimal = class(TAutoObject, IConnectionPointContainer, IOleAnimal)
private

public
AnimalNames: Tstrings;
procedure Initialize; override;
protected

property ConnectionPoints: TConnectionPoints read FConnectionPoints
implements IConnectionPointContainer;
procedure EventSinkChanged(const EventSink: IUnknown); override;
function Get_BOF: WordBool; safecall;
function Get_EOF: WordBool; safecall;
function GetFieldValue(const Fieldname: WideString):WideString; safecall;
function Getnames:IStrings; safecall;
function Locate(const name: WideString):WordBool; safecall;
procedure Next; safecall;
procedure Prior; safecall;
procedure DataChange(Sender:Tobject;Field:Tfield);

end;

implementation

uses ComServ, ServMain;

procedure TOleAnimal.EventSinkChanged(const EventSink: IUnknown);
begin
FEvents := EventSink as IOleAnimalEvents;
end;

procedure TOleAnimal.Initialize;
begin
inherited Initialize;
FConnectionPoints := TConnectionPoints.Create(Self);
if AutoFactory.EventTypeInfo <> nil then
begin
FConnectionPoint := FConnectionPoints.CreateConnectionPoint(
AutoFactory.EventIID, ckSingle, EventConnect);

AnimalNames:=TStringList.Create;
Form1.table1.next;
form1.datasource1.ondatachange:=Datachange;
form1.memo1.lines.add('AutoObj initialize');
end
else

FConnectionPoint := nil;

end;
Procedure ToleAnimal.dataChange(Sender:TObject;Field:TField);
begin
Form1.Memo1.lines.add('Event:DataChange');
if FEvents<>nil then FEvents.onDataChange;
end;

function TOleAnimal.Get_BOF: WordBool;
begin
Result:=Form1.Table1.Bof;
Form1.Memo1.Lines.Add('Property:Bof');
end;

function TOleAnimal.Get_EOF: WordBool;
begin
Result:=Form1.Table1.EOF;
Form1.Memo1.Lines.Add('Property:EOF');
end;

function TOleAnimal.GetFieldValue(const Fieldname: WideString):WideString;
var ws:Array[0..1023] of WideChar;
begin
StringToWideChar(Form1.Table1.FieldByName(FieldName).AsString,Ws,1023);
Form1.Memo1.Lines.Add('Method:GetFieldName('+FieldName+')');
Result:=Ws;
end;

function TOleAnimal.Getnames:Istrings;
begin
GetOleStrings(AnimalNames,Result);
Form1.Memo1.Lines.Add('Method:GetNames');
end;

function TOleAnimal.Locate(const name: WideString):WordBool;
begin
Result:=Form1.Table1.Locate('name',name,[loCaseInsensitive]);
Form1.Memo1.Lines.Add('method: Locate(name='+name+')');
end;

procedure TOleAnimal.Next;
begin
Form1.Table1.Next;
Form1.Memo1.Lines.Add('Method:next');

end;

procedure TOleAnimal.Prior;
begin
Form1.Table1.Prior;
Form1.Memo1.Lines.Add('method:prior');
end;



initialization
TAutoObjectFactory.Create(ComServer, TOleAnimal, Class_OleAnimal,
ciMultiInstance, tmApartment);
end.


unit OleAnimalserver_TLB;

// ************************************************************************ //
// WARNING
// -------
// The types declared in this file were generated from data read from a
// Type Library. If this type library is explicitly or indirectly (via
// another type library referring to this type library) re-imported, or the
// 'Refresh' command of the Type Library Editor activated while editing the
// Type Library, the contents of this file will be regenerated and all
// manual modifications will be lost.
// ************************************************************************ //

// PASTLWTR : $Revision: 1.130 $
// File generated on 2003-2-13 12:12:59 from Type Library described below.

// ************************************************************************ //
// Type Lib: F:/新建文件夹/OleAnimalserver.tlb (1)
// LIBID: {4AEEB894-16C8-437B-92EB-797C7916E3F3}
// LCID: 0
// Helpfile:
// DepndLst:
// (1) v2.0 stdole, (C:/WINNT/System32/stdole2.tlb)
// (2) v4.0 StdVCL, (C:/WINNT/System32/stdvcl40.dll)
// ************************************************************************ //
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}

interface

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


// *********************************************************************//
// GUIDS declared in the TypeLibrary. Following prefixes are used:
// Type Libraries : LIBID_xxxx
// CoClasses : CLASS_xxxx
// DISPInterfaces : DIID_xxxx
// Non-DISP interfaces: IID_xxxx
// *********************************************************************//
const
// TypeLibrary Major and minor versions
OleAnimalserverMajorVersion = 1;
OleAnimalserverMinorVersion = 0;

LIBID_OleAnimalserver: TGUID = '{4AEEB894-16C8-437B-92EB-797C7916E3F3}';

IID_IOleAnimal: TGUID = '{63962B73-0213-4D3E-A22E-639A7AF52CFA}';
DIID_IOleAnimalEvents: TGUID = '{5FB4F015-9ED5-4ED9-B968-566F5A49A7C6}';
CLASS_OleAnimal: TGUID = '{849210C0-BB01-4055-8914-C3308890428B}';
type

// *********************************************************************//
// Forward declaration of types defined in TypeLibrary
// *********************************************************************//
IOleAnimal = interface;
IOleAnimalDisp = dispinterface;
IOleAnimalEvents = dispinterface;

// *********************************************************************//
// Declaration of CoClasses defined in Type Library
// (NOTE: Here we map each CoClass to its Default Interface)
// *********************************************************************//
OleAnimal = IOleAnimal;


// *********************************************************************//
// Interface: IOleAnimal
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {63962B73-0213-4D3E-A22E-639A7AF52CFA}
// *********************************************************************//
IOleAnimal = interface(IDispatch)
['{63962B73-0213-4D3E-A22E-639A7AF52CFA}']
function Get_BOF: WordBool; safecall;
function Get_EOF: WordBool; safecall;
procedure Prior; safecall;
procedure Next; safecall;
function Locate(const name: WideString):WordBool; safecall;
function GetFieldValue(const Fieldname: WideString):WideString; safecall;
function Getnames:IStrings; safecall;

property BOF: WordBool read Get_BOF;
property EOF: WordBool read Get_EOF;

end;

// *********************************************************************//
// DispIntf: IOleAnimalDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {63962B73-0213-4D3E-A22E-639A7AF52CFA}
// *********************************************************************//
IOleAnimalDisp = dispinterface
['{63962B73-0213-4D3E-A22E-639A7AF52CFA}']
property BOF: WordBool readonly dispid 1;
property EOF: WordBool readonly dispid 2;
procedure Prior; dispid 3;
procedure Next; dispid 4;
function Locate(const name: WideString):WordBool; dispid 5;
function GetFieldValue(const Fieldname: WideString):WideString; dispid 6;
function Getnames:IStrings; dispid 7;

end;

// *********************************************************************//
// DispIntf: IOleAnimalEvents
// Flags: (4096) Dispatchable
// GUID: {5FB4F015-9ED5-4ED9-B968-566F5A49A7C6}
// *********************************************************************//
IOleAnimalEvents = dispinterface
['{5FB4F015-9ED5-4ED9-B968-566F5A49A7C6}']
procedure onDataChange; dispid 1;
end;

// *********************************************************************//
// The Class CoOleAnimal provides a Create and CreateRemote method to
// create instances of the default interface IOleAnimal exposed by
// the CoClass OleAnimal. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoOleAnimal = class
class function Create: IOleAnimal;
class function CreateRemote(const MachineName: string): IOleAnimal;
end;

implementation

uses ComObj;

class function CoOleAnimal.Create: IOleAnimal;
begin
Result := CreateComObject(CLASS_OleAnimal) as IOleAnimal;
end;

class function CoOleAnimal.CreateRemote(const MachineName: string): IOleAnimal;
begin
Result := CreateRemoteComObject(MachineName, CLASS_OleAnimal) as IOleAnimal;
end;

end.


unit Client;

interface

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

type
TForm1 = class(TForm)
Search: TGroupBox;
Name: TLabel;
cmbNames: TComboBox;
BtnQuery: TSpeedButton;
BtnPrior: TSpeedButton;
BtnNext: TSpeedButton;
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
EdtName: TEdit;
EdtSize: TEdit;
EdtWeight: TEdit;
EdtArea: TEdit;
procedure FormCreate(Sender: TObject);
Procedure GetDataFromServer;
procedure BtnQueryClick(Sender: TObject);
procedure BtnPriorClick(Sender: TObject);
procedure BtnNextClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
// Animals:IOleAnimal;

end;

var
animals:variant;
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var i:integer;

//Ts:TStrings;
begin
{animals:=CoOleAniamal.create;
Ts:=TStringlist.create;
SetOleStrings(Ts,animals.Getnames);
CmbNames.Items.Assign(ts);
Ts.free;
GEtDataFromServer; }
animals:=CreateOleObject('oleAnimalserver.OleAnimal');
For i:=0 to Animals.GetNames.Count-1 do
CmbNames.Items.Add(animals.GetNames.item);
GetDataFromServer
end;
Procedure TForm1.GetDataFromServer;
Begin
edtName.text:=animals.getFieldValue('name');
edtSize.text:=animals.getFieldValue('Size');
edtWeight.text:=animals.getFieldValue('Weight');
edtArea.text:=animals.getFieldValue('Area');
end;

procedure TForm1.BtnQueryClick(Sender: TObject);
begin
if not animals.Locate(cmbNames.text) then
showMessage('can not find');

GetDataFromServer;

end;

procedure TForm1.BtnPriorClick(Sender: TObject);
begin
if not animals.BoF then animals.Prior;
GetdataFromServer;
end;

procedure TForm1.BtnNextClick(Sender: TObject);
begin
if not animals.BOF then animals.Next;
GetdataFromServer;
end;

end.
 
呵呵,这么多,头都大了。
内存报错个人认为是没有很好的释放内存,以便让客户端执行程序。
还有就是需要正确的安装中间层。
可以安装也可以注册~!
不过注册麻烦点,垃圾多,最好就是安装吧。
 
我是在同一台机器上运行服务器端和客户端的,服务器端已经注册了
 
我自己以前碰到过内存错误问题,我认为是内存小了,呵呵。

也许程序中有没有释放出来的内存,因为太长了,所以看不懂,呵呵:)
 
从代码中看出来,很明显,当由客户端激活服务器程序运行时,自动化对象初始化过程中,
Form1的实例还未生成,而代码中已经在使用了Form1了,请参考上面代码的procedure TOleAnimal.Initialize;
那部分。
但如果服务器程序先运行,就当然不会出现这种情况啦。

只要想办法避免这样写就可以了。
 
多人接受答案了。
 
顶部