Delphi 三层框架开发 服务端开发
2014-10-24 14:40
225 查看
采用Delphi7+SQL2008
一、创建数据库和表
二、写服务端
2.1 先创建一个application
在窗体中添加Label如图显示
2.2 File-New-Other
点击OK 在弹出的对话框中 填写
名字自己根据需要 填写
此时生成2个单元 一个Project1_TLB 和 Unit2 单元
打开Project1_TLB 单元 按F12键
在弹出的对话框中
Name就是我们要的方法名称(根据自己需要填写)GetData 获取数据
新增参数 如下图
再按相同的方法 添加PostData方法(保存数据)
最终结果如下图
添加后的最代码终结果
Unit2单元成功 添加以下
前面新增了2个接口方法 然后我们在这个单元里面 实现 方便客户端调用
代码如下
新建一个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
一、创建数据库和表
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
相关文章推荐
- Delphi 三层框架开发 服务端开发
- Delphi 三层框架开发客户端开发
- 用动软.NET代码生成器Codematic配合Nant开发W eb三层框架
- FastSpring.NET V2.0 Preview 1 发布[Spring.NET & NHibernate的三层的开发框架]
- delphi 三层开发经验汇总
- Delphi三层开发小技巧:TClientDataSet的Delta妙用
- 基于.Net(C#开发)平台的三层框架架构软件的设计与实现
- 物流信息系统开发手记-Delphi的三层开发
- Delphi三层开发小技巧:TClientDataSet的Delta妙用
- 简单的Delphi三层程序开发
- 简单的Delphi三层程序开发
- 简单的Delphi三层程序开发
- 三层开发框架
- 《开源合辑-(软件开发->框架)之(Delphi/Kylix)》 (3)
- 《开源合辑-(软件开发->框架)之(Delphi/Kylix)》 (2)
- 简单的Delphi三层程序开发
- 简单的Delphi三层程序开发(转载备份)
- Delphi三层开发手册——三层开发基本概念介绍
- 简单的Delphi三层程序开发
- delphi 三层开发经验汇总