db.pp 70 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006
  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,Variants;
  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. {$ifdef ver1_0}
  26. PtrInt = Longint;
  27. PPtrInt = ^PtrInt;
  28. {$endif}
  29. {LargeInt}
  30. LargeInt = Int64;
  31. { Auxiliary type }
  32. TStringFieldBuffer = Array[0..dsMaxStringSize] of Char;
  33. { Misc Dataset types }
  34. TDataSetState = (dsInactive, dsBrowse, dsEdit, dsInsert, dsSetKey,
  35. dsCalcFields, dsFilter, dsNewValue, dsOldValue, dsCurValue);
  36. TDataEvent = (deFieldChange, deRecordChange, deDataSetChange,
  37. deDataSetScroll, deLayoutChange, deUpdateRecord, deUpdateState,
  38. deCheckBrowseMode, dePropertyChange, deFieldListChange, deFocusControl);
  39. TUpdateStatus = (usUnmodified, usModified, usInserted, usDeleted);
  40. TUpdateMode = (upWhereAll, upWhereChanged, upWhereKeyOnly);
  41. TProviderFlag = (pfInUpdate, pfInWhere, pfInKey, pfHidden);
  42. TProviderFlags = set of TProviderFlag;
  43. { Forward declarations }
  44. TFieldDef = class;
  45. TFieldDefs = class;
  46. TField = class;
  47. TFields = Class;
  48. TDataSet = class;
  49. TDataBase = Class;
  50. TDatasource = Class;
  51. TDatalink = Class;
  52. TDBTransaction = Class;
  53. { Exception classes }
  54. EDatabaseError = class(Exception);
  55. { TFieldDef }
  56. TFieldClass = class of TField;
  57. {
  58. TFieldType = (ftUnknown, ftString, ftSmallint, ftInteger, ftWord,
  59. ftBoolean, ftFloat, ftDate, ftTime, ftDateTime,
  60. ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic,
  61. ftFmtMemo, ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor);
  62. }
  63. TFieldType = (ftUnknown, ftString, ftSmallint, ftInteger, ftWord,
  64. ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime,
  65. ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic, ftFmtMemo,
  66. ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftFixedChar,
  67. ftWideString, ftLargeint, ftADT, ftArray, ftReference,
  68. ftDataSet, ftOraBlob, ftOraClob, ftVariant, ftInterface,
  69. ftIDispatch, ftGuid, ftTimeStamp, ftFMTBcd);
  70. { TDateTimeRec }
  71. TDateTimeAlias = type TDateTime;
  72. TDateTimeRec = record
  73. case TFieldType of
  74. ftDate: (Date: Longint);
  75. ftTime: (Time: Longint);
  76. ftDateTime: (DateTime: TDateTimeAlias);
  77. end;
  78. TFieldAttribute = (faHiddenCol, faReadonly, faRequired, faLink, faUnNamed, faFixed);
  79. TFieldAttributes = set of TFieldAttribute;
  80. TFieldDef = class(TComponent)
  81. Private
  82. FDataType : TFieldType;
  83. FFieldNo : Longint;
  84. FInternalCalcField : Boolean;
  85. FPrecision : Longint;
  86. FRequired : Boolean;
  87. FSize : Word;
  88. FName : String;
  89. FDisplayName : String;
  90. FAttributes : TFieldAttributes;
  91. Function GetFieldClass : TFieldClass;
  92. public
  93. constructor Create(AOwner: TFieldDefs; const AName: string;
  94. ADataType: TFieldType; ASize: Word; ARequired: Boolean; AFieldNo: Longint);
  95. destructor Destroy; override;
  96. function CreateField(AOwner: TComponent): TField;
  97. property FieldClass: TFieldClass read GetFieldClass;
  98. property FieldNo: Longint read FFieldNo;
  99. property InternalCalcField: Boolean read FInternalCalcField write FInternalCalcField;
  100. property Required: Boolean read FRequired;
  101. Published
  102. property Attributes: TFieldAttributes read FAttributes write FAttributes default [];
  103. property Name: string read FName write FName; // Must move to TNamedItem
  104. property DisplayName : string read FDisplayName write FDisplayName; // Must move to TNamedItem
  105. property DataType: TFieldType read FDataType write FDataType;
  106. property Precision: Longint read FPrecision write FPrecision;
  107. property Size: Word read FSize write FSize;
  108. end;
  109. { TFieldDefs }
  110. TFieldDefs = class(TComponent)
  111. private
  112. FDataSet: TDataSet;
  113. FItems: TList;
  114. FUpdated: Boolean;
  115. FHiddenFields : Boolean;
  116. function GetCount: Longint;
  117. function GetItem(Index: Longint): TFieldDef;
  118. public
  119. constructor Create(ADataSet: TDataSet);
  120. destructor Destroy; override;
  121. procedure Add(const AName: string; ADataType: TFieldType; ASize: Word; ARequired: Boolean);
  122. procedure Add(const AName: string; ADataType: TFieldType; ASize: Word);
  123. procedure Add(const AName: string; ADataType: TFieldType);
  124. Function AddFieldDef : TFieldDef;
  125. procedure Assign(FieldDefs: TFieldDefs);
  126. procedure Clear;
  127. function Find(const AName: string): TFieldDef;
  128. function IndexOf(const AName: string): Longint;
  129. procedure Update;
  130. property Count: Longint read GetCount;
  131. Property HiddenFields : Boolean Read FHiddenFields Write FHiddenFields;
  132. property Items[Index: Longint]: TFieldDef read GetItem; default;
  133. end;
  134. { TField }
  135. TFieldKind = (fkData, fkCalculated, fkLookup, fkInternalCalc);
  136. TFieldKinds = Set of TFieldKind;
  137. TFieldNotifyEvent = procedure(Sender: TField) of object;
  138. TFieldGetTextEvent = procedure(Sender: TField; var Text: string;
  139. DisplayText: Boolean) of object;
  140. TFieldSetTextEvent = procedure(Sender: TField; const Text: string) of object;
  141. TFieldRef = ^TField;
  142. TFieldChars = set of Char;
  143. TField = class(TComponent)
  144. Private
  145. FAlignMent : TAlignment;
  146. FAttributeSet : String;
  147. FBuffers : ppchar;
  148. FCalculated : Boolean;
  149. FCanModify : Boolean;
  150. FConstraintErrorMessage : String;
  151. FCustomConstraint : String;
  152. FDataSet : TDataSet;
  153. // FDataSize : Word;
  154. FDataType : TFieldType;
  155. FDefaultExpression : String;
  156. FDisplayLabel : String;
  157. FDisplayWidth : Longint;
  158. FEditText : String;
  159. FFieldKind : TFieldKind;
  160. FFieldName : String;
  161. FFieldNo : Longint;
  162. FFields : TFields;
  163. FHasConstraints : Boolean;
  164. FImportedConstraint : String;
  165. FIsIndexField : Boolean;
  166. FKeyFields : String;
  167. FLookupCache : Boolean;
  168. FLookupDataSet : TDataSet;
  169. FLookupKeyfields : String;
  170. FLookupresultField : String;
  171. FOffset : Word;
  172. FOnChange : TFieldNotifyEvent;
  173. FOnGetText: TFieldGetTextEvent;
  174. FOnSetText: TFieldSetTextEvent;
  175. FOnValidate: TFieldNotifyEvent;
  176. FOrigin : String;
  177. FReadOnly : Boolean;
  178. FRequired : Boolean;
  179. FSize : Word;
  180. FValidChars : TFieldChars;
  181. FValueBuffer : Pointer;
  182. FValidating : Boolean;
  183. FVisible : Boolean;
  184. FProviderFlags : TProviderFlags;
  185. Function GetIndex : longint;
  186. procedure SetAlignment(const AValue: TAlignMent);
  187. Procedure SetDataset(Value : TDataset);
  188. function GetDisplayText: String;
  189. procedure SetDisplayLabel(const AValue: string);
  190. procedure SetDisplayWidth(const AValue: Longint);
  191. function GetDisplayWidth: integer;
  192. procedure SetReadOnly(const AValue: Boolean);
  193. procedure SetVisible(const AValue: Boolean);
  194. function IsDisplayStored : Boolean;
  195. protected
  196. function AccessError(const TypeName: string): EDatabaseError;
  197. procedure CheckInactive;
  198. class procedure CheckTypeSize(AValue: Longint); virtual;
  199. procedure Change; virtual;
  200. procedure DataChanged;
  201. procedure FreeBuffers; virtual;
  202. function GetAsBoolean: Boolean; virtual;
  203. function GetAsDateTime: TDateTime; virtual;
  204. function GetAsFloat: Double; virtual;
  205. function GetAsLongint: Longint; virtual;
  206. function GetAsInteger: Longint; virtual;
  207. function GetAsVariant: variant; virtual;
  208. function GetOldValue: variant; virtual;
  209. function GetAsString: string; virtual;
  210. function GetCanModify: Boolean; virtual;
  211. function GetDataSize: Word; virtual;
  212. function GetDefaultWidth: Longint; virtual;
  213. function GetDisplayName : String;
  214. function GetIsNull: Boolean; virtual;
  215. function GetParentComponent: TComponent; override;
  216. procedure GetText(var AText: string; ADisplayText: Boolean); virtual;
  217. function HasParent: Boolean; override;
  218. procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  219. procedure PropertyChanged(LayoutAffected: Boolean);
  220. procedure ReadState(Reader: TReader); override;
  221. procedure SetAsBoolean(AValue: Boolean); virtual;
  222. procedure SetAsDateTime(AValue: TDateTime); virtual;
  223. procedure SetAsFloat(AValue: Double); virtual;
  224. procedure SetAsLongint(AValue: Longint); virtual;
  225. procedure SetAsInteger(AValue: Integer); virtual;
  226. procedure SetAsVariant(AValue: variant); virtual;
  227. procedure SetAsString(const AValue: string); virtual;
  228. procedure SetDataType(AValue: TFieldType);
  229. procedure SetSize(AValue: Word); virtual;
  230. procedure SetParentComponent(AParent: TComponent); override;
  231. procedure SetText(const AValue: string); virtual;
  232. public
  233. constructor Create(AOwner: TComponent); override;
  234. destructor Destroy; override;
  235. procedure Assign(Source: TPersistent); override;
  236. procedure Clear; virtual;
  237. procedure FocusControl;
  238. function GetData(Buffer: Pointer): Boolean;
  239. class function IsBlob: Boolean; virtual;
  240. function IsValidChar(InputChar: Char): Boolean; virtual;
  241. procedure SetData(Buffer: Pointer);
  242. procedure SetFieldType(AValue: TFieldType); virtual;
  243. procedure Validate(Buffer: Pointer);
  244. property AsBoolean: Boolean read GetAsBoolean write SetAsBoolean;
  245. property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
  246. property AsFloat: Double read GetAsFloat write SetAsFloat;
  247. property AsLongint: Longint read GetAsLongint write SetAsLongint;
  248. property AsInteger: Integer read GetAsInteger write SetAsInteger;
  249. property AsString: string read GetAsString write SetAsString;
  250. property AttributeSet: string read FAttributeSet write FAttributeSet;
  251. property Calculated: Boolean read FCalculated write FCalculated;
  252. property CanModify: Boolean read FCanModify;
  253. property DataSet: TDataSet read FDataSet write SetDataSet;
  254. property DataSize: Word read GetDataSize;
  255. property DataType: TFieldType read FDataType;
  256. property DisplayName: String Read GetDisplayName;
  257. property DisplayText: String read GetDisplayText;
  258. property FieldNo: Longint read FFieldNo;
  259. property IsIndexField: Boolean read FIsIndexField;
  260. property IsNull: Boolean read GetIsNull;
  261. property Offset: word read FOffset;
  262. property Size: Word read FSize write FSize;
  263. property Text: string read FEditText write FEditText;
  264. property ValidChars : TFieldChars Read FValidChars;
  265. property Value: variant read GetAsVariant write SetAsVariant;
  266. property OldValue: variant read GetOldValue;
  267. property ProviderFlags : TProviderFlags read FProviderFlags write FProviderFlags;
  268. published
  269. property AlignMent : TAlignMent Read FAlignMent write SetAlignment;
  270. property CustomConstraint: string read FCustomConstraint write FCustomConstraint;
  271. property ConstraintErrorMessage: string read FConstraintErrorMessage write FConstraintErrorMessage;
  272. property DefaultExpression: string read FDefaultExpression write FDefaultExpression;
  273. property DisplayLabel : string read GetDisplayName write SetDisplayLabel stored IsDisplayStored;
  274. property DisplayWidth: Longint read GetDisplayWidth write SetDisplayWidth;
  275. property FieldKind: TFieldKind read FFieldKind write FFieldKind;
  276. property FieldName: string read FFieldName write FFieldName;
  277. property HasConstraints: Boolean read FHasConstraints;
  278. property Index: Longint read GetIndex;
  279. property ImportedConstraint: string read FImportedConstraint write FImportedConstraint;
  280. property LookupDataSet: TDataSet read FLookupDataSet write FLookupDataSet;
  281. property LookupKeyFields: string read FLookupKeyFields write FLookupKeyFields;
  282. property LookupResultField: string read FLookupResultField write FLookupResultField;
  283. property KeyFields: string read FKeyFields write FKeyFields;
  284. property LookupCache: Boolean read FLookupCache write FLookupCache;
  285. property Origin: string read FOrigin write FOrigin;
  286. property ReadOnly: Boolean read FReadOnly write SetReadOnly;
  287. property Required: Boolean read FRequired write FRequired;
  288. property Visible: Boolean read FVisible write SetVisible;
  289. property OnChange: TFieldNotifyEvent read FOnChange write FOnChange;
  290. property OnGetText: TFieldGetTextEvent read FOnGetText write FOnGetText;
  291. property OnSetText: TFieldSetTextEvent read FOnSetText write FOnSetText;
  292. property OnValidate: TFieldNotifyEvent read FOnValidate write FOnValidate;
  293. end;
  294. { TStringField }
  295. TStringField = class(TField)
  296. protected
  297. class procedure CheckTypeSize(AValue: Longint); override;
  298. function GetAsBoolean: Boolean; override;
  299. function GetAsDateTime: TDateTime; override;
  300. function GetAsFloat: Double; override;
  301. function GetAsLongint: Longint; override;
  302. function GetAsString: string; override;
  303. function GetAsVariant: variant; override;
  304. function GetDataSize: Word; override;
  305. function GetDefaultWidth: Longint; override;
  306. procedure GetText(var AText: string; ADisplayText: Boolean); override;
  307. function GetValue(var AValue: string): Boolean;
  308. procedure SetAsBoolean(AValue: Boolean); override;
  309. procedure SetAsDateTime(AValue: TDateTime); override;
  310. procedure SetAsFloat(AValue: Double); override;
  311. procedure SetAsLongint(AValue: Longint); override;
  312. procedure SetAsString(const AValue: string); override;
  313. public
  314. constructor Create(AOwner: TComponent); override;
  315. published
  316. property Size default 20;
  317. end;
  318. { TNumericField }
  319. TNumericField = class(TField)
  320. Private
  321. FDisplayFormat : String;
  322. FEditFormat : String;
  323. protected
  324. procedure RangeError(AValue, Min, Max: Double);
  325. procedure SetDisplayFormat(const AValue: string);
  326. procedure SetEditFormat(const AValue: string);
  327. public
  328. constructor Create(AOwner: TComponent); override;
  329. published
  330. property DisplayFormat: string read FDisplayFormat write SetDisplayFormat;
  331. property EditFormat: string read FEditFormat write SetEditFormat;
  332. end;
  333. { TLongintField }
  334. TLongintField = class(TNumericField)
  335. private
  336. FMinValue,
  337. FMaxValue,
  338. FMinRange,
  339. FMAxRange : Longint;
  340. Procedure SetMinValue (AValue : longint);
  341. Procedure SetMaxValue (AValue : longint);
  342. protected
  343. function GetAsFloat: Double; override;
  344. function GetAsLongint: Longint; override;
  345. function GetAsString: string; override;
  346. function GetAsVariant: variant; override;
  347. function GetDataSize: Word; override;
  348. procedure GetText(var AText: string; ADisplayText: Boolean); override;
  349. function GetValue(var AValue: Longint): Boolean;
  350. procedure SetAsFloat(AValue: Double); override;
  351. procedure SetAsLongint(AValue: Longint); override;
  352. procedure SetAsString(const AValue: string); override;
  353. procedure SetAsVariant(AValue: variant); override;
  354. public
  355. constructor Create(AOwner: TComponent); override;
  356. Function CheckRange(AValue : longint) : Boolean;
  357. property Value: Longint read GetAsLongint write SetAsLongint;
  358. published
  359. property MaxValue: Longint read FMaxValue write SetMaxValue default 0;
  360. property MinValue: Longint read FMinValue write SetMinValue default 0;
  361. end;
  362. TIntegerField = TLongintField;
  363. { TLargeintField }
  364. TLargeintField = class(TNumericField)
  365. private
  366. FMinValue,
  367. FMaxValue,
  368. FMinRange,
  369. FMAxRange : Largeint;
  370. Procedure SetMinValue (AValue : Largeint);
  371. Procedure SetMaxValue (AValue : Largeint);
  372. protected
  373. function GetAsFloat: Double; override;
  374. function GetAsLongint: Longint; override;
  375. function GetAsLargeint: Largeint; virtual;
  376. function GetAsString: string; override;
  377. function GetAsVariant: variant; override;
  378. function GetDataSize: Word; override;
  379. procedure GetText(var AText: string; ADisplayText: Boolean); override;
  380. function GetValue(var AValue: Largeint): Boolean;
  381. procedure SetAsFloat(AValue: Double); override;
  382. procedure SetAsLongint(AValue: Longint); override;
  383. procedure SetAsLargeint(AValue: Largeint); virtual;
  384. procedure SetAsString(const AValue: string); override;
  385. public
  386. constructor Create(AOwner: TComponent); override;
  387. Function CheckRange(AValue : largeint) : Boolean;
  388. property Value: Longint read GetAsLongint write SetAsLongint;
  389. published
  390. property MaxValue: Largeint read FMaxValue write SetMaxValue default 0;
  391. property MinValue: Largeint read FMinValue write SetMinValue default 0;
  392. end;
  393. { TSmallintField }
  394. TSmallintField = class(TLongintField)
  395. protected
  396. function GetDataSize: Word; override;
  397. public
  398. constructor Create(AOwner: TComponent); override;
  399. end;
  400. { TWordField }
  401. TWordField = class(TLongintField)
  402. protected
  403. function GetDataSize: Word; override;
  404. public
  405. constructor Create(AOwner: TComponent); override;
  406. end;
  407. { TAutoIncField }
  408. TAutoIncField = class(TLongintField)
  409. Protected
  410. Procedure SetAsLongInt(AValue : Longint); override;
  411. public
  412. constructor Create(AOwner: TComponent); override;
  413. end;
  414. { TFloatField }
  415. TFloatField = class(TNumericField)
  416. private
  417. FMaxValue : Double;
  418. FMinValue : Double;
  419. FPrecision : Longint;
  420. protected
  421. function GetAsFloat: Double; override;
  422. function GetAsLongint: Longint; override;
  423. function GetAsVariant: variant; override;
  424. function GetAsString: string; override;
  425. function GetDataSize: Word; override;
  426. procedure GetText(var theText: string; ADisplayText: Boolean); override;
  427. procedure SetAsFloat(AValue: Double); override;
  428. procedure SetAsLongint(AValue: Longint); override;
  429. procedure SetAsString(const AValue: string); override;
  430. public
  431. constructor Create(AOwner: TComponent); override;
  432. Function CheckRange(AValue : Double) : Boolean;
  433. property Value: Double read GetAsFloat write SetAsFloat;
  434. published
  435. property MaxValue: Double read FMaxValue write FMaxValue;
  436. property MinValue: Double read FMinValue write FMinValue;
  437. property Precision: Longint read FPrecision write FPrecision default 15;
  438. end;
  439. { TBooleanField }
  440. TBooleanField = class(TField)
  441. private
  442. FDisplayValues : String;
  443. // First byte indicates uppercase or not.
  444. FDisplays : Array[Boolean,Boolean] of string;
  445. Procedure SetDisplayValues(AValue : String);
  446. protected
  447. function GetAsBoolean: Boolean; override;
  448. function GetAsString: string; override;
  449. function GetAsVariant: variant; override;
  450. function GetDataSize: Word; override;
  451. function GetDefaultWidth: Longint; override;
  452. procedure SetAsBoolean(AValue: Boolean); override;
  453. procedure SetAsString(const AValue: string); override;
  454. public
  455. constructor Create(AOwner: TComponent); override;
  456. property Value: Boolean read GetAsBoolean write SetAsBoolean;
  457. published
  458. property DisplayValues: string read FDisplayValues write SetDisplayValues;
  459. end;
  460. { TDateTimeField }
  461. TDateTimeField = class(TField)
  462. private
  463. FDisplayFormat : String;
  464. protected
  465. function GetAsDateTime: TDateTime; override;
  466. function GetAsFloat: Double; override;
  467. function GetAsString: string; override;
  468. function GetAsVariant: variant; override;
  469. function GetDataSize: Word; override;
  470. procedure GetText(var theText: string; ADisplayText: Boolean); override;
  471. procedure SetAsDateTime(AValue: TDateTime); override;
  472. procedure SetAsFloat(AValue: Double); override;
  473. procedure SetAsString(const AValue: string); override;
  474. public
  475. constructor Create(AOwner: TComponent); override;
  476. property Value: TDateTime read GetAsDateTime write SetAsDateTime;
  477. published
  478. property DisplayFormat: string read FDisplayFormat write FDisplayFormat;
  479. end;
  480. { TDateField }
  481. TDateField = class(TDateTimeField)
  482. protected
  483. function GetDataSize: Word; override;
  484. public
  485. constructor Create(AOwner: TComponent); override;
  486. end;
  487. { TTimeField }
  488. TTimeField = class(TDateTimeField)
  489. protected
  490. function GetDataSize: Word; override;
  491. public
  492. constructor Create(AOwner: TComponent); override;
  493. end;
  494. { TBinaryField }
  495. TBinaryField = class(TField)
  496. protected
  497. class procedure CheckTypeSize(AValue: Longint); override;
  498. function GetAsString: string; 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. published
  505. property Size default 16;
  506. end;
  507. { TBytesField }
  508. TBytesField = class(TBinaryField)
  509. protected
  510. function GetDataSize: Word; override;
  511. public
  512. constructor Create(AOwner: TComponent); override;
  513. end;
  514. { TVarBytesField }
  515. TVarBytesField = class(TBytesField)
  516. protected
  517. function GetDataSize: Word; override;
  518. public
  519. constructor Create(AOwner: TComponent); override;
  520. end;
  521. { TBCDField }
  522. TBCDField = class(TNumericField)
  523. private
  524. FMinValue,
  525. FMaxValue : currency;
  526. FPrecision : Longint;
  527. FCurrency : boolean;
  528. protected
  529. class procedure CheckTypeSize(AValue: Longint); override;
  530. function GetAsCurrency: Currency; virtual;
  531. function GetAsFloat: Double; override;
  532. function GetAsLongint: Longint; override;
  533. function GetAsString: string; override;
  534. function GetAsVariant: variant; override;
  535. function GetDataSize: Word; override;
  536. function GetDefaultWidth: Longint; override;
  537. procedure GetText(var TheText: string; ADisplayText: Boolean); override;
  538. procedure SetAsFloat(AValue: Double); override;
  539. procedure SetAsLongint(AValue: Longint); override;
  540. procedure SetAsString(const AValue: string); override;
  541. procedure SetAsCurrency(AValue: Currency); virtual;
  542. public
  543. constructor Create(AOwner: TComponent); override;
  544. Function CheckRange(AValue : Currency) : Boolean;
  545. property Value: Longint read GetAsLongint write SetAsLongint;
  546. published
  547. property Precision: Longint read FPrecision write FPrecision;
  548. property Currency: Boolean read FCurrency write FCurrency;
  549. property MaxValue: Currency read FMaxValue write FMaxValue;
  550. property MinValue: Currency read FMinValue write FMinValue;
  551. property Size default 4;
  552. end;
  553. { TBlobField }
  554. TBlobStreamMode = (bmRead, bmWrite, bmReadWrite);
  555. TBlobType = ftBlob..ftTypedBinary;
  556. TBlobField = class(TField)
  557. private
  558. FBlobSize : Longint;
  559. FBlobType : TBlobType;
  560. FModified : Boolean;
  561. FTransliterate : Boolean;
  562. Function GetBlobStream (Mode : TBlobStreamMode) : TStream;
  563. protected
  564. procedure AssignTo(Dest: TPersistent); override;
  565. procedure FreeBuffers; override;
  566. function GetAsString: string; override;
  567. function GetBlobSize: Longint; virtual;
  568. function GetIsNull: Boolean; override;
  569. procedure GetText(var TheText: string; ADisplayText: Boolean); override;
  570. procedure SetAsString(const AValue: string); override;
  571. procedure SetText(const AValue: string); override;
  572. public
  573. constructor Create(AOwner: TComponent); override;
  574. procedure Assign(Source: TPersistent); override;
  575. procedure Clear; override;
  576. class function IsBlob: Boolean; override;
  577. procedure LoadFromFile(const FileName: string);
  578. procedure LoadFromStream(Stream: TStream);
  579. procedure SaveToFile(const FileName: string);
  580. procedure SaveToStream(Stream: TStream);
  581. procedure SetFieldType(AValue: TFieldType); override;
  582. property BlobSize: Longint read FBlobSize;
  583. property Modified: Boolean read FModified write FModified;
  584. property Value: string read GetAsString write SetAsString;
  585. property Transliterate: Boolean read FTransliterate write FTransliterate;
  586. published
  587. property BlobType: TBlobType read FBlobType write FBlobType;
  588. property Size default 0;
  589. end;
  590. { TMemoField }
  591. TMemoField = class(TBlobField)
  592. public
  593. constructor Create(AOwner: TComponent); override;
  594. published
  595. property Transliterate default True;
  596. end;
  597. { TGraphicField }
  598. TGraphicField = class(TBlobField)
  599. public
  600. constructor Create(AOwner: TComponent); override;
  601. end;
  602. { TIndexDef }
  603. TIndexDefs = class;
  604. TIndexOptions = set of (ixPrimary, ixUnique, ixDescending,
  605. ixCaseInsensitive, ixExpression);
  606. TIndexDef = class(TCollectionItem)
  607. Private
  608. FExpression : String;
  609. FFields : String;
  610. FName : String;
  611. FOptions : TIndexOptions;
  612. FSource : String;
  613. public
  614. constructor Create(Owner: TIndexDefs; const AName, TheFields: string;
  615. TheOptions: TIndexOptions);
  616. destructor Destroy; override;
  617. property Expression: string read FExpression;
  618. property Fields: string read FFields write FFields;
  619. property Name: string read FName write FName;
  620. property Options: TIndexOptions read FOptions write FOptions;
  621. property Source: string read FSource write FSource;
  622. end;
  623. { TIndexDefs }
  624. TIndexDefs = class(TOwnedCollection)
  625. Private
  626. FUpDated : Boolean;
  627. FDataset : Tdataset;
  628. Function GetItem(Index: Integer): TIndexDef;
  629. Procedure SetItem(Index: Integer; Value: TIndexDef);
  630. public
  631. constructor Create(DataSet: TDataSet); overload;
  632. destructor Destroy; override;
  633. procedure Add(const Name, Fields: string; Options: TIndexOptions);
  634. Function AddIndexDef: TIndexDef;
  635. procedure Assign(IndexDefs: TIndexDefs);
  636. // procedure Clear;
  637. function FindIndexForFields(const Fields: string): TIndexDef;
  638. function GetIndexForFields(const Fields: string;
  639. CaseInsensitive: Boolean): TIndexDef;
  640. // function IndexOf(const Name: string): Longint;
  641. procedure Update;
  642. // property Count: Longint read FCount;
  643. Property Items[Index: Integer] : TIndexDef read GetItem write SetItem; default;
  644. property Updated: Boolean read FUpdated write FUpdated;
  645. end;
  646. { TCheckConstraint }
  647. TCheckConstraint = class(TCollectionItem)
  648. Private
  649. FCustomConstraint : String;
  650. FErrorMessage : String;
  651. FFromDictionary : Boolean;
  652. FImportedConstraint : String;
  653. public
  654. procedure Assign(Source: TPersistent); override;
  655. // function GetDisplayName: string; override;
  656. published
  657. property CustomConstraint: string read FCustomConstraint write FCustomConstraint;
  658. property ErrorMessage: string read FErrorMessage write FErrorMessage;
  659. property FromDictionary: Boolean read FFromDictionary write FFromDictionary;
  660. property ImportedConstraint: string read FImportedConstraint write FImportedConstraint;
  661. end;
  662. { TCheckConstraints }
  663. TCheckConstraints = class(TCollection)
  664. Private
  665. Function GetItem(Index : Longint) : TCheckConstraint;
  666. Procedure SetItem(index : Longint; Value : TCheckConstraint);
  667. protected
  668. function GetOwner: TPersistent; override;
  669. public
  670. constructor Create(AOwner: TPersistent);
  671. function Add: TCheckConstraint;
  672. property Items[Index: Longint]: TCheckConstraint read GetItem write SetItem; default;
  673. end;
  674. { TFields }
  675. Tfields = Class(TObject)
  676. Private
  677. FDataset : TDataset;
  678. FFieldList : TList;
  679. FOnChange : TNotifyEvent;
  680. FValidFieldKinds : TFieldKinds;
  681. Protected
  682. Procedure Changed;
  683. Procedure CheckfieldKind(Fieldkind : TFieldKind; Field : TField);
  684. Function GetCount : Longint;
  685. Function GetField (Index : longint) : TField;
  686. Procedure SetFieldIndex (Field : TField;Value : Integer);
  687. Property OnChange : TNotifyEvent Read FOnChange Write FOnChange;
  688. Property ValidFieldKinds : TFieldKinds Read FValidFieldKinds;
  689. Public
  690. Constructor Create(ADataset : TDataset);
  691. Destructor Destroy;override;
  692. Procedure Add(Field : TField);
  693. Procedure CheckFieldName (Const Value : String);
  694. Procedure CheckFieldNames (Const Value : String);
  695. Procedure Clear;
  696. Function FindField (Const Value : String) : TField;
  697. Function FieldByName (Const Value : String) : TField;
  698. Function FieldByNumber(FieldNo : Integer) : TField;
  699. Procedure GetFieldNames (Values : TStrings);
  700. Function IndexOf(Field : TField) : Longint;
  701. procedure Remove(Value : TField);
  702. Property Count : Integer Read GetCount;
  703. Property Dataset : TDataset Read FDataset;
  704. Property Fields [Index : Integer] : TField Read GetField; default;
  705. end;
  706. { TDataSet }
  707. TBookmark = Pointer;
  708. TBookmarkStr = string;
  709. PBookmarkFlag = ^TBookmarkFlag;
  710. TBookmarkFlag = (bfCurrent, bfBOF, bfEOF, bfInserted);
  711. PBufferList = ^TBufferList;
  712. TBufferList = array[0..dsMaxBufferCount - 1] of PChar;
  713. TGetMode = (gmCurrent, gmNext, gmPrior);
  714. TGetResult = (grOK, grBOF, grEOF, grError);
  715. TResyncMode = set of (rmExact, rmCenter);
  716. TDataAction = (daFail, daAbort, daRetry);
  717. TUpdateKind = (ukModify, ukInsert, ukDelete);
  718. TLocateOption = (loCaseInsensitive, loPartialKey);
  719. TLocateOptions = set of TLocateOption;
  720. TDataOperation = procedure of object;
  721. TDataSetNotifyEvent = procedure(DataSet: TDataSet) of object;
  722. TDataSetErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
  723. var Action: TDataAction) of object;
  724. TFilterOption = (foCaseInsensitive, foNoPartialCompare);
  725. TFilterOptions = set of TFilterOption;
  726. TFilterRecordEvent = procedure(DataSet: TDataSet;
  727. var Accept: Boolean) of object;
  728. TDatasetClass = Class of TDataset;
  729. TBufferArray = ^pchar;
  730. TDataSet = class(TComponent)
  731. Private
  732. FOpenAfterRead : boolean;
  733. FActiveRecord: Longint;
  734. FAfterCancel: TDataSetNotifyEvent;
  735. FAfterClose: TDataSetNotifyEvent;
  736. FAfterDelete: TDataSetNotifyEvent;
  737. FAfterEdit: TDataSetNotifyEvent;
  738. FAfterInsert: TDataSetNotifyEvent;
  739. FAfterOpen: TDataSetNotifyEvent;
  740. FAfterPost: TDataSetNotifyEvent;
  741. FAfterScroll: TDataSetNotifyEvent;
  742. FAutoCalcFields: Boolean;
  743. FBOF: Boolean;
  744. FBeforeCancel: TDataSetNotifyEvent;
  745. FBeforeClose: TDataSetNotifyEvent;
  746. FBeforeDelete: TDataSetNotifyEvent;
  747. FBeforeEdit: TDataSetNotifyEvent;
  748. FBeforeInsert: TDataSetNotifyEvent;
  749. FBeforeOpen: TDataSetNotifyEvent;
  750. FBeforePost: TDataSetNotifyEvent;
  751. FBeforeScroll: TDataSetNotifyEvent;
  752. FBlobFieldCount: Longint;
  753. FBookmarkSize: Longint;
  754. FBuffers : TBufferArray;
  755. FBufferCount: Longint;
  756. FCalcBuffer: PChar;
  757. FCalcFieldsSize: Longint;
  758. FCanModify: Boolean;
  759. FConstraints: TCheckConstraints;
  760. FDisableControlsCount : Integer;
  761. FDisableControlsState : TDatasetState;
  762. FCurrentRecord: Longint;
  763. FDataSources : TList;
  764. FDefaultFields: Boolean;
  765. FEOF: Boolean;
  766. FEnableControlsEvent : TDataEvent;
  767. FFieldList : TFields;
  768. FFieldCount : Longint;
  769. FFieldDefs: TFieldDefs;
  770. FFilterOptions: TFilterOptions;
  771. FFilterText: string;
  772. FFiltered: Boolean;
  773. FFound: Boolean;
  774. FInternalCalcFields: Boolean;
  775. FModified: Boolean;
  776. FOnCalcFields: TDataSetNotifyEvent;
  777. FOnDeleteError: TDataSetErrorEvent;
  778. FOnEditError: TDataSetErrorEvent;
  779. FOnFilterRecord: TFilterRecordEvent;
  780. FOnNewRecord: TDataSetNotifyEvent;
  781. FOnPostError: TDataSetErrorEvent;
  782. FRecordCount: Longint;
  783. FIsUniDirectional: Boolean;
  784. FState : TDataSetState;
  785. Procedure DoInsertAppend(DoAppend : Boolean);
  786. Procedure DoInternalOpen;
  787. Procedure DoInternalClose(DoCheck : Boolean);
  788. Function GetBuffer (Index : longint) : Pchar;
  789. Function GetField (Index : Longint) : TField;
  790. Procedure RegisterDataSource(ADatasource : TDataSource);
  791. Procedure RemoveField (Field : TField);
  792. Procedure SetActive (Value : Boolean);
  793. Procedure SetField (Index : Longint;Value : TField);
  794. Procedure ShiftBuffersForward;
  795. Procedure ShiftBuffersBackward;
  796. Function TryDoing (P : TDataOperation; Ev : TDatasetErrorEvent) : Boolean;
  797. Function GetActive : boolean;
  798. Procedure UnRegisterDataSource(ADatasource : TDatasource);
  799. Procedure UpdateFieldDefs;
  800. protected
  801. procedure RecalcBufListSize;
  802. procedure ActivateBuffers; virtual;
  803. procedure BindFields(Binding: Boolean);
  804. function BookmarkAvailable: Boolean;
  805. procedure CalculateFields(Buffer: PChar); virtual;
  806. procedure CheckActive; virtual;
  807. procedure CheckInactive; virtual;
  808. procedure Loaded; override;
  809. procedure ClearBuffers; virtual;
  810. procedure ClearCalcFields(Buffer: PChar); virtual;
  811. procedure CloseBlob(Field: TField); virtual;
  812. procedure CloseCursor; virtual;
  813. procedure CreateFields;
  814. procedure DataEvent(Event: TDataEvent; Info: Ptrint); virtual;
  815. procedure DestroyFields; virtual;
  816. procedure DoAfterCancel; virtual;
  817. procedure DoAfterClose; virtual;
  818. procedure DoAfterDelete; virtual;
  819. procedure DoAfterEdit; virtual;
  820. procedure DoAfterInsert; virtual;
  821. procedure DoAfterOpen; virtual;
  822. procedure DoAfterPost; virtual;
  823. procedure DoAfterScroll; virtual;
  824. procedure DoBeforeCancel; virtual;
  825. procedure DoBeforeClose; virtual;
  826. procedure DoBeforeDelete; virtual;
  827. procedure DoBeforeEdit; virtual;
  828. procedure DoBeforeInsert; virtual;
  829. procedure DoBeforeOpen; virtual;
  830. procedure DoBeforePost; virtual;
  831. procedure DoBeforeScroll; virtual;
  832. procedure DoOnCalcFields; virtual;
  833. procedure DoOnNewRecord; virtual;
  834. function FieldByNumber(FieldNo: Longint): TField;
  835. function FindRecord(Restart, GoForward: Boolean): Boolean; virtual;
  836. procedure FreeFieldBuffers; virtual;
  837. function GetBookmarkStr: TBookmarkStr; virtual;
  838. procedure GetCalcFields(Buffer: PChar); virtual;
  839. function GetCanModify: Boolean; virtual;
  840. procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
  841. function GetFieldClass(FieldType: TFieldType): TFieldClass; virtual;
  842. Function GetfieldCount : Integer;
  843. function GetFieldValues(fieldname : string) : string; virtual;
  844. function GetIsIndexField(Field: TField): Boolean; virtual;
  845. function GetNextRecords: Longint; virtual;
  846. function GetNextRecord: Boolean; virtual;
  847. function GetPriorRecords: Longint; virtual;
  848. function GetPriorRecord: Boolean; virtual;
  849. function GetRecordCount: Longint; virtual;
  850. function GetRecNo: Longint; virtual;
  851. procedure InitFieldDefs; virtual;
  852. procedure InitRecord(Buffer: PChar); virtual;
  853. procedure InternalCancel; virtual;
  854. procedure InternalEdit; virtual;
  855. procedure InternalInsert; virtual;
  856. procedure InternalRefresh; virtual;
  857. procedure OpenCursor(InfoQuery: Boolean); virtual;
  858. procedure RefreshInternalCalcFields(Buffer: PChar); virtual;
  859. procedure RestoreState(const Value: TDataSetState);
  860. procedure SetBookmarkStr(const Value: TBookmarkStr); virtual;
  861. procedure SetBufListSize(Value: Longint);
  862. procedure SetChildOrder(Component: TComponent; Order: Longint); override;
  863. procedure SetCurrentRecord(Index: Longint); virtual;
  864. procedure SetFiltered(Value: Boolean); virtual;
  865. procedure SetFilterOptions(Value: TFilterOptions); virtual;
  866. procedure SetFilterText(const Value: string); virtual;
  867. procedure SetFound(const Value: Boolean);
  868. procedure SetFieldValues(fieldname : string;value : string); virtual;
  869. procedure SetModified(Value: Boolean);
  870. procedure SetName(const Value: TComponentName); override;
  871. procedure SetOnFilterRecord(const Value: TFilterRecordEvent); virtual;
  872. procedure SetRecNo(Value: Longint); virtual;
  873. procedure SetState(Value: TDataSetState);
  874. function SetTempState(const Value: TDataSetState): TDataSetState;
  875. function TempBuffer: PChar;
  876. procedure UpdateIndexDefs; virtual;
  877. property ActiveRecord: Longint read FActiveRecord;
  878. property CurrentRecord: Longint read FCurrentRecord;
  879. property BlobFieldCount: Longint read FBlobFieldCount;
  880. property BookmarkSize: Longint read FBookmarkSize write FBookmarkSize;
  881. property Buffers[Index: Longint]: PChar read GetBuffer;
  882. property BufferCount: Longint read FBufferCount;
  883. property CalcBuffer: PChar read FCalcBuffer;
  884. property CalcFieldsSize: Longint read FCalcFieldsSize;
  885. property InternalCalcFields: Boolean read FInternalCalcFields;
  886. property Constraints: TCheckConstraints read FConstraints write FConstraints;
  887. protected { abstract methods }
  888. function AllocRecordBuffer: PChar; virtual; abstract;
  889. procedure FreeRecordBuffer(var Buffer: PChar); virtual; abstract;
  890. procedure GetBookmarkData(Buffer: PChar; Data: Pointer); virtual; abstract;
  891. function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; virtual; abstract;
  892. function GetDataSource: TDataSource; virtual;
  893. function GetFieldData(Field: TField; Buffer: Pointer): Boolean; virtual; abstract;
  894. function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; virtual; abstract;
  895. function GetRecordSize: Word; virtual; abstract;
  896. procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); virtual; abstract;
  897. procedure InternalClose; virtual; abstract;
  898. procedure InternalDelete; virtual; abstract;
  899. procedure InternalFirst; virtual; abstract;
  900. procedure InternalGotoBookmark(ABookmark: Pointer); virtual; abstract;
  901. procedure InternalHandleException; virtual; abstract;
  902. procedure InternalInitFieldDefs; virtual; abstract;
  903. procedure InternalInitRecord(Buffer: PChar); virtual; abstract;
  904. procedure InternalLast; virtual; abstract;
  905. procedure InternalOpen; virtual; abstract;
  906. procedure InternalPost; virtual; abstract;
  907. procedure InternalSetToRecord(Buffer: PChar); virtual; abstract;
  908. function IsCursorOpen: Boolean; virtual; abstract;
  909. procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); virtual; abstract;
  910. procedure SetBookmarkData(Buffer: PChar; Data: Pointer); virtual; abstract;
  911. procedure SetFieldData(Field: TField; Buffer: Pointer); virtual; abstract;
  912. public
  913. constructor Create(AOwner: TComponent); override;
  914. destructor Destroy; override;
  915. function ActiveBuffer: PChar;
  916. procedure Append;
  917. procedure AppendRecord(const Values: array of const);
  918. function BookmarkValid(ABookmark: TBookmark): Boolean; virtual;
  919. procedure Cancel; virtual;
  920. procedure CheckBrowseMode;
  921. procedure ClearFields;
  922. procedure Close;
  923. function ControlsDisabled: Boolean;
  924. function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint; virtual;
  925. function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; virtual;
  926. procedure CursorPosChanged;
  927. procedure Delete;
  928. procedure DisableControls;
  929. procedure Edit;
  930. procedure EnableControls;
  931. function FieldByName(const FieldName: string): TField;
  932. function FindField(const FieldName: string): TField;
  933. function FindFirst: Boolean;
  934. function FindLast: Boolean;
  935. function FindNext: Boolean;
  936. function FindPrior: Boolean;
  937. procedure First;
  938. procedure FreeBookmark(ABookmark: TBookmark); virtual;
  939. function GetBookmark: TBookmark; virtual;
  940. function GetCurrentRecord(Buffer: PChar): Boolean; virtual;
  941. procedure GetFieldList(List: TList; const FieldNames: string);
  942. procedure GetFieldNames(List: TStrings);
  943. procedure GotoBookmark(ABookmark: TBookmark);
  944. procedure Insert;
  945. procedure InsertRecord(const Values: array of const);
  946. function IsEmpty: Boolean;
  947. function IsSequenced: Boolean; virtual;
  948. procedure Last;
  949. function MoveBy(Distance: Longint): Longint;
  950. procedure Next;
  951. procedure Open;
  952. procedure Post; virtual;
  953. procedure Prior;
  954. procedure Refresh;
  955. procedure Resync(Mode: TResyncMode); virtual;
  956. procedure SetFields(const Values: array of const);
  957. function Translate(Src, Dest: PChar; ToOem: Boolean): Integer; virtual;
  958. procedure UpdateCursorPos;
  959. procedure UpdateRecord;
  960. property BOF: Boolean read FBOF;
  961. property Bookmark: TBookmarkStr read GetBookmarkStr write SetBookmarkStr;
  962. property CanModify: Boolean read GetCanModify;
  963. property DataSource: TDataSource read GetDataSource;
  964. property DefaultFields: Boolean read FDefaultFields;
  965. property EOF: Boolean read FEOF;
  966. property FieldCount: Longint read GetFieldCount;
  967. property FieldDefs: TFieldDefs read FFieldDefs write FFieldDefs;
  968. // property Fields[Index: Longint]: TField read GetField write SetField;
  969. property Found: Boolean read FFound;
  970. property Modified: Boolean read FModified write SetModified;
  971. property IsUniDirectional: Boolean read FIsUniDirectional write FIsUniDirectional default False;
  972. property RecordCount: Longint read GetRecordCount;
  973. property RecNo: Longint read GetRecNo write SetRecNo;
  974. property RecordSize: Word read GetRecordSize;
  975. property State: TDataSetState read FState;
  976. property Fields : TFields read FFieldList;
  977. property FieldValues[fieldname : string] : string read GetFieldValues write SetFieldValues; default;
  978. property Filter: string read FFilterText write SetFilterText;
  979. property Filtered: Boolean read FFiltered write SetFiltered default False;
  980. property FilterOptions: TFilterOptions read FFilterOptions write FFilterOptions;
  981. property Active: Boolean read GetActive write SetActive default False;
  982. property AutoCalcFields: Boolean read FAutoCalcFields write FAutoCalcFields;
  983. property BeforeOpen: TDataSetNotifyEvent read FBeforeOpen write FBeforeOpen;
  984. property AfterOpen: TDataSetNotifyEvent read FAfterOpen write FAfterOpen;
  985. property BeforeClose: TDataSetNotifyEvent read FBeforeClose write FBeforeClose;
  986. property AfterClose: TDataSetNotifyEvent read FAfterClose write FAfterClose;
  987. property BeforeInsert: TDataSetNotifyEvent read FBeforeInsert write FBeforeInsert;
  988. property AfterInsert: TDataSetNotifyEvent read FAfterInsert write FAfterInsert;
  989. property BeforeEdit: TDataSetNotifyEvent read FBeforeEdit write FBeforeEdit;
  990. property AfterEdit: TDataSetNotifyEvent read FAfterEdit write FAfterEdit;
  991. property BeforePost: TDataSetNotifyEvent read FBeforePost write FBeforePost;
  992. property AfterPost: TDataSetNotifyEvent read FAfterPost write FAfterPost;
  993. property BeforeCancel: TDataSetNotifyEvent read FBeforeCancel write FBeforeCancel;
  994. property AfterCancel: TDataSetNotifyEvent read FAfterCancel write FAfterCancel;
  995. property BeforeDelete: TDataSetNotifyEvent read FBeforeDelete write FBeforeDelete;
  996. property AfterDelete: TDataSetNotifyEvent read FAfterDelete write FAfterDelete;
  997. property BeforeScroll: TDataSetNotifyEvent read FBeforeScroll write FBeforeScroll;
  998. property AfterScroll: TDataSetNotifyEvent read FAfterScroll write FAfterScroll;
  999. property OnCalcFields: TDataSetNotifyEvent read FOnCalcFields write FOnCalcFields;
  1000. property OnDeleteError: TDataSetErrorEvent read FOnDeleteError write FOnDeleteError;
  1001. property OnEditError: TDataSetErrorEvent read FOnEditError write FOnEditError;
  1002. property OnFilterRecord: TFilterRecordEvent read FOnFilterRecord write SetOnFilterRecord;
  1003. property OnNewRecord: TDataSetNotifyEvent read FOnNewRecord write FOnNewRecord;
  1004. property OnPostError: TDataSetErrorEvent read FOnPostError write FOnPostError;
  1005. end;
  1006. TDataLink = class(TPersistent)
  1007. private
  1008. FFIrstRecord,
  1009. FBufferCount : Integer;
  1010. FActive,
  1011. FDataSourceFixed,
  1012. FEditing,
  1013. FReadOnly,
  1014. FUpdatingRecord,
  1015. FVisualControl : Boolean;
  1016. FDataSource : TDataSource;
  1017. Function CalcFirstRecord(Index : Integer) : Integer;
  1018. Procedure CalcRange;
  1019. Procedure CheckActiveAndEditing;
  1020. Function GetDataset : TDataset;
  1021. procedure SetActive(AActive: Boolean);
  1022. procedure SetDataSource(Value: TDataSource);
  1023. Procedure SetReadOnly(Value : Boolean);
  1024. protected
  1025. procedure ActiveChanged; virtual;
  1026. procedure CheckBrowseMode; virtual;
  1027. procedure DataEvent(Event: TDataEvent; Info: Ptrint); virtual;
  1028. procedure DataSetChanged; virtual;
  1029. procedure DataSetScrolled(Distance: Integer); virtual;
  1030. procedure EditingChanged; virtual;
  1031. procedure FocusControl(Field: TFieldRef); virtual;
  1032. function GetActiveRecord: Integer; virtual;
  1033. function GetBOF: Boolean; virtual;
  1034. function GetBufferCount: Integer; virtual;
  1035. function GetEOF: Boolean; virtual;
  1036. function GetRecordCount: Integer; virtual;
  1037. procedure LayoutChanged; virtual;
  1038. function MoveBy(Distance: Integer): Integer; virtual;
  1039. procedure RecordChanged(Field: TField); virtual;
  1040. procedure SetActiveRecord(Value: Integer); virtual;
  1041. procedure SetBufferCount(Value: Integer); virtual;
  1042. procedure UpdateData; virtual;
  1043. property VisualControl: Boolean read FVisualControl write FVisualControl;
  1044. public
  1045. constructor Create;
  1046. destructor Destroy; override;
  1047. function Edit: Boolean;
  1048. procedure UpdateRecord;
  1049. property Active: Boolean read FActive;
  1050. property ActiveRecord: Integer read GetActiveRecord write SetActiveRecord;
  1051. property BOF: Boolean read GetBOF;
  1052. property BufferCount: Integer read FBufferCount write SetBufferCount;
  1053. property DataSet: TDataSet read GetDataSet;
  1054. property DataSource: TDataSource read FDataSource write SetDataSource;
  1055. property DataSourceFixed: Boolean read FDataSourceFixed write FDataSourceFixed;
  1056. property Editing: Boolean read FEditing;
  1057. property Eof: Boolean read GetEOF;
  1058. property ReadOnly: Boolean read FReadOnly write SetReadOnly;
  1059. property RecordCount: Integer read GetRecordCount;
  1060. end;
  1061. { TDetailDataLink }
  1062. TDetailDataLink = class(TDataLink)
  1063. protected
  1064. function GetDetailDataSet: TDataSet; virtual;
  1065. public
  1066. property DetailDataSet: TDataSet read GetDetailDataSet;
  1067. end;
  1068. { TMasterDataLink }
  1069. TMasterDataLink = class(TDetailDataLink)
  1070. private
  1071. FDataSet: TDataSet;
  1072. FFieldNames: string;
  1073. FFields: TList;
  1074. FOnMasterChange: TNotifyEvent;
  1075. FOnMasterDisable: TNotifyEvent;
  1076. procedure SetFieldNames(const Value: string);
  1077. protected
  1078. procedure ActiveChanged; override;
  1079. procedure CheckBrowseMode; override;
  1080. function GetDetailDataSet: TDataSet; override;
  1081. procedure LayoutChanged; override;
  1082. procedure RecordChanged(Field: TField); override;
  1083. public
  1084. constructor Create(ADataSet: TDataSet);
  1085. destructor Destroy; override;
  1086. property FieldNames: string read FFieldNames write SetFieldNames;
  1087. property Fields: TList read FFields;
  1088. property OnMasterChange: TNotifyEvent read FOnMasterChange write FOnMasterChange;
  1089. property OnMasterDisable: TNotifyEvent read FOnMasterDisable write FOnMasterDisable;
  1090. end;
  1091. { TDataSource }
  1092. TDataChangeEvent = procedure(Sender: TObject; Field: TField) of object;
  1093. TDataSource = class(TComponent)
  1094. private
  1095. FDataSet: TDataSet;
  1096. FDataLinks: TList;
  1097. FEnabled: Boolean;
  1098. FAutoEdit: Boolean;
  1099. FState: TDataSetState;
  1100. FOnStateChange: TNotifyEvent;
  1101. FOnDataChange: TDataChangeEvent;
  1102. FOnUpdateData: TNotifyEvent;
  1103. procedure DistributeEvent(Event: TDataEvent; Info: Ptrint);
  1104. procedure RegisterDataLink(DataLink: TDataLink);
  1105. Procedure ProcessEvent(Event : TDataEvent; Info : Ptrint);
  1106. procedure SetDataSet(ADataSet: TDataSet);
  1107. procedure SetEnabled(Value: Boolean);
  1108. procedure UnregisterDataLink(DataLink: TDataLink);
  1109. protected
  1110. Procedure DoDataChange (Info : Pointer);virtual;
  1111. Procedure DoStateChange; virtual;
  1112. Procedure DoUpdateData;
  1113. property DataLinks: TList read FDataLinks;
  1114. public
  1115. constructor Create(AOwner: TComponent); override;
  1116. destructor Destroy; override;
  1117. procedure Edit;
  1118. function IsLinkedTo(ADataSet: TDataSet): Boolean;
  1119. property State: TDataSetState read FState;
  1120. published
  1121. property AutoEdit: Boolean read FAutoEdit write FAutoEdit default True;
  1122. property DataSet: TDataSet read FDataSet write SetDataSet;
  1123. property Enabled: Boolean read FEnabled write SetEnabled default True;
  1124. property OnStateChange: TNotifyEvent read FOnStateChange write FOnStateChange;
  1125. property OnDataChange: TDataChangeEvent read FOnDataChange write FOnDataChange;
  1126. property OnUpdateData: TNotifyEvent read FOnUpdateData write FOnUpdateData;
  1127. end;
  1128. { TDBDataset }
  1129. TDBDatasetClass = Class of TDBDataset;
  1130. TDBDataset = Class(TDataset)
  1131. Private
  1132. FDatabase : TDatabase;
  1133. FTransaction : TDBTransaction;
  1134. Protected
  1135. Procedure SetDatabase (Value : TDatabase); virtual;
  1136. Procedure SetTransaction(Value : TDBTransaction); virtual;
  1137. Procedure CheckDatabase;
  1138. Public
  1139. Destructor destroy; override;
  1140. Property DataBase : TDatabase Read FDatabase Write SetDatabase;
  1141. Property Transaction : TDBTransaction Read FTransaction Write SetTransaction;
  1142. end;
  1143. { TDBTransaction }
  1144. TDBTransactionClass = Class of TDBTransaction;
  1145. TDBTransaction = Class(TComponent)
  1146. Private
  1147. FActive : boolean;
  1148. FDatabase : TDatabase;
  1149. FDataSets : TList;
  1150. FOpenAfterRead : boolean;
  1151. Procedure SetDatabase (Value : TDatabase);
  1152. Function GetDataSetCount : Longint;
  1153. Function GetDataset(Index : longint) : TDBDataset;
  1154. procedure RegisterDataset (DS : TDBDataset);
  1155. procedure UnRegisterDataset (DS : TDBDataset);
  1156. procedure RemoveDataSets;
  1157. procedure SetActive(Value : boolean);
  1158. Protected
  1159. procedure CloseTrans;
  1160. procedure openTrans;
  1161. Procedure CheckDatabase;
  1162. Procedure CheckActive;
  1163. Procedure CheckInactive;
  1164. procedure EndTransaction; virtual; abstract;
  1165. procedure StartTransaction; virtual; abstract;
  1166. procedure Loaded; override;
  1167. Public
  1168. constructor Create(AOwner: TComponent); override;
  1169. Destructor destroy; override;
  1170. procedure CloseDataSets;
  1171. Property DataBase : TDatabase Read FDatabase Write SetDatabase;
  1172. published
  1173. property Active : boolean read FActive write setactive;
  1174. end;
  1175. { TDatabase }
  1176. TLoginEvent = procedure(Database: TDatabase;
  1177. LoginParams: TStrings) of object;
  1178. TDatabaseClass = Class Of TDatabase;
  1179. TDatabase = class(TComponent)
  1180. private
  1181. FConnected : Boolean;
  1182. FDataBaseName : String;
  1183. FDataSets : TList;
  1184. FTransactions : TList;
  1185. FDirectory : String;
  1186. FKeepConnection : Boolean;
  1187. FLoginPrompt : Boolean;
  1188. FOnLogin : TLoginEvent;
  1189. FParams : TStrings;
  1190. FSQLBased : Boolean;
  1191. FOpenAfterRead : boolean;
  1192. Function GetDataSetCount : Longint;
  1193. Function GetTransactionCount : Longint;
  1194. Function GetDataset(Index : longint) : TDBDataset;
  1195. Function GetTransaction(Index : longint) : TDBTransaction;
  1196. procedure SetConnected (Value : boolean);
  1197. procedure RegisterDataset (DS : TDBDataset);
  1198. procedure RegisterTransaction (TA : TDBTransaction);
  1199. procedure UnRegisterDataset (DS : TDBDataset);
  1200. procedure UnRegisterTransaction(TA : TDBTransaction);
  1201. procedure RemoveDataSets;
  1202. procedure RemoveTransactions;
  1203. protected
  1204. Procedure CheckConnected;
  1205. Procedure CheckDisConnected;
  1206. procedure Loaded; override;
  1207. procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  1208. Procedure DoInternalConnect; Virtual;Abstract;
  1209. Procedure DoInternalDisConnect; Virtual;Abstract;
  1210. public
  1211. constructor Create(AOwner: TComponent); override;
  1212. destructor Destroy; override;
  1213. procedure Close;
  1214. procedure Open;
  1215. procedure CloseDataSets;
  1216. procedure CloseTransactions;
  1217. // procedure ApplyUpdates;
  1218. procedure StartTransaction; virtual; abstract;
  1219. procedure EndTransaction; virtual; abstract;
  1220. property DataSetCount: Longint read GetDataSetCount;
  1221. property DataSets[Index: Longint]: TDBDataSet read GetDataSet;
  1222. property TransactionCount: Longint read GetTransactionCount;
  1223. property Transactions[Index: Longint]: TDBTransaction read GetTransaction;
  1224. property Directory: string read FDirectory write FDirectory;
  1225. property IsSQLBased: Boolean read FSQLBased;
  1226. published
  1227. property Connected: Boolean read FConnected write SetConnected;
  1228. property DatabaseName: string read FDatabaseName write FDatabaseName;
  1229. property KeepConnection: Boolean read FKeepConnection write FKeepConnection;
  1230. property LoginPrompt: Boolean read FLoginPrompt write FLoginPrompt;
  1231. property Params : TStrings read FParams Write FParams;
  1232. property OnLogin: TLoginEvent read FOnLogin write FOnLogin;
  1233. end;
  1234. { TBufDataset }
  1235. PBufBookmark = ^TBufBookmark;
  1236. TBufBookmark = record
  1237. BookmarkData : integer;
  1238. BookmarkFlag : TBookmarkFlag;
  1239. end;
  1240. PFieldUpdateBuffer = ^TFieldUpdateBuffer;
  1241. TFieldUpdateBuffer = record
  1242. FieldNo : integer;
  1243. NewValue : pointer;
  1244. IsNull : boolean;
  1245. end;
  1246. TFieldsUpdateBuffer = array of TFieldUpdateBuffer;
  1247. PRecUpdateBuffer = ^TRecUpdateBuffer;
  1248. TRecUpdateBuffer = record
  1249. RecordNo : integer;
  1250. FieldsUpdateBuffer : TFieldsUpdateBuffer;
  1251. UpdateKind : TUpdateKind;
  1252. end;
  1253. TRecordsUpdateBuffer = array of TRecUpdateBuffer;
  1254. TBufDataset = class(TDBDataSet)
  1255. private
  1256. FBBuffers : TBufferArray;
  1257. FBRecordCount : integer;
  1258. FBBufferCount : integer;
  1259. FBCurrentRecord : integer;
  1260. FIsEOF : boolean;
  1261. FIsBOF : boolean;
  1262. FPacketRecords : integer;
  1263. FRecordSize : Integer;
  1264. FNullmaskSize : byte;
  1265. FOpen : Boolean;
  1266. FUpdateBuffer : TRecordsUpdateBuffer;
  1267. FEditBuf : PRecUpdateBuffer;
  1268. FApplyingUpdates: boolean;
  1269. FBDeletedRecords: integer;
  1270. procedure CalcRecordSize;
  1271. function LoadBuffer(Buffer : PChar): TGetResult;
  1272. function GetFieldSize(FieldDef : TFieldDef) : longint;
  1273. function GetRecordUpdateBuffer(rno : integer;var RecUpdBuf : PRecUpdateBuffer) : boolean;
  1274. function GetFieldUpdateBuffer(fieldno : integer;RecUpdBuf : PRecUpdateBuffer;var FieldUpdBuf : pFieldUpdateBuffer) : boolean;
  1275. protected
  1276. procedure SetRecNo(Value: Longint); override;
  1277. function GetRecNo: Longint; override;
  1278. function AllocRecordBuffer: PChar; override;
  1279. procedure FreeRecordBuffer(var Buffer: PChar); override;
  1280. procedure InternalInitRecord(Buffer: PChar); override;
  1281. function GetCanModify: Boolean; override;
  1282. function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
  1283. procedure InternalOpen; override;
  1284. procedure InternalClose; override;
  1285. function getnextpacket : integer;
  1286. function GetRecordSize: Word; override;
  1287. procedure InternalPost; override;
  1288. procedure InternalCancel; override;
  1289. procedure InternalEdit; override;
  1290. procedure InternalInsert; override;
  1291. procedure InternalDelete; override;
  1292. procedure InternalFirst; override;
  1293. procedure InternalLast; override;
  1294. procedure InternalSetToRecord(Buffer: PChar); override;
  1295. procedure InternalGotoBookmark(ABookmark: Pointer); override;
  1296. procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
  1297. procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
  1298. procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
  1299. function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
  1300. function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
  1301. procedure SetFieldData(Field: TField; Buffer: Pointer); override;
  1302. function IsCursorOpen: Boolean; override;
  1303. function GetRecordCount: Longint; override;
  1304. function ApplyRecUpdate(UpdateKind : TUpdateKind) : boolean; virtual;
  1305. {abstracts, must be overidden by descendents}
  1306. function Fetch : boolean; virtual; abstract;
  1307. function LoadField(FieldDef : TFieldDef;buffer : pointer) : boolean; virtual; abstract;
  1308. public
  1309. constructor Create(AOwner: TComponent); override;
  1310. procedure ApplyUpdates; virtual;
  1311. procedure CancelUpdates; virtual;
  1312. destructor Destroy; override;
  1313. end;
  1314. { TParam }
  1315. TBlobData = string;
  1316. TParamType = (ptUnknown, ptInput, ptOutput, ptInputOutput, ptResult);
  1317. TParamTypes = set of TParamType;
  1318. TParams = class;
  1319. TParam = class(TCollectionItem)
  1320. private
  1321. FNativeStr: string;
  1322. FValue: Variant;
  1323. FPrecision: Integer;
  1324. FNumericScale: Integer;
  1325. FNull: Boolean;
  1326. FName: string;
  1327. FDataType: TFieldType;
  1328. FBound: Boolean;
  1329. FParamType: TParamType;
  1330. FSize: Integer;
  1331. Function GetDataSet: TDataSet;
  1332. Function IsParamStored: Boolean;
  1333. protected
  1334. Procedure AssignParam(Param: TParam);
  1335. Procedure AssignTo(Dest: TPersistent); override;
  1336. Function GetAsBoolean: Boolean;
  1337. Function GetAsCurrency: Currency;
  1338. Function GetAsDateTime: TDateTime;
  1339. Function GetAsFloat: Double;
  1340. Function GetAsInteger: Longint;
  1341. Function GetAsMemo: string;
  1342. Function GetAsString: string;
  1343. Function GetAsVariant: Variant;
  1344. Function GetDisplayName: string; override;
  1345. Function GetIsNull: Boolean;
  1346. Function IsEqual(AValue: TParam): Boolean;
  1347. Procedure SetAsBlob(const AValue: TBlobData);
  1348. Procedure SetAsBoolean(AValue: Boolean);
  1349. Procedure SetAsCurrency(const AValue: Currency);
  1350. Procedure SetAsDate(const AValue: TDateTime);
  1351. Procedure SetAsDateTime(const AValue: TDateTime);
  1352. Procedure SetAsFloat(const AValue: Double);
  1353. Procedure SetAsInteger(AValue: Longint);
  1354. Procedure SetAsMemo(const AValue: string);
  1355. Procedure SetAsSmallInt(AValue: LongInt);
  1356. Procedure SetAsString(const AValue: string);
  1357. Procedure SetAsTime(const AValue: TDateTime);
  1358. Procedure SetAsVariant(const AValue: Variant);
  1359. Procedure SetAsWord(AValue: LongInt);
  1360. Procedure SetDataType(AValue: TFieldType);
  1361. Procedure SetText(const AValue: string);
  1362. public
  1363. constructor Create(ACollection: TCollection); overload; override;
  1364. constructor Create(AParams: TParams; AParamType: TParamType); reintroduce; overload;
  1365. Procedure Assign(Source: TPersistent); override;
  1366. Procedure AssignField(Field: TField);
  1367. Procedure AssignToField(Field: TField);
  1368. Procedure AssignFieldValue(Field: TField; const AValue: Variant);
  1369. Procedure Clear;
  1370. Procedure GetData(Buffer: Pointer);
  1371. Function GetDataSize: Integer;
  1372. Procedure LoadFromFile(const FileName: string; BlobType: TBlobType);
  1373. Procedure LoadFromStream(Stream: TStream; BlobType: TBlobType);
  1374. Procedure SetBlobData(Buffer: Pointer; Size: Integer);
  1375. Procedure SetData(Buffer: Pointer);
  1376. Property AsBlob : TBlobData read GetAsString write SetAsBlob;
  1377. Property AsBoolean : Boolean read GetAsBoolean write SetAsBoolean;
  1378. Property AsCurrency : Currency read GetAsCurrency write SetAsCurrency;
  1379. Property AsDate : TDateTime read GetAsDateTime write SetAsDate;
  1380. Property AsDateTime : TDateTime read GetAsDateTime write SetAsDateTime;
  1381. Property AsFloat : Double read GetAsFloat write SetAsFloat;
  1382. Property AsInteger : LongInt read GetAsInteger write SetAsInteger;
  1383. Property AsMemo : string read GetAsMemo write SetAsMemo;
  1384. Property AsSmallInt : LongInt read GetAsInteger write SetAsSmallInt;
  1385. Property AsString : string read GetAsString write SetAsString;
  1386. Property AsTime : TDateTime read GetAsDateTime write SetAsTime;
  1387. Property AsWord : LongInt read GetAsInteger write SetAsWord;
  1388. Property Bound : Boolean read FBound write FBound;
  1389. Property Dataset : TDataset Read GetDataset;
  1390. Property IsNull : Boolean read GetIsNull;
  1391. Property NativeStr : string read FNativeStr write FNativeStr;
  1392. Property Text : string read GetAsString write SetText;
  1393. Property Value : Variant read GetAsVariant write SetAsVariant stored IsParamStored;
  1394. published
  1395. Property DataType : TFieldType read FDataType write SetDataType;
  1396. Property Name : string read FName write FName;
  1397. Property NumericScale : Integer read FNumericScale write FNumericScale default 0;
  1398. Property ParamType : TParamType read FParamType write FParamType;
  1399. Property Precision : Integer read FPrecision write FPrecision default 0;
  1400. Property Size : Integer read FSize write FSize default 0;
  1401. end;
  1402. { TParams }
  1403. TParams = class(TCollection)
  1404. private
  1405. FOwner: TPersistent;
  1406. Function GetItem(Index: Integer): TParam;
  1407. Function GetParamValue(const ParamName: string): Variant;
  1408. Procedure SetItem(Index: Integer; Value: TParam);
  1409. Procedure SetParamValue(const ParamName: string; const Value: Variant);
  1410. protected
  1411. Procedure AssignTo(Dest: TPersistent); override;
  1412. Function GetDataSet: TDataSet;
  1413. Function GetOwner: TPersistent; override;
  1414. public
  1415. Constructor Create(AOwner: TPersistent); overload;
  1416. Constructor Create; overload;
  1417. Procedure AddParam(Value: TParam);
  1418. Procedure AssignValues(Value: TParams);
  1419. Function CreateParam(FldType: TFieldType; const ParamName: string; ParamType: TParamType): TParam;
  1420. Function FindParam(const Value: string): TParam;
  1421. Procedure GetParamList(List: TList; const ParamNames: string);
  1422. Function IsEqual(Value: TParams): Boolean;
  1423. Function ParamByName(const Value: string): TParam;
  1424. Function ParseSQL(SQL: String; DoCreate: Boolean): String;
  1425. Procedure RemoveParam(Value: TParam);
  1426. Property Dataset : TDataset Read GetDataset;
  1427. Property Items[Index: Integer] : TParam read GetItem write SetItem; default;
  1428. Property ParamValues[const ParamName: string] : Variant read GetParamValue write SetParamValue;
  1429. end;
  1430. const
  1431. FieldTypetoVariantMap : array[TFieldType] of Integer = (varError, varOleStr, varSmallint,
  1432. varInteger, varSmallint, varBoolean, varDouble, varCurrency, varCurrency,
  1433. varDate, varDate, varDate, varOleStr, varOleStr, varInteger, varOleStr,
  1434. varOleStr, varOleStr, varOleStr, varOleStr, varOleStr, varOleStr, varError,
  1435. varOleStr, varOleStr, varError, varError, varError, varError, varError,
  1436. varOleStr, varOleStr, varVariant, varUnknown, varDispatch, varOleStr, varOleStr,varOleStr);
  1437. Const
  1438. Fieldtypenames : Array [TFieldType] of String[15] =
  1439. (
  1440. 'Unknown',
  1441. 'String',
  1442. 'Smallint',
  1443. 'Integer',
  1444. 'Word',
  1445. 'Boolean',
  1446. 'Float',
  1447. 'Currency',
  1448. 'BCD',
  1449. 'Date',
  1450. 'Time',
  1451. 'DateTime',
  1452. 'Bytes',
  1453. 'VarBytes',
  1454. 'AutoInc',
  1455. 'Blob',
  1456. 'Memo',
  1457. 'Graphic',
  1458. 'FmtMemo',
  1459. 'ParadoxOle',
  1460. 'DBaseOle',
  1461. 'TypedBinary',
  1462. 'Cursor',
  1463. 'FixedChar',
  1464. 'WideString',
  1465. 'Largeint',
  1466. 'ADT',
  1467. 'Array',
  1468. 'Reference',
  1469. 'DataSet',
  1470. 'OraBlob',
  1471. 'OraClob',
  1472. 'Variant',
  1473. 'Interface',
  1474. 'IDispatch',
  1475. 'Guid',
  1476. 'TimeStamp',
  1477. 'FMTBcd'
  1478. );
  1479. { 'Unknown',
  1480. 'String',
  1481. 'Smallint',
  1482. 'Integer',
  1483. 'Word',
  1484. 'Boolean',
  1485. 'Float',
  1486. 'Date',
  1487. 'Time',
  1488. 'DateTime',
  1489. 'Bytes',
  1490. 'VarBytes',
  1491. 'AutoInc',
  1492. 'Blob',
  1493. 'Memo',
  1494. 'Graphic',
  1495. 'FmtMemo',
  1496. 'ParadoxOle',
  1497. 'DBaseOle',
  1498. 'TypedBinary',
  1499. 'Cursor'
  1500. );}
  1501. dsEditModes = [dsEdit, dsInsert];
  1502. { Auxiliary functions }
  1503. Procedure DatabaseError (Const Msg : String);
  1504. Procedure DatabaseError (Const Msg : String; Comp : TComponent);
  1505. Procedure DatabaseErrorFmt (Const Fmt : String; Args : Array Of Const);
  1506. Procedure DatabaseErrorFmt (Const Fmt : String; Args : Array Of const;
  1507. Comp : TComponent);
  1508. implementation
  1509. uses dbconst;
  1510. { ---------------------------------------------------------------------
  1511. Auxiliary functions
  1512. ---------------------------------------------------------------------}
  1513. Procedure DatabaseError (Const Msg : String);
  1514. begin
  1515. Raise EDataBaseError.Create(Msg);
  1516. end;
  1517. Procedure DatabaseError (Const Msg : String; Comp : TComponent);
  1518. begin
  1519. Raise EDatabaseError.CreateFmt('%s : %s',[Comp.Name,Msg]);
  1520. end;
  1521. Procedure DatabaseErrorFmt (Const Fmt : String; Args : Array Of Const);
  1522. begin
  1523. Raise EDatabaseError.CreateFmt(Fmt,Args);
  1524. end;
  1525. Procedure DatabaseErrorFmt (Const Fmt : String; Args : Array Of const;
  1526. Comp : TComponent);
  1527. begin
  1528. Raise EDatabaseError.CreateFmt(Format('%s : %s',[Comp.Name,Fmt]),Args);
  1529. end;
  1530. { TIndexDef }
  1531. constructor TIndexDef.Create(Owner: TIndexDefs; const AName, TheFields: string;
  1532. TheOptions: TIndexOptions);
  1533. begin
  1534. inherited create(Owner);
  1535. FName := aname;
  1536. FFields := TheFields;
  1537. FOptions := TheOptions;
  1538. end;
  1539. destructor TIndexDef.Destroy;
  1540. begin
  1541. //!! To be implemented
  1542. end;
  1543. { TIndexDefs }
  1544. Function TIndexDefs.GetItem (Index : integer) : TIndexDef;
  1545. begin
  1546. Result:=(Inherited GetItem(Index)) as TIndexDef;
  1547. end;
  1548. Procedure TIndexDefs.SetItem(Index: Integer; Value: TIndexDef);
  1549. begin
  1550. Inherited SetItem(Index,Value);
  1551. end;
  1552. constructor TIndexDefs.Create(DataSet: TDataSet);
  1553. begin
  1554. FDataset := Dataset;
  1555. inherited create(Dataset, TIndexDef);
  1556. end;
  1557. destructor TIndexDefs.Destroy;
  1558. begin
  1559. //!! To be implemented
  1560. end;
  1561. Function TIndexDefs.AddIndexDef: TIndexDef;
  1562. begin
  1563. // Result := inherited add as TIndexDef;
  1564. Result:=TIndexDef.Create(Self,'','',[]);
  1565. end;
  1566. procedure TIndexDefs.Add(const Name, Fields: string; Options: TIndexOptions);
  1567. begin
  1568. TIndexDef.Create(Self,Name,Fields,Options);
  1569. end;
  1570. procedure TIndexDefs.Assign(IndexDefs: TIndexDefs);
  1571. begin
  1572. //!! To be implemented
  1573. end;
  1574. {procedure TIndexDefs.Clear;
  1575. begin
  1576. //!! To be implemented
  1577. end;}
  1578. function TIndexDefs.FindIndexForFields(const Fields: string): TIndexDef;
  1579. begin
  1580. //!! To be implemented
  1581. end;
  1582. function TIndexDefs.GetIndexForFields(const Fields: string;
  1583. CaseInsensitive: Boolean): TIndexDef;
  1584. begin
  1585. //!! To be implemented
  1586. end;
  1587. {function TIndexDefs.IndexOf(const Name: string): Longint;
  1588. begin
  1589. //!! To be implemented
  1590. end;}
  1591. procedure TIndexDefs.Update;
  1592. begin
  1593. if assigned(Fdataset) then
  1594. Fdataset.UpdateIndexDefs;
  1595. end;
  1596. { TCheckConstraint }
  1597. procedure TCheckConstraint.Assign(Source: TPersistent);
  1598. begin
  1599. //!! To be implemented
  1600. end;
  1601. { TCheckConstraints }
  1602. Function TCheckConstraints.GetItem(Index : Longint) : TCheckConstraint;
  1603. begin
  1604. //!! To be implemented
  1605. end;
  1606. Procedure TCheckConstraints.SetItem(index : Longint; Value : TCheckConstraint);
  1607. begin
  1608. //!! To be implemented
  1609. end;
  1610. function TCheckConstraints.GetOwner: TPersistent;
  1611. begin
  1612. //!! To be implemented
  1613. end;
  1614. constructor TCheckConstraints.Create(AOwner: TPersistent);
  1615. begin
  1616. //!! To be implemented
  1617. end;
  1618. function TCheckConstraints.Add: TCheckConstraint;
  1619. begin
  1620. //!! To be implemented
  1621. end;
  1622. {$i dataset.inc}
  1623. {$i fields.inc}
  1624. {$i datasource.inc}
  1625. {$i database.inc}
  1626. {$i BufDataset.inc}
  1627. {$i dsparams.inc}
  1628. end.
  1629. {
  1630. $Log$
  1631. Revision 1.36 2005-02-07 11:21:50 joost
  1632. - Added TDataset.InternalInsert
  1633. - Implemented TField.DisplayName
  1634. - added support for TBufDataset delete and insert
  1635. Revision 1.35 2005/02/03 19:10:39 florian
  1636. + adapted for use fo tcollection.owner
  1637. Revision 1.34 2005/01/12 10:28:44 michael
  1638. * Patch from Joost Van der Sluis:
  1639. - implemented TUpdateMode, TProviderFlags
  1640. - implemented TIndexDef, TIndexDefs
  1641. Revision 1.33 2004/12/29 14:30:53 michael
  1642. + Patch from Joost van der Sluis
  1643. - implemented CachedUpdates (only modifications, no inserts/deletes)
  1644. - implemented GetAsVariant/SetAsVariant for all fields
  1645. - implemented TField.OldValue as a variant
  1646. - changed TField.Value to a variant
  1647. Revision 1.32 2004/12/13 20:19:49 michael
  1648. + Initial implementation of params
  1649. Revision 1.31 2004/12/13 19:20:12 michael
  1650. * Patch from Joost van der Sluis
  1651. - moved IsCursorOpen from TSQLQuery to tbufdataset
  1652. - moved SetFieldData from TSQLQuery to TBufDataset
  1653. - very first start for support of cached updates
  1654. Revision 1.30 2004/12/05 00:05:38 michael
  1655. patch to enable RecNo and DisplayFormat
  1656. Revision 1.29 2004/12/04 22:44:24 michael
  1657. * Patch from Joost van der Sluis
  1658. - implemented TBCDFields
  1659. - adapted for the changes in TBuffDataset
  1660. Revision 1.28 2004/11/05 08:32:02 michael
  1661. TBufDataset.inc:
  1662. - replaced Freemem by Reallocmem, Free by FreeAndNil
  1663. Database.inc:
  1664. - Moved Active property from TSQLTransaction to TDBTransaction
  1665. - Gives an error if the database of an active transaction is changed
  1666. Dataset.inc
  1667. - Don't distribute events if FDisableControlsCount > 0
  1668. - Replaced FActive by FState<>dsInactive
  1669. - Set EOF after append
  1670. db.pp:
  1671. - Removed duplicate definition of TAlignment
  1672. - Moved Active property from TSQLTransaction to TDBTransaction
  1673. - Replaced FActive by FState<>dsInactive
  1674. - Gives an error if the database of an active transaction is changed
  1675. sqldb:
  1676. - Moved Active property from TSQLTransaction to TDBTransaction
  1677. - replaced Freemem by Reallocmem, Free by FreeAndNil
  1678. IBConnection:
  1679. - Moved FSQLDAAllocated to the cursor
  1680. PQConnection:
  1681. - Don't try to free the statement if a fatal error occured
  1682. Revision 1.27 2004/10/27 07:23:13 michael
  1683. + Patch from Joost Van der Sluis to fix transactions
  1684. Revision 1.26 2004/10/10 14:45:51 michael
  1685. + Use of dbconst for resource strings
  1686. Revision 1.25 2004/10/10 14:25:21 michael
  1687. + Small fix for close so it does not check browsemode
  1688. Revision 1.24 2004/09/26 16:55:24 michael
  1689. * big patch from Joost van der Sluis
  1690. bufdataset.inc:
  1691. fix getrecord (prior)
  1692. getcanmodify default false
  1693. database.inc / db.inc:
  1694. Added transactions
  1695. dataset.inc:
  1696. raise error if trying to insert into an readonly dataset
  1697. db.inc:
  1698. remove published properties from bufdataset
  1699. changed ancestor of tbufdataset to tdbdataset
  1700. Revision 1.23 2004/08/31 09:51:27 michael
  1701. + Initial TBufDataset by Joost van der Sluis
  1702. Revision 1.22 2004/08/23 07:30:19 michael
  1703. + Fixes from joost van der sluis: tfieldsdefs.tdatafield and size, cancel of only record and dataset.fieldvalyes
  1704. Revision 1.21 2004/08/14 12:46:35 michael
  1705. + Patch from Joost van der Sluis to implement Modified and UpdateRecord event
  1706. Revision 1.20 2004/08/13 07:06:02 michael
  1707. + Rework of buffer management by Joost Van der Sluis
  1708. Revision 1.19 2004/07/25 11:32:40 michael
  1709. * Patches from Joost van der Sluis
  1710. interbase.pp:
  1711. * Removed unused Fprepared
  1712. * Changed the error message 'database connect string not filled
  1713. in' to 'database connect string (databasename) not filled in'
  1714. * Preparestatement and execute now checks if transaction is
  1715. assigned (in stead of crashing if it isn't) and if the
  1716. transaction isn't started, it calls starttransaction.
  1717. dataset.inc:
  1718. * In DoInternalOpen the buffers are now initialised before the
  1719. dataset is set into browse-state
  1720. database.inc and db.pp:
  1721. * If the dataset is created from a stream, the database is opened
  1722. after the dataset is read completely
  1723. Revision 1.18 2004/07/19 20:27:28 michael
  1724. + Fixes from Jesus Reyes to implement DisplayWith, DisplayLabel, Visibility
  1725. Revision 1.17 2004/07/18 13:16:50 michael
  1726. + Changed extended to double for better Delphi compatibility
  1727. Revision 1.16 2004/05/02 21:23:18 peter
  1728. * use ptrint
  1729. Revision 1.15 2004/03/25 20:43:39 michael
  1730. Some compatibility additions
  1731. Revision 1.14 2004/03/19 23:19:51 michael
  1732. + Corrected the Fields property.
  1733. Revision 1.13 2004/02/25 16:29:26 michael
  1734. + Added AsInteger to TField. Maps to AsLongint for now
  1735. Revision 1.12 2003/11/09 21:23:10 michael
  1736. + Patch from Micha Nelissen, fixing some Delphi compatibility issues
  1737. Revision 1.11 2003/10/06 17:04:27 florian
  1738. * small step towards calculated fields
  1739. Revision 1.10 2003/08/16 16:42:21 michael
  1740. + Fixes in TDBDataset etc. Changed MySQLDb to use database as well
  1741. Revision 1.9 2003/05/15 15:15:15 michael
  1742. + Database class in TDBDataset is public, not published
  1743. Revision 1.8 2003/05/08 21:52:41 michael
  1744. + Patch from Jesus Reyes
  1745. Revision 1.7 2003/02/20 19:30:28 michael
  1746. + Fixes from Jesus Reyes
  1747. Revision 1.6 2002/09/07 15:15:23 peter
  1748. * old logs removed and tabs fixed
  1749. }