← Back to branch summary

~ubuntu-branches/ubuntu/feisty/fpc/feisty

« back to all changes in this revision

Viewing changes to fcl/db/db.pp

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2007-01-27 20:08:50 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20070127200850-9mrptaqqjsx9nwa7
Tags: 2.0.4-5
* Fixed Build-Depends.
* Add myself to Uploaders in debian/control.
* Make sure that the sources are really patched before building them.
* Build unit 'libc' on powerpc too.

Show diffs side-by-side

added added

removed removed

Lines of Context:
fcl/db/db.pp
1
1
{
2
 
    $Id: db.pp,v 1.51 2005/04/26 16:48:58 michael Exp $
3
2
    This file is part of the Free Pascal run time library.
4
3
    Copyright (c) 1999-2000 by Michael Van Canneyt, member of the
5
4
    Free Pascal development team
33
32
  // whether it's true or false.
34
33
  YesNoChars : Array[Boolean] of char = ('Y','N');
35
34
 
 
35
  SQLDelimiterCharacters = [';',',',' ','(',')',#13,#10,#9];
36
36
 
37
37
type
38
 
{$ifdef ver1_0}
39
 
  PtrInt = Longint;
40
 
  PPtrInt = ^PtrInt;
41
 
{$endif}
42
38
 
43
39
{LargeInt}
44
40
  LargeInt = Int64;
55
51
  TDataEvent = (deFieldChange, deRecordChange, deDataSetChange,
56
52
    deDataSetScroll, deLayoutChange, deUpdateRecord, deUpdateState,
57
53
    deCheckBrowseMode, dePropertyChange, deFieldListChange, deFocusControl,
58
 
    deParentScroll);
 
54
    deParentScroll,deConnectChange,deReconcileError,deDisabledStateChange);
59
55
 
60
56
  TUpdateStatus = (usUnmodified, usModified, usInserted, usDeleted);
 
57
  TUpdateStatusSet = SET OF TUpdateStatus;
61
58
 
62
59
  TUpdateMode = (upWhereAll, upWhereChanged, upWhereKeyOnly);
 
60
  TResolverResponse = (rrSkip, rrAbort, rrMerge, rrApply, rrIgnore);
63
61
 
64
62
  TProviderFlag = (pfInUpdate, pfInWhere, pfInKey, pfHidden);
65
63
  TProviderFlags = set of TProviderFlag;
71
69
  TField = class;
72
70
  TFields = Class;
73
71
  TDataSet = class;
 
72
  TBufDataSet = class;
74
73
  TDataBase = Class;
75
74
  TDatasource = Class;
76
75
  TDatalink = Class;
79
78
{ Exception classes }
80
79
 
81
80
  EDatabaseError = class(Exception);
 
81
  EUpdateError   = class(EDatabaseError)
 
82
  private
 
83
    FContext           : String;
 
84
    FErrorCode         : integer;
 
85
    FOriginalException : Exception;
 
86
    FPreviousError     : Integer;
 
87
  public
 
88
    constructor Create(NativeError, Context : String;
 
89
      ErrCode, PrevError : integer; E: Exception);
 
90
    Destructor Destroy;
 
91
    property Context : String read FContext;
 
92
    property ErrorCode : integer read FErrorcode;
 
93
    property OriginalExcaption : Exception read FOriginalException;
 
94
    property PreviousError : Integer read FPreviousError;
 
95
  end;
 
96
  
82
97
 
83
98
{ TFieldDef }
84
99
 
112
127
  TFieldAttribute = (faHiddenCol, faReadonly, faRequired, faLink, faUnNamed, faFixed);
113
128
  TFieldAttributes = set of TFieldAttribute;
114
129
 
115
 
  TFieldDef = class(TComponent)
 
130
  { TFieldDef }
 
131
 
 
132
  TFieldDef = class(TCollectionItem)
116
133
  Private
117
134
    FDataType : TFieldType;
118
135
    FFieldNo : Longint;
124
141
    FDisplayName : String;
125
142
    FAttributes : TFieldAttributes;
126
143
    Function GetFieldClass : TFieldClass;
 
144
    procedure SetAttributes(AValue: TFieldAttributes);
 
145
    procedure SetDataType(AValue: TFieldType);
 
146
    procedure SetPrecision(const AValue: Longint);
 
147
    procedure SetSize(const AValue: Word);
 
148
    procedure SetRequired(const AValue: Boolean);
 
149
  protected
 
150
    function GetDisplayName: string; override;
 
151
    procedure SetDisplayName(const AValue: string); override;
127
152
  public
128
153
    constructor Create(AOwner: TFieldDefs; const AName: string;
129
154
      ADataType: TFieldType; ASize: Word; ARequired: Boolean; AFieldNo: Longint);
130
155
    destructor Destroy; override;
 
156
    procedure Assign(APersistent: TPersistent); override;
131
157
    function CreateField(AOwner: TComponent): TField;
132
158
    property FieldClass: TFieldClass read GetFieldClass;
133
159
    property FieldNo: Longint read FFieldNo;
134
160
    property InternalCalcField: Boolean read FInternalCalcField write FInternalCalcField;
135
 
    property Required: Boolean read FRequired;
 
161
    property Required: Boolean read FRequired write SetRequired;
136
162
  Published
137
 
    property Attributes: TFieldAttributes read FAttributes write FAttributes default [];
 
163
    property Attributes: TFieldAttributes read FAttributes write SetAttributes default [];
138
164
    property Name: string read FName write FName; // Must move to TNamedItem
139
165
    property DisplayName : string read FDisplayName write FDisplayName; // Must move to TNamedItem
140
 
    property DataType: TFieldType read FDataType write FDataType;
141
 
    property Precision: Longint read FPrecision write FPrecision;
142
 
    property Size: Word read FSize write FSize;
 
166
    property DataType: TFieldType read FDataType write SetDataType;
 
167
    property Precision: Longint read FPrecision write SetPrecision;
 
168
    property Size: Word read FSize write SetSize;
143
169
  end;
144
170
 
145
171
{ TFieldDefs }
146
172
 
147
 
  TFieldDefs = class(TComponent)
 
173
  TFieldDefs = class(TOwnedCollection)
148
174
  private
149
 
    FDataSet: TDataSet;
150
 
    FItems: TList;
151
175
    FUpdated: Boolean;
152
176
    FHiddenFields : Boolean;
153
 
    function GetCount: Longint;
154
177
    function GetItem(Index: Longint): TFieldDef;
 
178
    function GetDataset: TDataset;
 
179
    procedure SetItem(Index: Longint; const AValue: TFieldDef);
 
180
  protected
 
181
    procedure SetItemName(AItem: TCollectionItem); override;
155
182
  public
156
183
    constructor Create(ADataSet: TDataSet);
157
 
    destructor Destroy; override;
 
184
//    destructor Destroy; override;
158
185
    procedure Add(const AName: string; ADataType: TFieldType; ASize: Word; ARequired: Boolean);
159
186
    procedure Add(const AName: string; ADataType: TFieldType; ASize: Word);
160
187
    procedure Add(const AName: string; ADataType: TFieldType);
161
188
    Function AddFieldDef : TFieldDef;
162
189
    procedure Assign(FieldDefs: TFieldDefs);
163
 
    procedure Clear;
 
190
//    procedure Clear;
 
191
//    procedure Delete(Index: Longint);
164
192
    function Find(const AName: string): TFieldDef;
165
193
    function IndexOf(const AName: string): Longint;
166
194
    procedure Update;
167
 
    property Count: Longint read GetCount;
168
195
    Property HiddenFields : Boolean Read FHiddenFields Write FHiddenFields;
169
 
    property Items[Index: Longint]: TFieldDef read GetItem; default;
 
196
    property Items[Index: Longint]: TFieldDef read GetItem write SetItem; default;
 
197
    property Dataset: TDataset read GetDataset;
170
198
    property Updated: Boolean read FUpdated write FUpdated;
171
199
  end;
172
200
 
182
210
  TFieldRef = ^TField;
183
211
  TFieldChars = set of Char;
184
212
 
 
213
  PLookupListRec = ^TLookupListRec;
 
214
  TLookupListRec = record
 
215
    Key: Variant;
 
216
    Value: Variant;
 
217
  end;
 
218
 
 
219
  { TLookupList }
 
220
 
 
221
  TLookupList = class(TObject)
 
222
  private
 
223
    FList: TList;
 
224
  public
 
225
    constructor Create;
 
226
    destructor Destroy; override;
 
227
    procedure Add(const AKey, AValue: Variant);
 
228
    procedure Clear;
 
229
    function ValueOfKey(const AKey: Variant): Variant;
 
230
  end;
 
231
 
185
232
  { TField }
186
233
 
187
234
  TField = class(TComponent)
188
235
  Private
189
236
    FAlignMent : TAlignment;
190
237
    FAttributeSet : String;
191
 
    FBuffers : ppchar;
192
238
    FCalculated : Boolean;
193
 
    FCanModify : Boolean;
194
239
    FConstraintErrorMessage : String;
195
240
    FCustomConstraint : String;
196
241
    FDataSet : TDataSet;
199
244
    FDefaultExpression : String;
200
245
    FDisplayLabel : String;
201
246
    FDisplayWidth : Longint;
202
 
    FEditText : String;
203
247
    FFieldKind : TFieldKind;
204
248
    FFieldName : String;
205
249
    FFieldNo : Longint;
212
256
    FLookupDataSet : TDataSet;
213
257
    FLookupKeyfields : String;
214
258
    FLookupresultField : String;
 
259
    FLookupList: TLookupList;
215
260
    FOffset : Word;
216
261
    FOnChange : TFieldNotifyEvent;
217
262
    FOnGetText: TFieldGetTextEvent;
228
273
    FProviderFlags : TProviderFlags;
229
274
    Function GetIndex : longint;
230
275
    procedure SetAlignment(const AValue: TAlignMent);
231
 
    Procedure SetDataset(Value : TDataset);
 
276
    procedure SetIndex(AValue: Integer);
 
277
    Procedure SetDataset(AValue : TDataset);
232
278
    function GetDisplayText: String;
 
279
    function GetEditText: String;
 
280
    procedure SetEditText(const AValue: string);
233
281
    procedure SetDisplayLabel(const AValue: string);
234
282
    procedure SetDisplayWidth(const AValue: Longint);
235
283
    function GetDisplayWidth: integer;
236
284
    procedure SetReadOnly(const AValue: Boolean);
237
285
    procedure SetVisible(const AValue: Boolean);
238
286
    function IsDisplayStored : Boolean;
 
287
    function GetLookupList: TLookupList;
 
288
    procedure CalcLookupValue;
239
289
  protected
240
290
    function AccessError(const TypeName: string): EDatabaseError;
241
291
    procedure CheckInactive;
245
295
    procedure FreeBuffers; virtual;
246
296
    function GetAsBoolean: Boolean; virtual;
247
297
    function GetAsCurrency: Currency; virtual;
 
298
    function GetAsLargeInt: LargeInt; virtual;
248
299
    function GetAsDateTime: TDateTime; virtual;
249
300
    function GetAsFloat: Double; virtual;
250
301
    function GetAsLongint: Longint; virtual;
256
307
    function GetDataSize: Word; virtual;
257
308
    function GetDefaultWidth: Longint; virtual;
258
309
    function GetDisplayName : String;
 
310
    function GetCurValue: Variant; virtual;
 
311
    function GetNewValue: Variant; virtual;
259
312
    function GetIsNull: Boolean; virtual;
260
313
    function GetParentComponent: TComponent; override;
261
314
    procedure GetText(var AText: string; ADisplayText: Boolean); virtual;
269
322
    procedure SetAsFloat(AValue: Double); virtual;
270
323
    procedure SetAsLongint(AValue: Longint); virtual;
271
324
    procedure SetAsInteger(AValue: Integer); virtual;
 
325
    procedure SetAsLargeint(AValue: Largeint); virtual;
272
326
    procedure SetAsVariant(AValue: variant); virtual;
273
327
    procedure SetAsString(const AValue: string); virtual;
274
328
    procedure SetDataType(AValue: TFieldType);
 
329
    procedure SetNewValue(const AValue: Variant);
275
330
    procedure SetSize(AValue: Word); virtual;
276
331
    procedure SetParentComponent(AParent: TComponent); override;
277
332
    procedure SetText(const AValue: string); virtual;
280
335
    constructor Create(AOwner: TComponent); override;
281
336
    destructor Destroy; override;
282
337
    procedure Assign(Source: TPersistent); override;
283
 
    procedure AssignValue(const Value: TVarRec);
 
338
    procedure AssignValue(const AValue: TVarRec);
284
339
    procedure Clear; virtual;
285
340
    procedure FocusControl;
286
341
    function GetData(Buffer: Pointer): Boolean;
 
342
    function GetData(Buffer: Pointer; NativeFormat : Boolean): Boolean;
287
343
    class function IsBlob: Boolean; virtual;
288
344
    function IsValidChar(InputChar: Char): Boolean; virtual;
 
345
    procedure RefreshLookupList;
289
346
    procedure SetData(Buffer: Pointer);
 
347
    procedure SetData(Buffer: Pointer; NativeFormat : Boolean);
290
348
    procedure SetFieldType(AValue: TFieldType); virtual;
291
349
    procedure Validate(Buffer: Pointer);
292
350
    property AsBoolean: Boolean read GetAsBoolean write SetAsBoolean;
294
352
    property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
295
353
    property AsFloat: Double read GetAsFloat write SetAsFloat;
296
354
    property AsLongint: Longint read GetAsLongint write SetAsLongint;
 
355
    property AsLargeInt: LargeInt read GetAsLargeInt write SetAsLargeInt;
297
356
    property AsInteger: Integer read GetAsInteger write SetAsInteger;
298
357
    property AsString: string read GetAsString write SetAsString;
299
358
    property AsVariant: variant read GetAsVariant write SetAsVariant;
300
359
    property AttributeSet: string read FAttributeSet write FAttributeSet;
301
360
    property Calculated: Boolean read FCalculated write FCalculated;
302
 
    property CanModify: Boolean read FCanModify;
 
361
    property CanModify: Boolean read GetCanModify;
 
362
    property CurValue: Variant read GetCurValue;
303
363
    property DataSet: TDataSet read FDataSet write SetDataSet;
304
364
    property DataSize: Word read GetDataSize;
305
365
    property DataType: TFieldType read FDataType;
308
368
    property FieldNo: Longint read FFieldNo;
309
369
    property IsIndexField: Boolean read FIsIndexField;
310
370
    property IsNull: Boolean read GetIsNull;
 
371
    property NewValue: Variant read GetNewValue write SetNewValue;
311
372
    property Offset: word read FOffset;
312
373
    property Size: Word read FSize write FSize;
313
 
    property Text: string read FEditText write FEditText;
 
374
    property Text: string read GetEditText write SetEditText;
314
375
    property ValidChars : TFieldChars Read FValidChars;
315
376
    property Value: variant read GetAsVariant write SetAsVariant;
316
377
    property OldValue: variant read GetOldValue;
317
 
    property ProviderFlags : TProviderFlags read FProviderFlags write FProviderFlags;
 
378
    property LookupList: TLookupList read GetLookupList;
318
379
  published
319
 
    property AlignMent : TAlignMent Read FAlignMent write SetAlignment;
 
380
    property AlignMent : TAlignMent Read FAlignMent write SetAlignment default taLeftJustify;
320
381
    property CustomConstraint: string read FCustomConstraint write FCustomConstraint;
321
382
    property ConstraintErrorMessage: string read FConstraintErrorMessage write FConstraintErrorMessage;
322
383
    property DefaultExpression: string read FDefaultExpression write FDefaultExpression;
325
386
    property FieldKind: TFieldKind read FFieldKind write FFieldKind;
326
387
    property FieldName: string read FFieldName write FFieldName;
327
388
    property HasConstraints: Boolean read FHasConstraints;
328
 
    property Index: Longint read GetIndex;
 
389
    property Index: Longint read GetIndex write SetIndex;
329
390
    property ImportedConstraint: string read FImportedConstraint write FImportedConstraint;
330
391
    property LookupDataSet: TDataSet read FLookupDataSet write FLookupDataSet;
331
392
    property LookupKeyFields: string read FLookupKeyFields write FLookupKeyFields;
333
394
    property KeyFields: string read FKeyFields write FKeyFields;
334
395
    property LookupCache: Boolean read FLookupCache write FLookupCache;
335
396
    property Origin: string read FOrigin write FOrigin;
 
397
    property ProviderFlags : TProviderFlags read FProviderFlags write FProviderFlags;
336
398
    property ReadOnly: Boolean read FReadOnly write SetReadOnly;
337
399
    property Required: Boolean read FRequired write FRequired;
338
 
    property Visible: Boolean read FVisible write SetVisible;
 
400
    property Visible: Boolean read FVisible write SetVisible default True;
339
401
    property OnChange: TFieldNotifyEvent read FOnChange write FOnChange;
340
402
    property OnGetText: TFieldGetTextEvent read FOnGetText write FOnGetText;
341
403
    property OnSetText: TFieldSetTextEvent read FOnSetText write FOnSetText;
345
407
{ TStringField }
346
408
 
347
409
  TStringField = class(TField)
 
410
  private
 
411
    FFixedChar     : boolean;
 
412
    FTransliterate : Boolean;
348
413
  protected
349
414
    class procedure CheckTypeSize(AValue: Longint); override;
350
415
    function GetAsBoolean: Boolean; override;
365
430
    procedure SetVarValue(const AValue: Variant); override;
366
431
  public
367
432
    constructor Create(AOwner: TComponent); override;
 
433
    property FixedChar : Boolean read FFixedChar write FFixedChar;
 
434
    property Transliterate: Boolean read FTransliterate write FTransliterate;
368
435
  published
369
436
    property Size default 20;
370
437
  end;
430
497
  protected
431
498
    function GetAsFloat: Double; override;
432
499
    function GetAsLongint: Longint; override;
433
 
    function GetAsLargeint: Largeint; virtual;
 
500
    function GetAsLargeint: Largeint; override;
434
501
    function GetAsString: string; override;
435
502
    function GetAsVariant: variant; override;
436
503
    function GetDataSize: Word; override;
438
505
    function GetValue(var AValue: Largeint): Boolean;
439
506
    procedure SetAsFloat(AValue: Double); override;
440
507
    procedure SetAsLongint(AValue: Longint); override;
441
 
    procedure SetAsLargeint(AValue: Largeint); virtual;
 
508
    procedure SetAsLargeint(AValue: Largeint); override;
442
509
    procedure SetAsString(const AValue: string); override;
443
510
    procedure SetVarValue(const AValue: Variant); override;
444
511
  public
506
573
    property Precision: Longint read FPrecision write FPrecision default 15;
507
574
  end;
508
575
 
 
576
{ TCurrencyField }
 
577
 
 
578
  TCurrencyField = class(TFloatField)
 
579
  public
 
580
    constructor Create(AOwner: TComponent); override;
 
581
    procedure GetText(var TheText: string; ADisplayText: Boolean); override;
 
582
  end;
509
583
 
510
584
{ TBooleanField }
511
585
 
619
693
    function GetAsFloat: Double; override;
620
694
    function GetAsLongint: Longint; override;
621
695
    function GetAsString: string; override;
 
696
    function GetValue(var AValue: Currency): Boolean;
622
697
    function GetAsVariant: variant; override;
623
698
    function GetDataSize: Word; override;
624
699
    function GetDefaultWidth: Longint; override;
793
868
      Procedure CheckfieldKind(Fieldkind : TFieldKind; Field : TField);
794
869
      Function GetCount : Longint;
795
870
      Function GetField (Index : longint) : TField;
 
871
      Procedure SetField(Index: Integer; Value: TField);
796
872
      Procedure SetFieldIndex (Field : TField;Value : Integer);
797
873
      Property OnChange : TNotifyEvent Read FOnChange Write FOnChange;
798
874
      Property ValidFieldKinds : TFieldKinds Read FValidFieldKinds;
811
887
      procedure Remove(Value : TField);
812
888
      Property Count : Integer Read GetCount;
813
889
      Property Dataset : TDataset Read FDataset;
814
 
      Property Fields [Index : Integer] : TField Read GetField; default;
 
890
      Property Fields [Index : Integer] : TField Read GetField Write SetField; default;
815
891
    end;
816
892
 
817
893
 
834
910
 
835
911
  TDataAction = (daFail, daAbort, daRetry);
836
912
 
 
913
  TUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApplied);
 
914
 
837
915
  TUpdateKind = (ukModify, ukInsert, ukDelete);
838
916
 
839
917
 
844
922
 
845
923
  TDataSetNotifyEvent = procedure(DataSet: TDataSet) of object;
846
924
  TDataSetErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
847
 
    var Action: TDataAction) of object;
 
925
    var DataAction: TDataAction) of object;
 
926
  TResolverErrorEvent = procedure(Sender: TObject; DataSet: TBufDataset; E: EUpdateError;
 
927
    UpdateKind: TUpdateKind; var Response: TResolverResponse) of object;
848
928
 
849
929
  TFilterOption = (foCaseInsensitive, foNoPartialCompare);
850
930
  TFilterOptions = set of TFilterOption;
866
946
    FAfterInsert: TDataSetNotifyEvent;
867
947
    FAfterOpen: TDataSetNotifyEvent;
868
948
    FAfterPost: TDataSetNotifyEvent;
 
949
    FAfterRefresh: TDataSetNotifyEvent;
869
950
    FAfterScroll: TDataSetNotifyEvent;
870
951
    FAutoCalcFields: Boolean;
871
952
    FBOF: Boolean;
876
957
    FBeforeInsert: TDataSetNotifyEvent;
877
958
    FBeforeOpen: TDataSetNotifyEvent;
878
959
    FBeforePost: TDataSetNotifyEvent;
 
960
    FBeforeRefresh: TDataSetNotifyEvent;
879
961
    FBeforeScroll: TDataSetNotifyEvent;
880
962
    FBlobFieldCount: Longint;
881
963
    FBookmarkSize: Longint;
883
965
    FBufferCount: Longint;
884
966
    FCalcBuffer: PChar;
885
967
    FCalcFieldsSize: Longint;
886
 
    FCanModify: Boolean;
887
968
    FConstraints: TCheckConstraints;
888
969
    FDisableControlsCount : Integer;
889
970
    FDisableControlsState : TDatasetState;
893
974
    FEOF: Boolean;
894
975
    FEnableControlsEvent : TDataEvent;
895
976
    FFieldList : TFields;
896
 
    FFieldCount : Longint;
897
977
    FFieldDefs: TFieldDefs;
898
978
    FFilterOptions: TFilterOptions;
899
979
    FFilterText: string;
912
992
    FState : TDataSetState;
913
993
    Procedure DoInsertAppend(DoAppend : Boolean);
914
994
    Procedure DoInternalOpen;
915
 
    Procedure DoInternalClose(DoCheck : Boolean);
 
995
    Procedure DoInternalClose;
916
996
    Function  GetBuffer (Index : longint) : Pchar;
917
997
    Function  GetField (Index : Longint) : TField;
918
998
    Procedure RegisterDataSource(ADatasource : TDataSource);
919
999
    Procedure RemoveField (Field : TField);
920
 
    Procedure SetActive (Value : Boolean);
921
1000
    Procedure SetField (Index : Longint;Value : TField);
922
1001
    Procedure ShiftBuffersForward;
923
1002
    Procedure ShiftBuffersBackward;
933
1012
    procedure CalculateFields(Buffer: PChar); virtual;
934
1013
    procedure CheckActive; virtual;
935
1014
    procedure CheckInactive; virtual;
 
1015
    procedure CheckBiDirectional;
936
1016
    procedure Loaded; override;
937
1017
    procedure ClearBuffers; virtual;
938
1018
    procedure ClearCalcFields(Buffer: PChar); virtual;
939
1019
    procedure CloseBlob(Field: TField); virtual;
940
1020
    procedure CloseCursor; virtual;
941
 
    procedure CreateFields;
 
1021
    procedure CreateFields; virtual;
942
1022
    procedure DataEvent(Event: TDataEvent; Info: Ptrint); virtual;
943
1023
    procedure DestroyFields; virtual;
944
1024
    procedure DoAfterCancel; virtual;
949
1029
    procedure DoAfterOpen; virtual;
950
1030
    procedure DoAfterPost; virtual;
951
1031
    procedure DoAfterScroll; virtual;
 
1032
    procedure DoAfterRefresh; virtual;
952
1033
    procedure DoBeforeCancel; virtual;
953
1034
    procedure DoBeforeClose; virtual;
954
1035
    procedure DoBeforeDelete; virtual;
957
1038
    procedure DoBeforeOpen; virtual;
958
1039
    procedure DoBeforePost; virtual;
959
1040
    procedure DoBeforeScroll; virtual;
 
1041
    procedure DoBeforeRefresh; virtual;
960
1042
    procedure DoOnCalcFields; virtual;
961
1043
    procedure DoOnNewRecord; virtual;
962
1044
    function  FieldByNumber(FieldNo: Longint): TField;
968
1050
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
969
1051
    function  GetFieldClass(FieldType: TFieldType): TFieldClass; virtual;
970
1052
    Function  GetfieldCount : Integer;
971
 
    function  GetFieldValues(fieldname : string) : string; virtual;
 
1053
    function  GetFieldValues(fieldname : string) : Variant; virtual;
972
1054
    function  GetIsIndexField(Field: TField): Boolean; virtual;
973
1055
    function  GetNextRecords: Longint; virtual;
974
1056
    function  GetNextRecord: Boolean; virtual;
985
1067
    procedure OpenCursor(InfoQuery: Boolean); virtual;
986
1068
    procedure RefreshInternalCalcFields(Buffer: PChar); virtual;
987
1069
    procedure RestoreState(const Value: TDataSetState);
 
1070
    Procedure SetActive (Value : Boolean); virtual;
988
1071
    procedure SetBookmarkStr(const Value: TBookmarkStr); virtual;
989
1072
    procedure SetBufListSize(Value: Longint);
990
1073
    procedure SetChildOrder(Component: TComponent; Order: Longint); override;
993
1076
    procedure SetFilterOptions(Value: TFilterOptions); virtual;
994
1077
    procedure SetFilterText(const Value: string); virtual;
995
1078
    procedure SetFound(const Value: Boolean);
996
 
    procedure SetFieldValues(fieldname : string;value : string); virtual;
 
1079
    procedure SetFieldValues(fieldname: string; Value: Variant); virtual;
997
1080
    procedure SetModified(Value: Boolean);
998
1081
    procedure SetName(const Value: TComponentName); override;
999
1082
    procedure SetOnFilterRecord(const Value: TFilterRecordEvent); virtual;
1000
1083
    procedure SetRecNo(Value: Longint); virtual;
1001
1084
    procedure SetState(Value: TDataSetState);
1002
1085
    function SetTempState(const Value: TDataSetState): TDataSetState;
1003
 
    function TempBuffer: PChar;
 
1086
    Function Tempbuffer: PChar;
1004
1087
    procedure UpdateIndexDefs; virtual;
1005
1088
    property ActiveRecord: Longint read FActiveRecord;
1006
1089
    property CurrentRecord: Longint read FCurrentRecord;
1018
1101
    procedure GetBookmarkData(Buffer: PChar; Data: Pointer); virtual; abstract;
1019
1102
    function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; virtual; abstract;
1020
1103
    function GetDataSource: TDataSource; virtual;
1021
 
    function GetFieldData(Field: TField; Buffer: Pointer): Boolean; virtual; abstract;
 
1104
    function GetFieldData(Field: TField; Buffer: Pointer): Boolean; overload; virtual;
 
1105
    function GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): Boolean; overload; virtual;
1022
1106
    function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; virtual; abstract;
1023
1107
    function GetRecordSize: Word; virtual; abstract;
1024
 
    procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); virtual; abstract;
 
1108
    procedure InternalAddRecord(Buffer: Pointer; AAppend: Boolean); virtual; abstract;
1025
1109
    procedure InternalClose; virtual; abstract;
1026
1110
    procedure InternalDelete; virtual; abstract;
1027
1111
    procedure InternalFirst; virtual; abstract;
1028
1112
    procedure InternalGotoBookmark(ABookmark: Pointer); virtual; abstract;
1029
 
    procedure InternalHandleException; virtual; abstract;
 
1113
    procedure InternalHandleException; virtual;
1030
1114
    procedure InternalInitFieldDefs; virtual; abstract;
1031
1115
    procedure InternalInitRecord(Buffer: PChar); virtual; abstract;
1032
1116
    procedure InternalLast; virtual; abstract;
1036
1120
    function IsCursorOpen: Boolean; virtual; abstract;
1037
1121
    procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); virtual; abstract;
1038
1122
    procedure SetBookmarkData(Buffer: PChar; Data: Pointer); virtual; abstract;
1039
 
    procedure SetFieldData(Field: TField; Buffer: Pointer); virtual; abstract;
 
1123
    procedure SetFieldData(Field: TField; Buffer: Pointer); overload; virtual;
 
1124
    procedure SetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean); overload; virtual;
1040
1125
  public
1041
1126
    constructor Create(AOwner: TComponent); override;
1042
1127
    destructor Destroy; override;
1072
1157
    procedure Insert;
1073
1158
    procedure InsertRecord(const Values: array of const);
1074
1159
    function IsEmpty: Boolean;
 
1160
    function IsLinkedTo(ADataSource: TDataSource): Boolean;
1075
1161
    function IsSequenced: Boolean; virtual;
1076
1162
    procedure Last;
1077
1163
    function Locate(const keyfields: string; const keyvalues: Variant; options: TLocateOptions) : boolean; virtual;
 
1164
    function Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant; virtual;
1078
1165
    function MoveBy(Distance: Longint): Longint;
1079
1166
    procedure Next;
1080
1167
    procedure Open;
1086
1173
    function  Translate(Src, Dest: PChar; ToOem: Boolean): Integer; virtual;
1087
1174
    procedure UpdateCursorPos;
1088
1175
    procedure UpdateRecord;
 
1176
    function UpdateStatus: TUpdateStatus; virtual;
1089
1177
    property BOF: Boolean read FBOF;
1090
1178
    property Bookmark: TBookmarkStr read GetBookmarkStr write SetBookmarkStr;
1091
1179
    property CanModify: Boolean read GetCanModify;
1103
1191
    property RecordSize: Word read GetRecordSize;
1104
1192
    property State: TDataSetState read FState;
1105
1193
    property Fields : TFields read FFieldList;
1106
 
    property FieldValues[fieldname : string] : string read GetFieldValues write SetFieldValues; default;
 
1194
    property FieldValues[fieldname : string] : Variant read GetFieldValues write SetFieldValues; default;
1107
1195
    property Filter: string read FFilterText write SetFilterText;
1108
1196
    property Filtered: Boolean read FFiltered write SetFiltered default False;
1109
 
    property FilterOptions: TFilterOptions read FFilterOptions write FFilterOptions;
 
1197
    property FilterOptions: TFilterOptions read FFilterOptions write SetFilterOptions;
1110
1198
    property Active: Boolean read GetActive write SetActive default False;
1111
1199
    property AutoCalcFields: Boolean read FAutoCalcFields write FAutoCalcFields;
1112
1200
    property BeforeOpen: TDataSetNotifyEvent read FBeforeOpen write FBeforeOpen;
1125
1213
    property AfterDelete: TDataSetNotifyEvent read FAfterDelete write FAfterDelete;
1126
1214
    property BeforeScroll: TDataSetNotifyEvent read FBeforeScroll write FBeforeScroll;
1127
1215
    property AfterScroll: TDataSetNotifyEvent read FAfterScroll write FAfterScroll;
 
1216
    property BeforeRefresh: TDataSetNotifyEvent read FBeforeRefresh write FBeforeRefresh;
 
1217
    property AfterRefresh: TDataSetNotifyEvent read FAfterRefresh write FAfterRefresh;
1128
1218
    property OnCalcFields: TDataSetNotifyEvent read FOnCalcFields write FOnCalcFields;
1129
1219
    property OnDeleteError: TDataSetErrorEvent read FOnDeleteError write FOnDeleteError;
1130
1220
    property OnEditError: TDataSetErrorEvent read FOnEditError write FOnEditError;
1203
1293
 
1204
1294
  TMasterDataLink = class(TDetailDataLink)
1205
1295
  private
1206
 
    FDataSet: TDataSet;
 
1296
    FDetailDataSet: TDataSet;
1207
1297
    FFieldNames: string;
1208
1298
    FFields: TList;
1209
1299
    FOnMasterChange: TNotifyEvent;
1215
1305
    function GetDetailDataSet: TDataSet; override;
1216
1306
    procedure LayoutChanged; override;
1217
1307
    procedure RecordChanged(Field: TField); override;
 
1308
    Procedure DoMasterDisable; virtual;
 
1309
    Procedure DoMasterChange; virtual;
1218
1310
  public
1219
 
    constructor Create(ADataSet: TDataSet);
 
1311
    constructor Create(ADataSet: TDataSet);virtual;
1220
1312
    destructor Destroy; override;
1221
1313
    property FieldNames: string read FFieldNames write SetFieldNames;
1222
1314
    property Fields: TList read FFields;
1305
1397
    Procedure CheckInactive;
1306
1398
    procedure EndTransaction; virtual; abstract;
1307
1399
    procedure StartTransaction; virtual; abstract;
 
1400
    procedure InternalHandleException; virtual;
1308
1401
    procedure Loaded; override;
1309
1402
  Public
1310
1403
    constructor Create(AOwner: TComponent); override;
1348
1441
  protected
1349
1442
    Procedure CheckConnected;
1350
1443
    Procedure CheckDisConnected;
 
1444
    procedure InternalHandleException; virtual;
1351
1445
    procedure Loaded; override;
1352
 
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
1353
1446
    Procedure DoInternalConnect; Virtual;Abstract;
1354
1447
    Procedure DoInternalDisConnect; Virtual;Abstract;
1355
1448
  public
1376
1469
    property Params : TStrings read FParams Write FParams;
1377
1470
    property OnLogin: TLoginEvent read FOnLogin write FOnLogin;
1378
1471
  end;
1379
 
  
 
1472
 
1380
1473
    { TCustomConnection }
1381
1474
 
1382
1475
  TCustomConnection = class(TDatabase)
1403
1496
    property AfterDisconnect : TNotifyEvent read FAfterDisconnect write SetAfterDisconnect;
1404
1497
    property BeforeDisconnect : TNotifyEvent read FBeforeDisconnect write SetBeforeDisconnect;
1405
1498
  end;
1406
 
  
 
1499
 
1407
1500
 
1408
1501
  { TBufDataset }
1409
1502
 
 
1503
  PBufRecLinkItem = ^TBufRecLinkItem;
 
1504
  TBufRecLinkItem = record
 
1505
    prior   : PBufRecLinkItem;
 
1506
    next    : PBufRecLinkItem;
 
1507
  end;
 
1508
 
1410
1509
  PBufBookmark = ^TBufBookmark;
1411
1510
  TBufBookmark = record
1412
 
    BookmarkData : integer;
 
1511
    BookmarkData : PBufRecLinkItem;
1413
1512
    BookmarkFlag : TBookmarkFlag;
1414
1513
  end;
1415
1514
 
1416
 
  PFieldUpdateBuffer = ^TFieldUpdateBuffer;
1417
 
  TFieldUpdateBuffer = record
1418
 
    FieldNo      : integer;
1419
 
    NewValue     : pointer;
1420
 
    IsNull       : boolean;
1421
 
  end;
1422
 
 
1423
 
  TFieldsUpdateBuffer = array of TFieldUpdateBuffer;
1424
 
 
1425
1515
  PRecUpdateBuffer = ^TRecUpdateBuffer;
1426
1516
  TRecUpdateBuffer = record
1427
 
    RecordNo           : integer;
1428
 
    FieldsUpdateBuffer : TFieldsUpdateBuffer;
1429
1517
    UpdateKind         : TUpdateKind;
 
1518
    BookmarkData       : pointer;
 
1519
    OldValuesBuffer    : pchar;
1430
1520
  end;
1431
1521
 
1432
1522
  TRecordsUpdateBuffer = array of TRecUpdateBuffer;
1433
1523
 
1434
1524
  TBufDataset = class(TDBDataSet)
1435
1525
  private
1436
 
    FBBuffers       : TBufferArray;
 
1526
    FCurrentRecBuf  : PBufRecLinkItem;
 
1527
    FLastRecBuf     : PBufRecLinkItem;
 
1528
    FFirstRecBuf    : PBufRecLinkItem;
1437
1529
    FBRecordCount   : integer;
1438
 
    FBBufferCount   : integer;
1439
 
    FBCurrentRecord : integer;
1440
 
    FIsEOF          : boolean;
1441
 
    FIsBOF          : boolean;
 
1530
 
1442
1531
    FPacketRecords  : integer;
1443
1532
    FRecordSize     : Integer;
1444
1533
    FNullmaskSize   : byte;
1445
1534
    FOpen           : Boolean;
1446
1535
    FUpdateBuffer   : TRecordsUpdateBuffer;
1447
 
    FEditBuf        : PRecUpdateBuffer;
1448
 
    FApplyingUpdates: boolean;
1449
 
    FBDeletedRecords: integer;
 
1536
    FCurrentUpdateBuffer : integer;
 
1537
 
 
1538
    FFieldBufPositions : array of longint;
 
1539
    
 
1540
    FAllPacketsFetched : boolean;
 
1541
    FOnUpdateError  : TResolverErrorEvent;
1450
1542
    procedure CalcRecordSize;
1451
1543
    function LoadBuffer(Buffer : PChar): TGetResult;
1452
1544
    function GetFieldSize(FieldDef : TFieldDef) : longint;
1453
 
    function GetRecordUpdateBuffer(rno : integer;var RecUpdBuf : PRecUpdateBuffer) : boolean;
1454
 
    function GetFieldUpdateBuffer(fieldno : integer;RecUpdBuf : PRecUpdateBuffer;var FieldUpdBuf : pFieldUpdateBuffer) : boolean;
 
1545
    function GetRecordUpdateBuffer : boolean;
 
1546
    procedure SetPacketRecords(aValue : integer);
 
1547
    function  IntAllocRecordBuffer: PChar;
1455
1548
  protected
1456
1549
    procedure SetRecNo(Value: Longint); override;
1457
1550
    function  GetRecNo: Longint; override;
 
1551
    function GetChangeCount: integer; virtual;
1458
1552
    function  AllocRecordBuffer: PChar; override;
1459
1553
    procedure FreeRecordBuffer(var Buffer: PChar); override;
1460
1554
    procedure InternalInitRecord(Buffer: PChar); override;
1465
1559
    function getnextpacket : integer;
1466
1560
    function GetRecordSize: Word; override;
1467
1561
    procedure InternalPost; override;
1468
 
    procedure InternalCancel; override;
1469
 
    procedure InternalEdit; override;
1470
 
    procedure InternalInsert; override;
1471
1562
    procedure InternalDelete; override;
1472
1563
    procedure InternalFirst; override;
1473
1564
    procedure InternalLast; override;
1477
1568
    procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
1478
1569
    procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
1479
1570
    function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
 
1571
    function GetFieldData(Field: TField; Buffer: Pointer;
 
1572
      NativeFormat: Boolean): Boolean; override;
1480
1573
    function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
 
1574
    procedure SetFieldData(Field: TField; Buffer: Pointer;
 
1575
      NativeFormat: Boolean); override;
1481
1576
    procedure SetFieldData(Field: TField; Buffer: Pointer); override;
1482
1577
    function IsCursorOpen: Boolean; override;
1483
1578
    function  GetRecordCount: Longint; override;
1484
 
    function ApplyRecUpdate(UpdateKind : TUpdateKind) : boolean; virtual;
 
1579
    procedure ApplyRecUpdate(UpdateKind : TUpdateKind); virtual;
 
1580
    procedure SetOnUpdateError(const aValue: TResolverErrorEvent);
1485
1581
  {abstracts, must be overidden by descendents}
1486
1582
    function Fetch : boolean; virtual; abstract;
1487
1583
    function LoadField(FieldDef : TFieldDef;buffer : pointer) : boolean; virtual; abstract;
1488
1584
  public
1489
1585
    constructor Create(AOwner: TComponent); override;
1490
 
    procedure ApplyUpdates; virtual;
 
1586
    procedure ApplyUpdates; virtual; overload;
 
1587
    procedure ApplyUpdates(MaxErrors: Integer); virtual; overload;
1491
1588
    procedure CancelUpdates; virtual;
1492
1589
    destructor Destroy; override;
 
1590
    function Locate(const keyfields: string; const keyvalues: Variant; options: TLocateOptions) : boolean; override;
 
1591
    function UpdateStatus: TUpdateStatus; override;
 
1592
    property ChangeCount : Integer read GetChangeCount;
 
1593
  published
 
1594
    property PacketRecords : Integer read FPacketRecords write FPacketRecords default 10;
 
1595
    property OnUpdateError: TResolverErrorEvent read FOnUpdateError write SetOnUpdateError;
1493
1596
  end;
1494
1597
 
1495
1598
  { TParam }
1496
1599
 
1497
1600
  TBlobData = string;
1498
1601
 
 
1602
  TParamBinding = array of integer;
 
1603
 
1499
1604
  TParamType = (ptUnknown, ptInput, ptOutput, ptInputOutput, ptResult);
1500
1605
  TParamTypes = set of TParamType;
1501
1606
 
 
1607
  TParamStyle = (psInterbase,psPostgreSQL,psSimulated);
 
1608
 
1502
1609
  TParams = class;
1503
1610
 
1504
1611
  TParam = class(TCollectionItem)
1522
1629
    Function GetAsDateTime: TDateTime;
1523
1630
    Function GetAsFloat: Double;
1524
1631
    Function GetAsInteger: Longint;
 
1632
    Function GetAsLargeInt: LargeInt;
1525
1633
    Function GetAsMemo: string;
1526
1634
    Function GetAsString: string;
1527
1635
    Function GetAsVariant: Variant;
1535
1643
    Procedure SetAsDateTime(const AValue: TDateTime);
1536
1644
    Procedure SetAsFloat(const AValue: Double);
1537
1645
    Procedure SetAsInteger(AValue: Longint);
 
1646
    Procedure SetAsLargeInt(AValue: LargeInt);
1538
1647
    Procedure SetAsMemo(const AValue: string);
1539
1648
    Procedure SetAsSmallInt(AValue: LongInt);
1540
1649
    Procedure SetAsString(const AValue: string);
1550
1659
    Procedure AssignField(Field: TField);
1551
1660
    Procedure AssignToField(Field: TField);
1552
1661
    Procedure AssignFieldValue(Field: TField; const AValue: Variant);
 
1662
    procedure AssignFromField(Field : TField);
1553
1663
    Procedure Clear;
1554
1664
    Procedure GetData(Buffer: Pointer);
1555
1665
    Function  GetDataSize: Integer;
1556
1666
    Procedure LoadFromFile(const FileName: string; BlobType: TBlobType);
1557
1667
    Procedure LoadFromStream(Stream: TStream; BlobType: TBlobType);
1558
 
    Procedure SetBlobData(Buffer: Pointer; Size: Integer);
 
1668
    Procedure SetBlobData(Buffer: Pointer; ASize: Integer);
1559
1669
    Procedure SetData(Buffer: Pointer);
1560
1670
    Property AsBlob : TBlobData read GetAsString write SetAsBlob;
1561
1671
    Property AsBoolean : Boolean read GetAsBoolean write SetAsBoolean;
1564
1674
    Property AsDateTime : TDateTime read GetAsDateTime write SetAsDateTime;
1565
1675
    Property AsFloat : Double read GetAsFloat write SetAsFloat;
1566
1676
    Property AsInteger : LongInt read GetAsInteger write SetAsInteger;
 
1677
    Property AsLargeInt : LargeInt read GetAsLargeInt write SetAsLargeInt;
1567
1678
    Property AsMemo : string read GetAsMemo write SetAsMemo;
1568
1679
    Property AsSmallInt : LongInt read GetAsInteger write SetAsSmallInt;
1569
1680
    Property AsString : string read GetAsString write SetAsString;
1609
1720
    Function  IsEqual(Value: TParams): Boolean;
1610
1721
    Function  ParamByName(const Value: string): TParam;
1611
1722
    Function  ParseSQL(SQL: String; DoCreate: Boolean): String;
 
1723
    Function  ParseSQL(SQL: String; DoCreate: Boolean; ParameterStyle : TParamStyle): String; overload;
 
1724
    Function  ParseSQL(SQL: String; DoCreate: Boolean; ParameterStyle : TParamStyle; var ParamBinding: TParambinding): String; overload;
 
1725
    Function  ParseSQL(SQL: String; DoCreate: Boolean; ParameterStyle : TParamStyle; var ParamBinding: TParambinding; var ReplaceString : string): String;
1612
1726
    Procedure RemoveParam(Value: TParam);
 
1727
    Procedure CopyParamValuesFromDataset(ADataset : TDataset; CopyBound : Boolean);
1613
1728
    Property Dataset : TDataset Read GetDataset;
1614
1729
    Property Items[Index: Integer] : TParam read GetItem write SetItem; default;
1615
1730
    Property ParamValues[const ParamName: string] : Variant read GetParamValue write SetParamValue;
1616
1731
  end;
1617
1732
 
 
1733
  TMasterParamsDataLink = Class(TMasterDataLink)
 
1734
  Private
 
1735
    FParams : TParams;
 
1736
    Procedure SetParams(AVAlue : TParams);  
 
1737
  Protected  
 
1738
    Procedure DoMasterDisable; override;
 
1739
    Procedure DoMasterChange; override;
 
1740
  Public
 
1741
    constructor Create(ADataSet: TDataSet); override;
 
1742
    Procedure RefreshParamNames; virtual;
 
1743
    Procedure CopyParamsFromMaster(CopyBound : Boolean); virtual;
 
1744
    Property Params : TParams Read FParams Write SetParams;  
 
1745
  end;
 
1746
 
1618
1747
const
1619
1748
  FieldTypetoVariantMap : array[TFieldType] of Integer = (varError, varOleStr, varSmallint,
1620
1749
    varInteger, varSmallint, varBoolean, varDouble, varCurrency, varCurrency,
1689
1818
      'Cursor'
1690
1819
    );}
1691
1820
 
 
1821
const
 
1822
  DefaultFieldClasses : Array [TFieldType] of TFieldClass =
 
1823
    ( { ftUnknown} Tfield,
 
1824
      { ftString} TStringField,
 
1825
      { ftSmallint} TSmallIntField,
 
1826
      { ftInteger} TLongintField,
 
1827
      { ftWord} TLongintField,
 
1828
      { ftBoolean} TBooleanField,
 
1829
      { ftFloat} TFloatField,
 
1830
      { ftCurrency} Nil,
 
1831
      { ftBCD} TBCDField,
 
1832
      { ftDate} TDateField,
 
1833
      { ftTime} TTimeField,
 
1834
      { ftDateTime} TDateTimeField,
 
1835
      { ftBytes} TBytesField,
 
1836
      { ftVarBytes} TVarBytesField,
 
1837
      { ftAutoInc} TAutoIncField,
 
1838
      { ftBlob} TBlobField,
 
1839
      { ftMemo} TMemoField,
 
1840
      { ftGraphic} TGraphicField,
 
1841
      { ftFmtMemo} TMemoField,
 
1842
      { ftParadoxOle} Nil,
 
1843
      { ftDBaseOle} Nil,
 
1844
      { ftTypedBinary} Nil,
 
1845
      { ftCursor} Nil,
 
1846
      { ftFixedChar} TStringField,
 
1847
      { ftWideString} Nil,
 
1848
      { ftLargeint} TLargeIntField,
 
1849
      { ftADT} Nil,
 
1850
      { ftArray} Nil,
 
1851
      { ftReference} Nil,
 
1852
      { ftDataSet} Nil,
 
1853
      { ftOraBlob} TBlobField,
 
1854
      { ftOraClob} TMemoField,
 
1855
      { ftVariant} Nil,
 
1856
      { ftInterface} Nil,
 
1857
      { ftIDispatch} Nil,
 
1858
      { ftGuid} Nil,
 
1859
      { ftTimeStamp} Nil,
 
1860
      { ftFMTBcd} Nil
 
1861
    );
 
1862
 
1692
1863
  dsEditModes = [dsEdit, dsInsert, dsSetKey];
1693
1864
  dsWriteModes = [dsEdit, dsInsert, dsSetKey, dsCalcFields, dsFilter,
1694
1865
    dsNewValue, dsInternalCalc];
1700
1871
Procedure DatabaseErrorFmt (Const Fmt : String; Args : Array Of Const);
1701
1872
Procedure DatabaseErrorFmt (Const Fmt : String; Args : Array Of const;
1702
1873
                            Comp : TComponent);
 
1874
Function ExtractFieldName(Const Fields: String; var Pos: Integer): String;
 
1875
Function DateTimeRecToDateTime(DT: TFieldType; Data: TDateTimeRec): TDateTime;
 
1876
Function DateTimeToDateTimeRec(DT: TFieldType; Data: TDateTime): TDateTimeRec;
 
1877
 
 
1878
procedure DisposeMem(var Buffer; Size: Integer);
 
1879
function BuffersEqual(Buf1, Buf2: Pointer; Size: Integer): Boolean;
1703
1880
 
1704
1881
implementation
1705
1882
 
1706
 
uses dbconst;
 
1883
uses dbconst,typinfo;
1707
1884
 
1708
1885
{ ---------------------------------------------------------------------
1709
1886
    Auxiliary functions
1720
1897
Procedure DatabaseError (Const Msg : String; Comp : TComponent);
1721
1898
 
1722
1899
begin
1723
 
  Raise EDatabaseError.CreateFmt('%s : %s',[Comp.Name,Msg]);
 
1900
  if assigned(Comp) then
 
1901
    Raise EDatabaseError.CreateFmt('%s : %s',[Comp.Name,Msg])
 
1902
  else
 
1903
    DatabaseError(Msg);
1724
1904
end;
1725
1905
 
1726
1906
Procedure DatabaseErrorFmt (Const Fmt : String; Args : Array Of Const);
1732
1912
Procedure DatabaseErrorFmt (Const Fmt : String; Args : Array Of const;
1733
1913
                            Comp : TComponent);
1734
1914
begin
1735
 
  Raise EDatabaseError.CreateFmt(Format('%s : %s',[Comp.Name,Fmt]),Args);
1736
 
end;
1737
 
 
 
1915
  if assigned(comp) then
 
1916
    Raise EDatabaseError.CreateFmt(Format('%s : %s',[Comp.Name,Fmt]),Args)
 
1917
  else
 
1918
    DatabaseErrorFmt(Fmt, Args);
 
1919
end;
 
1920
 
 
1921
Function ExtractFieldName(Const Fields: String; var Pos: Integer): String;
 
1922
 
 
1923
var
 
1924
  i: integer;
 
1925
begin
 
1926
  for i := Pos to Length(Fields) do begin
 
1927
    if Fields[i] = ';' then begin
 
1928
      Result := Copy(Fields, Pos, i - Pos);
 
1929
      Pos := i + 1;
 
1930
      Exit;
 
1931
    end;
 
1932
  end;
 
1933
  Result := Copy(Fields, Pos, Length(Fields));
 
1934
  Pos := Length(Fields) + 1;
 
1935
end;
 
1936
 
 
1937
{ EUpdateError }
 
1938
constructor EUpdateError.Create(NativeError, Context : String;
 
1939
                                ErrCode, PrevError : integer; E: Exception);
 
1940
                                
 
1941
begin
 
1942
  Inherited CreateFmt(NativeError,[Context]);
 
1943
  FContext := Context;
 
1944
  FErrorCode := ErrCode;
 
1945
  FPreviousError := PrevError;
 
1946
  FOriginalException := E;
 
1947
end;
 
1948
 
 
1949
Destructor EUpdateError.Destroy;
 
1950
 
 
1951
begin
 
1952
  FOriginalException.Free;
 
1953
end;
1738
1954
 
1739
1955
{ TIndexDef }
1740
1956
 
1835
2051
var
1836
2052
  i, FieldsLen: integer;
1837
2053
  Last: TIndexDef;
1838
 
  Name: string;
1839
 
  Flds: string;
1840
2054
begin
1841
2055
  Last := nil;
1842
2056
  FieldsLen := Length(Fields);
1843
2057
  for i := 0 to Count - 1 do
1844
2058
  begin
1845
2059
    Result := Items[I];
1846
 
    Name := Result.Name;
1847
 
    Flds := Result.Fields;
1848
2060
    if (Result.Options * [ixDescending, ixExpression] = []) and
1849
2061
       (not CaseInsensitive or (ixCaseInsensitive in Result.Options)) and
1850
2062
       AnsiSameText(Fields, Result.Fields) then
1869
2081
var i: LongInt;
1870
2082
begin
1871
2083
  Result := -1;
1872
 
  for i := 0 to Count - 1 do 
 
2084
  for i := 0 to Count - 1 do
1873
2085
    if AnsiSameText(Items[i].Name, Name) then
1874
2086
    begin
1875
2087
      Result := i;
1931
2143
  //!! To be implemented
1932
2144
end;
1933
2145
 
 
2146
{ TLookupList }
 
2147
 
 
2148
constructor TLookupList.Create;
 
2149
 
 
2150
begin
 
2151
  FList := TList.Create;
 
2152
end;
 
2153
 
 
2154
destructor TLookupList.Destroy;
 
2155
 
 
2156
begin
 
2157
  if FList <> nil then Clear;
 
2158
  FList.Free;
 
2159
  inherited Destroy;
 
2160
end;
 
2161
 
 
2162
procedure TLookupList.Add(const AKey, AValue: Variant);
 
2163
 
 
2164
var LookupRec: PLookupListRec;
 
2165
begin
 
2166
  New(LookupRec);
 
2167
  LookupRec^.Key := AKey;
 
2168
  LookupRec^.Value := AValue;
 
2169
  FList.Add(LookupRec);
 
2170
end;
 
2171
 
 
2172
procedure TLookupList.Clear;
 
2173
var i: integer;
 
2174
begin
 
2175
  for i := 0 to FList.Count - 1 do Dispose(PLookupListRec(FList[i]));
 
2176
  FList.Clear;
 
2177
end;
 
2178
 
 
2179
function TLookupList.ValueOfKey(const AKey: Variant): Variant;
 
2180
 
 
2181
var I: Integer;
 
2182
begin
 
2183
  Result := Null;
 
2184
  if VarIsNull(AKey) then Exit;
 
2185
  i := FList.Count - 1;
 
2186
  while (i > 0) And (PLookupListRec(FList.Items[I])^.Key <> AKey) do Dec(i);
 
2187
  if i >= 0 then Result := PLookupListRec(FList.Items[I])^.Value;
 
2188
end;
 
2189
 
 
2190
procedure DisposeMem(var Buffer; Size: Integer);
 
2191
begin
 
2192
  if Pointer(Buffer) <> nil then
 
2193
    begin
 
2194
    FreeMem(Pointer(Buffer), Size);
 
2195
    Pointer(Buffer) := nil;
 
2196
    end;
 
2197
end;
 
2198
 
 
2199
function BuffersEqual(Buf1, Buf2: Pointer; Size: Integer): Boolean; 
 
2200
 
 
2201
begin
 
2202
  Result:=CompareByte(Buf1,Buf2,Size)=0
 
2203
end;
 
2204
 
1934
2205
{$i dataset.inc}
1935
2206
{$i fields.inc}
1936
2207
{$i datasource.inc}
1937
2208
{$i database.inc}
1938
 
{$i BufDataset.inc}
 
2209
{$i bufdataset.inc}
1939
2210
{$i dsparams.inc}
1940
2211
 
1941
2212
end.
1942
 
 
1943
 
{
1944
 
  $Log: db.pp,v $
1945
 
  Revision 1.51  2005/04/26 16:48:58  michael
1946
 
   * Some patches from Uberto Barbini
1947
 
     + TLoginEvent more Delphi compatible (D5 and bigger).
1948
 
     * AsCurrency Property for TField.
1949
 
 
1950
 
  Revision 1.50  2005/04/26 16:37:44  michael
1951
 
  + Added TCustomConnection by Uberto Barbini
1952
 
 
1953
 
  Revision 1.49  2005/04/26 15:45:30  michael
1954
 
  + Patch from Sergey Smirnov to fix TTimeField.AsString
1955
 
 
1956
 
  Revision 1.48  2005/04/24 19:21:28  joost
1957
 
  - some fixes in assignment of transactions and databases
1958
 
 
1959
 
  Revision 1.47  2005/04/13 22:09:15  joost
1960
 
  - TIndexDefs.Destroy now calls inhedited.Destroy
1961
 
 
1962
 
  Revision 1.46  2005/04/10 22:18:43  joost
1963
 
  Patch from Alexandrov Alexandru
1964
 
  - implemented TDataset.BindFields
1965
 
  - master-detail relation implemented
1966
 
  - improved variant-support for fields
1967
 
  - implemented TField.Assign and TField.AssignValue
1968
 
 
1969
 
  Revision 1.45  2005/04/10 18:26:54  joost
1970
 
  - implemented TDataset.Locate
1971
 
  - removed TParam.FNull
1972
 
 
1973
 
  Revision 1.44  2005/04/04 07:30:51  michael
1974
 
  + Patch from Jesus reyes to notify changes to DisplayFormat
1975
 
 
1976
 
  Revision 1.43  2005/03/29 10:07:34  michael
1977
 
  + fix for activerecord, bof false after append.
1978
 
 
1979
 
  Revision 1.42  2005/03/25 11:38:01  michael
1980
 
  + Implementation of IndexForFields from   Alexandrov Alexandru
1981
 
 
1982
 
  Revision 1.41  2005/03/18 11:54:56  michael
1983
 
  + Fixed second typo in provided patch
1984
 
 
1985
 
  Revision 1.39  2005/03/18 10:17:34  michael
1986
 
  + Patch to IndexDefs from Alexandrov Alexandru
1987
 
 
1988
 
  Revision 1.38  2005/02/16 09:31:58  michael
1989
 
  - Remove TTimeField and TDateField GetDataSize functions since both are exactly
1990
 
    equal to their ancestor: TDateTimeField.GetDataSize
1991
 
  - TAutoInc fields are set to ReadyOnly on create
1992
 
  - In TFieldDef.CreateField the presence of faReadyOnly in Attributes is respected
1993
 
 
1994
 
  Revision 1.37  2005/02/14 17:13:12  peter
1995
 
    * truncate log
1996
 
 
1997
 
  Revision 1.36  2005/02/07 11:21:50  joost
1998
 
    - Added TDataset.InternalInsert
1999
 
    - Implemented TField.DisplayName
2000
 
    - added support for TBufDataset delete and insert
2001
 
 
2002
 
  Revision 1.35  2005/02/03 19:10:39  florian
2003
 
    + adapted for use fo tcollection.owner
2004
 
 
2005
 
  Revision 1.34  2005/01/12 10:28:44  michael
2006
 
    * Patch from Joost Van der Sluis:
2007
 
     - implemented TUpdateMode, TProviderFlags
2008
 
     - implemented TIndexDef, TIndexDefs
2009
 
 
2010
 
}