Проблема заключается в следующем:
При подключении клиента к внепроцессорному серверу автоматизации со следующим кодом:
While (1<>3) do
begin
Aserv.Connect;
Aserv.Disconnect;
end;
Происходит утечка памяти сервера автоматизации.

Каким образом можно производить очистку памяти на стороне сервера автоматизации?
Какой код нужно добавить в перегруженный деструктор destructor Destroy; override?

Единственным выходом пока является переписать сервер на C++ Builder. На C++ Builder 5 данной проблемы нет.

Здравствуйте, Tesla, Вы писали:

T>При подключении клиента к внепроцессорному серверу автоматизации со следующим кодом:
T>While (1<>3) do
T>begin
T>Aserv.Connect;
T>Aserv.Disconnect;
T>end;
T>Происходит утечка памяти сервера автоматизации.

А как ты это видишь? Память какого процесса растет?

Ну и, докучи, покажи методы Connect и Disconnect

T>Каким образом можно производить очистку памяти на стороне сервера автоматизации?

Есть правила управления памятью (здесь), их придерживаться.

T>Какой код нужно добавить в перегруженный деструктор destructor Destroy; override?

БМП.

Здравствуйте, George Seryakov.
Maxim Mednikov


Спасибо за ответ.

Суть проблемы в том, что при подключении и отключении сервера автоматизации происходит утечка памяти.
Т.е. при подключении и отключении клиента происходит увеличении размера внепроцессорного сервера автоматизации вплоть до переполнения виртуальной памяти.
Данные примеры не из моего проекта, а из книги Delphi 6 руководство разработчика Стив Тейксер. Подобные примеры можно найти в книге Delphi 6 и Com Елманова, А Тенцер.
В каждом примере утечка памяти сервера автоматизации. Могу их выслать по E-mail.

Если вы писали сервер автоматизации на Delphi 5-7, то не могли не заметить этого подводного камня.

Вот пример приложения.
Внепроцессорный сервер автоматизации:

unit ServAuto;
interface
{$WARN SYMBOL_PLATFORM OFF}
uses
ComObj, ActiveX, AxCtrls, Server_TLB;
type
TServerWithEvents = class(TAutoObject, IConnectionPointContainer, IServerWithEvents)
private
{ Private declarations }
FConnectionPoints: TConnectionPoints;
FEvents: IServerWithEventsEvents;
procedure MemoChange(Sender: TObject);
public
procedure Initialize; override;
protected
{ Protected declarations }
property ConnectionPoints: TConnectionPoints read FConnectionPoints
implements IConnectionPointContainer;
procedure EventSinkChanged(const EventSink: IUnknown); override;
procedure Clear; safecall;
procedure AddText(const NewText: WideString); safecall;
end;

implementation
uses ComServ, ServMain, SysUtils, StdCtrls;
procedure TServerWithEvents.EventSinkChanged(const EventSink: IUnknown);
begin
FEvents := EventSink as IServerWithEventsEvents;
end;
procedure TServerWithEvents.Initialize;
begin
inherited Initialize;
FConnectionPoints := TConnectionPoints.Create(Self);
if AutoFactory.EventTypeInfo <> nil then
FConnectionPoints.CreateConnectionPoint(AutoFactory.EventIID,
ckSingle, EventConnect);
// Route main form memo's OnChange event to MemoChange method:
MainForm.Memo.OnChange := MemoChange;
end;
procedure TServerWithEvents.Clear;
begin
MainForm.Memo.Lines.Clear;
if FEvents <> nil then FEvents.OnClear;
end;
procedure TServerWithEvents.AddText(const NewText: WideString);
begin
MainForm.Memo.Lines.Add(NewText);
end;
procedure TServerWithEvents.MemoChange(Sender: TObject);
begin
if FEvents <> nil then FEvents.OnTextChanged((Sender as TMemo).Text);
end;
initialization
TAutoObjectFactory.Create(ComServer, TServerWithEvents,
Class_ServerWithEvents, ciMultiInstance, tmApartment);
end.



Клиент:
На стороне клиента вызывать FormCreate и FormDestroy, которые подключаются и отключаются от сервера автоматизации.

unit CliMain;
{$WARN SYMBOL_PLATFORM OFF}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Server_TLB, ComObj;
type
TEventSink = class;
TMainForm = class(TForm)
SendButton: TButton;
CloseButton: TButton;
ClearButton: TButton;
Edit: TEdit;
Memo: TMemo;
procedure FormCreate(Sender: TObject);
procedure SendButtonClick(Sender: TObject);
procedure ClearButtonClick(Sender: TObject);
procedure CloseButtonClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
FServer: IServerWithEvents;
FEventSink: TEventSink;
FCookie: Integer;
procedure OnServerMemoChanged(const NewText: string);
procedure OnClear;
public
{ Public declarations }
end;

TEventSink = class(TObject, IUnknown, IDispatch)
private
FController: TMainForm;
{ IUnknown }
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
{ IDispatch }
function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
function GetIDsOfNames(const IID: TGUID; Names: Pointer;
NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
public
constructor Create(Controller: TMainForm);
end;

var
MainForm: TMainForm;

implementation
uses ActiveX;
{$R *.DFM}
{ TMainForm }
procedure TMainForm.FormCreate(Sender: TObject);
begin
FServer := CoServerWithEvents.Create;
FEventSink := TEventSink.Create(Self);
InterfaceConnect(FServer, IServerWithEventsEvents, FEventSink, FCookie);
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
InterfaceDisconnect(FEventSink, IServerWithEventsEvents, FCookie);
FEventSink.Free;
end;
procedure TMainForm.SendButtonClick(Sender: TObject);
begin
FServer.AddText(Edit.Text);
end;
procedure TMainForm.ClearButtonClick(Sender: TObject);
begin
FServer.Clear;
end;
procedure TMainForm.CloseButtonClick(Sender: TObject);
begin
Close;
end;
procedure TMainForm.OnServerMemoChanged(const NewText: string);
begin
Memo.Text := NewText;
end;
procedure TMainForm.OnClear;
begin
Memo.Clear;
end;
{ TEventSink }
constructor TEventSink.Create(Controller: TMainForm);
begin
FController := Controller;
inherited Create;
end;
{ TEventSink.IUnknown }

function TEventSink._AddRef: Integer;
begin
// No need to implement, since lifetime is tied to client
Result := 1;
end;
function TEventSink._Release: Integer;
begin
// No need to implement, since lifetime is tied to client
Result := 1;
end;
function TEventSink.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
// First look for my own implementation of an interface
// (I implement IUnknown and IDispatch).
if GetInterface(IID, Obj) then
Result := S_OK
// Next, if they are looking for outgoing interface, recurse to return
// our IDispatch pointer.
else if IsEqualIID(IID, IServerWithEventsEvents) then
Result := QueryInterface(IDispatch, Obj)
// For everything else, return an error.
else
Result := E_NOINTERFACE;
end;
{ TEventSink.IDispatch }
function TEventSink.GetIDsOfNames(const IID: TGUID; Names: Pointer;
NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin
Result := E_NOTIMPL;
end;
function TEventSink.GetTypeInfo(Index, LocaleID: Integer;
out TypeInfo): HResult;
begin
Pointer(TypeInfo) := nil;
Result := E_NOTIMPL;
end;
function TEventSink.GetTypeInfoCount(out Count: Integer): HResult;
begin
Count := 0;
Result := S_OK;
end;
function TEventSink.Invoke(DispID: Integer; const IID: TGUID;
LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
ArgErr: Pointer): HResult;
var
V: OleVariant;
begin
Result := S_OK;
case DispID of
1:
begin
// First parameter is new string
V := OleVariant(TDispParams(Params).rgvarg^[0]);
FController.OnServerMemoChanged(V);
end;
2: FController.OnClear;
end;
end;
end.

Здравствуйте, Tesla, Вы писали:

T> Если вы писали сервер автоматизации на Delphi 5-7, то не могли не заметить этого подводного камня.

Нет, не писал и не мог заметить. Когда-то давно лабал на паскале.

T>procedure TMainForm.FormCreate(Sender: TObject);
T>begin
T>  FServer := CoServerWithEvents.Create;
T>  FEventSink := TEventSink.Create(Self);
T>  InterfaceConnect(FServer, IServerWithEventsEvents, FEventSink, FCookie);
T>end;
T>procedure TMainForm.FormDestroy(Sender: TObject);
T>begin
T>  InterfaceDisconnect(FEventSink, IServerWithEventsEvents, FCookie);
T>  FEventSink.Free;
    FServer.Free
T>end;

Если в FormCreate FServer создается, то в FormDestroy я бы попробовал его освобождать. Или в FormCreate проверять, что он уже создан, и не создавать по новой.

Спасибо за ответ.

Все-таки выбор пал на то, что нужно переписать COM сервер на C++ Builder.
Как не странно в C++ Builder сервер работает шустрее на 25 процентов.
Решения с Delphi найти не удалось. Видимо эта ошибка с 4-7 Delphi для того чтобы выбирали технологию Cobra.