采用Delphi7+SQL2008

一、创建数据库和表

  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如图显示

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

2.2 File-New-Other

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

名字自己根据需要 填写

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

打开Project1_TLB 单元  按F12键

在弹出的对话框中

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

新增参数  如下图

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

最终结果如下图

添加后的最代码终结果

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

Unit2单元成功 添加以下

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

代码如下

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

  1. socket服务端开发之测试使用threading和gevent框架

    socket服务端开发之测试使用threading和gevent框架 话题是测试下多线程和gevent在socket服务端的小包表现能力,测试的方法不太严谨,也没有用event loop + pool ...

  2. Swift3.0服务端开发(一) 完整示例概述及Perfect环境搭建与配置(服务端+iOS端)

    本篇博客算是一个开头,接下来会持续更新使用Swift3.0开发服务端相关的博客.当然,我们使用目前使用Swift开发服务端较为成熟的框架Perfect来实现.Perfect框架是加拿大一个创业团队开发 ...

  3. Swift3.0服务端开发(三) Mustache页面模板与日志记录

    本篇博客主要介绍如果在Perfect工程中引入和使用Mustache页面模板与日志记录系统.Mustache页面模板类似于PHP中的smarty模板引擎或者Java中的JSTL标签.当然Mustach ...

  4. Swift3.0服务端开发(五) 记事本的开发(iOS端+服务端)

    前边以及陆陆续续的介绍了使用Swift3.0开发的服务端应用程序的Perfect框架.本篇博客就做一个阶段性的总结,做一个完整的实例,其实这个实例在<Swift3.0服务端开发(一)>这篇 ...

  5. 如何有效快速提高Java服务端开发人员的技术水平?

    我相信很多工作了3-5年的开发人员都会经常问自己几个问题: 1.为什么总是感觉技术没有质的提高? 2.如何能够有效和快速的提高自身的技术水平? 3.如何进入到一个牛逼的大公司,认识牛逼的人? 这篇文章 ...

  6. 微服务项目开发学成在线_day01_CMS服务端开发

    05-CMS需求分析-什么是CMS 什么是CMS?CMS (Content Management System)即内容管理系统,不同的项目对CMS的定位不同.CMS有哪些类型? 每个公司对每个项目的C ...

  7. Day01_搭建环境&CMS服务端开发

    学成在线 第1天 讲义-项目概述 CMS接口开发 1 项目的功能构架 1.1 项目背景 受互联网+概念的催化,当今中国在线教育市场的发展可谓是百花齐放.如火如荼. 按照市场领域细分为:学前教育.K12 ...

  8. 俯瞰 Java 服务端开发

    原文首发于 github ,欢迎 star . Java 服务端开发是一个非常宽广的领域,要概括其全貌,即使是几本书也讲不完,该文将会提到许多的技术及工具,但不会深入去讲解,旨在以一个俯瞰的视角去探寻 ...

  9. 在线教学、视频会议 Webus Fox(2) 服务端开发手册

    上次在<在线教学.视频会议软件 Webus Fox(1)文本.语音.视频聊天及电子白板基本用法>里介绍了软件的基本用法.本文主要介绍服务器端如何配置.开发. 1. 配置 1.1 IIS配置 ...

随机推荐

  1. BZOJ5296 CQOI2018 破解D-H协议 【BSGS】

    BZOJ5296 CQOI2018Day1T1 破解D-H协议 Description Diffie-Hellman密钥交换协议是一种简单有效的密钥交换方法.它可以让通讯双方在没有事先约定密钥(密码) ...

  2. python,java操作mysql数据库,数据引擎设置为myisam时能够插入数据,转为innodb时无法插入数据

    今天想给数据库换一个数据引擎,mysiam转为 innodb 结果 python 插入数据时失败,但是自增id值是存在的, 换回mysiam后,又可以插入了~~ 想换php插入试试,结果php数据引擎 ...

  3. 7个GIF动图帮你瞬间理解三角函数

    7个GIF动图帮你瞬间理解三角函数 蝌蚪五线谱 百家号04-2120:53 图片来源:IMGUR 三角函数是数学中研究三角形的一个分支,专门阐述三角形的角度和对应边的关系. 有趣的是,定义边角关系的三 ...

  4. Android 系统四大组件

    Android 系统四大组件分别是活动(Activity).服务(Service).广播接收器(Broadcast Receiver)和内容提供器(Content Provider). 活动是所有 A ...

  5. pheanstalk put 延时队列

    用pheanstalk客户端投放延时任务时,按照文档的参数顺序投放起不到延时的效果,取出(预订)job时data获取的数据也不是投放的字段值, put <pri> <delay> ...

  6. ubuntu :安装skype聊天工具

    如题,今天就想搞个软件在ubuntu能聊天,查一下skype,好像网上有人说不是每个安装包都用的了,skype-ubuntu-precise_4.2.0.13-1_i386.deb可以, 我在微盘下载 ...

  7. struts2学习(15)struts2防重复提交

    一.重复提交的例子: 模拟一种情况,存在延时啊,系统比较繁忙啊啥的. 模拟延迟5s钟,用户点了一次提交,又点了一次提交,例子中模拟这种情况: 这样会造成重复提交:   com.cy.action.St ...

  8. H5测试 有空了解下里面没有用过的东西

  9. 018:InnoDB 存储引擎、表空间

    目录 一.InnoDB 存储引擎 1. InnoDB的历史 2. InnoDB的特点 3. InnoDB存储引擎的文件 3.1 概述 3.2 InnoDB - 表空间 3.3 General表空间 3 ...

  10. STL sort

    STL的sort()算法,数据量大时采用Quick Sort,分段递归排序,一旦分段后的数据量小于某个门槛,为避免Quick Sort的递归调用带来过大的额外负荷,就改用Insertion Sort. ...