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
  • 相关阅读:
    设计一个数据结构，包含两个函数，1.插入一个数字，2.获得中数
    数状数组
    25匹马，每次能5匹一起跑，选出最快的3匹
    禁止ImageCapture自动启动
    SublimeText Videos Notes
    10G个64bit整数，找出中位数
    python初步要点II
    python初步要点
    找出丢失的数字
    nice & renice
  • 原文地址：https://www.cnblogs.com/linjincheng/p/11833248.html
Copyright © 2011-2022 走看看