相关资料：
1.http://my.oschina.net/u/582827/blog/284766
2.http://www.cnblogs.com/findumars/p/5277561.html
3.http://www.360doc.com/content/12/1208/18/9200790_252887530.shtml
4.http://www.360doc.com/content/12/1208/18/9200790_252887530.shtml
5.http://blog.csdn.net/yoie01/article/details/12194367
结果：
1.Server端与Client端中的接口单元代码都是自动生成的，不用手动增加。
2.在Server中增加方法不能手动写（手写的保存时就不见了），必须用Delphi提供的编辑器（相关资料有提到）。
操作步伐：
Server端：
1.File->New->VCL Forms Application - Delphi for Win32->-Sava All。
2.File->New->Other...->Delphi Projects->ActiveX->Automation Object->CoClass Name->D2007Test->OK。
3.在Project1.tlb->选中“ID2007Test”->“New Method”->选中“Paramerers”->点“Add”->增加自己想要的方法。
4.保存Project1.tlb->Project1_TLB中就会有相关的接口方法了。
5.Unit2中编写对应方法的实现体（Variants必须引入）。
6.保存全部
7.生成EXE，在同目录中放一个“RegCom.cmd”文件，里面写上“D2007ComServer.exe -regserver”，双击此文件注册Server。
Client端:
1.File->New->VCL Forms Application - Delphi for Win32->-Sava All。
2.
D7->Project->Import Type Library...->选中“D2007ComServer”->Create Unit。
D2007->Component->Import Component...->选中“Import a Type Library”->Next->选中“D2007ComServer”->Next->Unit Dir Name->Next。
3.Unit1单元就可以编写调用代码了（D2007ComServer_TLB, ActiveX, OleServer必须引入）。
实例代码
Server端：
1 unit Unit2;
2
3 {$WARN SYMBOL_PLATFORM OFF}
4
5 interface
6
7 uses
8 ComObj, ActiveX, D2007ComServer_TLB, StdVcl,
9 Variants;//Variants必须引入
10 type
11 TD2007TestD2007Test = class(TAutoObject, ID2007Test)
12 private
13 function TextToOleData(const AText: string): OleVariant;
14 function OleDataToText(const AData: OleVariant): string;
15 public
16 //在此不得不说，COM中用的数据类型与咱们之前在DLEPHI的程序中有所不同。必须注意
17 //A+B 加法
18 procedure AddNumber(ANumber1: Integer; ANumber2: Integer; out AReturn: OleVariant); safecall;//整型数据处理
19 //A&B 拼接
20 procedure AddString(const AString1: WideString; const AString2: WideString;
21 out AReturn: OleVariant); safecall;//字符串数据处理
22 end;
23
24 implementation
25
26 uses ComServ;
27
28 { Td7test }
29
30 procedure TD2007TestD2007Test.AddNumber(ANumber1: Integer; ANumber2: Integer; out AReturn: OleVariant);
31 begin
32 AReturn := ANumber1 + ANumber2;
33 end;
34
35 procedure TD2007TestD2007Test.AddString(const AString1: WideString; const AString2: WideString;
36 out AReturn: OleVariant);
37 begin
38 AReturn := AString1 + ' ' + AString2;
39 end;
40
41 function TD2007TestD2007Test.OleDataToText(const AData: OleVariant): string;
42 var
43 nSize: Integer;
44 pData: Pointer;
45 begin
46 if AData = Null then
47 Result := ''
48 else begin
49 nSize := VarArrayHighBound(AData, 1) - VarArrayLowBound(AData, 1) + 1;
50 SetLength(Result, nSize);
51 pData := VarArrayLock(AData);
52 try
53 Move(pData^, Pchar(Result)^, nSize);
54 finally
55 VarArrayUnlock(AData);
56 end;
57 end;
58 end;
59
60 function TD2007TestD2007Test.TextToOleData(const AText: string): OleVariant;
61 var
62 nSize: Integer;
63 pData: Pointer;
64 begin
65 nSize := Length(AText);
66 if nSize = 0 then
67 Result := Null
68 else begin
69 Result := VarArrayCreate([0, nSize - 1], varByte);
70 pData := VarArrayLock(Result);
71 try
72 Move(Pchar(AText)^, pData^, nSize);
73 finally
74 VarArrayUnlock(Result);
75 end;
76 end;
77 end;
78
79 initialization
80 TAutoObjectFactory.Create(ComServer, TD2007TestD2007Test, Class_D2007Test,
81 ciMultiInstance, tmApartment);
82 end.
Server端接口：
1 unit D2007ComServer_TLB;
2
3 // ************************************************************************ //
4 // WARNING
5 // -------
6 // The types declared in this file were generated from data read from a
7 // Type Library. If this type library is explicitly or indirectly (via
8 // another type library referring to this type library) re-imported, or the
9 // 'Refresh' command of the Type Library Editor activated while editing the
10 // Type Library, the contents of this file will be regenerated and all
11 // manual modifications will be lost.
12 // ************************************************************************ //
13
14 // $Rev: 8291 $
15 // File generated on 2016/8/15 14:49:21 from Type Library described below.
16
17 // ************************************************************************ //
18 // Type Lib: E:\D2007Com\D2007ComServer\D2007ComServer.tlb (1)
19 // LIBID: {DF65EF04-7A4E-4A68-9132-7D357AF71708}
20 // LCID: 0
21 // Helpfile:
22 // HelpString: D2007ComServer Library
23 // DepndLst:
24 // (1) v2.0 stdole, (C:\Windows\SysWOW64\stdole2.tlb)
25 // ************************************************************************ //
26 {$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
27 {$WARN SYMBOL_PLATFORM OFF}
28 {$WRITEABLECONST ON}
29 {$VARPROPSETTER ON}
30 interface
31
32 uses Windows, ActiveX, Classes, Graphics, StdVCL, Variants;
33
34
35 // *********************************************************************//
36 // GUIDS declared in the TypeLibrary. Following prefixes are used:
37 // Type Libraries : LIBID_xxxx
38 // CoClasses : CLASS_xxxx
39 // DISPInterfaces : DIID_xxxx
40 // Non-DISP interfaces: IID_xxxx
41 // *********************************************************************//
42 const
43 // TypeLibrary Major and minor versions
44 D2007ComServerMajorVersion = 1;
45 D2007ComServerMinorVersion = 0;
46
47 LIBID_D2007ComServer: TGUID = '{DF65EF04-7A4E-4A68-9132-7D357AF71708}';
48
49 IID_ID2007Test: TGUID = '{BA65E10E-369E-4285-B7B7-4FE85678EAC0}';
50 CLASS_D2007Test: TGUID = '{3C531DD1-361D-4F28-B817-3EA79DE2205A}';
51 type
52
53 // *********************************************************************//
54 // Forward declaration of types defined in TypeLibrary
55 // *********************************************************************//
56 ID2007Test = interface;
57 ID2007TestDisp = dispinterface;
58
59 // *********************************************************************//
60 // Declaration of CoClasses defined in Type Library
61 // (NOTE: Here we map each CoClass to its Default Interface)
62 // *********************************************************************//
63 D2007Test = ID2007Test;
64
65
66 // *********************************************************************//
67 // Interface: ID2007Test
68 // Flags: (4416) Dual OleAutomation Dispatchable
69 // GUID: {BA65E10E-369E-4285-B7B7-4FE85678EAC0}
70 // *********************************************************************//
71 ID2007Test = interface(IDispatch)
72 ['{BA65E10E-369E-4285-B7B7-4FE85678EAC0}']
73 procedure AddNumber(ANumber1: Integer; ANumber2: Integer; out AReturn: OleVariant); safecall;
74 procedure AddString(const AString1: WideString; const AString2: WideString;
75 out AReturn: OleVariant); safecall;
76 end;
77
78 // *********************************************************************//
79 // DispIntf: ID2007TestDisp
80 // Flags: (4416) Dual OleAutomation Dispatchable
81 // GUID: {BA65E10E-369E-4285-B7B7-4FE85678EAC0}
82 // *********************************************************************//
83 ID2007TestDisp = dispinterface
84 ['{BA65E10E-369E-4285-B7B7-4FE85678EAC0}']
85 procedure AddNumber(ANumber1: Integer; ANumber2: Integer; out AReturn: OleVariant); dispid 201;
86 procedure AddString(const AString1: WideString; const AString2: WideString;
87 out AReturn: OleVariant); dispid 202;
88 end;
89
90 // *********************************************************************//
91 // The Class CoD2007Test provides a Create and CreateRemote method to
92 // create instances of the default interface ID2007Test exposed by
93 // the CoClass D2007Test. The functions are intended to be used by
94 // clients wishing to automate the CoClass objects exposed by the
95 // server of this typelibrary.
96 // *********************************************************************//
97 CoD2007Test = class
98 class function Create: ID2007Test;
99 class function CreateRemote(const MachineName: string): ID2007Test;
100 end;
101
102 implementation
103
104 uses ComObj;
105
106 class function CoD2007Test.Create: ID2007Test;
107 begin
108 Result := CreateComObject(CLASS_D2007Test) as ID2007Test;
109 end;
110
111 class function CoD2007Test.CreateRemote(const MachineName: string): ID2007Test;
112 begin
113 Result := CreateRemoteComObject(MachineName, CLASS_D2007Test) as ID2007Test;
114 end;
115
116 end.
Client端:
1 unit Unit1;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, StdCtrls,
8 D2007ComServer_TLB, ActiveX, OleServer, jpeg, ExtCtrls;
9
10 type
11 TForm1 = class(TForm)
12 Button1: TButton;
13 Label1: TLabel;
14 Label2: TLabel;
15 Image1: TImage;
16 procedure Button1Click(Sender: TObject);
17 private
18 { Private declarations }
19 public
20 { Public declarations }
21 end;
22
23 var
24 Form1: TForm1;
25
26 implementation
27
28 {$R *.dfm}
29
30 procedure TForm1.Button1Click(Sender: TObject);
31 var
32 oD2007Test :TD2007Test;
33 iInteger1, iInteger2: sysint;
34 iResult: OleVariant;
35 sString1, sString2: string;
36 sResult: OleVariant;
37 begin
38 oD2007Test := TD2007Test.Create(nil);
39 oD2007Test.ConnectKind := ckRunningOrNew;
40 //数字处理
41 iInteger1 := 1;
42 iInteger2 := 2;
43 iResult := 0;
44 oD2007Test.AddNumber(iInteger1, iInteger2, iResult);
45 Label1.Caption := IntToStr(iResult);
46 //字符处理
47 sString1 := '3';
48 sString2 := '4';
49 sResult := '';
50 oD2007Test.AddString(sString1, sString2, sResult);
51 Label2.Caption := sResult;
52 end;
53
54 end.
Clinet端接口：
1 unit D2007ComServer_TLB;
2
3 // ************************************************************************ //
4 // WARNING
5 // -------
6 // The types declared in this file were generated from data read from a
7 // Type Library. If this type library is explicitly or indirectly (via
8 // another type library referring to this type library) re-imported, or the
9 // 'Refresh' command of the Type Library Editor activated while editing the
10 // Type Library, the contents of this file will be regenerated and all
11 // manual modifications will be lost.
12 // ************************************************************************ //
13
14 // $Rev: 8291 $
15 // File generated on 2016/8/15 14:29:34 from Type Library described below.
16
17 // ************************************************************************ //
18 // Type Lib: E:\D2007Com\D2007ComServer\D2007ComServer.exe (1)
19 // LIBID: {DF65EF04-7A4E-4A68-9132-7D357AF71708}
20 // LCID: 0
21 // Helpfile:
22 // HelpString: D2007ComServer Library
23 // DepndLst:
24 // (1) v2.0 stdole, (C:\Windows\SysWOW64\stdole2.tlb)
25 // ************************************************************************ //
26 // *************************************************************************//
27 // NOTE:
28 // Items guarded by $IFDEF_LIVE_SERVER_AT_DESIGN_TIME are used by properties
29 // which return objects that may need to be explicitly created via a function
30 // call prior to any access via the property. These items have been disabled
31 // in order to prevent accidental use from within the object inspector. You
32 // may enable them by defining LIVE_SERVER_AT_DESIGN_TIME or by selectively
33 // removing them from the $IFDEF blocks. However, such items must still be
34 // programmatically created via a method of the appropriate CoClass before
35 // they can be used.
36 {$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
37 {$WARN SYMBOL_PLATFORM OFF}
38 {$WRITEABLECONST ON}
39 {$VARPROPSETTER ON}
40 interface
41
42 uses Windows, ActiveX, Classes, Graphics, OleServer, StdVCL, Variants;
43
44
45 // *********************************************************************//
46 // GUIDS declared in the TypeLibrary. Following prefixes are used:
47 // Type Libraries : LIBID_xxxx
48 // CoClasses : CLASS_xxxx
49 // DISPInterfaces : DIID_xxxx
50 // Non-DISP interfaces: IID_xxxx
51 // *********************************************************************//
52 const
53 // TypeLibrary Major and minor versions
54 D2007ComServerMajorVersion = 1;
55 D2007ComServerMinorVersion = 0;
56
57 LIBID_D2007ComServer: TGUID = '{DF65EF04-7A4E-4A68-9132-7D357AF71708}';
58
59 IID_ID2007Test: TGUID = '{BA65E10E-369E-4285-B7B7-4FE85678EAC0}';
60 CLASS_D2007Test: TGUID = '{3C531DD1-361D-4F28-B817-3EA79DE2205A}';
61 type
62
63 // *********************************************************************//
64 // Forward declaration of types defined in TypeLibrary
65 // *********************************************************************//
66 ID2007Test = interface;
67 ID2007TestDisp = dispinterface;
68
69 // *********************************************************************//
70 // Declaration of CoClasses defined in Type Library
71 // (NOTE: Here we map each CoClass to its Default Interface)
72 // *********************************************************************//
73 D2007Test = ID2007Test;
74
75
76 // *********************************************************************//
77 // Interface: ID2007Test
78 // Flags: (4416) Dual OleAutomation Dispatchable
79 // GUID: {BA65E10E-369E-4285-B7B7-4FE85678EAC0}
80 // *********************************************************************//
81 ID2007Test = interface(IDispatch)
82 ['{BA65E10E-369E-4285-B7B7-4FE85678EAC0}']
83 procedure AddNumber(ANumber1: Integer; ANumber2: Integer; out AReturn: OleVariant); safecall;
84 procedure AddString(const AString1: WideString; const AString2: WideString;
85 out AReturn: OleVariant); safecall;
86 end;
87
88 // *********************************************************************//
89 // DispIntf: ID2007TestDisp
90 // Flags: (4416) Dual OleAutomation Dispatchable
91 // GUID: {BA65E10E-369E-4285-B7B7-4FE85678EAC0}
92 // *********************************************************************//
93 ID2007TestDisp = dispinterface
94 ['{BA65E10E-369E-4285-B7B7-4FE85678EAC0}']
95 procedure AddNumber(ANumber1: Integer; ANumber2: Integer; out AReturn: OleVariant); dispid 201;
96 procedure AddString(const AString1: WideString; const AString2: WideString;
97 out AReturn: OleVariant); dispid 202;
98 end;
99
100 // *********************************************************************//
101 // The Class CoD2007Test provides a Create and CreateRemote method to
102 // create instances of the default interface ID2007Test exposed by
103 // the CoClass D2007Test. The functions are intended to be used by
104 // clients wishing to automate the CoClass objects exposed by the
105 // server of this typelibrary.
106 // *********************************************************************//
107 CoD2007Test = class
108 class function Create: ID2007Test;
109 class function CreateRemote(const MachineName: string): ID2007Test;
110 end;
111
112
113 // *********************************************************************//
114 // OLE Server Proxy class declaration
115 // Server Object : TD2007Test
116 // Help String : d7test Object
117 // Default Interface: ID2007Test
118 // Def. Intf. DISP? : No
119 // Event Interface:
120 // TypeFlags : (2) CanCreate
121 // *********************************************************************//
122 {$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
123 TD2007TestProperties= class;
124 {$ENDIF}
125 TD2007Test = class(TOleServer)
126 private
127 FIntf: ID2007Test;
128 {$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
129 FProps: TD2007TestProperties;
130 function GetServerProperties: TD2007TestProperties;
131 {$ENDIF}
132 function GetDefaultInterface: ID2007Test;
133 protected
134 procedure InitServerData; override;
135 public
136 constructor Create(AOwner: TComponent); override;
137 destructor Destroy; override;
138 procedure Connect; override;
139 procedure ConnectTo(svrIntf: ID2007Test);
140 procedure Disconnect; override;
141 procedure AddNumber(ANumber1: Integer; ANumber2: Integer; out AReturn: OleVariant);
142 procedure AddString(const AString1: WideString; const AString2: WideString;
143 out AReturn: OleVariant);
144 property DefaultInterface: ID2007Test read GetDefaultInterface;
145 published
146 {$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
147 property Server: TD2007TestProperties read GetServerProperties;
148 {$ENDIF}
149 end;
150
151 {$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
152 // *********************************************************************//
153 // OLE Server Properties Proxy Class
154 // Server Object : TD2007Test
155 // (This object is used by the IDE's Property Inspector to allow editing
156 // of the properties of this server)
157 // *********************************************************************//
158 TD2007TestProperties = class(TPersistent)
159 private
160 FServer: TD2007Test;
161 function GetDefaultInterface: ID2007Test;
162 constructor Create(AServer: TD2007Test);
163 protected
164 public
165 property DefaultInterface: ID2007Test read GetDefaultInterface;
166 published
167 end;
168 {$ENDIF}
169
170
171 procedure Register;
172
173 resourcestring
174 dtlServerPage = '(none)';
175
176 dtlOcxPage = '(none)';
177
178 implementation
179
180 uses ComObj;
181
182 class function CoD2007Test.Create: ID2007Test;
183 begin
184 Result := CreateComObject(CLASS_D2007Test) as ID2007Test;
185 end;
186
187 class function CoD2007Test.CreateRemote(const MachineName: string): ID2007Test;
188 begin
189 Result := CreateRemoteComObject(MachineName, CLASS_D2007Test) as ID2007Test;
190 end;
191
192 procedure TD2007Test.InitServerData;
193 const
194 CServerData: TServerData = (
195 ClassID: '{3C531DD1-361D-4F28-B817-3EA79DE2205A}';
196 IntfIID: '{BA65E10E-369E-4285-B7B7-4FE85678EAC0}';
197 EventIID: '';
198 LicenseKey: nil;
199 Version: 500);
200 begin
201 ServerData := @CServerData;
202 end;
203
204 procedure TD2007Test.Connect;
205 var
206 punk: IUnknown;
207 begin
208 if FIntf = nil then
209 begin
210 punk := GetServer;
211 Fintf:= punk as ID2007Test;
212 end;
213 end;
214
215 procedure TD2007Test.ConnectTo(svrIntf: ID2007Test);
216 begin
217 Disconnect;
218 FIntf := svrIntf;
219 end;
220
221 procedure TD2007Test.DisConnect;
222 begin
223 if Fintf <> nil then
224 begin
225 FIntf := nil;
226 end;
227 end;
228
229 function TD2007Test.GetDefaultInterface: ID2007Test;
230 begin
231 if FIntf = nil then
232 Connect;
233 Assert(FIntf <> nil, 'DefaultInterface is NULL. Component is not connected to Server. You must call "Connect" or "ConnectTo" before this operation');
234 Result := FIntf;
235 end;
236
237 constructor TD2007Test.Create(AOwner: TComponent);
238 begin
239 inherited Create(AOwner);
240 {$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
241 FProps := TD2007TestProperties.Create(Self);
242 {$ENDIF}
243 end;
244
245 destructor TD2007Test.Destroy;
246 begin
247 {$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
248 FProps.Free;
249 {$ENDIF}
250 inherited Destroy;
251 end;
252
253 {$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
254 function TD2007Test.GetServerProperties: TD2007TestProperties;
255 begin
256 Result := FProps;
257 end;
258 {$ENDIF}
259
260 procedure TD2007Test.AddNumber(ANumber1: Integer; ANumber2: Integer; out AReturn: OleVariant);
261 begin
262 DefaultInterface.AddNumber(ANumber1, ANumber2, AReturn);
263 end;
264
265 procedure TD2007Test.AddString(const AString1: WideString; const AString2: WideString;
266 out AReturn: OleVariant);
267 begin
268 DefaultInterface.AddString(AString1, AString2, AReturn);
269 end;
270
271 {$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
272 constructor TD2007TestProperties.Create(AServer: TD2007Test);
273 begin
274 inherited Create;
275 FServer := AServer;
276 end;
277
278 function TD2007TestProperties.GetDefaultInterface: ID2007Test;
279 begin
280 Result := FServer.DefaultInterface;
281 end;
282
283 {$ENDIF}
284
285 procedure Register;
286 begin
287 RegisterComponents(dtlServerPage, [TD2007Test]);
288 end;
289
290 end.
扫一扫
963
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
