2023年7月13日发(作者：)

Delphi三层框架开发服务端开发采⽤Delphi7+SQL2008⼀、创建数据库和表

[sql]

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]

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]

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: (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:)

25. // (2) v1.0 Midas, (C:)

26. // (3) v4.0 StdVCL, (C:)

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 : ITestService;

119. begin

120. Result := CreateComObject(CLASS_TestService) as ITestService;

121. end;

122.

123. class function Remote(const MachineName: string): ITestService;

124. begin

125. Result := CreateRemoteComObject(MachineName, CLASS_TestService) as ITestService;

126. end;

127.

128. end.

Unit2单元成功 添加以下前⾯新增了2个接⼝⽅法 然后我们在这个单元⾥⾯ 实现 ⽅便客户端调⽤

代码如下

[delphi]

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 a(const Table, Where: WideString;

41. var Ret: OleVariant);

42. const SQL = 'select * from %s where %s';

43. begin

44. Ret := etData(Format(SQL, [Table, Where]));

45. end;

46.

47.

48. function etData(strSQL: String): OleVariant;

49. begin

50. // 必须是CLOSE状态, 否则报错.

51. if then := False;

52. Result := _GetRecords('dspTemp', -1, I, ResetOption+MetaDataOption,

53. strSQL, Params, OwnerData);

54. end;

55.

56. function ostData(Delta: OleVariant): Integer;

57. begin

58. _ApplyUpdates('dspTemp', Delta, 0, Result, OwnerData);

59. end;

60.

61. procedure ta(const Table: WideString; Value: OleVariant;

62. var Ret: OleVariant);

63. var

64. KeyField: TField;

65. begin

66. := Value;

67. if y then Exit;

68. {

69. 这⾥假设每个表都有⼀个FKey字段, 并且值是唯⼀的.

70. 也可以根据表中, 改成相应的主键字段名.

71. }

72. KeyField := eld('FKey');

73. if KeyField=nil then raise (' 键值字段未发现.');

74. if then

75. begin

76. := 'select * from '+Table+' where 1>2';

77. end

78. else

79. begin

80. := 'select * from '+Table+' where FKey='+QuotedStr(ng);

81. ;

82. with yName('FKey') do ProviderFlags := ProviderFlags + [pfInKey];

83. Mode := upWhereKeyOnly;

84. end;

85. ;

86. Ret := InnerPostData(Value);

87. end;

88.

89. class procedure Registry(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 DataModuleCreate(Sender: TObject);

107. begin

108. tion := a;

109. t := p;

110. s := s + [poAllowCommandText];

111. tionString:='File Name='+ExtractFilePath(ParamStr(0))+'';

112. try

113. ;

114. except

115. on e:Exception do

116. begin

117.

118. end;

119. end;

120. end;

121.

122. initialization

123. (ComServer, TTestService,

124. Class_TestService, ciMultiInstance, tmApartment);

125. end.

再讲讲 ⽂件的创建

新建⼀个txt⽂件

添加 内容[oledb]; Everything after this line is an OLE DB initstringProvider=SQLOLEDB.1;Password=test;Persist Security Info=True;User ID=sa;Initial Catalog=db_test;Data Source=192.168.0.1保存 修改扩展名 为.udl 就可以了。到此 服务端写完了开始写客户端程序之前( 先启动 此 在dephi程序的bin⽬录下 ) 然后 启动服务端

如果不想在客户的机器上注册 请在使⽤ClientDataSet单元中 引⽤ MidasLib 单元项⽬源码下载 —— /detail/gykthh/8077801