• 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端:

     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.
    View Code

    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:D2007ComD2007ComServerD2007ComServer.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:WindowsSysWOW64stdole2.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.
    View Code

     

    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.
    View Code

    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:D2007ComD2007ComServerD2007ComServer.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:WindowsSysWOW64stdole2.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.
    View Code

     

  • 相关阅读:
    微软系统及开发工具官方下载地址
    Office2010文档的MIME类型
    Android开发中Activity的生命周期
    DWZ框架POST方式提交Form提示JSON文件下载
    JAVA开发环境搭建
    FastJSON解析.Net生成的JSON字符串
    SQL Server 2008 如何更改服务器身份验证模式
    如何快速解决IIS中发布的网站不能访问。
    QlickView
    Lamabda表达式
  • 原文地址:https://www.cnblogs.com/FKdelphi/p/5772950.html
Copyright © 2020-2023  润新知