db.pp 47 KB

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