Delphi 三层框架开发 服务端开发

采用Delphi7+SQL2008

一、创建数据库和表

CREATE TABLE [dbo].[tb_Department](
	[FKey] [uniqueidentifier] NOT NULL,
	[FName] [varchar](50) NULL,
	[FAge] [varchar](50) NULL,
	[FSex] [varchar](50) NULL,
	[FMobile] [varchar](50) NULL,
	[FRemark] [varchar](200) NULL
) ON [PRIMARY]

二、写服务端

2.1 先创建一个application

在窗体中添加Label如图显示


unit ufrmMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TfrmMain = class(TForm)
    lbl1: TLabel;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

end.

2.2 File-New-Other 


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


名字自己根据需要 填写

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

打开Project1_TLB 单元  按F12键


在弹出的对话框中


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

新增参数  如下图 

 


再按相同的方法 添加PostData方法(保存数据)

最终结果如下图



添加后的最代码终结果

unit Project1_TLB;

// ************************************************************************ //
// WARNING                                                                    
// -------                                                                    
// The types declared in this file were generated from data read from a       
// Type Library. If this type library is explicitly or indirectly (via        
// another type library referring to this type library) re-imported, or the   
// 'Refresh' command of the Type Library Editor activated while editing the   
// Type Library, the contents of this file will be regenerated and all        
// manual modifications will be lost.                                         
// ************************************************************************ //

// PASTLWTR : 1.2
// File generated on 2014-10-24 14:24:49 from Type Library described below.

// ************************************************************************  //
// Type Lib: D:\Delphi7\Projects\Project1.tlb (1)
// LIBID: {C6713A20-F49B-4B06-8869-9E040C912074}
// LCID: 0
// Helpfile: 
// HelpString: Project1 Library
// DepndLst: 
//   (1) v2.0 stdole, (C:\Windows\SysWOW64\stdole2.tlb)
//   (2) v1.0 Midas, (C:\Windows\SysWOW64\midas.dll)
//   (3) v4.0 StdVCL, (C:\Windows\SysWOW64\stdvcl40.dll)
// ************************************************************************ //
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers. 
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}
{$VARPROPSETTER ON}
interface

uses Windows, ActiveX, Classes, Graphics, Midas, StdVCL, Variants;
  

// *********************************************************************//
// GUIDS declared in the TypeLibrary. Following prefixes are used:        
//   Type Libraries     : LIBID_xxxx                                      
//   CoClasses          : CLASS_xxxx                                      
//   DISPInterfaces     : DIID_xxxx                                       
//   Non-DISP interfaces: IID_xxxx                                        
// *********************************************************************//
const
  // TypeLibrary Major and minor versions
  Project1MajorVersion = 1;
  Project1MinorVersion = 0;

  LIBID_Project1: TGUID = '{C6713A20-F49B-4B06-8869-9E040C912074}';

  IID_ITestService: TGUID = '{C59D7F3C-4AE7-473B-81B8-8EE1C73BB2B1}';
  CLASS_TestService: TGUID = '{82AEC5B8-E53F-4725-A24D-456FD570E355}';
type

// *********************************************************************//
// Forward declaration of types defined in TypeLibrary                    
// *********************************************************************//
  ITestService = interface;
  ITestServiceDisp = dispinterface;

// *********************************************************************//
// Declaration of CoClasses defined in Type Library                       
// (NOTE: Here we map each CoClass to its Default Interface)              
// *********************************************************************//
  TestService = ITestService;


// *********************************************************************//
// Interface: ITestService
// Flags:     (4416) Dual OleAutomation Dispatchable
// GUID:      {C59D7F3C-4AE7-473B-81B8-8EE1C73BB2B1}
// *********************************************************************//
  ITestService = interface(IAppServer)
    ['{C59D7F3C-4AE7-473B-81B8-8EE1C73BB2B1}']
    procedure GetData(const Table: WideString; const Where: WideString; var Ret: OleVariant); safecall;
    procedure PostData(const Table: WideString; Value: OleVariant; var Ret: OleVariant); safecall;
  end;

// *********************************************************************//
// DispIntf:  ITestServiceDisp
// Flags:     (4416) Dual OleAutomation Dispatchable
// GUID:      {C59D7F3C-4AE7-473B-81B8-8EE1C73BB2B1}
// *********************************************************************//
  ITestServiceDisp = dispinterface
    ['{C59D7F3C-4AE7-473B-81B8-8EE1C73BB2B1}']
    procedure GetData(const Table: WideString; const Where: WideString; var Ret: OleVariant); dispid 301;
    procedure PostData(const Table: WideString; Value: OleVariant; var Ret: OleVariant); dispid 302;
    function AS_ApplyUpdates(const ProviderName: WideString; Delta: OleVariant; MaxErrors: Integer; 
                             out ErrorCount: Integer; var OwnerData: OleVariant): OleVariant; dispid 20000000;
    function AS_GetRecords(const ProviderName: WideString; Count: Integer; out RecsOut: Integer; 
                           Options: Integer; const CommandText: WideString; var Params: OleVariant; 
                           var OwnerData: OleVariant): OleVariant; dispid 20000001;
    function AS_DataRequest(const ProviderName: WideString; Data: OleVariant): OleVariant; dispid 20000002;
    function AS_GetProviderNames: OleVariant; dispid 20000003;
    function AS_GetParams(const ProviderName: WideString; var OwnerData: OleVariant): OleVariant; dispid 20000004;
    function AS_RowRequest(const ProviderName: WideString; Row: OleVariant; RequestType: Integer; 
                           var OwnerData: OleVariant): OleVariant; dispid 20000005;
    procedure AS_Execute(const ProviderName: WideString; const CommandText: WideString; 
                         var Params: OleVariant; var OwnerData: OleVariant); dispid 20000006;
  end;

// *********************************************************************//
// The Class CoTestService provides a Create and CreateRemote method to          
// create instances of the default interface ITestService exposed by              
// the CoClass TestService. The functions are intended to be used by             
// clients wishing to automate the CoClass objects exposed by the         
// server of this typelibrary.                                            
// *********************************************************************//
  CoTestService = class
    class function Create: ITestService;
    class function CreateRemote(const MachineName: string): ITestService;
  end;

implementation

uses ComObj;

class function CoTestService.Create: ITestService;
begin
  Result := CreateComObject(CLASS_TestService) as ITestService;
end;

class function CoTestService.CreateRemote(const MachineName: string): ITestService;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_TestService) as ITestService;
end;

end.



Unit2单元成功 添加以下


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

代码如下

unit Unit2;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Windows, Messages, SysUtils, Classes, ComServ, ComObj, VCLCom, DataBkr,
  DBClient, Project1_TLB, StdVcl, ADODB, Provider, DB;

type
  TTestService = class(TRemoteDataModule, ITestService)
    conData: TADOConnection;
    dsTemp: TClientDataSet;
    dspTemp: TDataSetProvider;
    qryTemp: TADOQuery;
    procedure RemoteDataModuleCreate(Sender: TObject);
  private
    I: Integer;
    Params: OleVariant;
    OwnerData: OleVariant;
    // 自己加入
    function InnerGetData(strSQL: String): OleVariant;
    function InnerPostData(Delta: OleVariant): Integer;
  protected
    class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); override;
    procedure GetData(const Table, Where: WideString; var Ret: OleVariant);
      safecall;
    procedure PostData(const Table: WideString; Value: OleVariant;
      var Ret: OleVariant); safecall;

  public
    { Public declarations }
  end;

implementation

{$R *.DFM}

procedure TTestService.GetData(const Table, Where: WideString;
  var Ret: OleVariant);
const SQL = 'select * from %s where %s';
begin
  Ret := Self.InnerGetData(Format(SQL, [Table, Where]));
end;


function TTestService.InnerGetData(strSQL: String): OleVariant;
begin
    // 必须是CLOSE状态, 否则报错.
  if qryTemp.Active then qryTemp.Active := False;
  Result := Self.AS_GetRecords('dspTemp', -1, I, ResetOption+MetaDataOption,
    strSQL, Params, OwnerData);
end;

function TTestService.InnerPostData(Delta: OleVariant): Integer;
begin
  Self.AS_ApplyUpdates('dspTemp', Delta, 0, Result, OwnerData);
end;

procedure TTestService.PostData(const Table: WideString; Value: OleVariant;
  var Ret: OleVariant);
var
  KeyField: TField;
begin
  dsTemp.Data := Value;
  if dsTemp.IsEmpty then Exit;
  {
    这里假设每个表都有一个FKey字段, 并且值是唯一的.
    也可以根据表中, 改成相应的主键字段名.
  }
  KeyField := dsTemp.FindField('FKey');
  if KeyField=nil then raise Exception.Create(' 键值字段未发现.');
  if KeyField.IsNull then
  begin
    qryTemp.SQL.Text := 'select * from '+Table+' where 1>2';
  end
  else
  begin
    qryTemp.SQL.Text := 'select * from '+Table+' where FKey='+QuotedStr(KeyField.AsString);
    qryTemp.Open;
    with qryTemp.FieldByName('FKey') do ProviderFlags := ProviderFlags + [pfInKey];
    dspTemp.UpdateMode := upWhereKeyOnly;
  end;
  qryTemp.Open;
  Ret := InnerPostData(Value);
end;

class procedure TTestService.UpdateRegistry(Register: Boolean; const ClassID, ProgID: string);
begin
  if Register then
  begin
    inherited UpdateRegistry(Register, ClassID, ProgID);
    EnableSocketTransport(ClassID);
    EnableWebTransport(ClassID);
  end else
  begin
    DisableSocketTransport(ClassID);
    DisableWebTransport(ClassID);
    inherited UpdateRegistry(Register, ClassID, ProgID);
  end;
end;



procedure TTestService.RemoteDataModuleCreate(Sender: TObject);
begin
 Self.qryTemp.Connection := Self.conData;
  Self.dspTemp.DataSet := Self.qryTemp;
  Self.dspTemp.Options := Self.dspTemp.Options + [poAllowCommandText];
  conData.ConnectionString:='File Name='+ExtractFilePath(ParamStr(0))+'conData.udl';
 try
  Self.conData.Open;
  except
    on e:Exception do
    begin
      
    end;
 end;
end;

initialization
  TComponentFactory.Create(ComServer, TTestService,
    Class_TestService, ciMultiInstance, tmApartment);
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 单元

项目源码下载 —— http://download.csdn.net/detail/gykthh/8077801

MateyFrame是一款由Delphi开发三层架构框架,经过多年的升级改进,版本由MateyFrame V1.0升级到了当前的MateyFrame V5.0版本。MateyFrame V5.0具有功能强大、负载量大、安全性高、可扩展性强、同时支持B/S与C/S运行模式、开发简单等特性。MateyFrame V5.0由中间层服务端、客户端框架、MateyWeb组件三部分组成,同时支持 Oracle、MSSQL、MySQL数据库。 中间层服务端 采用面向对象方法设计而成,具有稳定性强、安全性高、负载量大、可扩展性强等特性。 采用数据库连接池技术,支持多数据库应用及多种数据库的应用,可以很好的处理断网、数据库重新启动等异常情况,一旦外界环境恢复后,连接池将重新连接数据库,不需要重启服务程序。 使用HTTP协议与客户端进行通信,可以适合企业内网及企业外网等任何网络环境,更适合在Internet网络上运行程序。 服务端支持多种类型的大型数据库一起使用,支持的数据库有:Oracle、MSSQL、MySQL。 服务端采用插件技术开发,系统核心插件可以直接使用,另外用户可轻松地扩展自己需要的服务插件。 服务端采用会话管理技术,为每个客户端会话分配唯一的加密密钥,交互数据在底层进行加密传输,保证了数据在传输过程中的高安全性。 服务端支持多实例运行模式,当客户端用户量大增时,可以适当增加中间层实例,解决大并发量的问题。 服务端插件实现了真三层、伪三层的核心插件,用户可以根据安全级别选用任何一种模式进行应用。 服务端使用Win服务运行模式,重启服务器不需登录系统开启服务程序,服务端即可自动运行。 具有客户端程序发布功能,可以为客户端软件的自动更新服务。 客户端框架 客户端设计成 EXE+BPL+DLL 的文件结构模式,具有扩展性强、易于开发、易于维护、使用简单等特点; 程序框架同时支持B/S、C/S模式,即可以通过客户端运行程序,也可以通过浏览器运行程序,并且支持两种模式同时存在。 使用插件开发模式,业务功能根据实际需要封装在不同的模块 DLL 中,即插即用; 封装了强大的基类,底层数据访问、出错处理、权限控制等; 系统功能根据业务模块信息自动生成,可以手动配置功能菜单列表; 框架中包含用户及权限管理插件,拿来即用,此模块可严格控制各功能Form 的详细权限(添加、修改、删除)、特殊数据的读取权限; 框架中包含了数据字典、系统参数的设置功能,拿来即可用。 框架采用调用时下载相关依赖文件的模式进行程序更新,具有更新文件少、更新速度快等特点; 框架支持程序文件流加载模式,更新的程序文件不需要保存在客户端的机器上,可大大增强程序的安全性。 框架有设计模式与运行模式之分,在设计模式下客户端通过框架功能用SQL可以直接读取到数据库的数据,方便程序开发;但在运行模式中,此功能不可用,这样可以保证数据的安全性。 框架设计了通用的报表设计模块,用户只需简单调,就可以得到自己所需要的报表模板设计,得到功能所需要的报表。 可选用分页数据处理技术,使大批量数据分页返回,分解服务器的压力; 具有负载平衡的功能,当连接的中间层服务器端负载过大或者崩溃时,会自动转向其它可用中间层服务器。 具有断线重连功能,当网络的异常恢复时,系统底层连接会重新连接,不用重启程序就可使用。 框架提供超级查询组件,组件可以根据编号、名称、五笔码、拼音码对需要查询的数据进行快速过滤。 MateyWeb组件 MateyWeb组件是一款能被IE加载运行的ActiveX控件,它是客户端程序在B/S模式下运行的载体。 MateyWeb组件支持WinXP、Win2000、Win2003、Win7、Vista等操作系统。 MateyWeb组件支持IE及以IE为内核的所有浏览器。 应用场合 非常适合开发各种应用于Internet之上的大中型的MIS管理软件
评论 8
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值