db.pp 50 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 1999-2000 by Michael Van Canneyt, member of the
  5. Free Pascal development team
  6. DB header file with interface section.
  7. See the file COPYING.FPC, included in this distribution,
  8. for details about the copyright.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  12. **********************************************************************}
  13. unit db;
  14. {$mode objfpc}
  15. {$h+}
  16. interface
  17. uses Classes,Sysutils;
  18. const
  19. dsMaxBufferCount = MAXINT div 8;
  20. dsMaxStringSize = 8192;
  21. // Used in AsBoolean for string fields to determine
  22. // whether it's true or false.
  23. YesNoChars : Array[Boolean] of char = ('Y','N');
  24. type
  25. {LargeInt}
  26. LargeInt = Int64;
  27. { Auxiliary type }
  28. TStringFieldBuffer = Array[0..dsMaxStringSize] of Char;
  29. { Misc Dataset types }
  30. TDataSetState = (dsInactive, dsBrowse, dsEdit, dsInsert, dsSetKey,
  31. dsCalcFields, dsFilter, dsNewValue, dsOldValue, dsCurValue);
  32. TDataEvent = (deFieldChange, deRecordChange, deDataSetChange,
  33. deDataSetScroll, deLayoutChange, deUpdateRecord, deUpdateState,
  34. deCheckBrowseMode, dePropertyChange, deFieldListChange, deFocusControl);
  35. TUpdateStatus = (usUnmodified, usModified, usInserted, usDeleted);
  36. { Forward declarations }
  37. TFieldDef = class;
  38. TFieldDefs = class;
  39. TField = class;
  40. TFields = Class;
  41. TDataSet = class;
  42. TDataBase = Class;
  43. TDatasource = Class;
  44. TDatalink = Class;
  45. { Exception classes }
  46. EDatabaseError = class(Exception);
  47. { TFieldDef }
  48. TFieldClass = class of TField;
  49. {
  50. TFieldType = (ftUnknown, ftString, ftSmallint, ftInteger, ftWord,
  51. ftBoolean, ftFloat, ftDate, ftTime, ftDateTime,
  52. ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic,
  53. ftFmtMemo, ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor);
  54. }
  55. TFieldType = (ftUnknown, ftString, ftSmallint, ftInteger, ftWord,
  56. ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime,
  57. ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic, ftFmtMemo,
  58. ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftFixedChar,
  59. ftWideString, ftLargeint, ftADT, ftArray, ftReference,
  60. ftDataSet, ftOraBlob, ftOraClob, ftVariant, ftInterface,
  61. ftIDispatch, ftGuid, ftTimeStamp, ftFMTBcd);
  62. { TDateTimeRec }
  63. TDateTimeAlias = type TDateTime;
  64. TDateTimeRec = record
  65. case TFieldType of
  66. ftDate: (Date: Longint);
  67. ftTime: (Time: Longint);
  68. ftDateTime: (DateTime: TDateTimeAlias);
  69. end;
  70. TFieldAttribute = (faHiddenCol, faReadonly, faRequired, faLink, faUnNamed, faFixed);
  71. TFieldAttributes = set of TFieldAttribute;
  72. TFieldDef = class(TComponent)
  73. Private
  74. FDataType : TFieldType;
  75. FFieldNo : Longint;
  76. FInternalCalcField : Boolean;
  77. FPrecision : Longint;
  78. FRequired : Boolean;
  79. FSize : Word;
  80. FName : String;
  81. FAttributes : TFieldAttributes;
  82. Function GetFieldClass : TFieldClass;
  83. public
  84. constructor Create(AOwner: TFieldDefs; const AName: string;
  85. ADataType: TFieldType; ASize: Word; ARequired: Boolean; AFieldNo: Longint);
  86. destructor Destroy; override;
  87. function CreateField(AOwner: TComponent): TField;
  88. property FieldClass: TFieldClass read GetFieldClass;
  89. property FieldNo: Longint read FFieldNo;
  90. property InternalCalcField: Boolean read FInternalCalcField write FInternalCalcField;
  91. property Required: Boolean read FRequired;
  92. Published
  93. property Attributes: TFieldAttributes read FAttributes write FAttributes default [];
  94. property Name: string read FName write FName; // Must move to TNamedItem
  95. property DataType: TFieldType read FDataType;
  96. property Precision: Longint read FPrecision write FPrecision;
  97. property Size: Word read FSize;
  98. end;
  99. { TFieldDefs }
  100. TFieldDefs = class(TComponent)
  101. private
  102. FDataSet: TDataSet;
  103. FItems: TList;
  104. FUpdated: Boolean;
  105. FHiddenFields : Boolean;
  106. function GetCount: Longint;
  107. function GetItem(Index: Longint): TFieldDef;
  108. public
  109. constructor Create(ADataSet: TDataSet);
  110. destructor Destroy; override;
  111. procedure Add(const AName: string; ADataType: TFieldType; ASize: Word; ARequired: Boolean);
  112. procedure Add(const AName: string; ADataType: TFieldType; ASize: Word);
  113. procedure Add(const AName: string; ADataType: TFieldType);
  114. Function AddFieldDef : TFieldDef;
  115. procedure Assign(FieldDefs: TFieldDefs);
  116. procedure Clear;
  117. function Find(const AName: string): TFieldDef;
  118. function IndexOf(const AName: string): Longint;
  119. procedure Update;
  120. property Count: Longint read GetCount;
  121. Property HiddenFields : Boolean Read FHiddenFields Write FHiddenFields;
  122. property Items[Index: Longint]: TFieldDef read GetItem; default;
  123. end;
  124. { TField }
  125. TFieldKind = (fkData, fkCalculated, fkLookup, fkInternalCalc);
  126. TFieldKinds = Set of TFieldKind;
  127. TFieldNotifyEvent = procedure(Sender: TField) of object;
  128. TFieldGetTextEvent = procedure(Sender: TField; var Text: string;
  129. DisplayText: Boolean) of object;
  130. TFieldSetTextEvent = procedure(Sender: TField; const Text: string) of object;
  131. TFieldRef = ^TField;
  132. TFieldChars = set of Char;
  133. { TAlignment may need to come from somewhere else }
  134. TAlignMent = (taLeftjustify,taCenter,taRightJustify);
  135. TField = class(TComponent)
  136. Private
  137. FAlignMent : TAlignment;
  138. FAttributeSet : String;
  139. FBuffers : ppchar;
  140. FCalculated : Boolean;
  141. FCanModify : Boolean;
  142. FConstraintErrorMessage : String;
  143. FCustomConstraint : String;
  144. FDataSet : TDataSet;
  145. FDataSize : Word;
  146. FDataType : TFieldType;
  147. FDefaultExpression : String;
  148. FDisplayLabel : String;
  149. FDisplayWidth : Longint;
  150. FEditText : String;
  151. FFieldKind : TFieldKind;
  152. FFieldName : String;
  153. FFieldNo : Longint;
  154. FFields : TFields;
  155. FHasConstraints : Boolean;
  156. FImportedConstraint : String;
  157. FIsIndexField : Boolean;
  158. FKeyFields : String;
  159. FLookupCache : Boolean;
  160. FLookupDataSet : TDataSet;
  161. FLookupKeyfields : String;
  162. FLookupresultField : String;
  163. FOffset : Word;
  164. FOnChange : TFieldNotifyEvent;
  165. FOnGetText: TFieldGetTextEvent;
  166. FOnSetText: TFieldSetTextEvent;
  167. FOnValidate: TFieldNotifyEvent;
  168. FOrigin : String;
  169. FReadOnly : Boolean;
  170. FRequired : Boolean;
  171. FSize : Word;
  172. FValidChars : TFieldChars;
  173. FValueBuffer : Pointer;
  174. FValidating : Boolean;
  175. FVisible : Boolean;
  176. Function GetIndex : longint;
  177. Procedure SetDataset(VAlue : TDataset);
  178. function GetDisplayText: String;
  179. protected
  180. function AccessError(const TypeName: string): EDatabaseError;
  181. procedure CheckInactive;
  182. class procedure CheckTypeSize(AValue: Longint); virtual;
  183. procedure Change; virtual;
  184. procedure DataChanged;
  185. procedure FreeBuffers; virtual;
  186. function GetAsBoolean: Boolean; virtual;
  187. function GetAsDateTime: TDateTime; virtual;
  188. function GetAsFloat: Extended; virtual;
  189. function GetAsLongint: Longint; virtual;
  190. function GetAsInteger: Longint; virtual;
  191. function GetAsString: string; virtual;
  192. function GetCanModify: Boolean; virtual;
  193. function GetDataSize: Word; virtual;
  194. function GetDefaultWidth: Longint; virtual;
  195. function GetDisplayName : String;
  196. function GetIsNull: Boolean; virtual;
  197. function GetParentComponent: TComponent; override;
  198. procedure GetText(var AText: string; ADisplayText: Boolean); virtual;
  199. function HasParent: Boolean; override;
  200. procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  201. procedure PropertyChanged(LayoutAffected: Boolean);
  202. procedure ReadState(Reader: TReader); override;
  203. procedure SetAsBoolean(AValue: Boolean); virtual;
  204. procedure SetAsDateTime(AValue: TDateTime); virtual;
  205. procedure SetAsFloat(AValue: Extended); virtual;
  206. procedure SetAsLongint(AValue: Longint); virtual;
  207. procedure SetAsInteger(AValue: Longint); virtual;
  208. procedure SetAsString(const AValue: string); virtual;
  209. procedure SetDataType(AValue: TFieldType);
  210. procedure SetSize(AValue: Word); virtual;
  211. procedure SetParentComponent(AParent: TComponent); override;
  212. procedure SetText(const AValue: string); virtual;
  213. public
  214. constructor Create(AOwner: TComponent); override;
  215. destructor Destroy; override;
  216. procedure Assign(Source: TPersistent); override;
  217. procedure Clear; virtual;
  218. procedure FocusControl;
  219. function GetData(Buffer: Pointer): Boolean;
  220. class function IsBlob: Boolean; virtual;
  221. function IsValidChar(InputChar: Char): Boolean; virtual;
  222. procedure SetData(Buffer: Pointer);
  223. procedure SetFieldType(AValue: TFieldType); virtual;
  224. procedure Validate(Buffer: Pointer);
  225. property AsBoolean: Boolean read GetAsBoolean write SetAsBoolean;
  226. property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
  227. property AsFloat: Extended read GetAsFloat write SetAsFloat;
  228. property AsLongint: Longint read GetAsLongint write SetAsLongint;
  229. property AsInteger: Integer read GetAsInteger write SetAsInteger;
  230. property AsString: string read GetAsString write SetAsString;
  231. property AttributeSet: string read FAttributeSet write FAttributeSet;
  232. property Calculated: Boolean read FCalculated write FCalculated;
  233. property CanModify: Boolean read FCanModify;
  234. property DataSet: TDataSet read FDataSet write SetDataSet;
  235. property DataSize: Word read GetDataSize;
  236. property DataType: TFieldType read FDataType;
  237. property DisplayName: String Read GetDisplayName;
  238. property DisplayText: String read GetDisplayText;
  239. property FieldNo: Longint read FFieldNo;
  240. property IsIndexField: Boolean read FIsIndexField;
  241. property IsNull: Boolean read GetIsNull;
  242. property Offset: word read FOffset;
  243. property Size: Word read FSize write FSize;
  244. property Text: string read FEditText write FEditText;
  245. property ValidChars : TFieldChars Read FValidChars;
  246. published
  247. property AlignMent : TAlignMent Read FAlignMent write FAlignment;
  248. property CustomConstraint: string read FCustomConstraint write FCustomConstraint;
  249. property ConstraintErrorMessage: string read FConstraintErrorMessage write FConstraintErrorMessage;
  250. property DefaultExpression: string read FDefaultExpression write FDefaultExpression;
  251. property DisplayLabel : string read FDisplayLabel write FDisplayLabel;
  252. property DisplayWidth: Longint read FDisplayWidth write FDisplayWidth;
  253. property FieldKind: TFieldKind read FFieldKind write FFieldKind;
  254. property FieldName: string read FFieldName write FFieldName;
  255. property HasConstraints: Boolean read FHasConstraints;
  256. property Index: Longint read GetIndex;
  257. property ImportedConstraint: string read FImportedConstraint write FImportedConstraint;
  258. property LookupDataSet: TDataSet read FLookupDataSet write FLookupDataSet;
  259. property LookupKeyFields: string read FLookupKeyFields write FLookupKeyFields;
  260. property LookupResultField: string read FLookupResultField write FLookupResultField;
  261. property KeyFields: string read FKeyFields write FKeyFields;
  262. property LookupCache: Boolean read FLookupCache write FLookupCache;
  263. property Origin: string read FOrigin write FOrigin;
  264. property ReadOnly: Boolean read FReadOnly write FReadOnly;
  265. property Required: Boolean read FRequired write FRequired;
  266. property Visible: Boolean read FVisible write FVisible;
  267. property OnChange: TFieldNotifyEvent read FOnChange write FOnChange;
  268. property OnGetText: TFieldGetTextEvent read FOnGetText write FOnGetText;
  269. property OnSetText: TFieldSetTextEvent read FOnSetText write FOnSetText;
  270. property OnValidate: TFieldNotifyEvent read FOnValidate write FOnValidate;
  271. end;
  272. { TStringField }
  273. TStringField = class(TField)
  274. protected
  275. class procedure CheckTypeSize(AValue: Longint); override;
  276. function GetAsBoolean: Boolean; override;
  277. function GetAsDateTime: TDateTime; override;
  278. function GetAsFloat: Extended; override;
  279. function GetAsLongint: Longint; override;
  280. function GetAsString: string; override;
  281. function GetDataSize: Word; override;
  282. function GetDefaultWidth: Longint; override;
  283. procedure GetText(var AText: string; ADisplayText: Boolean); override;
  284. function GetValue(var AValue: string): Boolean;
  285. procedure SetAsBoolean(AValue: Boolean); override;
  286. procedure SetAsDateTime(AValue: TDateTime); override;
  287. procedure SetAsFloat(AValue: Extended); override;
  288. procedure SetAsLongint(AValue: Longint); override;
  289. procedure SetAsString(const AValue: string); override;
  290. public
  291. constructor Create(AOwner: TComponent); override;
  292. property Value: string read GetAsString write SetAsString;
  293. published
  294. property Size default 20;
  295. end;
  296. { TNumericField }
  297. TNumericField = class(TField)
  298. Private
  299. FDisplayFormat : String;
  300. FEditFormat : String;
  301. protected
  302. procedure RangeError(AValue, Min, Max: Extended);
  303. procedure SetDisplayFormat(const AValue: string);
  304. procedure SetEditFormat(const AValue: string);
  305. public
  306. constructor Create(AOwner: TComponent); override;
  307. published
  308. property DisplayFormat: string read FDisplayFormat write SetDisplayFormat;
  309. property EditFormat: string read FEditFormat write SetEditFormat;
  310. end;
  311. { TLongintField }
  312. TLongintField = class(TNumericField)
  313. private
  314. FMinValue,
  315. FMaxValue,
  316. FMinRange,
  317. FMAxRange : Longint;
  318. Procedure SetMinValue (AValue : longint);
  319. Procedure SetMaxValue (AValue : longint);
  320. protected
  321. function GetAsFloat: Extended; override;
  322. function GetAsLongint: Longint; override;
  323. function GetAsString: string; override;
  324. function GetDataSize: Word; override;
  325. procedure GetText(var AText: string; ADisplayText: Boolean); override;
  326. function GetValue(var AValue: Longint): Boolean;
  327. procedure SetAsFloat(AValue: Extended); override;
  328. procedure SetAsLongint(AValue: Longint); override;
  329. procedure SetAsString(const AValue: string); override;
  330. public
  331. constructor Create(AOwner: TComponent); override;
  332. Function CheckRange(AValue : longint) : Boolean;
  333. property Value: Longint read GetAsLongint write SetAsLongint;
  334. published
  335. property MaxValue: Longint read FMaxValue write SetMaxValue default 0;
  336. property MinValue: Longint read FMinValue write SetMinValue default 0;
  337. end;
  338. TIntegerField = TLongintField;
  339. { TSmallintField }
  340. TSmallintField = class(TLongintField)
  341. protected
  342. function GetDataSize: Word; override;
  343. public
  344. constructor Create(AOwner: TComponent); override;
  345. end;
  346. { TWordField }
  347. TWordField = class(TLongintField)
  348. protected
  349. function GetDataSize: Word; override;
  350. public
  351. constructor Create(AOwner: TComponent); override;
  352. end;
  353. { TAutoIncField }
  354. TAutoIncField = class(TLongintField)
  355. Protected
  356. Procedure SetAsLongInt(AValue : Longint); override;
  357. public
  358. constructor Create(AOwner: TComponent); override;
  359. end;
  360. { TFloatField }
  361. TFloatField = class(TNumericField)
  362. private
  363. FMaxValue : Extended;
  364. FMinValue : Extended;
  365. FPrecision : Longint;
  366. protected
  367. function GetAsFloat: Extended; override;
  368. function GetAsLongint: Longint; override;
  369. function GetAsString: string; override;
  370. function GetDataSize: Word; override;
  371. procedure GetText(var theText: string; ADisplayText: Boolean); override;
  372. procedure SetAsFloat(AValue: Extended); override;
  373. procedure SetAsLongint(AValue: Longint); override;
  374. procedure SetAsString(const AValue: string); override;
  375. public
  376. constructor Create(AOwner: TComponent); override;
  377. Function CheckRange(AValue : Extended) : Boolean;
  378. property Value: Extended read GetAsFloat write SetAsFloat;
  379. published
  380. property MaxValue: Extended read FMaxValue write FMaxValue;
  381. property MinValue: Extended read FMinValue write FMinValue;
  382. property Precision: Longint read FPrecision write FPrecision default 15;
  383. end;
  384. { TBooleanField }
  385. TBooleanField = class(TField)
  386. private
  387. FDisplayValues : String;
  388. // First byte indicates uppercase or not.
  389. FDisplays : Array[Boolean,Boolean] of string;
  390. Procedure SetDisplayValues(AValue : String);
  391. protected
  392. function GetAsBoolean: Boolean; override;
  393. function GetAsString: string; override;
  394. function GetDataSize: Word; override;
  395. function GetDefaultWidth: Longint; override;
  396. procedure SetAsBoolean(AValue: Boolean); override;
  397. procedure SetAsString(const AValue: string); override;
  398. public
  399. constructor Create(AOwner: TComponent); override;
  400. property Value: Boolean read GetAsBoolean write SetAsBoolean;
  401. published
  402. property DisplayValues: string read FDisplayValues write SetDisplayValues;
  403. end;
  404. { TDateTimeField }
  405. TDateTimeField = class(TField)
  406. private
  407. FDisplayFormat : String;
  408. protected
  409. function GetAsDateTime: TDateTime; override;
  410. function GetAsFloat: Extended; override;
  411. function GetAsString: string; override;
  412. function GetDataSize: Word; override;
  413. procedure GetText(var theText: string; ADisplayText: Boolean); override;
  414. procedure SetAsDateTime(AValue: TDateTime); override;
  415. procedure SetAsFloat(AValue: Extended); override;
  416. procedure SetAsString(const AValue: string); override;
  417. public
  418. constructor Create(AOwner: TComponent); override;
  419. property Value: TDateTime read GetAsDateTime write SetAsDateTime;
  420. published
  421. property DisplayFormat: string read FDisplayFormat write FDisplayFormat;
  422. end;
  423. { TDateField }
  424. TDateField = class(TDateTimeField)
  425. protected
  426. function GetDataSize: Word; override;
  427. public
  428. constructor Create(AOwner: TComponent); override;
  429. end;
  430. { TTimeField }
  431. TTimeField = class(TDateTimeField)
  432. protected
  433. function GetDataSize: Word; override;
  434. public
  435. constructor Create(AOwner: TComponent); override;
  436. end;
  437. { TBinaryField }
  438. TBinaryField = class(TField)
  439. protected
  440. class procedure CheckTypeSize(AValue: Longint); override;
  441. function GetAsString: string; override;
  442. procedure GetText(var TheText: string; ADisplayText: Boolean); override;
  443. procedure SetAsString(const AValue: string); override;
  444. procedure SetText(const AValue: string); override;
  445. public
  446. constructor Create(AOwner: TComponent); override;
  447. published
  448. property Size default 16;
  449. end;
  450. { TBytesField }
  451. TBytesField = class(TBinaryField)
  452. protected
  453. function GetDataSize: Word; override;
  454. public
  455. constructor Create(AOwner: TComponent); override;
  456. end;
  457. { TVarBytesField }
  458. TVarBytesField = class(TBytesField)
  459. protected
  460. function GetDataSize: Word; override;
  461. public
  462. constructor Create(AOwner: TComponent); override;
  463. end;
  464. { TBCDField }
  465. TBCDField = class(TNumericField)
  466. private
  467. protected
  468. class procedure CheckTypeSize(AValue: Longint); override;
  469. function GetAsFloat: Extended; override;
  470. function GetAsLongint: Longint; override;
  471. function GetAsString: string; override;
  472. function GetDataSize: Word; override;
  473. function GetDefaultWidth: Longint; override;
  474. procedure GetText(var TheText: string; ADisplayText: Boolean); override;
  475. procedure SetAsFloat(AValue: Extended); override;
  476. procedure SetAsLongint(AValue: Longint); override;
  477. procedure SetAsString(const AValue: string); override;
  478. public
  479. constructor Create(AOwner: TComponent); override;
  480. published
  481. property Size default 4;
  482. end;
  483. { TBlobField }
  484. TBlobStreamMode = (bmRead, bmWrite, bmReadWrite);
  485. TBlobType = ftBlob..ftTypedBinary;
  486. TBlobField = class(TField)
  487. private
  488. FBlobSize : Longint;
  489. FBlobType : TBlobType;
  490. FModified : Boolean;
  491. FTransliterate : Boolean;
  492. Function GetBlobStream (Mode : TBlobStreamMode) : TStream;
  493. protected
  494. procedure AssignTo(Dest: TPersistent); override;
  495. procedure FreeBuffers; override;
  496. function GetAsString: string; override;
  497. function GetBlobSize: Longint; virtual;
  498. function GetIsNull: Boolean; override;
  499. procedure GetText(var TheText: string; ADisplayText: Boolean); override;
  500. procedure SetAsString(const AValue: string); override;
  501. procedure SetText(const AValue: string); override;
  502. public
  503. constructor Create(AOwner: TComponent); override;
  504. procedure Assign(Source: TPersistent); override;
  505. procedure Clear; override;
  506. class function IsBlob: Boolean; override;
  507. procedure LoadFromFile(const FileName: string);
  508. procedure LoadFromStream(Stream: TStream);
  509. procedure SaveToFile(const FileName: string);
  510. procedure SaveToStream(Stream: TStream);
  511. procedure SetFieldType(AValue: TFieldType); override;
  512. property BlobSize: Longint read FBlobSize;
  513. property Modified: Boolean read FModified write FModified;
  514. property Value: string read GetAsString write SetAsString;
  515. property Transliterate: Boolean read FTransliterate write FTransliterate;
  516. published
  517. property BlobType: TBlobType read FBlobType write FBlobType;
  518. property Size default 0;
  519. end;
  520. { TMemoField }
  521. TMemoField = class(TBlobField)
  522. public
  523. constructor Create(AOwner: TComponent); override;
  524. published
  525. property Transliterate default True;
  526. end;
  527. { TGraphicField }
  528. TGraphicField = class(TBlobField)
  529. public
  530. constructor Create(AOwner: TComponent); override;
  531. end;
  532. { TIndexDef }
  533. TIndexDefs = class;
  534. TIndexOptions = set of (ixPrimary, ixUnique, ixDescending,
  535. ixCaseInsensitive, ixExpression);
  536. TIndexDef = class
  537. Private
  538. FExpression : String;
  539. FFields : String;
  540. FName : String;
  541. FOptions : TIndexOptions;
  542. FSource : String;
  543. public
  544. constructor Create(Owner: TIndexDefs; const AName, TheFields: string;
  545. TheOptions: TIndexOptions);
  546. destructor Destroy; override;
  547. property Expression: string read FExpression;
  548. property Fields: string read FFields;
  549. property Name: string read FName;
  550. property Options: TIndexOptions read FOptions;
  551. property Source: string read FSource write FSource;
  552. end;
  553. { TIndexDefs }
  554. TIndexDefs = class
  555. Private
  556. FCount : Longint;
  557. FUpDated : Boolean;
  558. Function GetItem (Index : longint) : TindexDef;
  559. public
  560. constructor Create(DataSet: TDataSet);
  561. destructor Destroy; override;
  562. procedure Add(const Name, Fields: string; Options: TIndexOptions);
  563. procedure Assign(IndexDefs: TIndexDefs);
  564. procedure Clear;
  565. function FindIndexForFields(const Fields: string): TIndexDef;
  566. function GetIndexForFields(const Fields: string;
  567. CaseInsensitive: Boolean): TIndexDef;
  568. function IndexOf(const Name: string): Longint;
  569. procedure Update;
  570. property Count: Longint read FCount;
  571. property Items[Index: Longint]: TIndexDef read GetItem; default;
  572. property Updated: Boolean read FUpdated write FUpdated;
  573. end;
  574. { TCheckConstraint }
  575. TCheckConstraint = class(TCollectionItem)
  576. Private
  577. FCustomConstraint : String;
  578. FErrorMessage : String;
  579. FFromDictionary : Boolean;
  580. FImportedConstraint : String;
  581. public
  582. procedure Assign(Source: TPersistent); override;
  583. // function GetDisplayName: string; override;
  584. published
  585. property CustomConstraint: string read FCustomConstraint write FCustomConstraint;
  586. property ErrorMessage: string read FErrorMessage write FErrorMessage;
  587. property FromDictionary: Boolean read FFromDictionary write FFromDictionary;
  588. property ImportedConstraint: string read FImportedConstraint write FImportedConstraint;
  589. end;
  590. { TCheckConstraints }
  591. TCheckConstraints = class(TCollection)
  592. Private
  593. Function GetItem(Index : Longint) : TCheckConstraint;
  594. Procedure SetItem(index : Longint; Value : TCheckConstraint);
  595. protected
  596. function GetOwner: TPersistent; override;
  597. public
  598. constructor Create(Owner: TPersistent);
  599. function Add: TCheckConstraint;
  600. property Items[Index: Longint]: TCheckConstraint read GetItem write SetItem; default;
  601. end;
  602. { TFields }
  603. Tfields = Class(TObject)
  604. Private
  605. FDataset : TDataset;
  606. FFieldList : TList;
  607. FOnChange : TNotifyEvent;
  608. FValidFieldKinds : TFieldKinds;
  609. Protected
  610. Procedure Changed;
  611. Procedure CheckfieldKind(Fieldkind : TFieldKind; Field : TField);
  612. Function GetCount : Longint;
  613. Function GetField (Index : longint) : TField;
  614. Procedure SetFieldIndex (Field : TField;Value : Integer);
  615. Property OnChange : TNotifyEvent Read FOnChange Write FOnChange;
  616. Property ValidFieldKinds : TFieldKinds Read FValidFieldKinds;
  617. Public
  618. Constructor Create(ADataset : TDataset);
  619. Destructor Destroy;override;
  620. Procedure Add(Field : TField);
  621. Procedure CheckFieldName (Const Value : String);
  622. Procedure CheckFieldNames (Const Value : String);
  623. Procedure Clear;
  624. Function FindField (Const Value : String) : TField;
  625. Function FieldByName (Const Value : String) : TField;
  626. Function FieldByNumber(FieldNo : Integer) : TField;
  627. Procedure GetFieldNames (Values : TStrings);
  628. Function IndexOf(Field : TField) : Longint;
  629. procedure Remove(Value : TField);
  630. Property Count : Integer Read GetCount;
  631. Property Dataset : TDataset Read FDataset;
  632. Property Fields [Index : Integer] : TField Read GetField; default;
  633. end;
  634. { TDataSet }
  635. TBookmark = Pointer;
  636. TBookmarkStr = string;
  637. PBookmarkFlag = ^TBookmarkFlag;
  638. TBookmarkFlag = (bfCurrent, bfBOF, bfEOF, bfInserted);
  639. PBufferList = ^TBufferList;
  640. TBufferList = array[0..dsMaxBufferCount - 1] of PChar;
  641. TGetMode = (gmCurrent, gmNext, gmPrior);
  642. TGetResult = (grOK, grBOF, grEOF, grError);
  643. TResyncMode = set of (rmExact, rmCenter);
  644. TDataAction = (daFail, daAbort, daRetry);
  645. TUpdateKind = (ukModify, ukInsert, ukDelete);
  646. TLocateOption = (loCaseInsensitive, loPartialKey);
  647. TLocateOptions = set of TLocateOption;
  648. TDataOperation = procedure of object;
  649. TDataSetNotifyEvent = procedure(DataSet: TDataSet) of object;
  650. TDataSetErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
  651. var Action: TDataAction) of object;
  652. TFilterOption = (foCaseInsensitive, foNoPartialCompare);
  653. TFilterOptions = set of TFilterOption;
  654. TFilterRecordEvent = procedure(DataSet: TDataSet;
  655. var Accept: Boolean) of object;
  656. TDatasetClass = Class of TDataset;
  657. TBufferArray = ^pchar;
  658. TDataSet = class(TComponent)
  659. Private
  660. FActive: Boolean;
  661. FActiveRecord: Longint;
  662. FAfterCancel: TDataSetNotifyEvent;
  663. FAfterClose: TDataSetNotifyEvent;
  664. FAfterDelete: TDataSetNotifyEvent;
  665. FAfterEdit: TDataSetNotifyEvent;
  666. FAfterInsert: TDataSetNotifyEvent;
  667. FAfterOpen: TDataSetNotifyEvent;
  668. FAfterPost: TDataSetNotifyEvent;
  669. FAfterScroll: TDataSetNotifyEvent;
  670. FAutoCalcFields: Boolean;
  671. FBOF: Boolean;
  672. FBeforeCancel: TDataSetNotifyEvent;
  673. FBeforeClose: TDataSetNotifyEvent;
  674. FBeforeDelete: TDataSetNotifyEvent;
  675. FBeforeEdit: TDataSetNotifyEvent;
  676. FBeforeInsert: TDataSetNotifyEvent;
  677. FBeforeOpen: TDataSetNotifyEvent;
  678. FBeforePost: TDataSetNotifyEvent;
  679. FBeforeScroll: TDataSetNotifyEvent;
  680. FBlobFieldCount: Longint;
  681. FBookmark: TBookmarkStr;
  682. FBookmarkSize: Longint;
  683. FBuffers : TBufferArray;
  684. FBufferCount: Longint;
  685. FCalcBuffer: PChar;
  686. FCalcFieldsSize: Longint;
  687. FCanModify: Boolean;
  688. FConstraints: TCheckConstraints;
  689. FDisableControlsCount : Integer;
  690. FDisableControlsState : TDatasetState;
  691. FCurrentRecord: Longint;
  692. FDataSources : TList;
  693. FDefaultFields: Boolean;
  694. FEOF: Boolean;
  695. FEnableControlsEvent : TDataEvent;
  696. FFieldList : TFields;
  697. FFieldCount : Longint;
  698. FFieldDefs: TFieldDefs;
  699. FFilterOptions: TFilterOptions;
  700. FFilterText: string;
  701. FFiltered: Boolean;
  702. FFound: Boolean;
  703. FInternalCalcFields: Boolean;
  704. FModified: Boolean;
  705. FOnCalcFields: TDataSetNotifyEvent;
  706. FOnDeleteError: TDataSetErrorEvent;
  707. FOnEditError: TDataSetErrorEvent;
  708. FOnFilterRecord: TFilterRecordEvent;
  709. FOnNewRecord: TDataSetNotifyEvent;
  710. FOnPostError: TDataSetErrorEvent;
  711. FRecNo: Longint;
  712. FRecordCount: Longint;
  713. FRecordSize: Word;
  714. FState : TDataSetState;
  715. Procedure DoInsertAppend(DoAppend : Boolean);
  716. Procedure DoInternalOpen;
  717. Procedure DoInternalClose;
  718. Function GetBuffer (Index : longint) : Pchar;
  719. Function GetField (Index : Longint) : TField;
  720. procedure RecalcBufListSize;
  721. Procedure RegisterDataSource(ADatasource : TDataSource);
  722. Procedure RemoveField (Field : TField);
  723. Procedure SetActive (Value : Boolean);
  724. procedure SetBufferCount(const AValue: Longint);
  725. Procedure SetField (Index : Longint;Value : TField);
  726. Procedure ShiftBuffers (Offset,Distance : Longint);
  727. Function TryDoing (P : TDataOperation; Ev : TDatasetErrorEvent) : Boolean;
  728. Procedure UnRegisterDataSource(ADatasource : TDatasource);
  729. Procedure UpdateFieldDefs;
  730. protected
  731. procedure ActivateBuffers; virtual;
  732. procedure BindFields(Binding: Boolean);
  733. function BookmarkAvailable: Boolean;
  734. procedure CalculateFields(Buffer: PChar); virtual;
  735. procedure CheckActive; virtual;
  736. procedure CheckInactive; virtual;
  737. procedure ClearBuffers; virtual;
  738. procedure ClearCalcFields(Buffer: PChar); virtual;
  739. procedure CloseBlob(Field: TField); virtual;
  740. procedure CloseCursor; virtual;
  741. procedure CreateFields;
  742. procedure DataEvent(Event: TDataEvent; Info: Longint); virtual;
  743. procedure DestroyFields; virtual;
  744. procedure DoAfterCancel; virtual;
  745. procedure DoAfterClose; virtual;
  746. procedure DoAfterDelete; virtual;
  747. procedure DoAfterEdit; virtual;
  748. procedure DoAfterInsert; virtual;
  749. procedure DoAfterOpen; virtual;
  750. procedure DoAfterPost; virtual;
  751. procedure DoAfterScroll; virtual;
  752. procedure DoBeforeCancel; virtual;
  753. procedure DoBeforeClose; virtual;
  754. procedure DoBeforeDelete; virtual;
  755. procedure DoBeforeEdit; virtual;
  756. procedure DoBeforeInsert; virtual;
  757. procedure DoBeforeOpen; virtual;
  758. procedure DoBeforePost; virtual;
  759. procedure DoBeforeScroll; virtual;
  760. procedure DoOnCalcFields; virtual;
  761. procedure DoOnNewRecord; virtual;
  762. function FieldByNumber(FieldNo: Longint): TField;
  763. function FindRecord(Restart, GoForward: Boolean): Boolean; virtual;
  764. procedure FreeFieldBuffers; virtual;
  765. function GetBookmarkStr: TBookmarkStr; virtual;
  766. procedure GetCalcFields(Buffer: PChar); virtual;
  767. function GetCanModify: Boolean; virtual;
  768. procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
  769. function GetFieldClass(FieldType: TFieldType): TFieldClass; virtual;
  770. Function GetfieldCount : Integer;
  771. function GetIsIndexField(Field: TField): Boolean; virtual;
  772. function GetNextRecords: Longint; virtual;
  773. function GetNextRecord: Boolean; virtual;
  774. function GetPriorRecords: Longint; virtual;
  775. function GetPriorRecord: Boolean; virtual;
  776. function GetRecordCount: Longint; virtual;
  777. function GetRecNo: Longint; virtual;
  778. procedure InitFieldDefs; virtual;
  779. procedure InitRecord(Buffer: PChar); virtual;
  780. procedure InternalCancel; virtual;
  781. procedure InternalEdit; virtual;
  782. procedure InternalRefresh; virtual;
  783. procedure Loaded; override;
  784. procedure OpenCursor(InfoQuery: Boolean); virtual;
  785. procedure RefreshInternalCalcFields(Buffer: PChar); virtual;
  786. Function RequiredBuffers : longint;
  787. procedure RestoreState(const Value: TDataSetState);
  788. procedure SetBookmarkStr(const Value: TBookmarkStr); virtual;
  789. procedure SetBufListSize(Value: Longint);
  790. procedure SetChildOrder(Component: TComponent; Order: Longint); override;
  791. procedure SetCurrentRecord(Index: Longint); virtual;
  792. procedure SetFiltered(Value: Boolean); virtual;
  793. procedure SetFilterOptions(Value: TFilterOptions); virtual;
  794. procedure SetFilterText(const Value: string); virtual;
  795. procedure SetFound(const Value: Boolean);
  796. procedure SetModified(Value: Boolean);
  797. procedure SetName(const Value: TComponentName); override;
  798. procedure SetOnFilterRecord(const Value: TFilterRecordEvent); virtual;
  799. procedure SetRecNo(Value: Longint); virtual;
  800. procedure SetState(Value: TDataSetState);
  801. function SetTempState(const Value: TDataSetState): TDataSetState;
  802. function TempBuffer: PChar;
  803. procedure UpdateIndexDefs; virtual;
  804. property ActiveRecord: Longint read FActiveRecord;
  805. property CurrentRecord: Longint read FCurrentRecord;
  806. property BlobFieldCount: Longint read FBlobFieldCount;
  807. property BookmarkSize: Longint read FBookmarkSize write FBookmarkSize;
  808. property Buffers[Index: Longint]: PChar read GetBuffer;
  809. property BufferCount: Longint read FBufferCount;
  810. property CalcBuffer: PChar read FCalcBuffer;
  811. property CalcFieldsSize: Longint read FCalcFieldsSize;
  812. property InternalCalcFields: Boolean read FInternalCalcFields;
  813. property Constraints: TCheckConstraints read FConstraints write FConstraints;
  814. protected { abstract methods }
  815. function AllocRecordBuffer: PChar; virtual; abstract;
  816. procedure FreeRecordBuffer(var Buffer: PChar); virtual; abstract;
  817. procedure GetBookmarkData(Buffer: PChar; Data: Pointer); virtual; abstract;
  818. function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; virtual; abstract;
  819. function GetDataSource: TDataSource; virtual;
  820. function GetFieldData(Field: TField; Buffer: Pointer): Boolean; virtual; abstract;
  821. function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; virtual; abstract;
  822. function GetRecordSize: Word; virtual; abstract;
  823. procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); virtual; abstract;
  824. procedure InternalClose; virtual; abstract;
  825. procedure InternalDelete; virtual; abstract;
  826. procedure InternalFirst; virtual; abstract;
  827. procedure InternalGotoBookmark(ABookmark: Pointer); virtual; abstract;
  828. procedure InternalHandleException; virtual; abstract;
  829. procedure InternalInitFieldDefs; virtual; abstract;
  830. procedure InternalInitRecord(Buffer: PChar); virtual; abstract;
  831. procedure InternalLast; virtual; abstract;
  832. procedure InternalOpen; virtual; abstract;
  833. procedure InternalPost; virtual; abstract;
  834. procedure InternalSetToRecord(Buffer: PChar); virtual; abstract;
  835. function IsCursorOpen: Boolean; virtual; abstract;
  836. procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); virtual; abstract;
  837. procedure SetBookmarkData(Buffer: PChar; Data: Pointer); virtual; abstract;
  838. procedure SetFieldData(Field: TField; Buffer: Pointer); virtual; abstract;
  839. public
  840. constructor Create(AOwner: TComponent); override;
  841. destructor Destroy; override;
  842. function ActiveBuffer: PChar;
  843. procedure Append;
  844. procedure AppendRecord(const Values: array of const);
  845. function BookmarkValid(ABookmark: TBookmark): Boolean; virtual;
  846. procedure Cancel; virtual;
  847. procedure CheckBrowseMode;
  848. procedure ClearFields;
  849. procedure Close;
  850. function ControlsDisabled: Boolean;
  851. function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint; virtual;
  852. function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; virtual;
  853. procedure CursorPosChanged;
  854. procedure Delete;
  855. procedure DisableControls;
  856. procedure Edit;
  857. procedure EnableControls;
  858. function FieldByName(const FieldName: string): TField;
  859. function FindField(const FieldName: string): TField;
  860. function FindFirst: Boolean;
  861. function FindLast: Boolean;
  862. function FindNext: Boolean;
  863. function FindPrior: Boolean;
  864. procedure First;
  865. procedure FreeBookmark(ABookmark: TBookmark); virtual;
  866. function GetBookmark: TBookmark; virtual;
  867. function GetCurrentRecord(Buffer: PChar): Boolean; virtual;
  868. procedure GetFieldList(List: TList; const FieldNames: string);
  869. procedure GetFieldNames(List: TStrings);
  870. procedure GotoBookmark(ABookmark: TBookmark);
  871. procedure Insert;
  872. procedure InsertRecord(const Values: array of const);
  873. function IsEmpty: Boolean;
  874. function IsSequenced: Boolean; virtual;
  875. procedure Last;
  876. function MoveBy(Distance: Longint): Longint;
  877. procedure Next;
  878. procedure Open;
  879. procedure Post; virtual;
  880. procedure Prior;
  881. procedure Refresh;
  882. procedure Resync(Mode: TResyncMode); virtual;
  883. procedure SetFields(const Values: array of const);
  884. function Translate(Src, Dest: PChar; ToOem: Boolean): Integer; virtual;
  885. procedure UpdateCursorPos;
  886. procedure UpdateRecord;
  887. property BOF: Boolean read FBOF;
  888. property Bookmark: TBookmarkStr read GetBookmarkStr write SetBookmarkStr;
  889. property CanModify: Boolean read GetCanModify;
  890. property DataSource: TDataSource read GetDataSource;
  891. property DefaultFields: Boolean read FDefaultFields;
  892. property EOF: Boolean read FEOF;
  893. property FieldCount: Longint read GetFieldCount;
  894. property FieldDefs: TFieldDefs read FFieldDefs write FFieldDefs;
  895. // property Fields[Index: Longint]: TField read GetField write SetField;
  896. property Found: Boolean read FFound;
  897. property Modified: Boolean read FModified;
  898. property RecordCount: Longint read GetRecordCount;
  899. property RecNo: Longint read FRecNo write FRecNo;
  900. property RecordSize: Word read FRecordSize;
  901. property State: TDataSetState read FState;
  902. property Fields : TFields Read FFieldList;
  903. property Filter: string read FFilterText write FFilterText;
  904. property Filtered: Boolean read FFiltered write FFiltered default False;
  905. property FilterOptions: TFilterOptions read FFilterOptions write FFilterOptions;
  906. property Active: Boolean read FActive write SetActive default False;
  907. property AutoCalcFields: Boolean read FAutoCalcFields write FAutoCalcFields;
  908. property BeforeOpen: TDataSetNotifyEvent read FBeforeOpen write FBeforeOpen;
  909. property AfterOpen: TDataSetNotifyEvent read FAfterOpen write FAfterOpen;
  910. property BeforeClose: TDataSetNotifyEvent read FBeforeClose write FBeforeClose;
  911. property AfterClose: TDataSetNotifyEvent read FAfterClose write FAfterClose;
  912. property BeforeInsert: TDataSetNotifyEvent read FBeforeInsert write FBeforeInsert;
  913. property AfterInsert: TDataSetNotifyEvent read FAfterInsert write FAfterInsert;
  914. property BeforeEdit: TDataSetNotifyEvent read FBeforeEdit write FBeforeEdit;
  915. property AfterEdit: TDataSetNotifyEvent read FAfterEdit write FAfterEdit;
  916. property BeforePost: TDataSetNotifyEvent read FBeforePost write FBeforePost;
  917. property AfterPost: TDataSetNotifyEvent read FAfterPost write FAfterPost;
  918. property BeforeCancel: TDataSetNotifyEvent read FBeforeCancel write FBeforeCancel;
  919. property AfterCancel: TDataSetNotifyEvent read FAfterCancel write FAfterCancel;
  920. property BeforeDelete: TDataSetNotifyEvent read FBeforeDelete write FBeforeDelete;
  921. property AfterDelete: TDataSetNotifyEvent read FAfterDelete write FAfterDelete;
  922. property BeforeScroll: TDataSetNotifyEvent read FBeforeScroll write FBeforeScroll;
  923. property AfterScroll: TDataSetNotifyEvent read FAfterScroll write FAfterScroll;
  924. property OnCalcFields: TDataSetNotifyEvent read FOnCalcFields write FOnCalcFields;
  925. property OnDeleteError: TDataSetErrorEvent read FOnDeleteError write FOnDeleteError;
  926. property OnEditError: TDataSetErrorEvent read FOnEditError write FOnEditError;
  927. property OnFilterRecord: TFilterRecordEvent read FOnFilterRecord write SetOnFilterRecord;
  928. property OnNewRecord: TDataSetNotifyEvent read FOnNewRecord write FOnNewRecord;
  929. property OnPostError: TDataSetErrorEvent read FOnPostError write FOnPostError;
  930. end;
  931. TDataLink = class(TPersistent)
  932. private
  933. FFIrstRecord,
  934. FBufferCount : Integer;
  935. FActive,
  936. FDataSourceFixed,
  937. FEditing,
  938. FReadOnly,
  939. FUpdatingRecord,
  940. FVisualControl : Boolean;
  941. FDataSource : TDataSource;
  942. Function CalcFirstRecord(Index : Integer) : Integer;
  943. Procedure CalcRange;
  944. Procedure CheckActiveAndEditing;
  945. Function GetDataset : TDataset;
  946. procedure SetActive(AActive: Boolean);
  947. procedure SetDataSource(Value: TDataSource);
  948. Procedure SetReadOnly(Value : Boolean);
  949. protected
  950. procedure ActiveChanged; virtual;
  951. procedure CheckBrowseMode; virtual;
  952. procedure DataEvent(Event: TDataEvent; Info: Longint); virtual;
  953. procedure DataSetChanged; virtual;
  954. procedure DataSetScrolled(Distance: Integer); virtual;
  955. procedure EditingChanged; virtual;
  956. procedure FocusControl(Field: TFieldRef); virtual;
  957. function GetActiveRecord: Integer; virtual;
  958. function GetBOF: Boolean; virtual;
  959. function GetBufferCount: Integer; virtual;
  960. function GetEOF: Boolean; virtual;
  961. function GetRecordCount: Integer; virtual;
  962. procedure LayoutChanged; virtual;
  963. function MoveBy(Distance: Integer): Integer; virtual;
  964. procedure RecordChanged(Field: TField); virtual;
  965. procedure SetActiveRecord(Value: Integer); virtual;
  966. procedure SetBufferCount(Value: Integer); virtual;
  967. procedure UpdateData; virtual;
  968. property VisualControl: Boolean read FVisualControl write FVisualControl;
  969. public
  970. constructor Create;
  971. destructor Destroy; override;
  972. function Edit: Boolean;
  973. procedure UpdateRecord;
  974. property Active: Boolean read FActive;
  975. property ActiveRecord: Integer read GetActiveRecord write SetActiveRecord;
  976. property BOF: Boolean read GetBOF;
  977. property BufferCount: Integer read FBufferCount write SetBufferCount;
  978. property DataSet: TDataSet read GetDataSet;
  979. property DataSource: TDataSource read FDataSource write SetDataSource;
  980. property DataSourceFixed: Boolean read FDataSourceFixed write FDataSourceFixed;
  981. property Editing: Boolean read FEditing;
  982. property Eof: Boolean read GetEOF;
  983. property ReadOnly: Boolean read FReadOnly write SetReadOnly;
  984. property RecordCount: Integer read GetRecordCount;
  985. end;
  986. { TDetailDataLink }
  987. TDetailDataLink = class(TDataLink)
  988. protected
  989. function GetDetailDataSet: TDataSet; virtual;
  990. public
  991. property DetailDataSet: TDataSet read GetDetailDataSet;
  992. end;
  993. { TMasterDataLink }
  994. TMasterDataLink = class(TDetailDataLink)
  995. private
  996. FDataSet: TDataSet;
  997. FFieldNames: string;
  998. FFields: TList;
  999. FOnMasterChange: TNotifyEvent;
  1000. FOnMasterDisable: TNotifyEvent;
  1001. procedure SetFieldNames(const Value: string);
  1002. protected
  1003. procedure ActiveChanged; override;
  1004. procedure CheckBrowseMode; override;
  1005. function GetDetailDataSet: TDataSet; override;
  1006. procedure LayoutChanged; override;
  1007. procedure RecordChanged(Field: TField); override;
  1008. public
  1009. constructor Create(ADataSet: TDataSet);
  1010. destructor Destroy; override;
  1011. property FieldNames: string read FFieldNames write SetFieldNames;
  1012. property Fields: TList read FFields;
  1013. property OnMasterChange: TNotifyEvent read FOnMasterChange write FOnMasterChange;
  1014. property OnMasterDisable: TNotifyEvent read FOnMasterDisable write FOnMasterDisable;
  1015. end;
  1016. { TDataSource }
  1017. TDataChangeEvent = procedure(Sender: TObject; Field: TField) of object;
  1018. TDataSource = class(TComponent)
  1019. private
  1020. FDataSet: TDataSet;
  1021. FDataLinks: TList;
  1022. FEnabled: Boolean;
  1023. FAutoEdit: Boolean;
  1024. FState: TDataSetState;
  1025. FOnStateChange: TNotifyEvent;
  1026. FOnDataChange: TDataChangeEvent;
  1027. FOnUpdateData: TNotifyEvent;
  1028. procedure DistributeEvent(Event: TDataEvent; Info: Longint);
  1029. procedure RegisterDataLink(DataLink: TDataLink);
  1030. Procedure ProcessEvent(Event : TDataEvent; Info : longint);
  1031. procedure SetDataSet(ADataSet: TDataSet);
  1032. procedure SetEnabled(Value: Boolean);
  1033. procedure UnregisterDataLink(DataLink: TDataLink);
  1034. protected
  1035. Procedure DoDataChange (Info : Pointer);virtual;
  1036. Procedure DoStateChange; virtual;
  1037. Procedure DoUpdateData;
  1038. property DataLinks: TList read FDataLinks;
  1039. public
  1040. constructor Create(AOwner: TComponent); override;
  1041. destructor Destroy; override;
  1042. procedure Edit;
  1043. function IsLinkedTo(ADataSet: TDataSet): Boolean;
  1044. property State: TDataSetState read FState;
  1045. published
  1046. property AutoEdit: Boolean read FAutoEdit write FAutoEdit default True;
  1047. property DataSet: TDataSet read FDataSet write SetDataSet;
  1048. property Enabled: Boolean read FEnabled write SetEnabled default True;
  1049. property OnStateChange: TNotifyEvent read FOnStateChange write FOnStateChange;
  1050. property OnDataChange: TDataChangeEvent read FOnDataChange write FOnDataChange;
  1051. property OnUpdateData: TNotifyEvent read FOnUpdateData write FOnUpdateData;
  1052. end;
  1053. { TDBDataset }
  1054. TDBDatasetClass = Class of TDBDataset;
  1055. TDBDataset = Class(TDataset)
  1056. Private
  1057. FDatabase : TDatabase;
  1058. Procedure SetDatabase (Value : TDatabase);
  1059. Protected
  1060. Procedure CheckDatabase;
  1061. Public
  1062. Destructor destroy; override;
  1063. Property DataBase : TDatabase Read FDatabase Write SetDatabase;
  1064. end;
  1065. { TDatabase }
  1066. TLoginEvent = procedure(Database: TDatabase;
  1067. LoginParams: TStrings) of object;
  1068. TDatabaseClass = Class Of TDatabase;
  1069. TDatabase = class(TComponent)
  1070. private
  1071. FConnected : Boolean;
  1072. FDataBaseName : String;
  1073. FDataSets : TList;
  1074. FDirectory : String;
  1075. FKeepConnection : Boolean;
  1076. FLoginPrompt : Boolean;
  1077. FOnLogin : TLoginEvent;
  1078. FParams : TStrings;
  1079. FSQLBased : Boolean;
  1080. Function GetDataSetCount : Longint;
  1081. Function GetDataset(Index : longint) : TDBDataset;
  1082. procedure SetConnected (Value : boolean);
  1083. procedure RegisterDataset (DS : TDBDataset);
  1084. procedure UnRegisterDataset (DS : TDBDataset);
  1085. procedure RemoveDataSets;
  1086. protected
  1087. Procedure CheckConnected;
  1088. Procedure CheckDisConnected;
  1089. procedure Loaded; override;
  1090. procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  1091. Procedure DoInternalConnect; Virtual;Abstract;
  1092. Procedure DoInternalDisConnect; Virtual;Abstract;
  1093. public
  1094. constructor Create(AOwner: TComponent); override;
  1095. destructor Destroy; override;
  1096. procedure Close;
  1097. procedure Open;
  1098. procedure CloseDataSets;
  1099. procedure StartTransaction; virtual; abstract;
  1100. procedure EndTransaction; virtual; abstract;
  1101. property DataSetCount: Longint read GetDataSetCount;
  1102. property DataSets[Index: Longint]: TDBDataSet read GetDataSet;
  1103. property Directory: string read FDirectory write FDirectory;
  1104. property IsSQLBased: Boolean read FSQLBased;
  1105. published
  1106. property Connected: Boolean read FConnected write SetConnected;
  1107. property DatabaseName: string read FDatabaseName write FDatabaseName;
  1108. property KeepConnection: Boolean read FKeepConnection write FKeepConnection;
  1109. property LoginPrompt: Boolean read FLoginPrompt write FLoginPrompt;
  1110. property Params : TStrings read FParams Write FParams;
  1111. property OnLogin: TLoginEvent read FOnLogin write FOnLogin;
  1112. end;
  1113. Const
  1114. Fieldtypenames : Array [TFieldType] of String[15] =
  1115. (
  1116. 'Unknown',
  1117. 'String',
  1118. 'Smallint',
  1119. 'Integer',
  1120. 'Word',
  1121. 'Boolean',
  1122. 'Float',
  1123. 'Currency',
  1124. 'BCD',
  1125. 'Date',
  1126. 'Time',
  1127. 'DateTime',
  1128. 'Bytes',
  1129. 'VarBytes',
  1130. 'AutoInc',
  1131. 'Blob',
  1132. 'Memo',
  1133. 'Graphic',
  1134. 'FmtMemo',
  1135. 'ParadoxOle',
  1136. 'DBaseOle',
  1137. 'TypedBinary',
  1138. 'Cursor',
  1139. 'FixedChar',
  1140. 'WideString',
  1141. 'Largeint',
  1142. 'ADT',
  1143. 'Array',
  1144. 'Reference',
  1145. 'DataSet',
  1146. 'OraBlob',
  1147. 'OraClob',
  1148. 'Variant',
  1149. 'Interface',
  1150. 'IDispatch',
  1151. 'Guid',
  1152. 'TimeStamp',
  1153. 'FMTBcd'
  1154. );
  1155. { 'Unknown',
  1156. 'String',
  1157. 'Smallint',
  1158. 'Integer',
  1159. 'Word',
  1160. 'Boolean',
  1161. 'Float',
  1162. 'Date',
  1163. 'Time',
  1164. 'DateTime',
  1165. 'Bytes',
  1166. 'VarBytes',
  1167. 'AutoInc',
  1168. 'Blob',
  1169. 'Memo',
  1170. 'Graphic',
  1171. 'FmtMemo',
  1172. 'ParadoxOle',
  1173. 'DBaseOle',
  1174. 'TypedBinary',
  1175. 'Cursor'
  1176. );}
  1177. dsEditModes = [dsEdit, dsInsert];
  1178. { Auxiliary functions }
  1179. Procedure DatabaseError (Const Msg : String);
  1180. Procedure DatabaseError (Const Msg : String; Comp : TComponent);
  1181. Procedure DatabaseErrorFmt (Const Fmt : String; Args : Array Of Const);
  1182. Procedure DatabaseErrorFmt (Const Fmt : String; Args : Array Of const;
  1183. Comp : TComponent);
  1184. implementation
  1185. { ---------------------------------------------------------------------
  1186. Auxiliary functions
  1187. ---------------------------------------------------------------------}
  1188. Procedure DatabaseError (Const Msg : String);
  1189. begin
  1190. Raise EDataBaseError.Create(Msg);
  1191. end;
  1192. Procedure DatabaseError (Const Msg : String; Comp : TComponent);
  1193. begin
  1194. Raise EDatabaseError.CreateFmt('%s : %s',[Comp.Name,Msg]);
  1195. end;
  1196. Procedure DatabaseErrorFmt (Const Fmt : String; Args : Array Of Const);
  1197. begin
  1198. Raise EDatabaseError.CreateFmt(Fmt,Args);
  1199. end;
  1200. Procedure DatabaseErrorFmt (Const Fmt : String; Args : Array Of const;
  1201. Comp : TComponent);
  1202. begin
  1203. Raise EDatabaseError.CreateFmt(Format('%s : %s',[Comp.Name,Fmt]),Args);
  1204. end;
  1205. {$i dbs.inc}
  1206. { TIndexDef }
  1207. constructor TIndexDef.Create(Owner: TIndexDefs; const AName, TheFields: string;
  1208. TheOptions: TIndexOptions);
  1209. begin
  1210. //!! To be implemented
  1211. end;
  1212. destructor TIndexDef.Destroy;
  1213. begin
  1214. //!! To be implemented
  1215. end;
  1216. { TIndexDefs }
  1217. Function TIndexDefs.GetItem (Index : longint) : TindexDef;
  1218. begin
  1219. //!! To be implemented
  1220. end;
  1221. constructor TIndexDefs.Create(DataSet: TDataSet);
  1222. begin
  1223. //!! To be implemented
  1224. end;
  1225. destructor TIndexDefs.Destroy;
  1226. begin
  1227. //!! To be implemented
  1228. end;
  1229. procedure TIndexDefs.Add(const Name, Fields: string; Options: TIndexOptions);
  1230. begin
  1231. //!! To be implemented
  1232. end;
  1233. procedure TIndexDefs.Assign(IndexDefs: TIndexDefs);
  1234. begin
  1235. //!! To be implemented
  1236. end;
  1237. procedure TIndexDefs.Clear;
  1238. begin
  1239. //!! To be implemented
  1240. end;
  1241. function TIndexDefs.FindIndexForFields(const Fields: string): TIndexDef;
  1242. begin
  1243. //!! To be implemented
  1244. end;
  1245. function TIndexDefs.GetIndexForFields(const Fields: string;
  1246. CaseInsensitive: Boolean): TIndexDef;
  1247. begin
  1248. //!! To be implemented
  1249. end;
  1250. function TIndexDefs.IndexOf(const Name: string): Longint;
  1251. begin
  1252. //!! To be implemented
  1253. end;
  1254. procedure TIndexDefs.Update;
  1255. begin
  1256. //!! To be implemented
  1257. end;
  1258. { TCheckConstraint }
  1259. procedure TCheckConstraint.Assign(Source: TPersistent);
  1260. begin
  1261. //!! To be implemented
  1262. end;
  1263. { TCheckConstraints }
  1264. Function TCheckConstraints.GetItem(Index : Longint) : TCheckConstraint;
  1265. begin
  1266. //!! To be implemented
  1267. end;
  1268. Procedure TCheckConstraints.SetItem(index : Longint; Value : TCheckConstraint);
  1269. begin
  1270. //!! To be implemented
  1271. end;
  1272. function TCheckConstraints.GetOwner: TPersistent;
  1273. begin
  1274. //!! To be implemented
  1275. end;
  1276. constructor TCheckConstraints.Create(Owner: TPersistent);
  1277. begin
  1278. //!! To be implemented
  1279. end;
  1280. function TCheckConstraints.Add: TCheckConstraint;
  1281. begin
  1282. //!! To be implemented
  1283. end;
  1284. {$i dataset.inc}
  1285. {$i fields.inc}
  1286. {$i datasource.inc}
  1287. {$i database.inc}
  1288. end.
  1289. {
  1290. $Log$
  1291. Revision 1.15 2004-03-25 20:43:39 michael
  1292. Some compatibility additions
  1293. Revision 1.14 2004/03/19 23:19:51 michael
  1294. + Corrected the Fields property.
  1295. Revision 1.13 2004/02/25 16:29:26 michael
  1296. + Added AsInteger to TField. Maps to AsLongint for now
  1297. Revision 1.12 2003/11/09 21:23:10 michael
  1298. + Patch from Micha Nelissen, fixing some Delphi compatibility issues
  1299. Revision 1.11 2003/10/06 17:04:27 florian
  1300. * small step towards calculated fields
  1301. Revision 1.10 2003/08/16 16:42:21 michael
  1302. + Fixes in TDBDataset etc. Changed MySQLDb to use database as well
  1303. Revision 1.9 2003/05/15 15:15:15 michael
  1304. + Database class in TDBDataset is public, not published
  1305. Revision 1.8 2003/05/08 21:52:41 michael
  1306. + Patch from Jesus Reyes
  1307. Revision 1.7 2003/02/20 19:30:28 michael
  1308. + Fixes from Jesus Reyes
  1309. Revision 1.6 2002/09/07 15:15:23 peter
  1310. * old logs removed and tabs fixed
  1311. }