zoukankan      html  css  js  c++  java

  • delphi三层DCOM架构

    DCOM架构:

    服务端开发：

    采用Delphi7+SQL2008

    一、创建数据库和表

    [sql] view plain copy
     
    1. CREATE TABLE [dbo].[tb_Department](  
    2.     [FKey] [uniqueidentifier] NOT NULL,  
    3.     [FName] [varchar](50) NULL,  
    4.     [FAge] [varchar](50) NULL,  
    5.     [FSex] [varchar](50) NULL,  
    6.     [FMobile] [varchar](50) NULL,  
    7.     [FRemark] [varchar](200) NULL  
    8. ) ON [PRIMARY]  


    二、写服务端

    2.1 先创建一个application

    在窗体中添加Label如图显示

    [delphi] view plain copy
     
    1. unit ufrmMain;  
    2.   
    3. interface  
    4.   
    5. uses  
    6.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  
    7.   Dialogs, StdCtrls;  
    8.   
    9. type  
    10.   TfrmMain = class(TForm)  
    11.     lbl1: TLabel;  
    12.   private  
    13.     { Private declarations }  
    14.   public  
    15.     { Public declarations }  
    16.   end;  
    17.   
    18. var  
    19.   frmMain: TfrmMain;  
    20.   
    21. implementation  
    22.   
    23. {$R *.dfm}  
    24.   
    25. end.  


    2.2 File-New-Other 

    点击OK  在弹出的对话框中  填写

    名字自己根据需要 填写

    此时生成2个单元 一个Project1_TLB 和 Unit2 单元

    打开Project1_TLB 单元  按F12键

    在弹出的对话框中

    Name就是我们要的方法名称（根据自己需要填写）GetData 获取数据

    新增参数  如下图 

     

    再按相同的方法 添加PostData方法（保存数据）

    最终结果如下图

    添加后的最代码终结果

    [delphi] view plain copy
     
    1. unit Project1_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. // PASTLWTR : 1.2  
    15. // File generated on 2014-10-24 14:24:49 from Type Library described below.  
    16.   
    17. // ************************************************************************  //  
    18. // Type Lib: D:Delphi7ProjectsProject1.tlb (1)  
    19. // LIBID: {C6713A20-F49B-4B06-8869-9E040C912074}  
    20. // LCID: 0  
    21. // Helpfile:   
    22. // HelpString: Project1 Library  
    23. // DepndLst:   
    24. //   (1) v2.0 stdole, (C:WindowsSysWOW64stdole2.tlb)  
    25. //   (2) v1.0 Midas, (C:WindowsSysWOW64midas.dll)  
    26. //   (3) v4.0 StdVCL, (C:WindowsSysWOW64stdvcl40.dll)  
    27. // ************************************************************************ //  
    28. {$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.   
    29. {$WARN SYMBOL_PLATFORM OFF}  
    30. {$WRITEABLECONST ON}  
    31. {$VARPROPSETTER ON}  
    32. interface  
    33.   
    34. uses Windows, ActiveX, Classes, Graphics, Midas, StdVCL, Variants;  
    35.     
    36.   
    37. // *********************************************************************//  
    38. // GUIDS declared in the TypeLibrary. Following prefixes are used:          
    39. //   Type Libraries     : LIBID_xxxx                                        
    40. //   CoClasses          : CLASS_xxxx                                        
    41. //   DISPInterfaces     : DIID_xxxx                                         
    42. //   Non-DISP interfaces: IID_xxxx                                          
    43. // *********************************************************************//  
    44. const  
    45.   // TypeLibrary Major and minor versions  
    46.   Project1MajorVersion = 1;  
    47.   Project1MinorVersion = 0;  
    48.   
    49.   LIBID_Project1: TGUID = '{C6713A20-F49B-4B06-8869-9E040C912074}';  
    50.   
    51.   IID_ITestService: TGUID = '{C59D7F3C-4AE7-473B-81B8-8EE1C73BB2B1}';  
    52.   CLASS_TestService: TGUID = '{82AEC5B8-E53F-4725-A24D-456FD570E355}';  
    53. type  
    54.   
    55. // *********************************************************************//  
    56. // Forward declaration of types defined in TypeLibrary                      
    57. // *********************************************************************//  
    58.   ITestService = interface;  
    59.   ITestServiceDisp = dispinterface;  
    60.   
    61. // *********************************************************************//  
    62. // Declaration of CoClasses defined in Type Library                         
    63. // (NOTE: Here we map each CoClass to its Default Interface)                
    64. // *********************************************************************//  
    65.   TestService = ITestService;  
    66.   
    67.   
    68. // *********************************************************************//  
    69. // Interface: ITestService  
    70. // Flags:     (4416) Dual OleAutomation Dispatchable  
    71. // GUID:      {C59D7F3C-4AE7-473B-81B8-8EE1C73BB2B1}  
    72. // *********************************************************************//  
    73.   ITestService = interface(IAppServer)  
    74.     ['{C59D7F3C-4AE7-473B-81B8-8EE1C73BB2B1}']  
    75.     procedure GetData(const Table: WideString; const Where: WideString; var Ret: OleVariant); safecall;  
    76.     procedure PostData(const Table: WideString; Value: OleVariant; var Ret: OleVariant); safecall;  
    77.   end;  
    78.   
    79. // *********************************************************************//  
    80. // DispIntf:  ITestServiceDisp  
    81. // Flags:     (4416) Dual OleAutomation Dispatchable  
    82. // GUID:      {C59D7F3C-4AE7-473B-81B8-8EE1C73BB2B1}  
    83. // *********************************************************************//  
    84.   ITestServiceDisp = dispinterface  
    85.     ['{C59D7F3C-4AE7-473B-81B8-8EE1C73BB2B1}']  
    86.     procedure GetData(const Table: WideString; const Where: WideString; var Ret: OleVariant); dispid 301;  
    87.     procedure PostData(const Table: WideString; Value: OleVariant; var Ret: OleVariant); dispid 302;  
    88.     function AS_ApplyUpdates(const ProviderName: WideString; Delta: OleVariant; MaxErrors: Integer;   
    89.                              out ErrorCount: Integer; var OwnerData: OleVariant): OleVariant; dispid 20000000;  
    90.     function AS_GetRecords(const ProviderName: WideString; Count: Integer; out RecsOut: Integer;   
    91.                            Options: Integer; const CommandText: WideString; var Params: OleVariant;   
    92.                            var OwnerData: OleVariant): OleVariant; dispid 20000001;  
    93.     function AS_DataRequest(const ProviderName: WideString; Data: OleVariant): OleVariant; dispid 20000002;  
    94.     function AS_GetProviderNames: OleVariant; dispid 20000003;  
    95.     function AS_GetParams(const ProviderName: WideString; var OwnerData: OleVariant): OleVariant; dispid 20000004;  
    96.     function AS_RowRequest(const ProviderName: WideString; Row: OleVariant; RequestType: Integer;   
    97.                            var OwnerData: OleVariant): OleVariant; dispid 20000005;  
    98.     procedure AS_Execute(const ProviderName: WideString; const CommandText: WideString;   
    99.                          var Params: OleVariant; var OwnerData: OleVariant); dispid 20000006;  
    100.   end;  
    101.   
    102. // *********************************************************************//  
    103. // The Class CoTestService provides a Create and CreateRemote method to            
    104. // create instances of the default interface ITestService exposed by                
    105. // the CoClass TestService. The functions are intended to be used by               
    106. // clients wishing to automate the CoClass objects exposed by the           
    107. // server of this typelibrary.                                              
    108. // *********************************************************************//  
    109.   CoTestService = class  
    110.     class function Create: ITestService;  
    111.     class function CreateRemote(const MachineName: string): ITestService;  
    112.   end;  
    113.   
    114. implementation  
    115.   
    116. uses ComObj;  
    117.   
    118. class function CoTestService.Create: ITestService;  
    119. begin  
    120.   Result := CreateComObject(CLASS_TestService) as ITestService;  
    121. end;  
    122.   
    123. class function CoTestService.CreateRemote(const MachineName: string): ITestService;  
    124. begin  
    125.   Result := CreateRemoteComObject(MachineName, CLASS_TestService) as ITestService;  
    126. end;  
    127.   
    128. end.  



    Unit2单元成功 添加以下

    前面新增了2个接口方法 然后我们在这个单元里面  实现  方便客户端调用  

    代码如下

    [delphi] view plain copy
     
    1. unit Unit2;  
    2.   
    3. {$WARN SYMBOL_PLATFORM OFF}  
    4.   
    5. interface  
    6.   
    7. uses  
    8.   Windows, Messages, SysUtils, Classes, ComServ, ComObj, VCLCom, DataBkr,  
    9.   DBClient, Project1_TLB, StdVcl, ADODB, Provider, DB;  
    10.   
    11. type  
    12.   TTestService = class(TRemoteDataModule, ITestService)  
    13.     conData: TADOConnection;  
    14.     dsTemp: TClientDataSet;  
    15.     dspTemp: TDataSetProvider;  
    16.     qryTemp: TADOQuery;  
    17.     procedure RemoteDataModuleCreate(Sender: TObject);  
    18.   private  
    19.     I: Integer;  
    20.     Params: OleVariant;  
    21.     OwnerData: OleVariant;  
    22.     // 自己加入  
    23.     function InnerGetData(strSQL: String): OleVariant;  
    24.     function InnerPostData(Delta: OleVariant): Integer;  
    25.   protected  
    26.     class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); override;  
    27.     procedure GetData(const Table, Where: WideString; var Ret: OleVariant);  
    28.       safecall;  
    29.     procedure PostData(const Table: WideString; Value: OleVariant;  
    30.       var Ret: OleVariant); safecall;  
    31.   
    32.   public  
    33.     { Public declarations }  
    34.   end;  
    35.   
    36. implementation  
    37.   
    38. {$R *.DFM}  
    39.   
    40. procedure TTestService.GetData(const Table, Where: WideString;  
    41.   var Ret: OleVariant);  
    42. const SQL = 'select * from %s where %s';  
    43. begin  
    44.   Ret := Self.InnerGetData(Format(SQL, [Table, Where]));  
    45. end;  
    46.   
    47.   
    48. function TTestService.InnerGetData(strSQL: String): OleVariant;  
    49. begin  
    50.     // 必须是CLOSE状态, 否则报错.  
    51.   if qryTemp.Active then qryTemp.Active := False;  
    52.   Result := Self.AS_GetRecords('dspTemp', -1, I, ResetOption+MetaDataOption,  
    53.     strSQL, Params, OwnerData);  
    54. end;  
    55.   
    56. function TTestService.InnerPostData(Delta: OleVariant): Integer;  
    57. begin  
    58.   Self.AS_ApplyUpdates('dspTemp', Delta, 0, Result, OwnerData);  
    59. end;  
    60.   
    61. procedure TTestService.PostData(const Table: WideString; Value: OleVariant;  
    62.   var Ret: OleVariant);  
    63. var  
    64.   KeyField: TField;  
    65. begin  
    66.   dsTemp.Data := Value;  
    67.   if dsTemp.IsEmpty then Exit;  
    68.   { 
    69.     这里假设每个表都有一个FKey字段, 并且值是唯一的. 
    70.     也可以根据表中, 改成相应的主键字段名. 
    71.   }  
    72.   KeyField := dsTemp.FindField('FKey');  
    73.   if KeyField=nil then raise Exception.Create(' 键值字段未发现.');  
    74.   if KeyField.IsNull then  
    75.   begin  
    76.     qryTemp.SQL.Text := 'select * from '+Table+' where 1>2';  
    77.   end  
    78.   else  
    79.   begin  
    80.     qryTemp.SQL.Text := 'select * from '+Table+' where FKey='+QuotedStr(KeyField.AsString);  
    81.     qryTemp.Open;  
    82.     with qryTemp.FieldByName('FKey') do ProviderFlags := ProviderFlags + [pfInKey];  
    83.     dspTemp.UpdateMode := upWhereKeyOnly;  
    84.   end;  
    85.   qryTemp.Open;  
    86.   Ret := InnerPostData(Value);  
    87. end;  
    88.   
    89. class procedure TTestService.UpdateRegistry(Register: Boolean; const ClassID, ProgID: string);  
    90. begin  
    91.   if Register then  
    92.   begin  
    93.     inherited UpdateRegistry(Register, ClassID, ProgID);  
    94.     EnableSocketTransport(ClassID);  
    95.     EnableWebTransport(ClassID);  
    96.   end else  
    97.   begin  
    98.     DisableSocketTransport(ClassID);  
    99.     DisableWebTransport(ClassID);  
    100.     inherited UpdateRegistry(Register, ClassID, ProgID);  
    101.   end;  
    102. end;  
    103.   
    104.   
    105.   
    106. procedure TTestService.RemoteDataModuleCreate(Sender: TObject);  
    107. begin  
    108.  Self.qryTemp.Connection := Self.conData;  
    109.   Self.dspTemp.DataSet := Self.qryTemp;  
    110.   Self.dspTemp.Options := Self.dspTemp.Options + [poAllowCommandText];  
    111.   conData.ConnectionString:='File Name='+ExtractFilePath(ParamStr(0))+'conData.udl';  
    112.  try  
    113.   Self.conData.Open;  
    114.   except  
    115.     on e:Exception do  
    116.     begin  
    117.         
    118.     end;  
    119.  end;  
    120. end;  
    121.   
    122. initialization  
    123.   TComponentFactory.Create(ComServer, TTestService,  
    124.     Class_TestService, ciMultiInstance, tmApartment);  
    125. end.  

    再讲讲conData.udl  文件的创建

    新建一个txt文件   

    添加 内容

    [oledb]
    ; Everything after this line is an OLE DB initstring
    Provider=SQLOLEDB.1;Password=test;Persist Security Info=True;User ID=sa;Initial Catalog=db_test;Data Source=192.168.0.1

    保存  修改扩展名 为.udl  就可以了。

    到此 服务端写完了

    开始写客户端程序之前( 先启动scktsrvr.exe   此 在dephi程序的bin目录下  ) 然后   启动服务端 

    如果不想在客户的机器上注册midas.dll 请在使用ClientDataSet单元中 引用 MidasLib 单元

    客户端开发:

    新增TDCOMConnection（ComputerName选择服务器名称或者IP,ServerName选择服务端名称）、TClientDataSet连接DCOM
  • 相关阅读:
    再谈TextField
    IOS-TextField知多少
    leftBarButtonItems
    LeftBarButtonItems,定制导航栏返回按钮
    Apple Mach-O Linker (id) Error "_OBJC_CLASS...错误解决办法 Apple Mach-O Linker (id) Error "_OBJC_CLASS...错误解决办法
    Unrecognized Selector Sent to Instance问题之诱敌深入关门打狗解决办法
    UNRECOGNIZED SELECTOR SENT TO INSTANCE 问题快速定位的方法
    Present ViewController,模态详解
    UILABEL AUTOLAYOUT自动换行 版本区别
    iOS自动布局解决警告Automatic Preferred Max Layout Width is not available on iOS versions prior to 8.0
  • 原文地址：https://www.cnblogs.com/linjincheng/p/11833248.html
Copyright © 2011-2022 走看看