Com进程通信(Delphi2007)

 

相关资料： 

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端：

unit Unit2; 2  3 {$WARN SYMBOL_PLATFORM OFF} 4  5 interface 6  7 uses 8   ComObj, ActiveX, D2007ComServer_TLB, StdVcl, 9   Variants;//Variants必须引入10 type11   TD2007TestD2007Test = class(TAutoObject, ID2007Test)12   private13     function TextToOleData(const AText: string): OleVariant;14     function OleDataToText(const AData: OleVariant): string;15   public16     //在此不得不说，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 implementation25 26 uses ComServ;27 28 { Td7test }29 30 procedure TD2007TestD2007Test.AddNumber(ANumber1: Integer; ANumber2: Integer; out AReturn: OleVariant);31 begin32   AReturn :=  ANumber1 + ANumber2;33 end;34 35 procedure TD2007TestD2007Test.AddString(const AString1: WideString; const AString2: WideString;36   out AReturn: OleVariant);37 begin38   AReturn := AString1 + ' ' + AString2;39 end;40 41 function TD2007TestD2007Test.OleDataToText(const AData: OleVariant): string;42 var43   nSize: Integer;44   pData: Pointer;45 begin46   if AData = Null then47     Result := ''48   else begin49     nSize := VarArrayHighBound(AData, 1) - VarArrayLowBound(AData, 1) + 1;50     SetLength(Result, nSize);51     pData := VarArrayLock(AData);52     try53       Move(pData^, Pchar(Result)^, nSize);54     finally55       VarArrayUnlock(AData);56     end;57   end;58 end;59 60 function TD2007TestD2007Test.TextToOleData(const AText: string): OleVariant;61 var62   nSize: Integer;63   pData: Pointer;64 begin65   nSize := Length(AText);66   if nSize = 0 then67     Result := Null68   else begin69     Result := VarArrayCreate([0, nSize - 1], varByte);70     pData := VarArrayLock(Result);71     try72       Move(Pchar(AText)^, pData^, nSize);73     finally74       VarArrayUnlock(Result);75     end;76   end;77 end;78 79 initialization80   TAutoObjectFactory.Create(ComServer, TD2007TestD2007Test, Class_D2007Test,81     ciMultiInstance, tmApartment);82 end.

Server端接口：

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 implementation103 104 uses ComObj;105 106 class function CoD2007Test.Create: ID2007Test;107 begin108   Result := CreateComObject(CLASS_D2007Test) as ID2007Test;109 end;110 111 class function CoD2007Test.CreateRemote(const MachineName: string): ID2007Test;112 begin113   Result := CreateRemoteComObject(MachineName, CLASS_D2007Test) as ID2007Test;114 end;115 116 end.

 

Client端:

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 type11   TForm1 = class(TForm)12     Button1: TButton;13     Label1: TLabel;14     Label2: TLabel;15     Image1: TImage;16     procedure Button1Click(Sender: TObject);17   private18     { Private declarations }19   public20     { Public declarations }21   end;22 23 var24   Form1: TForm1;25 26 implementation27 28 {$R *.dfm}29 30 procedure TForm1.Button1Click(Sender: TObject);31 var32   oD2007Test :TD2007Test;33   iInteger1, iInteger2: sysint;34   iResult: OleVariant;35   sString1, sString2: string;36   sResult: OleVariant;37 begin38   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端接口：

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 = class108     class function Create: ID2007Test;109     class function CreateRemote(const MachineName: string): ID2007Test;110   end;111 112 113 // *********************************************************************//114 // OLE Server Proxy class declaration115 // Server Object    : TD2007Test116 // Help String      : d7test Object117 // Default Interface: ID2007Test118 // Def. Intf. DISP? : No119 // Event   Interface: 120 // TypeFlags        : (2) CanCreate121 // *********************************************************************//122 {$IFDEF LIVE_SERVER_AT_DESIGN_TIME}123   TD2007TestProperties= class;124 {$ENDIF}125   TD2007Test = class(TOleServer)126   private127     FIntf: ID2007Test;128 {$IFDEF LIVE_SERVER_AT_DESIGN_TIME}129     FProps: TD2007TestProperties;130     function GetServerProperties: TD2007TestProperties;131 {$ENDIF}132     function GetDefaultInterface: ID2007Test;133   protected134     procedure InitServerData; override;135   public136     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   published146 {$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 Class154 // Server Object    : TD2007Test155 // (This object is used by the IDE's Property Inspector to allow editing156 //  of the properties of this server)157 // *********************************************************************//158  TD2007TestProperties = class(TPersistent)159   private160     FServer:    TD2007Test;161     function    GetDefaultInterface: ID2007Test;162     constructor Create(AServer: TD2007Test);163   protected164   public165     property DefaultInterface: ID2007Test read GetDefaultInterface;166   published167   end;168 {$ENDIF}169 170 171 procedure Register;172 173 resourcestring174   dtlServerPage = '(none)';175 176   dtlOcxPage = '(none)';177 178 implementation179 180 uses ComObj;181 182 class function CoD2007Test.Create: ID2007Test;183 begin184   Result := CreateComObject(CLASS_D2007Test) as ID2007Test;185 end;186 187 class function CoD2007Test.CreateRemote(const MachineName: string): ID2007Test;188 begin189   Result := CreateRemoteComObject(MachineName, CLASS_D2007Test) as ID2007Test;190 end;191 192 procedure TD2007Test.InitServerData;193 const194   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 begin201   ServerData := @CServerData;202 end;203 204 procedure TD2007Test.Connect;205 var206   punk: IUnknown;207 begin208   if FIntf = nil then209   begin210     punk := GetServer;211     Fintf:= punk as ID2007Test;212   end;213 end;214 215 procedure TD2007Test.ConnectTo(svrIntf: ID2007Test);216 begin217   Disconnect;218   FIntf := svrIntf;219 end;220 221 procedure TD2007Test.DisConnect;222 begin223   if Fintf <> nil then224   begin225     FIntf := nil;226   end;227 end;228 229 function TD2007Test.GetDefaultInterface: ID2007Test;230 begin231   if FIntf = nil then232     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 begin239   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 begin247 {$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 begin256   Result := FProps;257 end;258 {$ENDIF}259 260 procedure TD2007Test.AddNumber(ANumber1: Integer; ANumber2: Integer; out AReturn: OleVariant);261 begin262   DefaultInterface.AddNumber(ANumber1, ANumber2, AReturn);263 end;264 265 procedure TD2007Test.AddString(const AString1: WideString; const AString2: WideString; 266                                out AReturn: OleVariant);267 begin268   DefaultInterface.AddString(AString1, AString2, AReturn);269 end;270 271 {$IFDEF LIVE_SERVER_AT_DESIGN_TIME}272 constructor TD2007TestProperties.Create(AServer: TD2007Test);273 begin274   inherited Create;275   FServer := AServer;276 end;277 278 function TD2007TestProperties.GetDefaultInterface: ID2007Test;279 begin280   Result := FServer.DefaultInterface;281 end;282 283 {$ENDIF}284 285 procedure Register;286 begin287   RegisterComponents(dtlServerPage, [TD2007Test]);288 end;289 290 end.