Форум по программированию Delphi Sources

 



Вернуться   Форум по программированию Delphi Sources > Все о Delphi > Технологии
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 16.06.2018, 14:56
F.o.x. F.o.x. вне форума
Прохожий
 
Регистрация: 16.06.2018
Сообщения: 6
Версия Delphi: Delphi XE3
Репутация: 10
Вопрос Почему реализация IInterface не работает у TDataModule?

У меня такая ситуация: понадобилось часть методов моего класса Tdm (наследника TDataModule) объявить в интерфейсах. И тут вдруг выясняется, что реализация IInterface у этого класса почему-то не работает или работает не до конца. Подсчет ссылок на объект не ведется.

Пришлось написать собственную реализацию IInterfece и после этого все наконец-то заработало!

Возникает вопрос: это такой баг или так и задумано?

Вот неполный текст модуля на всякий случай:

Код:
{=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\
|  ARZU - АИС "Расчет оплаты за аренду земельных участков"                     |                                                      |
|                                                                              |
|  Модуль: Logic.Connect                                                       |
|  Автор: GreyFox84 (greyfox84@list.ru)                                        |
|  Copyright: GreyFox84                                                        |
|  Дата: 02.05.2018                                                            |
|                                                                              |
|  Описание:                                                                   |
|     Модуль подключения к базе данных.                                        |
|     Класс Tdm реализует интерфейсы IDataBase и IAdminTools, создается        |
|     в единственном экземпляре и (неявно) служит фабрикой создания            |
|     сущностей - наследников TSelect.                                         |
|                                                                              |
\=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-}

unit ARZU.Logic.Connect;

interface

uses
  SysUtils, Classes, IBDatabase, DB, IBQuery, IBSQL,
  IBServices, IBCustomDataSet, Variants, DBInterfaces;

type

  TSelect = class(TIBQuery)
  protected
    fSearchFieldName: string;
    fSearchValue: Variant;
    function GetField(FieldName: string): TField;
  private
    fOnSelect: TNotifyEvent;
    procedure SelectAfterOpen(DataSet:TDataSet);
  public
    procedure ExecuteSQL(aSQL: string);
    function FindFirst(FieldName: string; Value: string): boolean;
    function FindNext: boolean;
    procedure FindReset;
    procedure RefreshRows;

    constructor Create; reintroduce; overload;

    property OnSelect:TNotifyEvent read fOnSelect write fOnSelect;
    property Field[FieldName: string]: TField read GetField;
  end;

  Tdm = class(TDataModule,IDataBase,IAdminTools)
    IBDB: TIBDatabase;
    RTransact: TIBTransaction;
    WTransact: TIBTransaction;
    myDML: TIBSQL;
    IBBackup: TIBBackupService;
    IBRestore: TIBRestoreService;
    QMetaData: TIBQuery;
    procedure DataModuleCreate(Sender: TObject);
  private
    { Private declarations }
    fRefCount: integer;
  public
    { Public declarations }
// IDataBase
    function GetGeneratorVal(GenName:string; Increment:integer):Int64;
    function GetMaxVal(TableName,FieldName:string):Int64;
    function ExecuteDML(aDML:string; aCommitTran: boolean):boolean;
    function ParamByName(ParamName:string): TIBXSQLVAR;
    function dbConnect(dbFileName,Usr,Pass:string):boolean;
    procedure dbDisconnect;
    function dbConnected: boolean;
// IAdminTools
    procedure dbBackup(FeedBack:TObject; bkpFileName:string);
    procedure dbRestore(FeedBack:TObject; bkpFileName:string);
// IInterface Переопределения, т.к. TDataModule
// является наследником TControl, а следовательно его
// реализация IInterface почему-то работает не до конца.
    function QueryInterface(const IID: TGUID; out Obj): HResult; override; stdcall;
    function _AddRef: Integer; overload; stdcall;
    function _Release: Integer; overload; stdcall;
  end;

function IDataModuleCreate(IID:TGUID; out Obj):HResult; stdcall;

var
  FloatFormatForSQL: TFormatSettings;

implementation

uses
  StrUtils, StdCtrls, Controls, UITypes, Dialogs, Windows, Forms,
  CustomizeDatasets;

var
  dm: Tdm;
  DmCreated: boolean = false;

{$R *.dfm}

{TSelect}

// ... Реализация методов TSelect

{Tdm}

function Tdm.dbConnect(dbFileName,Usr,Pass:string):boolean;
begin
  with dm.IBDB do begin
    DataBaseName:=dbFileName;
    Params.Clear;
    Params.Add('lc_ctype=WIN1251');
    Params.Add('user_name='+Usr);
    Params.Add('password='+Pass);
    LoginPrompt:=false;
  end;
  try
    dm.IBDB.Open;
  except
    on E:EDatabaseError do begin
      MessageDlg('Ошибка подключения к базе данных: '+E.Message,mtError,[mbOK],0);
      Result:=false;
      Exit;
    end;
  end;
  Result:=dm.IBDB.Connected;
end;

procedure Tdm.dbDisconnect;
begin
  if dm.WTransact.InTransaction then dm.WTransact.Rollback;
  if dm.RTransact.InTransaction then dm.RTransact.Commit;
  dm.IBDB.CloseDataSets;
  dm.IBDB.Close;
end;

function Tdm.ExecuteDML(aDML:string; aCommitTran:boolean):boolean;
begin
  dm.myDML.SQL.Text:=aDML;
  Result:=false;
  try
    if not dm.WTransact.InTransaction then  dm.WTransact.StartTransaction;
    dm.myDML.ExecQuery;
  except
    on E:Exception do begin
      dm.WTransact.Rollback;
      MessageDlg('Ошибка выполнения запроса:'+#10#13#10#13+aDML+#10#13#10#13+E.Message,mtError,[mbOK],0);
      Exit;
    end;
  end;
  if aCommitTran then dm.WTransact.Commit;
  Result:=true;
end;

procedure Tdm.DataModuleCreate(Sender: TObject);
begin
  fRefCount:=0;
  FloatFormatForSQL:=TFormatSettings.Create;
  FloatFormatForSQL.DecimalSeparator:='.';
end;

function Tdm.QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
begin
  if GetInterface(IID,Obj) then Result:=0
  else Result:=E_NOINTERFACE;
end;

function Tdm._AddRef:Integer; stdcall;
begin
  Inc(fRefCount);
  //MessageDlg('Cсылок на dm: '+IntToStr(fRefCount),mtInformation,[mbOk],0);
  Result:=fRefCount;
end;

function Tdm._Release: Integer; stdcall;
begin
  Dec(fRefCount);
  //MessageDlg('Cсылок на dm: '+IntToStr(fRefCount),mtInformation,[mbOk],0);
  Result:=fRefCount;
  if Result=0 then begin
    IBDB.Close;
    inherited Destroy;
  end;
end;

function Tdm.dbConnected: boolean;
begin
  dbConnected:=IBDB.Connected;
end;

// ... Реализация  остальных методов Tdm

function IDataModuleCreate(IID:TGUID; out Obj):HResult; stdcall;
begin
  if not DmCreated then begin
    dm:=Tdm.Create(nil);
    DmCreated:=true;
  end;
  Result:=dm.QueryInterface(IID,Obj);
end;

end.

Последний раз редактировалось F.o.x., 16.06.2018 в 16:22.
Ответить с цитированием
  #2  
Старый 16.06.2018, 18:38
F.o.x. F.o.x. вне форума
Прохожий
 
Регистрация: 16.06.2018
Сообщения: 6
Версия Delphi: Delphi XE3
Репутация: 10
Сообщение

Вопрос снимается. Оказывается все так и задумано, чтобы компоненты самостоятельно не удалялись при отсутствии ссылок на них.
Ответить с цитированием
Ответ



Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 16:10.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources", 2004-2018

ВКонтакте   Facebook   Twitter