-
Notifications
You must be signed in to change notification settings - Fork 0
/
Sco.Provider.pas
354 lines (290 loc) · 10.8 KB
/
Sco.Provider.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
unit Sco.Provider;
interface
uses
Data.DB, FireDAC.Comp.Client, System.Classes, System.Generics.Collections;
type
TProviderQuery = class(TFDCustomQuery)
end;
TProviderMemTable = class(TFDMemTable)
end;
TScoParam = record
Name: string;
ParamType: TFieldType;
Value: Variant;
end;
IField = interface
['{29D1BC0C-62BA-4016-A621-6219141961FA}']
function Index: integer; overload;
function Index(const Value: integer): IField; overload;
function PrimaryKey: Boolean; overload;
function PrimaryKey(const Value: Boolean): IField; overload;
function NotNull: Boolean; overload;
function NotNull(const Value: Boolean): IField; overload;
function Name: string; overload;
function Name(const Value: string): IField; overload;
function FieldType: string; overload;
function FieldType(const Value: string): IField; overload;
function FieldSize: integer; overload;
function FieldSize(const Value: integer): IField; overload;
function CharacterSet: string; overload;
function CharacterSet(const Value: string): IField; overload;
function Obs: string; overload;
function Obs(const Value: string): IField; overload;
end;
TTableFields = class(TDictionary<string, IField>)
public
function PrimaryKeys: TArray<IField>;
function PrimaryKeyCount: integer;
function HasPrimaryKey: Boolean;
function OrderedByIndex: TArray<IField>;
procedure AddField(const AField: IField);
function AddIntegerField(const AIndex: integer; const AName: string): IField;
function AddFloatField(const AIndex: integer; const AName: string; const ASize: integer = 15; APrecision: integer = 2): IField;
function AddStringField(const AIndex: integer; const AName: string; const ASize: integer; const ACharSet: string = 'NONE'): IField;
function AddBlobTextField(const AIndex: integer; const AName: string; const ACharSet: string = 'NONE'): IField;
function AddBlobBinaryField(const AIndex: integer; const AName: string): IField;
function AddDateTimeField(const AIndex: integer; const AName: string): IField;
function AddBooleanField(const AIndex: integer; const AName: string): IField;
end;
ITable = interface
['{AEF9F64E-33D2-4433-A999-C3A8C8EF3F03}']
function ID: string; overload;
function ID(const Value: string): ITable; overload;
function Name: string; overload;
function Name(const Value: string): ITable; overload;
function Fields: TTableFields;
function Obs: string; overload;
function Obs(const Value: string): ITable; overload;
end;
IProviderDatabaseInfo = interface
['{B40DDA43-91D6-4100-9617-4CE2EB09E2FC}']
function GetServer: string;
function GetPort: integer;
function GetFileName: string;
function GetUserName: string;
function GetPassword: string;
function GetCharacterSet: string;
function GetProtocol: string;
procedure SetServer(const Value: string);
procedure SetPort(const Value: integer);
procedure SetFileName(const Value: string);
procedure SetUserName(const Value: string);
procedure SetPassword(const Value: string);
procedure SetCharacterSet(const Value: string);
procedure SetProtocol(const Value: string);
property Server: string read GetServer write SetServer;
property Port: integer read GetPort write SetPort;
property FileName: string read GetFileName write SetFileName;
property UserName: string read GetUserName write SetUserName;
property Password: string read GetPassword write SetPassword;
property CharacterSet: string read GetCharacterSet write SetCharacterSet;
property Protocol: string read GetProtocol write SetProtocol;
end;
IProviderDatabase = interface
['{678D3DF1-4417-44EB-A88C-76D74F63B3E5}']
function FillTableNames(const AList: TStrings): IProviderDatabase;
function FillFieldNames(const ATableName: string; AList: TStrings): IProviderDatabase;
function FillFields(const ATable: ITable): IProviderDatabase;
function FillIndexNames(const ATableName: string; AList: TStrings): IProviderDatabase;
function FillPrimaryKeys(const ATableName: string; AList: TStrings): IProviderDatabase;
function FillForeignKeys(const ATableName: string; AList: TStrings): IProviderDatabase;
function FillSequences(const AList: TStrings): IProviderDatabase;
function FillTriggers(const ATableName: string; AList: TStrings): IProviderDatabase;
function CreateTable(const ATable: ITable): IProviderDatabase; overload;
function CreateTable(const ATable: ITable; const ADropIfExists: Boolean): IProviderDatabase; overload;
function FieldExists(const ATableName, AFieldName: string): boolean;
function TableExists(const ATableName: string): boolean;
function NewQuery: TProviderQuery;
function ConnectionString: string;
function Clear: IProviderDatabase;
function SetSQL(const ASql: string): IProviderDatabase; overload;
function SetSQL(const ASql: TStrings): IProviderDatabase; overload;
function SetDateTimeParam(const AName: string; const AValue: TDateTime): IProviderDatabase;
function SetDateParam(const AName: string; const AValue: TDate): IProviderDatabase;
function SetTimeParam(const AName: string; const AValue: TTime): IProviderDatabase;
function SetStringParam(const AName: string; const AValue: string): IProviderDatabase;
function SetWideStringParam(const AName: string; const AValue: string): IProviderDatabase;
function SetIntegerParam(const AName: string; const AValue: integer): IProviderDatabase;
function SetFloatParam(const AName: string; const AValue: Double): IProviderDatabase;
function SetCurrencyParam(const AName: string; const AValue: Currency): IProviderDatabase;
function SetBooleanParam(const AName: string; const AValue: Boolean): IProviderDatabase;
function SetDataset(var ADataSet: TProviderMemTable): IProviderDatabase;
function Open: IProviderDatabase; overload;
function Open(AParams: TArray<TScoParam>): IProviderDatabase; overload;
function Execute: IProviderDatabase; overload;
function Execute(AParams: TArray<TScoParam>): IProviderDatabase; overload;
function Execute(out ARowsAffected: integer): IProviderDatabase; overload;
function Execute(out ARowsAffected: integer; AParams: TArray<TScoParam>): IProviderDatabase; overload;
function DatabaseInfo: IProviderDatabaseInfo;
function StartTransaction: IProviderDatabase;
function InTransaction: Boolean;
function Commit: IProviderDatabase;
function Rollback: IProviderDatabase;
end;
TScoProvider = class
strict private
class var FInstance: IProviderDatabase;
public
class function Firebird: IProviderDatabase;
class function Instance: IProviderDatabase;
class function Info: IProviderDatabaseInfo;
end;
TStructureDomain = class
public
class function Table: ITable;
class function Field: IField;
end;
implementation
uses
Sco.Provider.Domain.Field, Sco.Provider.Domain.Table, Sco.Provider.Firebird,
System.SysUtils, System.Generics.Defaults, Sco.Provider.DatabaseInfo;
{ TProvider }
class function TScoProvider.Firebird: IProviderDatabase;
begin
Result := TProviderFirebird.Create;
end;
class function TScoProvider.Info: IProviderDatabaseInfo;
begin
Result := TProviderDatabaseInfo.New;
end;
class function TScoProvider.Instance: IProviderDatabase;
begin
if not Assigned(FInstance) then
FInstance := TProviderFirebird.Create;
Result := FInstance;
end;
{ TStructureDomain }
class function TStructureDomain.Field: IField;
begin
Result := TField.New;
end;
class function TStructureDomain.Table: ITable;
begin
Result := TTable.New;
end;
{ TTableField }
function TTableFields.AddBlobBinaryField(const AIndex: integer; const AName: string): IField;
begin
Result := TStructureDomain.Field
.Index(AIndex)
.Name(AName)
.FieldType('BLOB SUB_TYPE 0 SEGMENT SIZE 80');
Self.AddField(Result);
end;
function TTableFields.AddBlobTextField(const AIndex: integer; const AName: string; const ACharSet: string): IField;
begin
Result := TStructureDomain.Field
.Index(AIndex)
.Name(AName)
.FieldType('BLOB SUB_TYPE TEXT SEGMENT SIZE 80')
.CharacterSet(ACharSet);
Self.AddField(Result);
end;
function TTableFields.AddBooleanField(const AIndex: integer; const AName: string): IField;
begin
Result := TStructureDomain.Field
.Index(AIndex)
.Name(AName)
.FieldType('BOOLEAN');
Self.AddField(Result);
end;
function TTableFields.AddDateTimeField(const AIndex: integer; const AName: string): IField;
begin
Result := TStructureDomain.Field
.Index(AIndex)
.Name(AName)
.FieldType('TIMESTAMP');
Self.AddField(Result);
end;
procedure TTableFields.AddField(const AField: IField);
begin
Self.AddOrSetValue(AField.Name, AField);
end;
function TTableFields.AddFloatField(const AIndex: integer; const AName: string; const ASize: integer = 15; APrecision: integer = 2): IField;
var
LType: string;
begin
LType := 'NUMERIC(' + ASize.ToString + ',' + APrecision.ToString + ')';
Result := TStructureDomain.Field
.Index(AIndex)
.Name(AName)
.FieldType(LType);
Self.AddField(Result);
end;
function TTableFields.AddIntegerField(const AIndex: integer; const AName: string): IField;
begin
Result := TStructureDomain.Field
.Index(AIndex)
.Name(AName)
.FieldType('INTEGER');
Self.AddField(Result);
end;
function TTableFields.AddStringField(const AIndex: integer; const AName: string; const ASize: integer; const ACharSet: string): IField;
begin
Result := TStructureDomain.Field
.Index(AIndex)
.Name(AName)
.FieldType('VARCHAR')
.FieldSize(ASize);
if UpperCase(ACharSet.Trim) <> 'NONE' then
Result
.CharacterSet(ACharSet);
Self.AddField(Result);
end;
function TTableFields.HasPrimaryKey: Boolean;
begin
Result := Self.PrimaryKeyCount > 0;
end;
function TTableFields.OrderedByIndex: TArray<IField>;
var
LFields: TList<IField>;
begin
LFields := TList<IField>.Create;
try
LFields.AddRange(Self.Values.ToArray);
LFields.Sort(TComparer<IField>.Construct(
function (const L, R: IField): integer
begin
if L.Index = R.Index then
begin
Result := 0;
end
else
begin
if L.Index < R.Index then
begin
Result := -1;
end
else
begin
Result := 1;
end;
end;
end
));
Result := LFields.ToArray;
finally
LFields.Free;
end;
end;
function TTableFields.PrimaryKeyCount: integer;
begin
Result := Length(Self.PrimaryKeys);
end;
function TTableFields.PrimaryKeys: TArray<IField>;
var
LField: IField;
LFields: TArray<IField>;
begin
SetLength(Result, 0);
LFields := Self.OrderedByIndex;
for LField in LFields do
begin
if LField.PrimaryKey then
begin
SetLength(Result, Length(Result) + 1);
Result[Length(Result) - 1] := LField;
end;
end;
end;
end.