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
Delphi 三层框架开发 服务端开发的更多相关文章
- socket服务端开发之测试使用threading和gevent框架
socket服务端开发之测试使用threading和gevent框架 话题是测试下多线程和gevent在socket服务端的小包表现能力,测试的方法不太严谨,也没有用event loop + pool ...
- Swift3.0服务端开发(一) 完整示例概述及Perfect环境搭建与配置(服务端+iOS端)
本篇博客算是一个开头,接下来会持续更新使用Swift3.0开发服务端相关的博客.当然,我们使用目前使用Swift开发服务端较为成熟的框架Perfect来实现.Perfect框架是加拿大一个创业团队开发 ...
- Swift3.0服务端开发(三) Mustache页面模板与日志记录
本篇博客主要介绍如果在Perfect工程中引入和使用Mustache页面模板与日志记录系统.Mustache页面模板类似于PHP中的smarty模板引擎或者Java中的JSTL标签.当然Mustach ...
- Swift3.0服务端开发(五) 记事本的开发(iOS端+服务端)
前边以及陆陆续续的介绍了使用Swift3.0开发的服务端应用程序的Perfect框架.本篇博客就做一个阶段性的总结,做一个完整的实例,其实这个实例在<Swift3.0服务端开发(一)>这篇 ...
- 如何有效快速提高Java服务端开发人员的技术水平?
我相信很多工作了3-5年的开发人员都会经常问自己几个问题: 1.为什么总是感觉技术没有质的提高? 2.如何能够有效和快速的提高自身的技术水平? 3.如何进入到一个牛逼的大公司,认识牛逼的人? 这篇文章 ...
- 微服务项目开发学成在线_day01_CMS服务端开发
05-CMS需求分析-什么是CMS 什么是CMS?CMS (Content Management System)即内容管理系统,不同的项目对CMS的定位不同.CMS有哪些类型? 每个公司对每个项目的C ...
- Day01_搭建环境&CMS服务端开发
学成在线 第1天 讲义-项目概述 CMS接口开发 1 项目的功能构架 1.1 项目背景 受互联网+概念的催化,当今中国在线教育市场的发展可谓是百花齐放.如火如荼. 按照市场领域细分为:学前教育.K12 ...
- 俯瞰 Java 服务端开发
原文首发于 github ,欢迎 star . Java 服务端开发是一个非常宽广的领域,要概括其全貌,即使是几本书也讲不完,该文将会提到许多的技术及工具,但不会深入去讲解,旨在以一个俯瞰的视角去探寻 ...
- 在线教学、视频会议 Webus Fox(2) 服务端开发手册
上次在<在线教学.视频会议软件 Webus Fox(1)文本.语音.视频聊天及电子白板基本用法>里介绍了软件的基本用法.本文主要介绍服务器端如何配置.开发. 1. 配置 1.1 IIS配置 ...
随机推荐
- BZOJ5296 CQOI2018 破解D-H协议 【BSGS】
BZOJ5296 CQOI2018Day1T1 破解D-H协议 Description Diffie-Hellman密钥交换协议是一种简单有效的密钥交换方法.它可以让通讯双方在没有事先约定密钥(密码) ...
- python,java操作mysql数据库,数据引擎设置为myisam时能够插入数据,转为innodb时无法插入数据
今天想给数据库换一个数据引擎,mysiam转为 innodb 结果 python 插入数据时失败,但是自增id值是存在的, 换回mysiam后,又可以插入了~~ 想换php插入试试,结果php数据引擎 ...
- 7个GIF动图帮你瞬间理解三角函数
7个GIF动图帮你瞬间理解三角函数 蝌蚪五线谱 百家号04-2120:53 图片来源:IMGUR 三角函数是数学中研究三角形的一个分支,专门阐述三角形的角度和对应边的关系. 有趣的是,定义边角关系的三 ...
- Android 系统四大组件
Android 系统四大组件分别是活动(Activity).服务(Service).广播接收器(Broadcast Receiver)和内容提供器(Content Provider). 活动是所有 A ...
- pheanstalk put 延时队列
用pheanstalk客户端投放延时任务时,按照文档的参数顺序投放起不到延时的效果,取出(预订)job时data获取的数据也不是投放的字段值, put <pri> <delay> ...
- ubuntu :安装skype聊天工具
如题,今天就想搞个软件在ubuntu能聊天,查一下skype,好像网上有人说不是每个安装包都用的了,skype-ubuntu-precise_4.2.0.13-1_i386.deb可以, 我在微盘下载 ...
- struts2学习(15)struts2防重复提交
一.重复提交的例子: 模拟一种情况,存在延时啊,系统比较繁忙啊啥的. 模拟延迟5s钟,用户点了一次提交,又点了一次提交,例子中模拟这种情况: 这样会造成重复提交: com.cy.action.St ...
- H5测试 有空了解下里面没有用过的东西
- 018:InnoDB 存储引擎、表空间
目录 一.InnoDB 存储引擎 1. InnoDB的历史 2. InnoDB的特点 3. InnoDB存储引擎的文件 3.1 概述 3.2 InnoDB - 表空间 3.3 General表空间 3 ...
- STL sort
STL的sort()算法,数据量大时采用Quick Sort,分段递归排序,一旦分段后的数据量小于某个门槛,为避免Quick Sort的递归调用带来过大的额外负荷,就改用Insertion Sort. ...