forked from madorin/fibplus
-
Notifications
You must be signed in to change notification settings - Fork 0
/
pFIBProps.pas
2013 lines (1792 loc) · 51.8 KB
/
pFIBProps.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
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
{***************************************************************}
{ FIBPlus - component library for direct access to Firebird and }
{ InterBase databases }
{ }
{ FIBPlus is based in part on the product }
{ Free IB Components, written by Gregory H. Deatz for }
{ Hoagland, Longo, Moran, Dunst & Doukas Company. }
{ mailto:gdeatz@hlmdd.com }
{ }
{ Copyright (c) 1998-2007 Devrace Ltd. }
{ Written by Serge Buzadzhy (buzz@devrace.com) }
{ }
{ ------------------------------------------------------------- }
{ FIBPlus home page: http://www.fibplus.com/ }
{ FIBPlus support : http://www.devrace.com/support/ }
{ ------------------------------------------------------------- }
{ }
{ Please see the file License.txt for full license information }
{***************************************************************}
unit pFIBProps;
interface
{$I FIBPlus.inc}
{$J+}
uses
Classes,SysUtils,DB,IniFiles,FIBPlatforms;
type
TKindOnOperation =(koBefore,koAfter,koAfterFirstFetch,koOther);
TpFIBExistObject =(eoYes,eoNo,eoUnknown);
TpPrepareOption=
(pfSetRequiredFields,pfSetReadOnlyFields,pfImportDefaultValues,
psUseBooleanField,psUseGuidField,psSQLINT64ToBCD,psApplyRepositary,psGetOrderInfo,
psAskRecordCount,psCanEditComputedFields,psSetEmptyStrToNull,psSupportUnicodeBlobs,
psUseLargeIntField
);
TpPrepareOptions=set of TpPrepareOption;
TpFIBDsOption=
(poTrimCharFields,poRefreshAfterPost,
poRefreshDeletedRecord, poStartTransaction,poAutoFormatFields,poProtectedEdit,
poUseSelectForLock, poKeepSorting,
{$IFDEF OBSOLETE_PROPS}
poAllowChangeSqls,
{$ENDIF}
poPersistentSorting,poVisibleRecno,poNoForceIsNull,poFetchAll,poFreeHandlesAfterClose
,poCacheCalcFields,poRefreshAfterDelete,poDontCloseAfterEndTransaction
);
TpFIBDsOptions= set of TpFIBDsOption;
TpFIBQueryOption =(qoStartTransaction,qoAutoCommit,qoTrimCharFields,qoNoForceIsNull,
qoFreeHandleAfterExecute);
TpFIBQueryOptions=set of TpFIBQueryOption;
TDetailCondition=(dcForceOpen,dcIgnoreMasterClose,dcForceMasterRefresh,
dcWaitEndMasterScroll
);
TDetailConditions= set of TDetailCondition;
TFieldOriginRule =(forNoRule,forTableAndFieldName,forClientFieldName,forTableAliasAndFieldName);
TSQLs = class(TPersistent)
private
FOwner :TComponent;
function GetSelectSQL:TStrings;
procedure SetSelectSQL(Value:TStrings);
function GetInsertSQL:TStrings;
procedure SetInsertSQL(Value:TStrings);
function GetUpdateSQL:TStrings;
procedure SetUpdateSQL(Value:TStrings);
function GetDeleteSQL:TStrings;
procedure SetDeleteSQL(Value:TStrings);
function GetRefreshSQL:TStrings;
procedure SetRefreshSQL(Value:TStrings);
public
constructor Create(Owner:TComponent);
property Owner:TComponent read FOwner;
published
property SelectSQL:TStrings read GetSelectSQL write SetSelectSQL;
property UpdateSQL:TStrings read GetUpdateSQL write SetUpdateSQL;
property DeleteSQL:TStrings read GetDeleteSQL write SetDeleteSQL;
property InsertSQL:TStrings read GetInsertSQL write SetInsertSQL;
property RefreshSQL:TStrings read GetRefreshSQL write SetRefreshSQL;
end;
TFormatFields = class(TPersistent)
private
FOwner :TComponent;
FDisplayFormatDateTime:string;
FDisplayFormatDate :string;
FDisplayFormatTime :string;
FDisplayFormatNumeric :string;
FEditFormatNumeric :string;
function StoreDfDt:boolean;
function StoreDfN:boolean;
function StoreEfN:boolean;
function StoreDfD:boolean;
function StoreDfT:boolean;
protected
procedure AssignTo(Dest: TPersistent);override;
public
constructor Create(aOwner :TComponent);
published
property DateTimeDisplayFormat:string read FDisplayFormatDateTime
write FDisplayFormatDateTime stored StoreDfDt ;
property NumericDisplayFormat :string read FDisplayFormatNumeric
write FDisplayFormatNumeric stored StoreDfN ;
property NumericEditFormat :string read FEditFormatNumeric
write FEditFormatNumeric stored StoreEfN ;
property DisplayFormatDate:string read FDisplayFormatDate
write FDisplayFormatDate stored StoreDfD;
property DisplayFormatTime:string read FDisplayFormatTime
write FDisplayFormatTime stored StoreDfT;
end;
TWhenGetGenID=(wgNever,wgOnNewRecord,wgBeforePost);
TReturningFields =(rfAll,rfKeyFields,rfBlobFields);
TSetReturningFields=set of TReturningFields;
TAutoUpdateOptions= class (TPersistent)
private
FOwner :TComponent;
FUpdateTableName:string;
FKeyFieldList :TStrings;
FKeyFields :string;
FAutoReWriteSqls:boolean;
FCanChangeSQLs:boolean;
FGeneratorName :string;
FGeneratorStep:integer;
FSelectGenID:boolean;
FGenBeforePost:boolean;
FUpdateOnlyModifiedFields:boolean;
FWhenGetGenID:TWhenGetGenID;
FParamFieldLinks :TStrings;
FAutoParamsToFields:boolean;
FSeparateBlobUpdate:boolean;
FUseExecuteBlock :boolean; // For CachedUpdates only
FWhereCondition :string; // Cache where
FModifiedTable :string;
FAliasModifiedTable:string;
FModifiedTableHaveAlias:boolean;
FReadySelectSQL: string;
FReturningFields: TSetReturningFields;
FUseRowsClause :boolean;
FModified:boolean;
procedure SetUpdateTableName(const Value:string);
procedure SetSelectGenID(Value:boolean);
function GetSelectGenID:boolean;
function GetGenBeforePost:boolean;
procedure SetGenBeforePost(Value:boolean);
procedure SetParamFieldLinks(const Value: TStrings);
procedure SetUpdateOnlyModifiedFields(const Value: boolean);
procedure SetKeyFields(const Value:string);
function GetAliasModifiedTable: string;
function GetModifiedTable: string;
procedure PrepareUpdateTableStrings;
procedure SetReturningFields(const Value: TSetReturningFields);
protected
// for compatibility only
procedure ReadSelectGenID(Reader: TReader);
procedure ReadGenBeforePost(Reader: TReader);
procedure AssignTo(Dest: TPersistent);override;
procedure DefineProperties(Filer: TFiler); override;
public
constructor Create(Owner:TComponent);
destructor Destroy; override;
property Owner:TComponent read FOwner;
property SelectGenID:boolean read GetSelectGenID write SetSelectGenID ;
property GenBeforePost:boolean read GetGenBeforePost write SetGenBeforePost ;
property KeyFieldList:TStrings read FKeyFieldList;
// Cache Analize results
property WhereCondition :string read FWhereCondition write FWhereCondition;
property ModifiedTableName :string read GetModifiedTable;
property AliasModifiedTable:string read GetAliasModifiedTable;
property ModifiedTableHaveAlias:boolean read FModifiedTableHaveAlias;
property ReadySelectSQL:string read FReadySelectSQL write FReadySelectSQL;
property Modified:boolean read FModified write FModified;
published
property UpdateTableName:string read FUpdateTableName write SetUpdateTableName;
property KeyFields :string read FKeyFields write SetKeyFields;
property AutoReWriteSqls:boolean read FAutoReWriteSqls write FAutoReWriteSqls default False;
property CanChangeSQLs:boolean read FCanChangeSQLs write FCanChangeSQLs default False;
property GeneratorName :string read FGeneratorName write FGeneratorName ;
property UpdateOnlyModifiedFields:boolean read FUpdateOnlyModifiedFields write SetUpdateOnlyModifiedFields
default False;
property WhenGetGenID:TWhenGetGenID read FWhenGetGenID write FWhenGetGenID default wgNever;
property GeneratorStep:integer read FGeneratorStep write FGeneratorStep default 1;
property ParamsToFieldsLinks :TStrings read FParamFieldLinks write SetParamFieldLinks;
property AutoParamsToFields:boolean read FAutoParamsToFields write FAutoParamsToFields default False;
property SeparateBlobUpdate:boolean read FSeparateBlobUpdate write FSeparateBlobUpdate default False;
property UseExecuteBlock :boolean read FUseExecuteBlock write FUseExecuteBlock default False;
//^^^ For CachedUpdates only
property UseReturningFields: TSetReturningFields read FReturningFields write SetReturningFields default [];
property UseRowsClause :boolean read FUseRowsClause write FUseRowsClause default False;
end;
{$IFDEF SUPPORT_IB2007}
TIBConnectParams =class(TPersistent)
private
FOwner:TComponent;
function GetInstanceName:string;
procedure SetInstanceName(const Value:string);
public
constructor Create(Owner:TComponent);
published
property InstanceName: string read GetInstanceName write SetInstanceName stored False;
end;
{$ENDIF}
TUseGeneratorCache=(No,forAll,forGeneratorList);
TGeneratorParams=class(TNamedItem)
private
FStepForCache:integer;
FNextValue :Int64;
FLimit :Int64;
function StoreStep: Boolean;
public
constructor Create(Collection: TCollection); override;
procedure SaveToFile;
function NextValue:Int64;
published
property StepForCache:integer read FStepForCache write FStepForCache stored StoreStep;
end;
TGeneratorsCache=class(TPersistent)
private
FOwner:TComponent;
FCacheFileName:string;
FUseGeneratorCache:TUseGeneratorCache;
FGenerators:TOwnedCollection;
FDefaultStep:Integer;
FLoaded:boolean;
procedure SetGenerators(const Value: TOwnedCollection);
function DoSaveGenList: Boolean;
protected
function GetOwner: TPersistent; override;
public
constructor Create(Owner:TComponent);
destructor Destroy; override;
// Internal use methods
function IndexOf(const AName: string): Integer;
function Find(const GenName: string): TGeneratorParams;
function CanWork(const GenName: string):boolean;
function GetStep(const GenName: string):integer;
function GetNextValue(const GenName: string):Int64;
procedure InternalSetGenParams(const GenName: string; Limit:Int64);
procedure SaveToFile;
procedure LoadFromFile;
property Loaded:boolean read FLoaded;
public
procedure AddGenerator(const GenName: string; Limit:Int64);
procedure RemoveGenerator(const GenName: string);
published
property CacheFileName:string read FCacheFileName write FCacheFileName;
property UseGeneratorCache:TUseGeneratorCache
read FUseGeneratorCache write FUseGeneratorCache default No;
property GeneratorList:TOwnedCollection read FGenerators write SetGenerators stored DoSaveGenList;
property DefaultStep:Integer read FDefaultStep write FDefaultStep default 50;
end;
TConnectParams=class(TPersistent)
private
FOwner:TComponent;
FIsFirebird:boolean;
{$IFDEF SUPPORT_IB2007}
FIBParams:TIBConnectParams;
procedure SetIBParams(const Value: TIBConnectParams);
{$ENDIF}
function GetUserNameA: string;
procedure SetUserName(const Value:string);
function GetRoleName: string;
procedure SetRoleName(const Value:string);
function GetPassword: string;
procedure SetPassword(const Value:string);
function GetCharSet: string;
procedure SetCharSet(const Value:string);
public
constructor Create(Owner:TComponent);
destructor Destroy; override;
published
property UserName : string read GetUserNameA write SetUserName stored False;
property RoleName : string read GetRoleName write SetRoleName stored False;
property Password : string read GetPassword write SetPassword stored False;
property CharSet : string read GetCharSet write SetCharSet stored False;
property IsFirebird:boolean read FIsFirebird write FIsFirebird default True ;
{$IFDEF SUPPORT_IB2007}
property IB2007 : TIBConnectParams read FIBParams write SetIBParams;
{$ENDIF}
end;
{$IFDEF CSMonitor}
TCSMonitorEnabled = (csmeDisabled, csmeEnabled, csmeDatabaseDriven, csmeTransactionDriven);
EFIBCSMonitorError = class(Exception);
TCSMonitorSupport = class(TPersistent)
private
FOwner: TComponent;
FEnabled: TCSMonitorEnabled;
FIncludeDatasetDescription: boolean;
procedure SetEnabled(const Value: TCSMonitorEnabled);
procedure SetIncludeDatasetDescription(const Value: boolean);
function DoStoreEnabled:boolean;
public
constructor Create(AOwner: TComponent);
published
property Enabled: TCSMonitorEnabled read FEnabled write SetEnabled stored DoStoreEnabled;
property IncludeDatasetDescription: boolean read FIncludeDatasetDescription
write SetIncludeDatasetDescription default true;
end;
{$ENDIF}
TCacheSchemaOptions =class(TPersistent)
private
FLocalCacheFile :string;
FAutoSaveToFile :boolean;
FAutoLoadFromFile:boolean;
FValidateAfterLoad:boolean;
public
constructor Create;
published
property LocalCacheFile:string read FLocalCacheFile write FLocalCacheFile;
property AutoSaveToFile:boolean read FAutoSaveToFile write FAutoSaveToFile default False;
property AutoLoadFromFile:boolean read FAutoLoadFromFile write FAutoLoadFromFile default False;
property ValidateAfterLoad:boolean read FValidateAfterLoad write FValidateAfterLoad default True;
end;
TDBParams =class(TStringList)
private
FOwner : TComponent;
procedure ReadData(Reader: TReader);
procedure WriteData(Writer: TWriter);
protected
procedure DefineProperties(Filer: TFiler); override;
public
constructor Create(AOwner:TComponent);
end;
TTransactionAction1 =
(TARollback1, TARollbackRetaining1,TACommit1, TACommitRetaining1);
TTPBMode=(tpbDefault,tpbReadCommitted,tpbRepeatableRead);
TBlobSwapSupport=class(TPersistent)
private
FActive:boolean;
FAutoValidateSwap:boolean;
FSwapDirectory:string;
FMinBlobSizeToSwap:integer;
FTables:TStrings;
function GetSwapDirectory: string;
function StoreSwapDir: Boolean;
procedure SetTables(aTables:TStrings);
function StoreTables:boolean;
public
constructor Create;
destructor Destroy; override;
property SwapDirectory:string read GetSwapDirectory;
published
property Active:boolean read FActive write FActive default False;
property AutoValidateSwap:boolean read FAutoValidateSwap write FAutoValidateSwap default False;
property SwapDir:string read FSwapDirectory write FSwapDirectory stored StoreSwapDir;
property MinBlobSizeToSwap:integer read FMinBlobSizeToSwap write FMinBlobSizeToSwap default 0;
property Tables:TStrings read FTables write SetTables stored StoreTables;
end;
TConditions =class;
TCondition =class
private
FOwner:TConditions;
FEnabled:boolean;
FInDestroy:boolean;
FEnabledFromStream:boolean;
FValueFromStream:boolean;
function GetName: string;
function GetValue: string;
procedure SetValue(const Value: string);
procedure SetValueFromStream(const Value: string);
procedure SetName(const Name: string);
procedure SetEnabled(const Value: boolean);
procedure SetEnabledFromStream(const Value: boolean);
public
constructor Create(AOwner:TConditions);
destructor Destroy; override;
property Enabled:boolean read FEnabled write SetEnabled;
property Name: string read GetName write SetName;
property Value: string read GetValue write SetValue;
end;
TConditionsStateFlag = (csInApply,csInCancel,csInRestorePrimarySQL);
TConditionsState = set of TConditionsStateFlag;
TConditions= class (TStringList)
private
FFIBQuery :TComponent;
FApplied :boolean;
FPrimarySQL:string;
FState :TConditionsState;
function GetEnabledText: string;
function GetCondition(Index: integer): TCondition;
protected
procedure Put(Index: Integer; const S: string); override;
procedure DefineProperties(Filer: TFiler); override;
procedure ReadEnabled(Reader: TReader);
{$IFDEF DFM_VERSION1}
procedure WriteEnabled(Writer: TWriter);
{$ENDIF}
procedure ReadStrings(Reader: TReader);
procedure ReadData(Reader: TReader);
procedure WriteData(Writer: TWriter);
public
procedure WriteToExchangeStrings(Dest:TStrings);
function ExchangeString:string;
procedure ReadFromExchangeStrings(Source:TStrings);
procedure ReadFromExchangeString(const Source:string);
public
constructor Create(AOwner:TComponent);
destructor Destroy; override;
function Add(const S: string): Integer; override;
function AddObject(const S: string; AObject: TObject): Integer; override;
procedure Clear; override;
procedure Delete(Index: Integer); override;
function AddCondition(const Name,Condition:string;Enabled:boolean):TCondition;
function FindCondition(const Name:string):TCondition;
function ByName(const Name:string):TCondition;
procedure Remove(const Name:string);
procedure Apply;
procedure CancelApply;
procedure RestorePrimarySQL;
property EnabledText: string read GetEnabledText;
property Applied :boolean read FApplied;
property Condition[Index:integer] :TCondition read GetCondition ;default;
property PrimarySQL:string read FPrimarySQL write FPrimarySQL;
property State :TConditionsState read FState;
end;
TMemoSubtypes = class
private
FActive:boolean;
FSubTypes:array of ShortInt;
FSubTypesStr:string;
procedure SetSubTypes(const SubTypesStr:string);
public
function IsMemoSubtype(aSubtype:ShortInt):boolean;
property Active:boolean read FActive ;
published
property Subtypes:string read FSubTypesStr write SetSubTypes ;
end;
//DataSet defaults
const
StatDefPrepareOptions=[pfImportDefaultValues,psGetOrderInfo,psUseBooleanField,psSetEmptyStrToNull];
DefaultPrepareOptions:TpPrepareOptions =StatDefPrepareOptions;
StatDefDataSetOptions=[poTrimCharFields,poStartTransaction,poAutoFormatFields, poRefreshAfterPost];
DefaultOptions:TpFIBDsOptions =StatDefDataSetOptions;
// [poTrimCharFields,poStartTransaction,poAutoFormatFields, poRefreshAfterPost];
DefaultDetailConditions:TDetailConditions=[];
//DataBase Defaults
DefStoreConnected :boolean = True;
DefSynchronizeTime:boolean = True;
DefUpperOldNames :boolean = False;
DefUseLoginPrompt :boolean = False;
DefCharSet :string = '';
DefSQLDialect :integer = 1;
//Transaction Defaults
DefTimeOutAction :TTransactionAction1=taRollBack1;
DefTimeOut :Integer =0;
DefTPBMode:TTPBMode =tpbReadCommitted;
//FIBQuery Defaults
DefParamCheck :boolean = True;
DefGoToFirstRecordOnExecute :boolean = True;
DefQueryOptions :TpFIBQueryOptions =[];
//Registry Keys
RegFIBRoot ='FIBC_Software';
RegFIBTrKinds ='Transation Kinds';
RegPreferences='Preferences';
RegRepository ='Repository';
DefPrefixGenName :string = 'GEN_';
DefSufixGenName :string = '_ID';
DefEmptyStrToNull :boolean = True;
// FormatFields Defaults
FF_UseRuntimeDefaults:boolean = False;
RDefDateFormat :string ='dd.mm.yyyy';
RDefTimeFormat :string ='hh:nn';
RDefDisplayFormatNum:string ='#,##0.';
RDefEditFormatNum :string ='0.';
dDefDateFormat :string ='dd.mm.yyyy';
dDefTimeFormat :string ='hh:nn';
dDefDateTimeFormat :string ='dd.mm.yyyy hh:nn';
dDefDisplayFormatNum:string ='#,##0.';
dDefEditFormatNum :string ='0.';
implementation
uses
FIBDatabase,FIBDataSet,FIBQuery,fib,ibase,StrUtil,StdFuncs,SqlTxtRtns;
constructor TAutoUpdateOptions.Create;
begin
inherited Create;
FOwner:=Owner;
FGeneratorName :='';
FGenBeforePost:=True;
FWhenGetGenID :=wgNever;
FGeneratorStep:=1;
FParamFieldLinks:=TStringList.Create;
FKeyFieldList :=TStringList.Create;
end;
destructor TAutoUpdateOptions.Destroy;
begin
FParamFieldLinks.Free;
FKeyFieldList.Free;
inherited Destroy;
end;
procedure TAutoUpdateOptions.AssignTo(Dest: TPersistent);
begin
if Dest is TAutoUpdateOptions then
with TAutoUpdateOptions(Dest) do
begin
FUpdateTableName:=Self.FUpdateTableName;
FKeyFields :=Self.FKeyFields ;
FAutoReWriteSqls:=Self.FAutoReWriteSqls;
FCanChangeSQLs :=Self.FCanChangeSQLs ;
FGeneratorName :=Self.FGeneratorName ;
FGeneratorStep :=Self.FGeneratorStep ;
FSelectGenID :=Self.FSelectGenID ;
FGenBeforePost :=Self.FGenBeforePost ;
FUpdateOnlyModifiedFields:=Self.FUpdateOnlyModifiedFields;
FWhenGetGenID :=Self.FWhenGetGenID ;
FParamFieldLinks.Assign(Self.FParamFieldLinks);
FModifiedTableHaveAlias := Self.FModifiedTableHaveAlias;
FSeparateBlobUpdate:=Self.FSeparateBlobUpdate;
FAutoParamsToFields:=Self.FAutoParamsToFields;
end
else
inherited AssignTo(Dest)
end;
procedure TAutoUpdateOptions.DefineProperties(Filer: TFiler);
begin
if Filer is TReader then
begin
// For oldest dfm
Filer.DefineProperty('SelectGenID', ReadSelectGenID, nil, False );
Filer.DefineProperty('GenBeforePost', ReadGenBeforePost, nil, False );
end;
end;
procedure TAutoUpdateOptions.ReadSelectGenID(Reader: TReader);
begin
FSelectGenID:=Reader.ReadBoolean;
if FSelectGenID then
FWhenGetGenID := wgBeforePost
else
FWhenGetGenID := wgNever;
end;
procedure TAutoUpdateOptions.ReadGenBeforePost(Reader: TReader);
begin
FGenBeforePost:=Reader.ReadBoolean;
if not FSelectGenID then exit;
if FGenBeforePost then
FWhenGetGenID:=wgBeforePost
else
FWhenGetGenID:=wgOnNewRecord
end;
procedure TAutoUpdateOptions.SetUpdateTableName(const Value:string);
var
MT:string;
begin
FWhereCondition:='';
FUpdateTableName:=Value;
FModifiedTable:='';
FAliasModifiedTable:='';
FModifiedTableHaveAlias:=PosAlias(Value)>0;
if (FGeneratorName='') and (WhenGetGenID<>wgNever) then
begin
MT:=GetModifiedTable;
if (Length(MT)>0) and (MT[1]='"') then
begin
MT:=FastCopy(MT,2,Length(MT)-2);
FGeneratorName:='"'+DefPrefixGenName+MT+DefSufixGenName+'"'
end
else
FGeneratorName:=DefPrefixGenName+MT+DefSufixGenName;
end;
FModified:=True;
end;
// for compatibility only
function TAutoUpdateOptions.GetSelectGenID:boolean;
begin
result:=FWhenGetGenID<>wgNever
end;
procedure TAutoUpdateOptions.SetSelectGenID(Value: boolean);
begin
if not Value then
FWhenGetGenID:=wgNever
else
if FWhenGetGenID=wgNever then
FWhenGetGenID:=wgBeforePost;
end;
function TAutoUpdateOptions.GetGenBeforePost: boolean;
begin
result:=FWhenGetGenID in [wgBeforePost,wgNever]
end;
procedure TAutoUpdateOptions.SetGenBeforePost(Value: boolean);
begin
if FWhenGetGenID<>wgNever then
if Value then
FWhenGetGenID:=wgBeforePost
else
FWhenGetGenID :=wgOnNewRecord;
end;
procedure TAutoUpdateOptions.SetParamFieldLinks(const Value: TStrings);
begin
FParamFieldLinks.Assign( Value);
DeleteEmptyStr(FParamFieldLinks)
end;
procedure TAutoUpdateOptions.SetReturningFields(
const Value: TSetReturningFields);
begin
FReturningFields := Value;
FModified:=True;
end;
const
DefDateFormat='dd.mm.yyyy';
DefTimeFormat='hh:nn';
// TFormatFields
constructor TFormatFields.Create(aOwner :TComponent);
begin
FOwner:=aOwner;
if FF_UseRuntimeDefaults then
begin
FDisplayFormatDateTime:= RDefDateFormat + ' '+RDefTimeFormat;
FDisplayFormatNumeric := RDefDisplayFormatNum ;
FEditFormatNumeric := RDefEditFormatNum;
FDisplayFormatDate := RDefDateFormat;
FDisplayFormatTime := RDefTimeFormat;
end
else
if Assigned(FOwner) and (csDesigning in FOwner.ComponentState)
and not CmpInLoadedState(FOwner)
then
begin
// FDisplayFormatDateTime:= dDefDateFormat + ' '+dDefTimeFormat;
FDisplayFormatDateTime:= dDefDateTimeFormat;
FDisplayFormatNumeric := dDefDisplayFormatNum ;
FEditFormatNumeric := dDefEditFormatNum;
FDisplayFormatDate := dDefDateFormat;
FDisplayFormatTime := dDefTimeFormat;
end
else
begin
FDisplayFormatDateTime:= DefDateFormat + ' '+DefTimeFormat;
FDisplayFormatNumeric :='#,##0.' ;
FEditFormatNumeric :='0.';
FDisplayFormatDate := DefDateFormat;
FDisplayFormatTime := DefTimeFormat;
end;
end;
function TFormatFields.StoreDfT:boolean;
begin
if FF_UseRuntimeDefaults then
Result:= FDisplayFormatTime<>RDefTimeFormat
else
Result:= FDisplayFormatTime<>DefTimeFormat
end;
function TFormatFields.StoreDfD:boolean;
begin
if FF_UseRuntimeDefaults then
Result:= FDisplayFormatDate<>RDefDateFormat
else
Result:= FDisplayFormatDate<>DefDateFormat;
end;
function TFormatFields.StoreDfDt:boolean;
begin
if FF_UseRuntimeDefaults then
Result:= FDisplayFormatDateTime<>RDefDateFormat + ' '+RDefTimeFormat
else
Result:= FDisplayFormatDateTime<>DefDateFormat + ' '+DefTimeFormat;
end;
function TFormatFields.StoreDfN:boolean;
begin
if FF_UseRuntimeDefaults then
Result:= FDisplayFormatNumeric<>RDefDisplayFormatNum
else
Result:= FDisplayFormatNumeric <>'#,##0.' ;
end;
function TFormatFields.StoreEfN:boolean;
begin
if FF_UseRuntimeDefaults then
Result:=FEditFormatNumeric<>RDefEditFormatNum
else
Result:=FEditFormatNumeric<>'0.';
end;
procedure TFormatFields.AssignTo(Dest: TPersistent);
begin
if Dest is TFormatFields then
with TFormatFields(Dest) do
begin
FDisplayFormatDateTime:=Self.FDisplayFormatDateTime;
FDisplayFormatDate :=Self.FDisplayFormatDate;
FDisplayFormatTime :=Self.FDisplayFormatTime;
FDisplayFormatNumeric :=Self.FDisplayFormatNumeric;
FEditFormatNumeric :=Self.FEditFormatNumeric;
end
else
inherited AssignTo(Dest)
end;
///TConnectParams
constructor TConnectParams.Create(Owner:TComponent);
begin
inherited Create;
FOwner:=Owner;
FIsFirebird:=True;
{$IFDEF SUPPORT_IB2007}
FIBParams:=TIBConnectParams.Create(Owner);
{$ENDIF}
end;
destructor TConnectParams.Destroy;
begin
{$IFDEF SUPPORT_IB2007}
FIBParams.Free;
{$ENDIF}
inherited Destroy
end;
function TConnectParams.GetUserNameA: string;
begin
Result:='';
if Assigned(FOwner) and (FOwner is TFIBDataBase) then
with TFIBDataBase(FOwner) do
begin
Result:=DBParamByDPB[isc_dpb_user_name];
end;
end;
procedure TConnectParams.SetUserName(const Value:string);
begin
if Assigned(FOwner) and (FOwner is TFIBDataBase) then
with TFIBDataBase(FOwner) do
DBParamByDPB[isc_dpb_user_name]:= Value
end;
function TConnectParams.GetRoleName: string;
begin
Result:='';
if Assigned(FOwner) and (FOwner is TFIBDataBase) then
with TFIBDataBase(FOwner) do
begin
Result:=DBParamByDPB[isc_dpb_sql_role_name];
end;
end;
procedure TConnectParams.SetRoleName(const Value:string);
begin
if Assigned(FOwner) and (FOwner is TFIBDataBase) then
with TFIBDataBase(FOwner) do
DBParamByDPB[isc_dpb_sql_role_name]:= Value
end;
function TConnectParams.GetPassword: string;
begin
Result:='';
if Assigned(FOwner) and (FOwner is TFIBDataBase) then
with TFIBDataBase(FOwner) do
begin
Result:=DBParamByDPB[isc_dpb_password];
end;
end;
procedure TConnectParams.SetPassword(const Value:string);
begin
if Assigned(FOwner) and (FOwner is TFIBDataBase) then
with TFIBDataBase(FOwner) do
DBParamByDPB[isc_dpb_password]:= Value
end;
function TConnectParams.GetCharSet: string;
begin
Result:='';
if Assigned(FOwner) and (FOwner is TFIBDataBase) then
with TFIBDataBase(FOwner) do
begin
Result:=DBParamByDPB[isc_dpb_lc_ctype];
end;
end;
procedure TConnectParams.SetCharSet(const Value:string);
begin
if Assigned(FOwner) and (FOwner is TFIBDataBase) then
with TFIBDataBase(FOwner) do
DBParamByDPB[isc_dpb_lc_ctype]:= FastUpperCase(Value)
end;
{$IFDEF SUPPORT_IB2007}
procedure TConnectParams.SetIBParams(const Value: TIBConnectParams);
begin
FIBParams.Assign(Value);
end;
{ TIBConnectParams }
constructor TIBConnectParams.Create(Owner: TComponent);
begin
inherited Create;
FOwner:=Owner
end;
function TIBConnectParams.GetInstanceName:string;
begin
Result:='';
if Assigned(FOwner) and (FOwner is TFIBDataBase) then
with TFIBDataBase(FOwner) do
begin
Result:=DBParamByDPB[isc_dpb_instance_name];
end;
end;
procedure TIBConnectParams.SetInstanceName(const Value:string);
begin
if Assigned(FOwner) and (FOwner is TFIBDataBase) then
with TFIBDataBase(FOwner) do
DBParamByDPB[isc_dpb_instance_name]:= Value
end;
{$ENDIF}
{ TSQLs }
constructor TSQLs.Create(Owner: TComponent);
begin
inherited Create;
FOwner:=Owner;
end;
function TSQLs.GetDeleteSQL: TStrings;
begin
Result:=TFIBDataSet(FOwner).DeleteSQL
end;
function TSQLs.GetInsertSQL: TStrings;
begin
Result:=TFIBDataSet(FOwner).InsertSQL
end;
function TSQLs.GetRefreshSQL: TStrings;
begin
Result:=TFIBDataSet(FOwner).RefreshSQL
end;
function TSQLs.GetSelectSQL: TStrings;
begin
Result:=TFIBDataSet(FOwner).SelectSQL
end;
function TSQLs.GetUpdateSQL: TStrings;
begin
Result:=TFIBDataSet(FOwner).UpdateSQL
end;
procedure TSQLs.SetDeleteSQL(Value: TStrings);
begin
TFIBDataSet(FOwner).DeleteSQL:=Value
end;
procedure TSQLs.SetInsertSQL(Value: TStrings);
begin
TFIBDataSet(FOwner).InsertSQL:=Value
end;
procedure TSQLs.SetRefreshSQL(Value: TStrings);
begin
TFIBDataSet(FOwner).RefreshSQL:=Value
end;
procedure TSQLs.SetSelectSQL(Value: TStrings);
begin
TFIBDataSet(FOwner).SelectSQL:=Value
end;
procedure TSQLs.SetUpdateSQL(Value: TStrings);
begin
TFIBDataSet(FOwner).UpdateSQL:=Value
end;
{ TCacheSchemaOptions }
constructor TCacheSchemaOptions.Create;
begin
inherited Create;
FLocalCacheFile :='';
FAutoSaveToFile :=False;
FAutoLoadFromFile :=False;
FValidateAfterLoad:=True;
end;
{ TDBParams }
constructor TDBParams.Create(AOwner: TComponent);
begin
inherited Create;
FOwner := AOwner;
end;
procedure TDBParams.DefineProperties(Filer: TFiler);
function DoWrite: Boolean;
begin
if Filer.Ancestor <> nil then
begin
Result := True;
if Filer.Ancestor is TStrings then
Result := not Equals(TStrings(Filer.Ancestor))
end
else Result := Count > 0;
end;
begin
Filer.DefineProperty('Strings', ReadData, WriteData, DoWrite);
end;
procedure TDBParams.ReadData(Reader: TReader);
begin
Reader.ReadListBegin;
BeginUpdate;
try
Clear;
while not Reader.EndOfList do Add(Reader.ReadString);
finally
EndUpdate;
end;
Reader.ReadListEnd;
end;
procedure TDBParams.WriteData(Writer: TWriter);
var
I: Integer;
OldPassword:string;
begin
if (FOwner is TFIBDatabase) and
(ddoNotSavePassword in TFIBDatabase(FOwner).DesignDBOptions)
then
begin
OldPassword:=TFIBDatabase(FOwner).ConnectParams.Password;
TFIBDatabase(FOwner).ConnectParams.Password:='';
end;
try
Writer.WriteListBegin;
for I := 0 to Count - 1 do Writer.WriteString(Get(I));
Writer.WriteListEnd;
finally
if (FOwner is TFIBDatabase) and
(ddoNotSavePassword in TFIBDatabase(FOwner).DesignDBOptions)
then