версионирование oleautomation интерфейсов
28.06.2011, 10:23. Показов 1285. Ответов 0
Создаю ActiveX Library.
Создаю Autamation Object по имени MyCoClass;
вместе с этим создаётся интерфейс IMyCoClass, наследник IDispatch,
создаю там метод Method1.
Реализую интерфейс в классе TMyCoClass:
| Delphi | 1
| TMyCoClass = class(TAutoObject, IMyCoClass) |
|
Пишу много-много программ, которые юзают интерфейс IMyCoClass.
Теперь хочу немного изменить интерфейс - и опа... надо переписывать все программы.
Пытаюсь обойти эту ситуацию:
Создаю интерфейс IMyCoClass_2 (и соответсвующий ему MyCoClass_2), при этом:
| Delphi | 1
| IMyCoClass_2 = interface(IMyCoClass) |
|
и
| Delphi | 1
| TMyCoClass_2 = class(TMyCoClass, IMyCoClass_2) |
|
и создаю в IMyCoClass_2 метод Method2.
Предполагалось, что в TMyCoClass_2 попадёт реализация метода Method1 из TMyCoClass,
но Delphi почему-то хочет чтобы я реализовал оба метода Method1 и Method2 в TMyCoClass_2.
В принципе, если вручную удалить Method1 из Unit2.pas - то всё компилится и работает, но после следующего редактирования Project1.tlb (и генерации Project1_TLB.pas) в Unit2.pas появляются пустые реализации методов из IMyCoClass.
Как это отключить?
Файл проекта Project1.pas:
| Delphi | 1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
| library Project1;
uses
ComServ,
Project1_TLB in 'Project1_TLB.pas',
Unit1 in 'Unit1.pas' {MyCoClass: CoClass},
Unit2 in 'Unit2.pas' {MyCoClass_2: CoClass};
exports
DllGetClassObject,
DllCanUnloadNow,
DllRegisterServer,
DllUnregisterServer;
{$R *.TLB}
{$R *.RES}
begin
end. |
|
Project1_TLB.pas:
| Delphi | 1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
| unit Project1_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 : 1.2
// File generated on 27.06.2011 15:01:19 from Type Library described below.
// ************************************************************************ //
// Type Lib: D:\tmp\test\Project1.tlb (1)
// LIBID: {C87BD34F-7929-40E2-8BCA-4D7F971A79B9}
// LCID: 0
// Helpfile:
// HelpString: Project1 Library
// DepndLst:
// (1) v2.0 stdole, (C:\WINDOWS\system32\stdole2.tlb)
// (2) v4.0 StdVCL, (C:\WINDOWS\system32\stdvcl40.dll)
// (3) v4.0 StdVCL, (C:\WINDOWS\system32\stdvcl40.dll)
// ************************************************************************ //
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}
{$VARPROPSETTER ON}
interface
uses Windows, ActiveX, Classes, Graphics, StdVCL, Variants;
// *********************************************************************//
// 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
Project1MajorVersion = 1;
Project1MinorVersion = 0;
LIBID_Project1: TGUID = '{C87BD34F-7929-40E2-8BCA-4D7F971A79B9}';
IID_IMyCoClass: TGUID = '{5ECF25D5-5F3B-486A-AE9B-6F48E45AF2A9}';
CLASS_MyCoClass: TGUID = '{91893A26-FB68-45E3-ACAE-748BA022F0D6}';
IID_IMyCoClass_2: TGUID = '{94C8421C-0CF9-4C3D-8E3F-AD4E2E074C37}';
CLASS_MyCoClass_2: TGUID = '{A195770F-4D34-422B-89A9-90DCB3F2464E}';
type
// *********************************************************************//
// Forward declaration of types defined in TypeLibrary
// *********************************************************************//
IMyCoClass = interface;
IMyCoClassDisp = dispinterface;
IMyCoClass_2 = interface;
IMyCoClass_2Disp = dispinterface;
// *********************************************************************//
// Declaration of CoClasses defined in Type Library
// (NOTE: Here we map each CoClass to its Default Interface)
// *********************************************************************//
MyCoClass = IMyCoClass;
MyCoClass_2 = IMyCoClass_2;
// *********************************************************************//
// Interface: IMyCoClass
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {5ECF25D5-5F3B-486A-AE9B-6F48E45AF2A9}
// *********************************************************************//
IMyCoClass = interface(IDispatch)
['{5ECF25D5-5F3B-486A-AE9B-6F48E45AF2A9}']
function Method1(Param1: Integer; Param2: Integer): Integer; safecall;
end;
// *********************************************************************//
// DispIntf: IMyCoClassDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {5ECF25D5-5F3B-486A-AE9B-6F48E45AF2A9}
// *********************************************************************//
IMyCoClassDisp = dispinterface
['{5ECF25D5-5F3B-486A-AE9B-6F48E45AF2A9}']
function Method1(Param1: Integer; Param2: Integer): Integer; dispid 201;
end;
// *********************************************************************//
// Interface: IMyCoClass_2
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {94C8421C-0CF9-4C3D-8E3F-AD4E2E074C37}
// *********************************************************************//
IMyCoClass_2 = interface(IMyCoClass)
['{94C8421C-0CF9-4C3D-8E3F-AD4E2E074C37}']
function Method2(Param1: Integer): Integer; safecall;
end;
// *********************************************************************//
// DispIntf: IMyCoClass_2Disp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {94C8421C-0CF9-4C3D-8E3F-AD4E2E074C37}
// *********************************************************************//
IMyCoClass_2Disp = dispinterface
['{94C8421C-0CF9-4C3D-8E3F-AD4E2E074C37}']
function Method2(Param1: Integer): Integer; dispid 301;
function Method1(Param1: Integer; Param2: Integer): Integer; dispid 201;
end;
// *********************************************************************//
// The Class CoMyCoClass provides a Create and CreateRemote method to
// create instances of the default interface IMyCoClass exposed by
// the CoClass MyCoClass. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoMyCoClass = class
class function Create: IMyCoClass;
class function CreateRemote(const MachineName: string): IMyCoClass;
end;
// *********************************************************************//
// The Class CoMyCoClass_2 provides a Create and CreateRemote method to
// create instances of the default interface IMyCoClass_2 exposed by
// the CoClass MyCoClass_2. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoMyCoClass_2 = class
class function Create: IMyCoClass_2;
class function CreateRemote(const MachineName: string): IMyCoClass_2;
end;
implementation
uses ComObj;
class function CoMyCoClass.Create: IMyCoClass;
begin
Result := CreateComObject(CLASS_MyCoClass) as IMyCoClass;
end;
class function CoMyCoClass.CreateRemote(const MachineName: string): IMyCoClass;
begin
Result := CreateRemoteComObject(MachineName, CLASS_MyCoClass) as IMyCoClass;
end;
class function CoMyCoClass_2.Create: IMyCoClass_2;
begin
Result := CreateComObject(CLASS_MyCoClass_2) as IMyCoClass_2;
end;
class function CoMyCoClass_2.CreateRemote(const MachineName: string): IMyCoClass_2;
begin
Result := CreateRemoteComObject(MachineName, CLASS_MyCoClass_2) as IMyCoClass_2;
end;
end. |
|
Project1.tlb:
| Code | 1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
| [
uuid(C87BD34F-7929-40E2-8BCA-4D7F971A79B9),
version(1.0),
helpstring("Project1 Library")
]
library Project1
{
importlib("stdole2.tlb");
importlib("stdvcl40.dll");
importlib("stdvcl40.dll");
[
uuid(5ECF25D5-5F3B-486A-AE9B-6F48E45AF2A9),
version(1.0),
helpstring("Dispatch interface for MyCoClass Object"),
dual,
oleautomation
]
interface IMyCoClass: IDispatch
{
[
id(0x000000C9)
]
HRESULT _stdcall Method1([in] long Param1, [in] long Param2, [out, retval] long * Param3 );
};
[
uuid(91893A26-FB68-45E3-ACAE-748BA022F0D6),
version(1.0),
helpstring("MyCoClass Object")
]
coclass MyCoClass
{
[default] interface IMyCoClass;
};
[
uuid(94C8421C-0CF9-4C3D-8E3F-AD4E2E074C37),
version(1.0),
helpstring("Dispatch interface for IMyCoClass_2 Object"),
dual,
oleautomation
]
interface IMyCoClass_2: IMyCoClass
{
[
id(0x0000012D)
]
HRESULT _stdcall Method2([in] long Param1, [out, retval] long * Param2 );
};
[
uuid(A195770F-4D34-422B-89A9-90DCB3F2464E),
version(1.0),
helpstring("IMyCoClass_2 Object")
]
coclass MyCoClass_2
{
[default] interface IMyCoClass_2;
};
}; |
|
Unit1.pas:
| Delphi | 1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
| unit Unit1;
{$WARN SYMBOL_PLATFORM OFF}
interface
uses
ComObj, ActiveX, Project1_TLB, StdVcl;
type
TMyCoClass = class(TAutoObject, IMyCoClass)
protected
function Method1(Param1, Param2: Integer): Integer; safecall;
end;
implementation
uses ComServ;
function TMyCoClass.Method1(Param1, Param2: Integer): Integer;
begin
end;
initialization
TAutoObjectFactory.Create(ComServer, TMyCoClass, Class_MyCoClass,
ciMultiInstance, tmSingle);
end. |
|
Unit2.pas до изменения интерфейса IMyCoClass_2:
| Delphi | 1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
| unit Unit2;
{$WARN SYMBOL_PLATFORM OFF}
interface
uses
ComObj, ActiveX, Project1_TLB, StdVcl, Unit1;
type
TMyCoClass_2 = class(TMyCoClass, IMyCoClass_2)
protected
function Method2(Param1: Integer): Integer; safecall;
end;
implementation
uses ComServ;
function TMyCoClass_2.Method2(Param1: Integer): Integer;
begin
end;
initialization
TAutoObjectFactory.Create(ComServer, TMyCoClass_2, Class_MyCoClass_2,
ciMultiInstance, tmSingle);
end. |
|
Unit2.pas после изменения интерфейса IMyCoClass_2:
| Delphi | 1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
| unit Unit2;
{$WARN SYMBOL_PLATFORM OFF}
interface
uses
ComObj, ActiveX, Project1_TLB, StdVcl, Unit1;
type
TMyCoClass_2 = class(TMyCoClass, IMyCoClass_2)
protected
function Method2(Param1: Integer): Integer; safecall;
function Method1(Param1, Param2: Integer): Integer; safecall;
end;
implementation
uses ComServ;
function TMyCoClass_2.Method2(Param1: Integer): Integer;
begin
end;
function TMyCoClass_2.Method1(Param1, Param2: Integer): Integer;
begin
end;
initialization
TAutoObjectFactory.Create(ComServer, TMyCoClass_2, Class_MyCoClass_2,
ciMultiInstance, tmSingle);
end. |
|
Так, вроде бы разобрался:
dispinterface не поддерживает наследование в принципе, и поэтому для в dispinterface нового интерфейса пихаются все методы из всего дерева предков нового интерфейса, и, т.к. (как я понял) компанент реализует не интерфейс а dispinterface - то ему следовало бы реализовать все методы из dispinterface-а.
Но, т.к. интерфейс dual - то методы можно вызывать как через invoke, так и через стандартный для языка (в данном случае делфи) вызов метода через таблицу виртуальных методов. В итоге, без использования invoke всё работает.
В общем, стало ясно, что такой подход - не верный.
А надо в одном компаненте реализовывать несколько интерфейсов, типа:
| Delphi | 1
| TMyClass = class(TAutoObject, IMyClass, IMyClass2) |
|
Однако тут меня поджидают новые (для меня), но, надеюсь, всем известные грабли:
| Delphi | 1
2
3
4
| var IMyClass cmp;
begin
cmp := CoMyClass.Create;
cmp.Method2(); //Undectared identifier Method2 |
|
в то же время:
| Delphi | 1
2
3
| var IMyClass2 cmp;
begin
cmp := CoMyClass.Create; //Incompatible types IMyClass and IMyClass2 |
|
т.е. в первом случае в IMyClass нет метода Method2 (что совершенно естественно и понятно)
а во втором случае CoMyClass.Create возвращает указатель на IMyClass а не на IMyClass2,
вот и вопрос: как получить указатель на IMyClass2 ?
Project1.pas:
| Delphi | 1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
| library Project1;
uses
ComServ,
Project1_TLB in 'Project1_TLB.pas',
Unit1 in 'Unit1.pas' {MyClass: CoClass};
exports
DllGetClassObject,
DllCanUnloadNow,
DllRegisterServer,
DllUnregisterServer;
{$R *.TLB}
{$R *.RES}
begin
end. |
|
Project1.tlb
| Code | 1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
| [
uuid(03A94546-B031-4F33-B522-BE3F072077E7),
version(1.0),
helpstring("Project1 Library")
]
library Project1
{
importlib("stdole2.tlb");
[
uuid(BB81C3A3-A67E-4F3E-AB96-D10C3CC89D07),
version(1.0),
helpstring("Dispatch interface for MyClass Object"),
dual,
oleautomation
]
interface IMyClass: IDispatch
{
[
id(0x000000C9)
]
HRESULT _stdcall Method1( void );
};
[
uuid(F2FE2276-4CBD-4CF1-A06E-3222519E9D01),
version(1.0),
dual,
oleautomation
]
interface IMyClass2: IMyClass
{
[
id(0x0000012D)
]
HRESULT _stdcall Method2( void );
};
[
uuid(C2EEBF43-A4F9-4A6B-AE97-389871695ACA),
version(1.0),
helpstring("MyClass Object")
]
coclass MyClass
{
[default] interface IMyClass;
interface IMyClass2;
};
}; |
|
Project1_TLB.pas:
| Delphi | 1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
| unit Project1_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 : 1.2
// File generated on 27.06.2011 17:45:06 from Type Library described below.
// ************************************************************************ //
// Type Lib: D:\tmp\test\Project1.tlb (1)
// LIBID: {03A94546-B031-4F33-B522-BE3F072077E7}
// LCID: 0
// Helpfile:
// HelpString: Project1 Library
// DepndLst:
// (1) v2.0 stdole, (C:\WINDOWS\system32\stdole2.tlb)
// ************************************************************************ //
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}
{$VARPROPSETTER ON}
interface
uses Windows, ActiveX, Classes, Graphics, StdVCL, Variants;
// *********************************************************************//
// 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
Project1MajorVersion = 1;
Project1MinorVersion = 0;
LIBID_Project1: TGUID = '{03A94546-B031-4F33-B522-BE3F072077E7}';
IID_IMyClass: TGUID = '{BB81C3A3-A67E-4F3E-AB96-D10C3CC89D07}';
IID_IMyClass2: TGUID = '{F2FE2276-4CBD-4CF1-A06E-3222519E9D01}';
CLASS_MyClass: TGUID = '{C2EEBF43-A4F9-4A6B-AE97-389871695ACA}';
type
// *********************************************************************//
// Forward declaration of types defined in TypeLibrary
// *********************************************************************//
IMyClass = interface;
IMyClassDisp = dispinterface;
IMyClass2 = interface;
IMyClass2Disp = dispinterface;
// *********************************************************************//
// Declaration of CoClasses defined in Type Library
// (NOTE: Here we map each CoClass to its Default Interface)
// *********************************************************************//
MyClass = IMyClass;
// *********************************************************************//
// Interface: IMyClass
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {BB81C3A3-A67E-4F3E-AB96-D10C3CC89D07}
// *********************************************************************//
IMyClass = interface(IDispatch)
['{BB81C3A3-A67E-4F3E-AB96-D10C3CC89D07}']
procedure Method1; safecall;
end;
// *********************************************************************//
// DispIntf: IMyClassDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {BB81C3A3-A67E-4F3E-AB96-D10C3CC89D07}
// *********************************************************************//
IMyClassDisp = dispinterface
['{BB81C3A3-A67E-4F3E-AB96-D10C3CC89D07}']
procedure Method1; dispid 201;
end;
// *********************************************************************//
// Interface: IMyClass2
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {F2FE2276-4CBD-4CF1-A06E-3222519E9D01}
// *********************************************************************//
IMyClass2 = interface(IMyClass)
['{F2FE2276-4CBD-4CF1-A06E-3222519E9D01}']
procedure Method2; safecall;
end;
// *********************************************************************//
// DispIntf: IMyClass2Disp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {F2FE2276-4CBD-4CF1-A06E-3222519E9D01}
// *********************************************************************//
IMyClass2Disp = dispinterface
['{F2FE2276-4CBD-4CF1-A06E-3222519E9D01}']
procedure Method2; dispid 301;
procedure Method1; dispid 201;
end;
// *********************************************************************//
// The Class CoMyClass provides a Create and CreateRemote method to
// create instances of the default interface IMyClass exposed by
// the CoClass MyClass. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
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. |
|
Unit1.pas:
| Delphi | 1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
| unit Unit1;
{$WARN SYMBOL_PLATFORM OFF}
interface
uses
ComObj, ActiveX, Project1_TLB, StdVcl;
type
TMyClass = class(TAutoObject, IMyClass, Interface1)
protected
procedure Method1; safecall;
procedure Method2; safecall;
end;
implementation
uses ComServ;
procedure TMyClass.Method1;
begin
end;
procedure TMyClass.Method2;
begin
end;
initialization
TAutoObjectFactory.Create(ComServer, TMyClass, Class_MyClass,
ciMultiInstance, tmApartment);
end. |
|
Ну, тут оказалось совсем просто, помог метод попадания пальцем в небо.
Какой интерфейс в coclass MyClass помечен [default] - такой тип и возвращает CoMyClass.Create
Всем спасибо.
Там опечатка: в Unit1.pas
вместо
| Delphi | 1
| TMyClass = class(TAutoObject, IMyClass, Interface1) |
|
написано
| Delphi | 1
| TMyClass = class(TAutoObject, IMyClass, IMyClass2) |
|
Всем спасибо, кстати 
0
|
(
