db.pas 97 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 1999-2014 by Michael Van Canneyt, member of the
  4. Free Pascal development team
  5. DB header file with interface section.
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. unit DB;
  13. {$mode objfpc}
  14. {$h+}
  15. interface
  16. uses Classes,SysUtils,Variants,FmtBCD,MaskUtils;
  17. const
  18. dsMaxBufferCount = MAXINT div 8;
  19. dsMaxStringSize = 8192;
  20. // Used in AsBoolean for string fields to determine
  21. // whether it's true or false.
  22. YesNoChars : Array[Boolean] of char = ('N', 'Y');
  23. SQLDelimiterCharacters = [';',',',' ','(',')',#13,#10,#9];
  24. type
  25. {LargeInt}
  26. LargeInt = Int64;
  27. PLargeInt= ^LargeInt;
  28. { Auxiliary type }
  29. TStringFieldBuffer = Array[0..dsMaxStringSize] of AnsiChar;
  30. { Misc Dataset types }
  31. TDataSetState = (dsInactive, dsBrowse, dsEdit, dsInsert, dsSetKey,
  32. dsCalcFields, dsFilter, dsNewValue, dsOldValue, dsCurValue, dsBlockRead,
  33. dsInternalCalc, dsOpening, dsRefreshFields);
  34. TDataEvent = (deFieldChange, deRecordChange, deDataSetChange,
  35. deDataSetScroll, deLayoutChange, deUpdateRecord, deUpdateState,
  36. deCheckBrowseMode, dePropertyChange, deFieldListChange, deFocusControl,
  37. deParentScroll,deConnectChange,deReconcileError,deDisabledStateChange);
  38. TUpdateStatus = (usUnmodified, usModified, usInserted, usDeleted);
  39. TUpdateStatusSet = SET OF TUpdateStatus;
  40. TUpdateMode = (upWhereAll, upWhereChanged, upWhereKeyOnly);
  41. TResolverResponse = (rrSkip, rrAbort, rrMerge, rrApply, rrIgnore);
  42. TProviderFlag = (pfInUpdate, pfInWhere, pfInKey, pfHidden, pfRefreshOnInsert,pfRefreshOnUpdate);
  43. TProviderFlags = set of TProviderFlag;
  44. { Forward declarations }
  45. TFieldDef = class;
  46. TFieldDefs = class;
  47. TField = class;
  48. TFields = Class;
  49. TDataSet = class;
  50. TDataBase = Class;
  51. TDataSource = Class;
  52. TDataLink = Class;
  53. TDBTransaction = Class;
  54. { Exception classes }
  55. EDatabaseError = class(Exception);
  56. EUpdateError = class(EDatabaseError)
  57. private
  58. FContext : String;
  59. FErrorCode : integer;
  60. FOriginalException : Exception;
  61. FPreviousError : Integer;
  62. public
  63. constructor Create(NativeError, Context : String;
  64. ErrCode, PrevError : integer; E: Exception);
  65. Destructor Destroy; override;
  66. property Context : String read FContext;
  67. property ErrorCode : integer read FErrorcode;
  68. property OriginalException : Exception read FOriginalException;
  69. property PreviousError : Integer read FPreviousError;
  70. end;
  71. { TFieldDef }
  72. TFieldClass = class of TField;
  73. // Data type for field.
  74. // The order is determined by Delphi compatibility
  75. TFieldType = (ftUnknown, ftString, ftSmallint, ftInteger, ftWord,
  76. ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime,
  77. ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic, ftFmtMemo,
  78. ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftFixedChar,
  79. ftWideString, ftLargeint, ftADT, ftArray, ftReference,
  80. ftDataSet, ftOraBlob, ftOraClob, ftVariant, ftInterface,
  81. ftIDispatch, ftGuid, ftTimeStamp, ftFMTBcd, ftFixedWideChar, ftWideMemo);
  82. { Part of DBCommon, but temporarily defined here (bug 8206) }
  83. TFieldMap = array[TFieldType] of Byte;
  84. { TDateTimeRec }
  85. TDateTimeAlias = type TDateTime;
  86. PDateTimeRec = ^TdateTimeRec;
  87. TDateTimeRec = record
  88. case TFieldType of
  89. ftDate: (Date: Longint);
  90. ftTime: (Time: Longint);
  91. ftDateTime: (DateTime: TDateTimeAlias);
  92. end;
  93. TFieldAttribute = (faHiddenCol, faReadonly, faRequired, faLink, faUnNamed, faFixed);
  94. TFieldAttributes = set of TFieldAttribute;
  95. { TNamedItem }
  96. TNamedItem = class(TCollectionItem)
  97. private
  98. FName: string;
  99. protected
  100. function GetDisplayName: string; override;
  101. procedure SetDisplayName(const AValue: string); override;
  102. Public
  103. property DisplayName : string read GetDisplayName write SetDisplayName;
  104. published
  105. property Name : string read FName write SetDisplayName;
  106. end;
  107. { TDefCollection }
  108. TDefCollection = class(TOwnedCollection)
  109. private
  110. FDataset: TDataset;
  111. FUpdated: boolean;
  112. protected
  113. procedure SetItemName(AItem: TCollectionItem); override;
  114. public
  115. constructor create(ADataset: TDataset; AOwner: TPersistent; AClass: TCollectionItemClass);
  116. function Find(const AName: string): TNamedItem;
  117. procedure GetItemNames(List: TStrings);
  118. function IndexOf(const AName: string): Longint;
  119. property Dataset: TDataset read FDataset;
  120. property Updated: boolean read FUpdated write FUpdated;
  121. end;
  122. { TFieldDef }
  123. TFieldDef = class(TNamedItem)
  124. Private
  125. FAttributes : TFieldAttributes;
  126. FCodePage : TSystemCodePage;
  127. FDataType : TFieldType;
  128. FFieldNo : Longint;
  129. FInternalCalcField : Boolean;
  130. FPrecision : Longint;
  131. FRequired : Boolean;
  132. FSize : Integer;
  133. function GetCharSize: Word;
  134. Function GetFieldClass : TFieldClass;
  135. procedure SetAttributes(AValue: TFieldAttributes);
  136. procedure SetDataType(AValue: TFieldType);
  137. procedure SetPrecision(const AValue: Longint);
  138. procedure SetSize(const AValue: Integer);
  139. procedure SetRequired(const AValue: Boolean);
  140. public
  141. constructor Create(ACollection : TCollection); override;
  142. constructor Create(AOwner: TFieldDefs; const AName: string;
  143. ADataType: TFieldType; ASize: Integer; ARequired: Boolean; AFieldNo: Longint;
  144. ACodePage: TSystemCodePage = CP_ACP); overload;
  145. destructor Destroy; override;
  146. procedure Assign(APersistent: TPersistent); override;
  147. function CreateField(AOwner: TComponent): TField;
  148. property FieldClass: TFieldClass read GetFieldClass;
  149. property FieldNo: Longint read FFieldNo;
  150. property CharSize: Word read GetCharSize;
  151. property InternalCalcField: Boolean read FInternalCalcField write FInternalCalcField;
  152. property Required: Boolean read FRequired write SetRequired;
  153. Published
  154. property Attributes: TFieldAttributes read FAttributes write SetAttributes default [];
  155. property DataType: TFieldType read FDataType write SetDataType;
  156. property Precision: Longint read FPrecision write SetPrecision default 0;
  157. property Size: Integer read FSize write SetSize default 0;
  158. end;
  159. TFieldDefClass = Class of TFieldDef;
  160. { TFieldDefs }
  161. TFieldDefs = class(TDefCollection)
  162. private
  163. FHiddenFields : Boolean;
  164. function GetItem(Index: Longint): TFieldDef;
  165. procedure SetItem(Index: Longint; const AValue: TFieldDef);
  166. Protected
  167. Class Function FieldDefClass : TFieldDefClass; virtual;
  168. public
  169. constructor Create(ADataSet: TDataSet);
  170. // destructor Destroy; override;
  171. Function Add(const AName: string; ADataType: TFieldType; ASize, APrecision: Integer; ARequired, AReadOnly: Boolean; AFieldNo : Integer; ACodePage:TSystemCodePage) : TFieldDef; overload;
  172. Function Add(const AName: string; ADataType: TFieldType; ASize: Word; ARequired: Boolean; AFieldNo : Integer) : TFieldDef; overload;
  173. procedure Add(const AName: string; ADataType: TFieldType; ASize: Word; ARequired: Boolean); overload;
  174. procedure Add(const AName: string; ADataType: TFieldType; ASize: Word); overload;
  175. procedure Add(const AName: string; ADataType: TFieldType); overload;
  176. Function AddFieldDef : TFieldDef;
  177. procedure Assign(FieldDefs: TFieldDefs); overload;
  178. function Find(const AName: string): TFieldDef;
  179. // procedure Clear;
  180. // procedure Delete(Index: Longint);
  181. procedure Update; overload;
  182. Function MakeNameUnique(const AName : String) : string; virtual;
  183. Property HiddenFields : Boolean Read FHiddenFields Write FHiddenFields;
  184. property Items[Index: Longint]: TFieldDef read GetItem write SetItem; default;
  185. end;
  186. TFieldDefsClass = Class of TFieldDefs;
  187. { TField }
  188. TFieldKind = (fkData, fkCalculated, fkLookup, fkInternalCalc);
  189. TFieldKinds = Set of TFieldKind;
  190. TFieldNotifyEvent = procedure(Sender: TField) of object;
  191. TFieldGetTextEvent = procedure(Sender: TField; var aText: string;
  192. DisplayText: Boolean) of object;
  193. TFieldSetTextEvent = procedure(Sender: TField; const aText: string) of object;
  194. TFieldRef = ^TField;
  195. TFieldChars = set of Char;
  196. PLookupListRec = ^TLookupListRec;
  197. TLookupListRec = record
  198. Key: Variant;
  199. Value: Variant;
  200. end;
  201. { TLookupList }
  202. TLookupList = class(TObject)
  203. private
  204. FList: TFPList;
  205. public
  206. constructor Create;
  207. destructor Destroy; override;
  208. procedure Add(const AKey, AValue: Variant);
  209. procedure Clear;
  210. function FirstKeyByValue(const AValue: Variant): Variant;
  211. function ValueOfKey(const AKey: Variant): Variant;
  212. procedure ValuesToStrings(AStrings: TStrings);
  213. end;
  214. { TField }
  215. TField = class(TComponent)
  216. private
  217. FAlignment : TAlignment;
  218. FAttributeSet : String;
  219. FCalculated : Boolean;
  220. FConstraintErrorMessage : String;
  221. FCustomConstraint : String;
  222. FDataSet : TDataSet;
  223. // FDataSize : Word;
  224. FDataType : TFieldType;
  225. FDefaultExpression : String;
  226. FDisplayLabel : String;
  227. FDisplayWidth : Longint;
  228. FEditMask: TEditMask;
  229. FFieldDef: TFieldDef;
  230. FFieldKind : TFieldKind;
  231. FFieldName : String;
  232. FFieldNo : Longint;
  233. FFields : TFields;
  234. FHasConstraints : Boolean;
  235. FImportedConstraint : String;
  236. FIsIndexField : Boolean;
  237. FKeyFields : String;
  238. FLookupCache : Boolean;
  239. FLookupDataSet : TDataSet;
  240. FLookupKeyfields : String;
  241. FLookupresultField : String;
  242. FLookupList: TLookupList;
  243. FOffset : Word;
  244. FOnChange : TFieldNotifyEvent;
  245. FOnGetText: TFieldGetTextEvent;
  246. FOnSetText: TFieldSetTextEvent;
  247. FOnValidate: TFieldNotifyEvent;
  248. FOrigin : String;
  249. FReadOnly : Boolean;
  250. FRequired : Boolean;
  251. FSize : integer;
  252. FValidChars : TFieldChars;
  253. FValueBuffer : Pointer;
  254. FValidating : Boolean;
  255. FVisible : Boolean;
  256. FProviderFlags : TProviderFlags;
  257. function GetIndex : longint;
  258. function GetLookup: Boolean;
  259. procedure SetAlignment(const AValue: TAlignMent);
  260. procedure SetIndex(const AValue: Longint);
  261. function GetDisplayText: String;
  262. function GetEditText: String;
  263. procedure SetEditText(const AValue: string);
  264. procedure SetDisplayLabel(const AValue: string);
  265. procedure SetDisplayWidth(const AValue: Longint);
  266. function GetDisplayWidth: integer;
  267. procedure SetLookup(const AValue: Boolean);
  268. procedure SetReadOnly(const AValue: Boolean);
  269. procedure SetVisible(const AValue: Boolean);
  270. function IsDisplayLabelStored : Boolean;
  271. function IsDisplayWidthStored: Boolean;
  272. function GetLookupList: TLookupList;
  273. procedure CalcLookupValue;
  274. protected
  275. function AccessError(const TypeName: string): EDatabaseError;
  276. procedure CheckInactive;
  277. class procedure CheckTypeSize(AValue: Longint); virtual;
  278. procedure Change; virtual;
  279. procedure Bind(Binding: Boolean); virtual;
  280. procedure DataChanged;
  281. procedure FreeBuffers; virtual;
  282. function GetAsBCD: TBCD; virtual;
  283. function GetAsBoolean: Boolean; virtual;
  284. function GetAsBytes: TBytes; virtual;
  285. function GetAsCurrency: Currency; virtual;
  286. function GetAsLargeInt: Largeint; virtual;
  287. function GetAsDateTime: TDateTime; virtual;
  288. function GetAsFloat: Double; virtual;
  289. function GetAsLongint: Longint; virtual;
  290. function GetAsInteger: Longint; virtual;
  291. function GetAsVariant: variant; virtual;
  292. function GetOldValue: variant; virtual;
  293. function GetAsString: string; virtual;
  294. function GetAsAnsiString: AnsiString; virtual;
  295. function GetAsUnicodeString: UnicodeString; virtual;
  296. function GetAsUTF8String: UTF8String; virtual;
  297. function GetAsWideString: WideString; virtual;
  298. function GetCanModify: Boolean; virtual;
  299. function GetClassDesc: String; virtual;
  300. function GetDataSize: Integer; virtual;
  301. function GetDefaultWidth: Longint; virtual;
  302. function GetDisplayName : String;
  303. function GetCurValue: Variant; virtual;
  304. function GetNewValue: Variant; virtual;
  305. function GetIsNull: Boolean; virtual;
  306. function GetParentComponent: TComponent; override;
  307. procedure GetText(var AText: string; ADisplayText: Boolean); virtual;
  308. function HasParent: Boolean; override;
  309. procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  310. procedure PropertyChanged(LayoutAffected: Boolean);
  311. procedure ReadState(Reader: TReader); override;
  312. procedure SetAsBCD(const AValue: TBCD); virtual;
  313. procedure SetAsBoolean(AValue: Boolean); virtual;
  314. procedure SetAsBytes(const AValue: TBytes); virtual;
  315. procedure SetAsCurrency(AValue: Currency); virtual;
  316. procedure SetAsDateTime(AValue: TDateTime); virtual;
  317. procedure SetAsFloat(AValue: Double); virtual;
  318. procedure SetAsLongint(AValue: Longint); virtual;
  319. procedure SetAsInteger(AValue: Longint); virtual;
  320. procedure SetAsLargeInt(AValue: Largeint); virtual;
  321. procedure SetAsVariant(const AValue: variant); virtual;
  322. procedure SetAsString(const AValue: string); virtual;
  323. procedure SetAsAnsiString(const AValue: AnsiString); virtual;
  324. procedure SetAsUnicodeString(const AValue: UnicodeString); virtual;
  325. procedure SetAsUTF8String(const AValue: UTF8String); virtual;
  326. procedure SetAsWideString(const AValue: WideString); virtual;
  327. procedure SetDataset(AValue : TDataset); virtual;
  328. procedure SetDataType(AValue: TFieldType);
  329. procedure SetNewValue(const AValue: Variant);
  330. procedure SetSize(AValue: Integer); virtual;
  331. procedure SetParentComponent(AParent: TComponent); override;
  332. procedure SetText(const AValue: string); virtual;
  333. procedure SetVarValue(const AValue: Variant); virtual;
  334. public
  335. constructor Create(AOwner: TComponent); override;
  336. destructor Destroy; override;
  337. procedure Assign(Source: TPersistent); override;
  338. procedure AssignValue(const AValue: TVarRec);
  339. procedure Clear; virtual;
  340. procedure FocusControl;
  341. function GetData(Buffer: Pointer): Boolean; overload;
  342. function GetData(Buffer: Pointer; NativeFormat : Boolean): Boolean; overload;
  343. class function IsBlob: Boolean; virtual;
  344. function IsValidChar(InputChar: Char): Boolean; virtual;
  345. procedure RefreshLookupList;
  346. procedure SetData(Buffer: Pointer); overload;
  347. procedure SetData(Buffer: Pointer; NativeFormat : Boolean); overload;
  348. procedure SetFieldType(AValue: TFieldType); virtual;
  349. procedure Validate(Buffer: Pointer);
  350. property AsBCD: TBCD read GetAsBCD write SetAsBCD;
  351. property AsBoolean: Boolean read GetAsBoolean write SetAsBoolean;
  352. property AsBytes: TBytes read GetAsBytes write SetAsBytes;
  353. property AsCurrency: Currency read GetAsCurrency write SetAsCurrency;
  354. property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
  355. property AsFloat: Double read GetAsFloat write SetAsFloat;
  356. property AsLongint: Longint read GetAsLongint write SetAsLongint;
  357. property AsLargeInt: LargeInt read GetAsLargeInt write SetAsLargeInt;
  358. property AsInteger: Longint read GetAsInteger write SetAsInteger;
  359. property AsString: string read GetAsString write SetAsString;
  360. property AsAnsiString: AnsiString read GetAsAnsiString write SetAsAnsiString;
  361. property AsUnicodeString: UnicodeString read GetAsUnicodeString write SetAsUnicodeString;
  362. property AsUTF8String: UTF8String read GetAsUTF8String write SetAsUTF8String;
  363. property AsWideString: WideString read GetAsWideString write SetAsWideString;
  364. property AsVariant: variant read GetAsVariant write SetAsVariant;
  365. property AttributeSet: string read FAttributeSet write FAttributeSet;
  366. property Calculated: Boolean read FCalculated write FCalculated;
  367. property CanModify: Boolean read GetCanModify;
  368. property CurValue: Variant read GetCurValue;
  369. property DataSet: TDataSet read FDataSet write SetDataSet;
  370. property DataSize: Integer read GetDataSize;
  371. property DataType: TFieldType read FDataType;
  372. property DisplayName: String Read GetDisplayName;
  373. property DisplayText: String read GetDisplayText;
  374. property EditMask: TEditMask read FEditMask write FEditMask;
  375. property EditMaskPtr: TEditMask read FEditMask;
  376. property FieldNo: Longint read FFieldNo;
  377. property IsIndexField: Boolean read FIsIndexField;
  378. property IsNull: Boolean read GetIsNull;
  379. property Lookup: Boolean read GetLookup write SetLookup; deprecated;
  380. property NewValue: Variant read GetNewValue write SetNewValue;
  381. property Offset: word read FOffset;
  382. property Size: Integer read FSize write SetSize;
  383. property Text: string read GetEditText write SetEditText;
  384. property ValidChars : TFieldChars read FValidChars write FValidChars;
  385. property Value: variant read GetAsVariant write SetAsVariant;
  386. property OldValue: variant read GetOldValue;
  387. property LookupList: TLookupList read GetLookupList;
  388. Property FieldDef : TFieldDef Read FFieldDef;
  389. published
  390. property Alignment : TAlignment read FAlignment write SetAlignment default taLeftJustify;
  391. property CustomConstraint: string read FCustomConstraint write FCustomConstraint;
  392. property ConstraintErrorMessage: string read FConstraintErrorMessage write FConstraintErrorMessage;
  393. property DefaultExpression: string read FDefaultExpression write FDefaultExpression;
  394. property DisplayLabel : string read GetDisplayName write SetDisplayLabel stored IsDisplayLabelStored;
  395. property DisplayWidth: Longint read GetDisplayWidth write SetDisplayWidth stored IsDisplayWidthStored;
  396. property FieldKind: TFieldKind read FFieldKind write FFieldKind;
  397. property FieldName: string read FFieldName write FFieldName;
  398. property HasConstraints: Boolean read FHasConstraints;
  399. property Index: Longint read GetIndex write SetIndex;
  400. property ImportedConstraint: string read FImportedConstraint write FImportedConstraint;
  401. property KeyFields: string read FKeyFields write FKeyFields;
  402. property LookupCache: Boolean read FLookupCache write FLookupCache;
  403. property LookupDataSet: TDataSet read FLookupDataSet write FLookupDataSet;
  404. property LookupKeyFields: string read FLookupKeyFields write FLookupKeyFields;
  405. property LookupResultField: string read FLookupResultField write FLookupResultField;
  406. property Origin: string read FOrigin write FOrigin;
  407. property ProviderFlags : TProviderFlags read FProviderFlags write FProviderFlags;
  408. property ReadOnly: Boolean read FReadOnly write SetReadOnly;
  409. property Required: Boolean read FRequired write FRequired;
  410. property Visible: Boolean read FVisible write SetVisible default True;
  411. property OnChange: TFieldNotifyEvent read FOnChange write FOnChange;
  412. property OnGetText: TFieldGetTextEvent read FOnGetText write FOnGetText;
  413. property OnSetText: TFieldSetTextEvent read FOnSetText write FOnSetText;
  414. property OnValidate: TFieldNotifyEvent read FOnValidate write FOnValidate;
  415. end;
  416. { TStringField }
  417. TStringField = class(TField)
  418. private
  419. FCodePage : TSystemCodePage;
  420. FFixedChar : boolean;
  421. FTransliterate : Boolean;
  422. protected
  423. class procedure CheckTypeSize(AValue: Longint); override;
  424. function GetAsBoolean: Boolean; override;
  425. function GetAsDateTime: TDateTime; override;
  426. function GetAsFloat: Double; override;
  427. function GetAsInteger: Longint; override;
  428. function GetAsLargeInt: Largeint; override;
  429. function GetAsString: String; override;
  430. function GetAsAnsiString: AnsiString; override;
  431. function GetAsUTF8String: UTF8String; override;
  432. function GetAsVariant: variant; override;
  433. function GetDataSize: Integer; override;
  434. function GetDefaultWidth: Longint; override;
  435. procedure GetText(var AText: string; ADisplayText: Boolean); override;
  436. function GetValue(out AValue: RawByteString): Boolean;
  437. procedure SetAsBoolean(AValue: Boolean); override;
  438. procedure SetAsDateTime(AValue: TDateTime); override;
  439. procedure SetAsFloat(AValue: Double); override;
  440. procedure SetAsInteger(AValue: Longint); override;
  441. procedure SetAsLargeInt(AValue: Largeint); override;
  442. procedure SetAsString(const AValue: String); override;
  443. procedure SetAsAnsiString(const AValue: AnsiString); override;
  444. procedure SetAsUTF8String(const AValue: UTF8String); override;
  445. procedure SetVarValue(const AValue: Variant); override;
  446. procedure SetValue(AValue: RawByteString);
  447. public
  448. constructor Create(AOwner: TComponent); override;
  449. procedure SetFieldType(AValue: TFieldType); override;
  450. property CodePage : TSystemCodePage read FCodePage;
  451. property FixedChar : Boolean read FFixedChar write FFixedChar;
  452. property Transliterate: Boolean read FTransliterate write FTransliterate;
  453. property Value: String read GetAsString write SetAsString;
  454. published
  455. property EditMask;
  456. property Size default 20;
  457. end;
  458. { TWideStringField }
  459. TWideStringField = class(TStringField)
  460. protected
  461. class procedure CheckTypeSize(AValue: Integer); override;
  462. function GetValue(out AValue: UnicodeString): Boolean;
  463. function GetAsString: string; override;
  464. procedure SetAsString(const AValue: string); override;
  465. function GetAsVariant: Variant; override;
  466. procedure SetVarValue(const AValue: Variant); override;
  467. function GetAsWideString: WideString; override;
  468. procedure SetAsWideString(const AValue: WideString); override;
  469. function GetAsUnicodeString: UnicodeString; override;
  470. procedure SetAsUnicodeString(const AValue: UnicodeString); override;
  471. function GetAsUTF8String: UTF8String; override;
  472. procedure SetAsUTF8String(const AValue: UTF8String); override;
  473. function GetDataSize: Integer; override;
  474. public
  475. constructor Create(AOwner: TComponent); override;
  476. procedure SetFieldType(AValue: TFieldType); override;
  477. property Value: WideString read GetAsWideString write SetAsWideString;
  478. end;
  479. { TNumericField }
  480. TNumericField = class(TField)
  481. Private
  482. FDisplayFormat : String;
  483. FEditFormat : String;
  484. protected
  485. class procedure CheckTypeSize(AValue: Longint); override;
  486. procedure RangeError(AValue, Min, Max: Double);
  487. procedure SetDisplayFormat(const AValue: string);
  488. procedure SetEditFormat(const AValue: string);
  489. function GetAsBoolean: Boolean; override;
  490. Procedure SetAsBoolean(AValue: Boolean); override;
  491. public
  492. constructor Create(AOwner: TComponent); override;
  493. published
  494. property Alignment default taRightJustify;
  495. property DisplayFormat: string read FDisplayFormat write SetDisplayFormat;
  496. property EditFormat: string read FEditFormat write SetEditFormat;
  497. end;
  498. { TLongintField }
  499. TLongintField = class(TNumericField)
  500. private
  501. FMinValue,
  502. FMaxValue,
  503. FMinRange,
  504. FMaxRange : Longint;
  505. Procedure SetMinValue (AValue : longint);
  506. Procedure SetMaxValue (AValue : longint);
  507. protected
  508. function GetAsFloat: Double; override;
  509. function GetAsInteger: Longint; override;
  510. function GetAsString: string; override;
  511. function GetAsVariant: variant; override;
  512. function GetDataSize: Integer; override;
  513. procedure GetText(var AText: string; ADisplayText: Boolean); override;
  514. function GetValue(var AValue: Longint): Boolean;
  515. procedure SetAsFloat(AValue: Double); override;
  516. procedure SetAsInteger(AValue: Longint); override;
  517. procedure SetAsString(const AValue: string); override;
  518. procedure SetVarValue(const AValue: Variant); override;
  519. function GetAsLargeInt: Largeint; override;
  520. procedure SetAsLargeInt(AValue: Largeint); override;
  521. public
  522. constructor Create(AOwner: TComponent); override;
  523. Function CheckRange(AValue : Longint) : Boolean;
  524. property Value: Longint read GetAsInteger write SetAsInteger;
  525. published
  526. property MaxValue: Longint read FMaxValue write SetMaxValue default 0;
  527. property MinValue: Longint read FMinValue write SetMinValue default 0;
  528. end;
  529. TIntegerField = Class(TLongintField);
  530. { TLargeintField }
  531. TLargeintField = class(TNumericField)
  532. private
  533. FMinValue,
  534. FMaxValue,
  535. FMinRange,
  536. FMaxRange : Largeint;
  537. Procedure SetMinValue (AValue : Largeint);
  538. Procedure SetMaxValue (AValue : Largeint);
  539. protected
  540. function GetAsFloat: Double; override;
  541. function GetAsInteger: Longint; override;
  542. function GetAsLargeInt: Largeint; override;
  543. function GetAsString: string; override;
  544. function GetAsVariant: variant; override;
  545. function GetDataSize: Integer; override;
  546. procedure GetText(var AText: string; ADisplayText: Boolean); override;
  547. function GetValue(var AValue: Largeint): Boolean;
  548. procedure SetAsFloat(AValue: Double); override;
  549. procedure SetAsInteger(AValue: Longint); override;
  550. procedure SetAsLargeInt(AValue: Largeint); override;
  551. procedure SetAsString(const AValue: string); override;
  552. procedure SetVarValue(const AValue: Variant); override;
  553. public
  554. constructor Create(AOwner: TComponent); override;
  555. Function CheckRange(AValue : Largeint) : Boolean;
  556. property Value: Largeint read GetAsLargeInt write SetAsLargeInt;
  557. published
  558. property MaxValue: Largeint read FMaxValue write SetMaxValue default 0;
  559. property MinValue: Largeint read FMinValue write SetMinValue default 0;
  560. end;
  561. { TSmallintField }
  562. TSmallintField = class(TLongintField)
  563. protected
  564. function GetDataSize: Integer; override;
  565. public
  566. constructor Create(AOwner: TComponent); override;
  567. end;
  568. { TWordField }
  569. TWordField = class(TLongintField)
  570. protected
  571. function GetDataSize: Integer; override;
  572. public
  573. constructor Create(AOwner: TComponent); override;
  574. end;
  575. { TAutoIncField }
  576. TAutoIncField = class(TLongintField)
  577. Protected
  578. procedure SetAsInteger(AValue: Longint); override;
  579. public
  580. constructor Create(AOwner: TComponent); override;
  581. end;
  582. { TFloatField }
  583. TFloatField = class(TNumericField)
  584. private
  585. FCurrency: Boolean;
  586. FMaxValue : Double;
  587. FMinValue : Double;
  588. FPrecision : Longint;
  589. procedure SetCurrency(const AValue: Boolean);
  590. procedure SetPrecision(const AValue: Longint);
  591. protected
  592. function GetAsBCD: TBCD; override;
  593. function GetAsFloat: Double; override;
  594. function GetAsLargeInt: LargeInt; override;
  595. function GetAsInteger: Longint; override;
  596. function GetAsVariant: variant; override;
  597. function GetAsString: string; override;
  598. function GetDataSize: Integer; override;
  599. procedure GetText(var AText: string; ADisplayText: Boolean); override;
  600. procedure SetAsBCD(const AValue: TBCD); override;
  601. procedure SetAsFloat(AValue: Double); override;
  602. procedure SetAsLargeInt(AValue: LargeInt); override;
  603. procedure SetAsInteger(AValue: Longint); override;
  604. procedure SetAsString(const AValue: string); override;
  605. procedure SetVarValue(const AValue: Variant); override;
  606. public
  607. constructor Create(AOwner: TComponent); override;
  608. Function CheckRange(AValue : Double) : Boolean;
  609. property Value: Double read GetAsFloat write SetAsFloat;
  610. published
  611. property Currency: Boolean read FCurrency write SetCurrency default False;
  612. property MaxValue: Double read FMaxValue write FMaxValue;
  613. property MinValue: Double read FMinValue write FMinValue;
  614. property Precision: Longint read FPrecision write SetPrecision default 15; // min 2 instellen, delphi compat
  615. end;
  616. { TCurrencyField }
  617. TCurrencyField = class(TFloatField)
  618. public
  619. constructor Create(AOwner: TComponent); override;
  620. published
  621. property Currency default True;
  622. end;
  623. { TBooleanField }
  624. TBooleanField = class(TField)
  625. private
  626. FDisplayValues : String;
  627. // First byte indicates uppercase or not.
  628. FDisplays : Array[Boolean,Boolean] of string;
  629. Procedure SetDisplayValues(const AValue : String);
  630. protected
  631. function GetAsBoolean: Boolean; override;
  632. function GetAsString: string; override;
  633. function GetAsVariant: variant; override;
  634. function GetAsInteger: Longint; override;
  635. function GetDataSize: Integer; override;
  636. function GetDefaultWidth: Longint; override;
  637. procedure SetAsBoolean(AValue: Boolean); override;
  638. procedure SetAsString(const AValue: string); override;
  639. procedure SetAsInteger(AValue: Longint); override;
  640. procedure SetVarValue(const AValue: Variant); override;
  641. public
  642. constructor Create(AOwner: TComponent); override;
  643. property Value: Boolean read GetAsBoolean write SetAsBoolean;
  644. published
  645. property DisplayValues: string read FDisplayValues write SetDisplayValues;
  646. end;
  647. { TDateTimeField }
  648. TDateTimeField = class(TField)
  649. private
  650. FDisplayFormat : String;
  651. procedure SetDisplayFormat(const AValue: string);
  652. protected
  653. function GetAsDateTime: TDateTime; override;
  654. function GetAsFloat: Double; override;
  655. function GetAsString: string; override;
  656. function GetAsVariant: variant; override;
  657. function GetDataSize: Integer; override;
  658. procedure GetText(var AText: string; ADisplayText: Boolean); override;
  659. procedure SetAsDateTime(AValue: TDateTime); override;
  660. procedure SetAsFloat(AValue: Double); override;
  661. procedure SetAsString(const AValue: string); override;
  662. procedure SetVarValue(const AValue: Variant); override;
  663. public
  664. constructor Create(AOwner: TComponent); override;
  665. property Value: TDateTime read GetAsDateTime write SetAsDateTime;
  666. published
  667. property DisplayFormat: string read FDisplayFormat write SetDisplayFormat;
  668. property EditMask;
  669. end;
  670. { TDateField }
  671. TDateField = class(TDateTimeField)
  672. public
  673. constructor Create(AOwner: TComponent); override;
  674. end;
  675. { TTimeField }
  676. TTimeField = class(TDateTimeField)
  677. protected
  678. procedure SetAsString(const AValue: string); override;
  679. public
  680. constructor Create(AOwner: TComponent); override;
  681. end;
  682. { TBinaryField }
  683. TBinaryField = class(TField)
  684. protected
  685. class procedure CheckTypeSize(AValue: Longint); override;
  686. function GetAsBytes: TBytes; override;
  687. function GetAsString: string; override;
  688. function GetAsVariant: Variant; override;
  689. function GetValue(var AValue: TBytes): Boolean;
  690. procedure SetAsBytes(const AValue: TBytes); override;
  691. procedure SetAsString(const AValue: string); override;
  692. procedure SetVarValue(const AValue: Variant); override;
  693. public
  694. constructor Create(AOwner: TComponent); override;
  695. published
  696. property Size default 16;
  697. end;
  698. { TBytesField }
  699. TBytesField = class(TBinaryField)
  700. protected
  701. function GetDataSize: Integer; override;
  702. public
  703. constructor Create(AOwner: TComponent); override;
  704. end;
  705. { TVarBytesField }
  706. TVarBytesField = class(TBytesField)
  707. protected
  708. function GetDataSize: Integer; override;
  709. public
  710. constructor Create(AOwner: TComponent); override;
  711. end;
  712. { TBCDField }
  713. TBCDField = class(TNumericField)
  714. private
  715. FMinValue,
  716. FMaxValue : currency;
  717. FPrecision : Longint;
  718. FCurrency : boolean;
  719. protected
  720. class procedure CheckTypeSize(AValue: Longint); override;
  721. function GetAsBCD: TBCD; override;
  722. function GetAsCurrency: Currency; override;
  723. function GetAsFloat: Double; override;
  724. function GetAsInteger: Longint; override;
  725. function GetAsString: string; override;
  726. function GetValue(var AValue: Currency): Boolean;
  727. function GetAsVariant: variant; override;
  728. function GetDataSize: Integer; override;
  729. function GetDefaultWidth: Longint; override;
  730. procedure GetText(var AText: string; ADisplayText: Boolean); override;
  731. procedure SetAsBCD(const AValue: TBCD); override;
  732. procedure SetAsFloat(AValue: Double); override;
  733. procedure SetAsInteger(AValue: Longint); override;
  734. procedure SetAsString(const AValue: string); override;
  735. procedure SetAsCurrency(AValue: Currency); override;
  736. procedure SetVarValue(const AValue: Variant); override;
  737. public
  738. constructor Create(AOwner: TComponent); override;
  739. Function CheckRange(AValue : Currency) : Boolean;
  740. property Value: Currency read GetAscurrency write SetAscurrency;
  741. published
  742. property Precision: Longint read FPrecision write FPrecision;
  743. property Currency: Boolean read FCurrency write FCurrency;
  744. property MaxValue: Currency read FMaxValue write FMaxValue;
  745. property MinValue: Currency read FMinValue write FMinValue;
  746. property Size default 4;
  747. end;
  748. { TFMTBCDField }
  749. TFMTBCDField = class(TNumericField)
  750. private
  751. FMinValue,
  752. FMaxValue : TBCD;
  753. FPrecision : Longint;
  754. FCurrency : boolean;
  755. function GetMaxValue: string;
  756. function GetMinValue: string;
  757. procedure SetMaxValue(const AValue: string);
  758. procedure SetMinValue(const AValue: string);
  759. protected
  760. class procedure CheckTypeSize(AValue: Longint); override;
  761. function GetAsBCD: TBCD; override;
  762. function GetAsCurrency: Currency; override;
  763. function GetAsFloat: Double; override;
  764. function GetAsLargeInt: LargeInt; override;
  765. function GetAsInteger: Longint; override;
  766. function GetAsString: string; override;
  767. function GetAsVariant: variant; override;
  768. function GetDataSize: Integer; override;
  769. function GetDefaultWidth: Longint; override;
  770. procedure GetText(var AText: string; ADisplayText: Boolean); override;
  771. procedure SetAsBCD(const AValue: TBCD); override;
  772. procedure SetAsFloat(AValue: Double); override;
  773. procedure SetAsLargeInt(AValue: LargeInt); override;
  774. procedure SetAsInteger(AValue: Longint); override;
  775. procedure SetAsString(const AValue: string); override;
  776. procedure SetAsCurrency(AValue: Currency); override;
  777. procedure SetVarValue(const AValue: Variant); override;
  778. public
  779. constructor Create(AOwner: TComponent); override;
  780. function CheckRange(AValue : TBCD) : Boolean;
  781. property Value: TBCD read GetAsBCD write SetAsBCD;
  782. published
  783. property Precision: Longint read FPrecision write FPrecision default 18;
  784. property Currency: Boolean read FCurrency write FCurrency;
  785. property MaxValue: string read GetMaxValue write SetMaxValue;
  786. property MinValue: string read GetMinValue write SetMinValue;
  787. property Size default 4;
  788. end;
  789. { TBlobField }
  790. TBlobStreamMode = (bmRead, bmWrite, bmReadWrite);
  791. // This type is needed for compatibility. While it should contain only blob
  792. // types, it actually does not.
  793. // Instead of this, please use ftBlobTypes
  794. TBlobType = ftBlob..ftWideMemo deprecated 'Warning: Does not contain BLOB types. Please use ftBlobTypes.';
  795. TBlobField = class(TField)
  796. private
  797. FModified : Boolean;
  798. FTransliterate : Boolean;
  799. Function GetBlobStream (Mode : TBlobStreamMode) : TStream;
  800. // Wrapper that retrieves FDataType as a TBlobType
  801. function GetBlobType: TBlobType;
  802. // Wrapper that calls SetFieldType
  803. procedure SetBlobType(AValue: TBlobType);
  804. protected
  805. procedure FreeBuffers; override;
  806. function GetAsBytes: TBytes; override;
  807. function GetAsString: string; override;
  808. function GetAsAnsiString: AnsiString; override;
  809. function GetAsUnicodeString: UnicodeString; override;
  810. function GetAsVariant: Variant; override;
  811. function GetBlobSize: Longint; virtual;
  812. function GetIsNull: Boolean; override;
  813. procedure GetText(var AText: string; ADisplayText: Boolean); override;
  814. procedure SetAsBytes(const AValue: TBytes); override;
  815. procedure SetAsString(const AValue: string); override;
  816. procedure SetAsAnsiString(const AValue: AnsiString); override;
  817. procedure SetAsUnicodeString(const AValue: UnicodeString); override;
  818. procedure SetVarValue(const AValue: Variant); override;
  819. public
  820. constructor Create(AOwner: TComponent); override;
  821. procedure Clear; override;
  822. class function IsBlob: Boolean; override;
  823. procedure LoadFromFile(const FileName: string);
  824. procedure LoadFromStream(Stream: TStream);
  825. procedure SaveToFile(const FileName: string);
  826. procedure SaveToStream(Stream: TStream);
  827. procedure SetFieldType(AValue: TFieldType); override;
  828. property BlobSize: Longint read GetBlobSize;
  829. property Modified: Boolean read FModified write FModified;
  830. property Value: string read GetAsString write SetAsString;
  831. property Transliterate: Boolean read FTransliterate write FTransliterate;
  832. published
  833. property BlobType: TBlobType read GetBlobType write SetBlobType default ftBlob;
  834. property Size default 0;
  835. end;
  836. { TMemoField }
  837. TMemoField = class(TBlobField)
  838. private
  839. FCodePage: TSystemCodePage;
  840. protected
  841. function GetAsAnsiString: AnsiString; override;
  842. procedure SetAsAnsiString(const AValue: AnsiString); override;
  843. function GetAsUnicodeString: UnicodeString; override;
  844. procedure SetAsUnicodeString(const AValue: UnicodeString); override;
  845. function GetAsUTF8String: UTF8String; override;
  846. procedure SetAsUTF8String(const AValue: UTF8String); override;
  847. public
  848. constructor Create(AOwner: TComponent); override;
  849. property CodePage : TSystemCodePage read FCodePage;
  850. published
  851. property Transliterate default True;
  852. end;
  853. { TWideMemoField }
  854. TWideMemoField = class(TBlobField)
  855. protected
  856. function GetAsVariant: Variant; override;
  857. procedure SetVarValue(const AValue: Variant); override;
  858. function GetAsString: string; override;
  859. procedure SetAsString(const AValue: string); override;
  860. function GetAsAnsiString: AnsiString; override;
  861. procedure SetAsAnsiString(const AValue: AnsiString); override;
  862. function GetAsUTF8String: UTF8String; override;
  863. procedure SetAsUTF8String(const AValue: UTF8String); override;
  864. public
  865. constructor Create(aOwner: TComponent); override;
  866. property Value: WideString read GetAsWideString write SetAsWideString;
  867. published
  868. end;
  869. { TGraphicField }
  870. TGraphicField = class(TBlobField)
  871. public
  872. constructor Create(AOwner: TComponent); override;
  873. end;
  874. { TVariantField }
  875. TVariantField = class(TField)
  876. protected
  877. class procedure CheckTypeSize(aValue: Integer); override;
  878. function GetAsBoolean: Boolean; override;
  879. procedure SetAsBoolean(aValue: Boolean); override;
  880. function GetAsDateTime: TDateTime; override;
  881. procedure SetAsDateTime(aValue: TDateTime); override;
  882. function GetAsFloat: Double; override;
  883. procedure SetAsFloat(aValue: Double); override;
  884. function GetAsInteger: Longint; override;
  885. procedure SetAsInteger(AValue: Longint); override;
  886. function GetAsString: string; override;
  887. procedure SetAsString(const aValue: string); override;
  888. function GetAsWideString: WideString; override;
  889. procedure SetAsWideString(const aValue: WideString); override;
  890. function GetAsVariant: Variant; override;
  891. procedure SetVarValue(const aValue: Variant); override;
  892. function GetDefaultWidth: Integer; override;
  893. public
  894. constructor Create(AOwner: TComponent); override;
  895. end;
  896. { TGuidField }
  897. TGuidField = class(TStringField)
  898. protected
  899. class procedure CheckTypeSize(AValue: Longint); override;
  900. function GetDefaultWidth: Longint; override;
  901. function GetAsGuid: TGUID;
  902. procedure SetAsGuid(const AValue: TGUID);
  903. public
  904. constructor Create(AOwner: TComponent); override;
  905. property AsGuid: TGUID read GetAsGuid write SetAsGuid;
  906. end;
  907. { TIndexDef }
  908. TIndexDefs = class;
  909. TIndexOption = (ixPrimary, ixUnique, ixDescending, ixCaseInsensitive,
  910. ixExpression, ixNonMaintained);
  911. TIndexOptions = set of TIndexOption;
  912. TIndexDef = class(TNamedItem)
  913. Private
  914. FCaseinsFields: string;
  915. FDescFields: string;
  916. FExpression : String;
  917. FFields : String;
  918. FOptions : TIndexOptions;
  919. FSource : String;
  920. protected
  921. procedure Assign(Source: TPersistent); override;
  922. function GetExpression: string;
  923. procedure SetCaseInsFields(const AValue: string); virtual;
  924. procedure SetDescFields(const AValue: string);
  925. procedure SetExpression(const AValue: string);
  926. public
  927. constructor Create(Owner: TIndexDefs; const AName, TheFields: string;
  928. TheOptions: TIndexOptions); overload;
  929. published
  930. property Expression: string read GetExpression write SetExpression;
  931. property Fields: string read FFields write FFields;
  932. property CaseInsFields: string read FCaseinsFields write SetCaseInsFields;
  933. property DescFields: string read FDescFields write SetDescFields;
  934. property Options: TIndexOptions read FOptions write FOptions;
  935. property Source: string read FSource write FSource;
  936. end;
  937. { TIndexDefs }
  938. TIndexDefs = class(TDefCollection)
  939. Private
  940. Function GetItem(Index: Integer): TIndexDef;
  941. Procedure SetItem(Index: Integer; Value: TIndexDef);
  942. public
  943. constructor Create(ADataSet: TDataSet); virtual; overload;
  944. procedure Add(const Name, Fields: string; Options: TIndexOptions); overload;
  945. Function AddIndexDef: TIndexDef;
  946. function Find(const IndexName: string): TIndexDef;
  947. function FindIndexForFields(const Fields: string): TIndexDef;
  948. function GetIndexForFields(const Fields: string;
  949. CaseInsensitive: Boolean): TIndexDef;
  950. procedure Update; overload; virtual;
  951. Property Items[Index: Integer] : TIndexDef read GetItem write SetItem; default;
  952. end;
  953. { TCheckConstraint }
  954. TCheckConstraint = class(TCollectionItem)
  955. Private
  956. FCustomConstraint : String;
  957. FErrorMessage : String;
  958. FFromDictionary : Boolean;
  959. FImportedConstraint : String;
  960. public
  961. procedure Assign(Source: TPersistent); override;
  962. // function GetDisplayName: string; override;
  963. published
  964. property CustomConstraint: string read FCustomConstraint write FCustomConstraint;
  965. property ErrorMessage: string read FErrorMessage write FErrorMessage;
  966. property FromDictionary: Boolean read FFromDictionary write FFromDictionary;
  967. property ImportedConstraint: string read FImportedConstraint write FImportedConstraint;
  968. end;
  969. { TCheckConstraints }
  970. TCheckConstraints = class(TCollection)
  971. Private
  972. Function GetItem(Index : Longint) : TCheckConstraint;
  973. Procedure SetItem(index : Longint; Value : TCheckConstraint);
  974. protected
  975. function GetOwner: TPersistent; override;
  976. public
  977. constructor Create(AOwner: TPersistent);
  978. function Add: TCheckConstraint;
  979. property Items[Index: Longint]: TCheckConstraint read GetItem write SetItem; default;
  980. end;
  981. { TFieldsEnumerator }
  982. TFieldsEnumerator = class
  983. private
  984. FPosition: Integer;
  985. FFields: TFields;
  986. function GetCurrent: TField;
  987. public
  988. constructor Create(AFields: TFields);
  989. function MoveNext: Boolean;
  990. property Current: TField read GetCurrent;
  991. end;
  992. { TFields }
  993. TFields = Class(TObject)
  994. Private
  995. FDataset : TDataset;
  996. FFieldList : TFpList;
  997. FOnChange : TNotifyEvent;
  998. FValidFieldKinds : TFieldKinds;
  999. Protected
  1000. Procedure ClearFieldDefs;
  1001. Procedure Changed;
  1002. Procedure CheckfieldKind(Fieldkind : TFieldKind; Field : TField);
  1003. Function GetCount : Longint;
  1004. Function GetField (Index : Integer) : TField;
  1005. Procedure SetField(Index: Integer; Value: TField);
  1006. Procedure SetFieldIndex (Field : TField;Value : Integer);
  1007. Property OnChange : TNotifyEvent Read FOnChange Write FOnChange;
  1008. Property ValidFieldKinds : TFieldKinds Read FValidFieldKinds;
  1009. Public
  1010. Constructor Create(ADataset : TDataset);
  1011. Destructor Destroy;override;
  1012. Procedure Add(Field : TField);
  1013. Procedure CheckFieldName (Const Value : String);
  1014. Procedure CheckFieldNames (Const Value : String);
  1015. Procedure Clear;
  1016. Function FindField (Const Value : String) : TField;
  1017. Function FieldByName (Const Value : String) : TField;
  1018. Function FieldByNumber(FieldNo : Integer) : TField;
  1019. Function GetEnumerator: TFieldsEnumerator;
  1020. Procedure GetFieldNames (Values : TStrings);
  1021. Function IndexOf(Field : TField) : Longint;
  1022. procedure Remove(Value : TField);
  1023. Property Count : Integer Read GetCount;
  1024. Property Dataset : TDataset Read FDataset;
  1025. Property Fields [Index : Integer] : TField Read GetField Write SetField; default;
  1026. end;
  1027. TFieldsClass = Class of TFields;
  1028. { TParam }
  1029. TBlobData = AnsiString; // Delphi defines it as alias to TBytes
  1030. TParamBinding = array of integer;
  1031. TParamType = (ptUnknown, ptInput, ptOutput, ptInputOutput, ptResult);
  1032. TParamTypes = set of TParamType;
  1033. TParamStyle = (psInterbase,psPostgreSQL,psSimulated);
  1034. TParams = class;
  1035. TParam = class(TCollectionItem)
  1036. private
  1037. FNativeStr: string;
  1038. FValue: Variant;
  1039. FPrecision: Integer;
  1040. FNumericScale: Integer;
  1041. FName: string;
  1042. FDataType: TFieldType;
  1043. FBound: Boolean;
  1044. FParamType: TParamType;
  1045. FSize: Integer;
  1046. Function GetDataSet: TDataSet;
  1047. Function IsParamStored: Boolean;
  1048. protected
  1049. Procedure AssignParam(Param: TParam);
  1050. Procedure AssignTo(Dest: TPersistent); override;
  1051. Function GetAsBoolean: Boolean;
  1052. Function GetAsBytes: TBytes;
  1053. Function GetAsCurrency: Currency;
  1054. Function GetAsDateTime: TDateTime;
  1055. Function GetAsFloat: Double;
  1056. Function GetAsInteger: Longint;
  1057. Function GetAsLargeInt: LargeInt;
  1058. Function GetAsMemo: string;
  1059. Function GetAsString: string;
  1060. Function GetAsAnsiString: AnsiString;
  1061. Function GetAsUnicodeString: UnicodeString;
  1062. Function GetAsUTF8String: UTF8String;
  1063. Function GetAsWideString: WideString;
  1064. Function GetAsVariant: Variant;
  1065. Function GetAsFMTBCD: TBCD;
  1066. Function GetDisplayName: string; override;
  1067. Function GetIsNull: Boolean;
  1068. Function IsEqual(AValue: TParam): Boolean;
  1069. Procedure SetAsBCD(const AValue: Currency);
  1070. Procedure SetAsBlob(const AValue: TBlobData);
  1071. Procedure SetAsBoolean(AValue: Boolean);
  1072. Procedure SetAsBytes(const AValue: TBytes);
  1073. Procedure SetAsCurrency(const AValue: Currency);
  1074. Procedure SetAsDate(const AValue: TDateTime);
  1075. Procedure SetAsDateTime(const AValue: TDateTime);
  1076. Procedure SetAsFloat(const AValue: Double);
  1077. Procedure SetAsInteger(AValue: Longint);
  1078. Procedure SetAsLargeInt(AValue: LargeInt);
  1079. Procedure SetAsMemo(const AValue: string);
  1080. Procedure SetAsSmallInt(AValue: LongInt);
  1081. Procedure SetAsString(const AValue: string);
  1082. Procedure SetAsAnsiString(const AValue: AnsiString);
  1083. Procedure SetAsUTF8String(const AValue: UTF8String);
  1084. Procedure SetAsUnicodeString(const AValue: UnicodeString);
  1085. Procedure SetAsWideString(const AValue: WideString);
  1086. Procedure SetAsTime(const AValue: TDateTime);
  1087. Procedure SetAsVariant(const AValue: Variant);
  1088. Procedure SetAsWord(AValue: LongInt);
  1089. Procedure SetAsFMTBCD(const AValue: TBCD);
  1090. Procedure SetDataType(AValue: TFieldType);
  1091. Procedure SetText(const AValue: string);
  1092. public
  1093. constructor Create(ACollection: TCollection); overload; override;
  1094. constructor Create(AParams: TParams; AParamType: TParamType); reintroduce; overload;
  1095. Procedure Assign(Source: TPersistent); override;
  1096. Procedure AssignField(Field: TField);
  1097. Procedure AssignToField(Field: TField);
  1098. Procedure AssignFieldValue(Field: TField; const AValue: Variant);
  1099. Procedure AssignFromField(Field : TField);
  1100. Procedure Clear;
  1101. Procedure GetData(Buffer: Pointer);
  1102. Function GetDataSize: Integer;
  1103. Procedure LoadFromFile(const FileName: string; BlobType: TBlobType);
  1104. Procedure LoadFromStream(Stream: TStream; BlobType: TBlobType);
  1105. Procedure SetBlobData(Buffer: Pointer; ASize: Integer);
  1106. Procedure SetData(Buffer: Pointer);
  1107. Property AsBCD : Currency read GetAsCurrency write SetAsBCD;
  1108. Property AsBlob : TBlobData read GetAsAnsiString write SetAsBlob;
  1109. Property AsBoolean : Boolean read GetAsBoolean write SetAsBoolean;
  1110. Property AsBytes : TBytes read GetAsBytes write SetAsBytes;
  1111. Property AsCurrency : Currency read GetAsCurrency write SetAsCurrency;
  1112. Property AsDate : TDateTime read GetAsDateTime write SetAsDate;
  1113. Property AsDateTime : TDateTime read GetAsDateTime write SetAsDateTime;
  1114. Property AsFloat : Double read GetAsFloat write SetAsFloat;
  1115. Property AsInteger : LongInt read GetAsInteger write SetAsInteger;
  1116. Property AsLargeInt : LargeInt read GetAsLargeInt write SetAsLargeInt;
  1117. Property AsMemo : string read GetAsMemo write SetAsMemo;
  1118. Property AsSmallInt : LongInt read GetAsInteger write SetAsSmallInt;
  1119. Property AsString : string read GetAsString write SetAsString;
  1120. Property AsAnsiString : AnsiString read GetAsAnsiString write SetAsAnsiString;
  1121. Property AsUTF8String: UTF8String read GetAsUTF8String write SetAsUTF8String;
  1122. Property AsUnicodeString: UnicodeString read GetAsUnicodeString write SetAsUnicodeString;
  1123. Property AsTime : TDateTime read GetAsDateTime write SetAsTime;
  1124. Property AsWord : LongInt read GetAsInteger write SetAsWord;
  1125. Property AsFMTBCD: TBCD read GetAsFMTBCD write SetAsFMTBCD;
  1126. Property Bound : Boolean read FBound write FBound;
  1127. Property Dataset : TDataset Read GetDataset;
  1128. Property IsNull : Boolean read GetIsNull;
  1129. Property NativeStr : string read FNativeStr write FNativeStr;
  1130. Property Text : string read GetAsString write SetText;
  1131. property AsWideString: WideString read GetAsWideString write SetAsWideString;
  1132. published
  1133. Property DataType : TFieldType read FDataType write SetDataType;
  1134. Property Name : string read FName write FName;
  1135. Property NumericScale : Integer read FNumericScale write FNumericScale default 0;
  1136. Property ParamType : TParamType read FParamType write FParamType;
  1137. Property Precision : Integer read FPrecision write FPrecision default 0;
  1138. Property Size : Integer read FSize write FSize default 0;
  1139. Property Value : Variant read GetAsVariant write SetAsVariant stored IsParamStored;
  1140. end;
  1141. TParamClass = Class of TParam;
  1142. { TParamsEnumerator }
  1143. TParamsEnumerator = class
  1144. private
  1145. FPosition: Integer;
  1146. FParams: TParams;
  1147. function GetCurrent: TParam;
  1148. public
  1149. constructor Create(AParams: TParams);
  1150. function MoveNext: Boolean;
  1151. property Current: TParam read GetCurrent;
  1152. end;
  1153. { TParams }
  1154. TParams = class(TCollection)
  1155. private
  1156. FOwner: TPersistent;
  1157. Function GetItem(Index: Integer): TParam;
  1158. Function GetParamValue(const ParamName: string): Variant;
  1159. Procedure SetItem(Index: Integer; Value: TParam);
  1160. Procedure SetParamValue(const ParamName: string; const Value: Variant);
  1161. protected
  1162. Procedure AssignTo(Dest: TPersistent); override;
  1163. Function GetDataSet: TDataSet;
  1164. Function GetOwner: TPersistent; override;
  1165. Class Function ParamClass : TParamClass; virtual;
  1166. public
  1167. Constructor Create(AOwner: TPersistent; AItemClass : TCollectionItemClass); overload;
  1168. Constructor Create(AOwner: TPersistent); overload;
  1169. Constructor Create; overload;
  1170. Procedure AddParam(Value: TParam);
  1171. Procedure AssignValues(Value: TParams);
  1172. Function CreateParam(FldType: TFieldType; const ParamName: string; ParamType: TParamType): TParam;
  1173. Function FindParam(const Value: string): TParam;
  1174. Procedure GetParamList(List: TList; const ParamNames: string);
  1175. Function IsEqual(Value: TParams): Boolean;
  1176. Function GetEnumerator: TParamsEnumerator;
  1177. Function ParamByName(const Value: string): TParam;
  1178. Function ParseSQL(SQL: String; DoCreate: Boolean): String; overload;
  1179. Function ParseSQL(SQL: String; DoCreate, EscapeSlash, EscapeRepeat : Boolean; ParameterStyle : TParamStyle): String; overload;
  1180. Function ParseSQL(SQL: String; DoCreate, EscapeSlash, EscapeRepeat : Boolean; ParameterStyle : TParamStyle; out ParamBinding: TParambinding): String; overload;
  1181. Function ParseSQL(SQL: String; DoCreate, EscapeSlash, EscapeRepeat : Boolean; ParameterStyle : TParamStyle; out ParamBinding: TParambinding; out ReplaceString : string): String; overload;
  1182. Procedure RemoveParam(Value: TParam);
  1183. Procedure CopyParamValuesFromDataset(ADataset : TDataset; CopyBound : Boolean);
  1184. Property Dataset : TDataset Read GetDataset;
  1185. Property Items[Index: Integer] : TParam read GetItem write SetItem; default;
  1186. Property ParamValues[const ParamName: string] : Variant read GetParamValue write SetParamValue;
  1187. end;
  1188. { TDataSet }
  1189. {$ifdef noautomatedbookmark}
  1190. TBookmark = Pointer;
  1191. {$else}
  1192. TBookMark = TBytes;
  1193. {$endif}
  1194. TBookmarkStr = ansistring;
  1195. PBookmarkFlag = ^TBookmarkFlag;
  1196. TBookmarkFlag = (bfCurrent, bfBOF, bfEOF, bfInserted);
  1197. { These types are used by Delphi/Unicode to replace the ambiguous "pchar" buffer types.
  1198. For now, they are just aliases to PAnsiChar, but in Delphi/Unicode it is pbyte. This will
  1199. be changed later (2.8?), to allow a grace period for descendents to catch up.
  1200. Testing with TRecordBuffer=PByte will turn up typing problems. TRecordBuffer=pansichar is backwards
  1201. compatible, even if overriden with "pchar" variants.
  1202. }
  1203. TRecordBufferBaseType = AnsiChar; // must match TRecordBuffer.
  1204. TRecordBuffer = PAnsiChar;
  1205. PBufferList = ^TBufferList;
  1206. TBufferList = array[0..dsMaxBufferCount - 1] of TRecordBuffer; // Dynamic array in Delphi.
  1207. TBufferArray = ^TRecordBuffer;
  1208. TGetMode = (gmCurrent, gmNext, gmPrior);
  1209. TGetResult = (grOK, grBOF, grEOF, grError);
  1210. TResyncMode = set of (rmExact, rmCenter);
  1211. TDataAction = (daFail, daAbort, daRetry);
  1212. TUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApplied);
  1213. TUpdateKind = (ukModify, ukInsert, ukDelete);
  1214. TLocateOption = (loCaseInsensitive, loPartialKey);
  1215. TLocateOptions = set of TLocateOption;
  1216. TDataOperation = procedure of object;
  1217. TDataSetNotifyEvent = procedure(DataSet: TDataSet) of object;
  1218. TDataSetErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
  1219. var DataAction: TDataAction) of object;
  1220. TFilterOption = (foCaseInsensitive, foNoPartialCompare);
  1221. TFilterOptions = set of TFilterOption;
  1222. TFilterRecordEvent = procedure(DataSet: TDataSet;
  1223. var Accept: Boolean) of object;
  1224. TDatasetClass = Class of TDataset;
  1225. {------------------------------------------------------------------------------}
  1226. {IProviderSupport interface}
  1227. TPSCommandType = (
  1228. ctUnknown,
  1229. ctQuery,
  1230. ctTable,
  1231. ctStoredProc,
  1232. ctSelect,
  1233. ctInsert,
  1234. ctUpdate,
  1235. ctDelete,
  1236. ctDDL
  1237. );
  1238. IProviderSupport = interface
  1239. procedure PSEndTransaction(ACommit: Boolean);
  1240. procedure PSExecute;
  1241. function PSExecuteStatement(const ASQL: string; AParams: TParams;
  1242. ResultSet: Pointer = nil): Integer;
  1243. procedure PSGetAttributes(List: TList);
  1244. function PSGetCommandText: string;
  1245. function PSGetCommandType: TPSCommandType;
  1246. function PSGetDefaultOrder: TIndexDef;
  1247. function PSGetIndexDefs(IndexTypes: TIndexOptions = [ixPrimary..ixNonMaintained])
  1248. : TIndexDefs;
  1249. function PSGetKeyFields: string;
  1250. function PSGetParams: TParams;
  1251. function PSGetQuoteChar: string;
  1252. function PSGetTableName: string;
  1253. function PSGetUpdateException(E: Exception; Prev: EUpdateError): EUpdateError;
  1254. function PSInTransaction: Boolean;
  1255. function PSIsSQLBased: Boolean;
  1256. function PSIsSQLSupported: Boolean;
  1257. procedure PSReset;
  1258. procedure PSSetCommandText(const CommandText: string);
  1259. procedure PSSetParams(AParams: TParams);
  1260. procedure PSStartTransaction;
  1261. function PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet): Boolean;
  1262. end;
  1263. {------------------------------------------------------------------------------}
  1264. TDataSet = class(TComponent)
  1265. Private
  1266. FOpenAfterRead : boolean;
  1267. FActiveRecord: Longint;
  1268. FAfterCancel: TDataSetNotifyEvent;
  1269. FAfterClose: TDataSetNotifyEvent;
  1270. FAfterDelete: TDataSetNotifyEvent;
  1271. FAfterEdit: TDataSetNotifyEvent;
  1272. FAfterInsert: TDataSetNotifyEvent;
  1273. FAfterOpen: TDataSetNotifyEvent;
  1274. FAfterPost: TDataSetNotifyEvent;
  1275. FAfterRefresh: TDataSetNotifyEvent;
  1276. FAfterScroll: TDataSetNotifyEvent;
  1277. FAutoCalcFields: Boolean;
  1278. FBOF: Boolean;
  1279. FBeforeCancel: TDataSetNotifyEvent;
  1280. FBeforeClose: TDataSetNotifyEvent;
  1281. FBeforeDelete: TDataSetNotifyEvent;
  1282. FBeforeEdit: TDataSetNotifyEvent;
  1283. FBeforeInsert: TDataSetNotifyEvent;
  1284. FBeforeOpen: TDataSetNotifyEvent;
  1285. FBeforePost: TDataSetNotifyEvent;
  1286. FBeforeRefresh: TDataSetNotifyEvent;
  1287. FBeforeScroll: TDataSetNotifyEvent;
  1288. FBlobFieldCount: Longint;
  1289. FBlockReadSize: Integer;
  1290. FBookmarkSize: Longint;
  1291. FBuffers : TBufferArray;
  1292. FBufferCount: Longint;
  1293. FCalcBuffer: TRecordBuffer;
  1294. FCalcFieldsSize: Longint;
  1295. FConstraints: TCheckConstraints;
  1296. FDisableControlsCount : Integer;
  1297. FDisableControlsState : TDatasetState;
  1298. FCurrentRecord: Longint;
  1299. FDataSources : TFPList;
  1300. FDefaultFields: Boolean;
  1301. FEOF: Boolean;
  1302. FEnableControlsEvent : TDataEvent;
  1303. FFieldList : TFields;
  1304. FFieldDefs: TFieldDefs;
  1305. FFilterOptions: TFilterOptions;
  1306. FFilterText: string;
  1307. FFiltered: Boolean;
  1308. FFound: Boolean;
  1309. FInternalCalcFields: Boolean;
  1310. FModified: Boolean;
  1311. FOnCalcFields: TDataSetNotifyEvent;
  1312. FOnDeleteError: TDataSetErrorEvent;
  1313. FOnEditError: TDataSetErrorEvent;
  1314. FOnFilterRecord: TFilterRecordEvent;
  1315. FOnNewRecord: TDataSetNotifyEvent;
  1316. FOnPostError: TDataSetErrorEvent;
  1317. FRecordCount: Longint;
  1318. FIsUniDirectional: Boolean;
  1319. FState : TDataSetState;
  1320. FInternalOpenComplete: Boolean;
  1321. Procedure DoInsertAppend(DoAppend : Boolean);
  1322. Procedure DoInternalOpen;
  1323. Function GetBuffer (Index : longint) : TRecordBuffer;
  1324. Function GetField (Index : Longint) : TField;
  1325. Procedure RegisterDataSource(ADataSource : TDataSource);
  1326. Procedure RemoveField (Field : TField);
  1327. procedure SetConstraints(Value: TCheckConstraints);
  1328. Procedure SetField (Index : Longint;Value : TField);
  1329. Procedure ShiftBuffersForward;
  1330. Procedure ShiftBuffersBackward;
  1331. Function TryDoing (P : TDataOperation; Ev : TDatasetErrorEvent) : Boolean;
  1332. Function GetActive : boolean;
  1333. Procedure UnRegisterDataSource(ADataSource : TDataSource);
  1334. Procedure UpdateFieldDefs;
  1335. procedure SetBlockReadSize(AValue: Integer); virtual;
  1336. Procedure SetFieldDefs(AFieldDefs: TFieldDefs);
  1337. procedure DoInsertAppendRecord(const Values: array of const; DoAppend : boolean);
  1338. protected
  1339. procedure RecalcBufListSize;
  1340. procedure ActivateBuffers; virtual;
  1341. procedure BindFields(Binding: Boolean);
  1342. procedure BlockReadNext; virtual;
  1343. function BookmarkAvailable: Boolean;
  1344. procedure CalculateFields(Buffer: TRecordBuffer); virtual;
  1345. procedure CheckActive; virtual;
  1346. procedure CheckInactive; virtual;
  1347. procedure CheckBiDirectional;
  1348. procedure Loaded; override;
  1349. procedure ClearBuffers; virtual;
  1350. procedure ClearCalcFields(Buffer: TRecordBuffer); virtual;
  1351. procedure CloseBlob(Field: TField); virtual;
  1352. procedure CloseCursor; virtual;
  1353. procedure CreateFields; virtual;
  1354. procedure DataEvent(Event: TDataEvent; Info: Ptrint); virtual;
  1355. procedure DestroyFields; virtual;
  1356. procedure DoAfterCancel; virtual;
  1357. procedure DoAfterClose; virtual;
  1358. procedure DoAfterDelete; virtual;
  1359. procedure DoAfterEdit; virtual;
  1360. procedure DoAfterInsert; virtual;
  1361. procedure DoAfterOpen; virtual;
  1362. procedure DoAfterPost; virtual;
  1363. procedure DoAfterScroll; virtual;
  1364. procedure DoAfterRefresh; virtual;
  1365. procedure DoBeforeCancel; virtual;
  1366. procedure DoBeforeClose; virtual;
  1367. procedure DoBeforeDelete; virtual;
  1368. procedure DoBeforeEdit; virtual;
  1369. procedure DoBeforeInsert; virtual;
  1370. procedure DoBeforeOpen; virtual;
  1371. procedure DoBeforePost; virtual;
  1372. procedure DoBeforeScroll; virtual;
  1373. procedure DoBeforeRefresh; virtual;
  1374. procedure DoOnCalcFields; virtual;
  1375. procedure DoOnNewRecord; virtual;
  1376. function FieldByNumber(FieldNo: Longint): TField;
  1377. function FindRecord(Restart, GoForward: Boolean): Boolean; virtual;
  1378. procedure FreeFieldBuffers; virtual;
  1379. function GetBookmarkStr: TBookmarkStr; virtual;
  1380. procedure GetCalcFields(Buffer: TRecordBuffer); virtual;
  1381. function GetCanModify: Boolean; virtual;
  1382. procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
  1383. function GetFieldClass(FieldType: TFieldType): TFieldClass; virtual;
  1384. Function GetfieldCount : Integer;
  1385. function GetFieldValues(const FieldName : string) : Variant; virtual;
  1386. function GetIsIndexField(Field: TField): Boolean; virtual;
  1387. function GetIndexDefs(IndexDefs : TIndexDefs; IndexTypes : TIndexOptions) : TIndexDefs;
  1388. function GetNextRecords: Longint; virtual;
  1389. function GetNextRecord: Boolean; virtual;
  1390. function GetPriorRecords: Longint; virtual;
  1391. function GetPriorRecord: Boolean; virtual;
  1392. function GetRecordCount: Longint; virtual;
  1393. function GetRecNo: Longint; virtual;
  1394. procedure InitFieldDefs; virtual;
  1395. procedure InitFieldDefsFromfields;
  1396. procedure InitRecord(Buffer: TRecordBuffer); virtual;
  1397. procedure InternalCancel; virtual;
  1398. procedure InternalEdit; virtual;
  1399. procedure InternalInsert; virtual;
  1400. procedure InternalRefresh; virtual;
  1401. procedure OpenCursor(InfoQuery: Boolean); virtual;
  1402. procedure OpenCursorcomplete; virtual;
  1403. procedure RefreshInternalCalcFields(Buffer: TRecordBuffer); virtual;
  1404. procedure RestoreState(const Value: TDataSetState);
  1405. Procedure SetActive (Value : Boolean); virtual;
  1406. procedure SetBookmarkStr(const Value: TBookmarkStr); virtual;
  1407. procedure SetBufListSize(Value: Longint); virtual;
  1408. procedure SetChildOrder(Component: TComponent; Order: Longint); override;
  1409. procedure SetCurrentRecord(Index: Longint); virtual;
  1410. procedure SetDefaultFields(const Value: Boolean);
  1411. procedure SetFiltered(Value: Boolean); virtual;
  1412. procedure SetFilterOptions(Value: TFilterOptions); virtual;
  1413. procedure SetFilterText(const Value: string); virtual;
  1414. procedure SetFieldValues(const FieldName: string; Value: Variant); virtual;
  1415. procedure SetFound(const Value: Boolean); virtual;
  1416. procedure SetModified(Value: Boolean);
  1417. procedure SetName(const Value: TComponentName); override;
  1418. procedure SetOnFilterRecord(const Value: TFilterRecordEvent); virtual;
  1419. procedure SetRecNo(Value: Longint); virtual;
  1420. procedure SetState(Value: TDataSetState);
  1421. function SetTempState(const Value: TDataSetState): TDataSetState;
  1422. Function TempBuffer: TRecordBuffer;
  1423. procedure UpdateIndexDefs; virtual;
  1424. property ActiveRecord: Longint read FActiveRecord;
  1425. property CurrentRecord: Longint read FCurrentRecord;
  1426. property BlobFieldCount: Longint read FBlobFieldCount;
  1427. property BookmarkSize: Longint read FBookmarkSize write FBookmarkSize;
  1428. property Buffers[Index: Longint]: TRecordBuffer read GetBuffer;
  1429. property BufferCount: Longint read FBufferCount;
  1430. property CalcBuffer: TRecordBuffer read FCalcBuffer;
  1431. property CalcFieldsSize: Longint read FCalcFieldsSize;
  1432. property InternalCalcFields: Boolean read FInternalCalcFields;
  1433. property Constraints: TCheckConstraints read FConstraints write SetConstraints;
  1434. function AllocRecordBuffer: TRecordBuffer; virtual;
  1435. procedure FreeRecordBuffer(var Buffer: TRecordBuffer); virtual;
  1436. procedure GetBookmarkData(Buffer: TRecordBuffer; Data: Pointer); virtual;
  1437. function GetBookmarkFlag(Buffer: TRecordBuffer): TBookmarkFlag; virtual;
  1438. function GetDataSource: TDataSource; virtual;
  1439. function GetRecordSize: Word; virtual;
  1440. procedure InternalAddRecord(Buffer: Pointer; AAppend: Boolean); virtual;
  1441. procedure InternalDelete; virtual;
  1442. procedure InternalFirst; virtual;
  1443. procedure InternalGotoBookmark(ABookmark: Pointer); virtual;
  1444. procedure InternalHandleException; virtual;
  1445. procedure InternalInitRecord(Buffer: TRecordBuffer); virtual;
  1446. procedure InternalLast; virtual;
  1447. procedure InternalPost; virtual;
  1448. procedure InternalSetToRecord(Buffer: TRecordBuffer); virtual;
  1449. procedure SetBookmarkFlag(Buffer: TRecordBuffer; Value: TBookmarkFlag); virtual;
  1450. procedure SetBookmarkData(Buffer: TRecordBuffer; Data: Pointer); virtual;
  1451. procedure SetUniDirectional(const Value: Boolean);
  1452. class function FieldDefsClass : TFieldDefsClass; virtual;
  1453. class function FieldsClass : TFieldsClass; virtual;
  1454. protected { abstract methods }
  1455. function GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: Boolean): TGetResult; virtual; abstract;
  1456. procedure InternalClose; virtual; abstract;
  1457. procedure InternalOpen; virtual; abstract;
  1458. procedure InternalInitFieldDefs; virtual; abstract;
  1459. function IsCursorOpen: Boolean; virtual; abstract;
  1460. protected { IProviderSupport methods }
  1461. procedure PSEndTransaction(Commit: Boolean); virtual;
  1462. procedure PSExecute; virtual;
  1463. function PSExecuteStatement(const ASQL: string; AParams: TParams;
  1464. ResultSet: Pointer = nil): Integer; virtual;
  1465. procedure PSGetAttributes(List: TList); virtual;
  1466. function PSGetCommandText: string; virtual;
  1467. function PSGetCommandType: TPSCommandType; virtual;
  1468. function PSGetDefaultOrder: TIndexDef; virtual;
  1469. function PSGetIndexDefs(IndexTypes: TIndexOptions = [ixPrimary..ixNonMaintained])
  1470. : TIndexDefs; virtual;
  1471. function PSGetKeyFields: string; virtual;
  1472. function PSGetParams: TParams; virtual;
  1473. function PSGetQuoteChar: string; virtual;
  1474. function PSGetTableName: string; virtual;
  1475. function PSGetUpdateException(E: Exception; Prev: EUpdateError)
  1476. : EUpdateError; virtual;
  1477. function PSInTransaction: Boolean; virtual;
  1478. function PSIsSQLBased: Boolean; virtual;
  1479. function PSIsSQLSupported: Boolean; virtual;
  1480. procedure PSReset; virtual;
  1481. procedure PSSetCommandText(const CommandText: string); virtual;
  1482. procedure PSSetParams(AParams: TParams); virtual;
  1483. procedure PSStartTransaction; virtual;
  1484. function PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet)
  1485. : Boolean; virtual;
  1486. public
  1487. constructor Create(AOwner: TComponent); override;
  1488. destructor Destroy; override;
  1489. function ActiveBuffer: TRecordBuffer;
  1490. function GetFieldData(Field: TField; Buffer: Pointer): Boolean; overload; virtual;
  1491. function GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): Boolean; overload; virtual;
  1492. procedure SetFieldData(Field: TField; Buffer: Pointer); overload; virtual;
  1493. procedure SetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean); overload; virtual;
  1494. procedure Append;
  1495. procedure AppendRecord(const Values: array of const);
  1496. function BookmarkValid(ABookmark: TBookmark): Boolean; virtual;
  1497. procedure Cancel; virtual;
  1498. procedure CheckBrowseMode;
  1499. procedure ClearFields;
  1500. procedure Close;
  1501. function ControlsDisabled: Boolean;
  1502. function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint; virtual;
  1503. function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; virtual;
  1504. procedure CursorPosChanged;
  1505. procedure DataConvert(aField: TField; aSource, aDest: Pointer; aToNative: Boolean); virtual;
  1506. procedure Delete; virtual;
  1507. procedure DisableControls;
  1508. procedure Edit;
  1509. procedure EnableControls;
  1510. function FieldByName(const FieldName: string): TField;
  1511. function FindField(const FieldName: string): TField;
  1512. function FindFirst: Boolean; virtual;
  1513. function FindLast: Boolean; virtual;
  1514. function FindNext: Boolean; virtual;
  1515. function FindPrior: Boolean; virtual;
  1516. procedure First;
  1517. procedure FreeBookmark(ABookmark: TBookmark); virtual;
  1518. function GetBookmark: TBookmark; virtual;
  1519. function GetCurrentRecord(Buffer: TRecordBuffer): Boolean; virtual;
  1520. procedure GetFieldList(List: TList; const FieldNames: string);
  1521. procedure GetFieldNames(List: TStrings);
  1522. procedure GotoBookmark(const ABookmark: TBookmark);
  1523. procedure Insert;
  1524. procedure InsertRecord(const Values: array of const);
  1525. function IsEmpty: Boolean;
  1526. function IsLinkedTo(ADataSource: TDataSource): Boolean;
  1527. function IsSequenced: Boolean; virtual;
  1528. procedure Last;
  1529. function Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions) : boolean; virtual;
  1530. function Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant; virtual;
  1531. function MoveBy(Distance: Longint): Longint;
  1532. procedure Next;
  1533. procedure Open;
  1534. procedure Post; virtual;
  1535. procedure Prior;
  1536. procedure Refresh;
  1537. procedure Resync(Mode: TResyncMode); virtual;
  1538. procedure SetFields(const Values: array of const);
  1539. function Translate(Src, Dest: PChar; ToOem: Boolean): Integer; virtual;
  1540. procedure UpdateCursorPos;
  1541. procedure UpdateRecord;
  1542. function UpdateStatus: TUpdateStatus; virtual;
  1543. property BlockReadSize: Integer read FBlockReadSize write SetBlockReadSize;
  1544. property BOF: Boolean read FBOF;
  1545. property Bookmark: TBookmark read GetBookmark write GotoBookmark;
  1546. property CanModify: Boolean read GetCanModify;
  1547. property DataSource: TDataSource read GetDataSource;
  1548. property DefaultFields: Boolean read FDefaultFields;
  1549. property EOF: Boolean read FEOF;
  1550. property FieldCount: Longint read GetFieldCount;
  1551. property FieldDefs: TFieldDefs read FFieldDefs write SetFieldDefs;
  1552. // property Fields[Index: Longint]: TField read GetField write SetField;
  1553. property Found: Boolean read FFound;
  1554. property Modified: Boolean read FModified;
  1555. property IsUniDirectional: Boolean read FIsUniDirectional default False;
  1556. property RecordCount: Longint read GetRecordCount;
  1557. property RecNo: Longint read GetRecNo write SetRecNo;
  1558. property RecordSize: Word read GetRecordSize;
  1559. property State: TDataSetState read FState;
  1560. property Fields : TFields read FFieldList;
  1561. property FieldValues[FieldName : string] : Variant read GetFieldValues write SetFieldValues; default;
  1562. property Filter: string read FFilterText write SetFilterText;
  1563. property Filtered: Boolean read FFiltered write SetFiltered default False;
  1564. property FilterOptions: TFilterOptions read FFilterOptions write SetFilterOptions;
  1565. property Active: Boolean read GetActive write SetActive default False;
  1566. property AutoCalcFields: Boolean read FAutoCalcFields write FAutoCalcFields default true;
  1567. property BeforeOpen: TDataSetNotifyEvent read FBeforeOpen write FBeforeOpen;
  1568. property AfterOpen: TDataSetNotifyEvent read FAfterOpen write FAfterOpen;
  1569. property BeforeClose: TDataSetNotifyEvent read FBeforeClose write FBeforeClose;
  1570. property AfterClose: TDataSetNotifyEvent read FAfterClose write FAfterClose;
  1571. property BeforeInsert: TDataSetNotifyEvent read FBeforeInsert write FBeforeInsert;
  1572. property AfterInsert: TDataSetNotifyEvent read FAfterInsert write FAfterInsert;
  1573. property BeforeEdit: TDataSetNotifyEvent read FBeforeEdit write FBeforeEdit;
  1574. property AfterEdit: TDataSetNotifyEvent read FAfterEdit write FAfterEdit;
  1575. property BeforePost: TDataSetNotifyEvent read FBeforePost write FBeforePost;
  1576. property AfterPost: TDataSetNotifyEvent read FAfterPost write FAfterPost;
  1577. property BeforeCancel: TDataSetNotifyEvent read FBeforeCancel write FBeforeCancel;
  1578. property AfterCancel: TDataSetNotifyEvent read FAfterCancel write FAfterCancel;
  1579. property BeforeDelete: TDataSetNotifyEvent read FBeforeDelete write FBeforeDelete;
  1580. property AfterDelete: TDataSetNotifyEvent read FAfterDelete write FAfterDelete;
  1581. property BeforeScroll: TDataSetNotifyEvent read FBeforeScroll write FBeforeScroll;
  1582. property AfterScroll: TDataSetNotifyEvent read FAfterScroll write FAfterScroll;
  1583. property BeforeRefresh: TDataSetNotifyEvent read FBeforeRefresh write FBeforeRefresh;
  1584. property AfterRefresh: TDataSetNotifyEvent read FAfterRefresh write FAfterRefresh;
  1585. property OnCalcFields: TDataSetNotifyEvent read FOnCalcFields write FOnCalcFields;
  1586. property OnDeleteError: TDataSetErrorEvent read FOnDeleteError write FOnDeleteError;
  1587. property OnEditError: TDataSetErrorEvent read FOnEditError write FOnEditError;
  1588. property OnFilterRecord: TFilterRecordEvent read FOnFilterRecord write SetOnFilterRecord;
  1589. property OnNewRecord: TDataSetNotifyEvent read FOnNewRecord write FOnNewRecord;
  1590. property OnPostError: TDataSetErrorEvent read FOnPostError write FOnPostError;
  1591. end;
  1592. TDataSetEnumerator = class
  1593. private
  1594. FDataSet: TDataSet;
  1595. FBOF: Boolean;
  1596. function GetCurrent: TFields;
  1597. public
  1598. constructor Create(ADataSet: TDataSet);
  1599. function MoveNext: Boolean;
  1600. property Current: TFields read GetCurrent;
  1601. end;
  1602. { TDataLink }
  1603. TDataLink = class(TPersistent)
  1604. private
  1605. FFirstRecord,
  1606. FBufferCount : Integer;
  1607. FActive,
  1608. FDataSourceFixed,
  1609. FEditing,
  1610. FReadOnly,
  1611. FUpdatingRecord,
  1612. FVisualControl : Boolean;
  1613. FDataSource : TDataSource;
  1614. Function CalcFirstRecord(Index : Integer) : Integer;
  1615. Procedure CalcRange;
  1616. Procedure CheckActiveAndEditing;
  1617. Function GetDataset : TDataset;
  1618. procedure SetActive(AActive: Boolean);
  1619. procedure SetDataSource(Value: TDataSource);
  1620. Procedure SetReadOnly(Value : Boolean);
  1621. protected
  1622. procedure ActiveChanged; virtual;
  1623. procedure CheckBrowseMode; virtual;
  1624. procedure DataEvent(Event: TDataEvent; Info: Ptrint); virtual;
  1625. procedure DataSetChanged; virtual;
  1626. procedure DataSetScrolled(Distance: Integer); virtual;
  1627. procedure EditingChanged; virtual;
  1628. procedure FocusControl(Field: TFieldRef); virtual;
  1629. function GetActiveRecord: Integer; virtual;
  1630. function GetBOF: Boolean; virtual;
  1631. function GetBufferCount: Integer; virtual;
  1632. function GetEOF: Boolean; virtual;
  1633. function GetRecordCount: Integer; virtual;
  1634. procedure LayoutChanged; virtual;
  1635. function MoveBy(Distance: Integer): Integer; virtual;
  1636. procedure RecordChanged(Field: TField); virtual;
  1637. procedure SetActiveRecord(Value: Integer); virtual;
  1638. procedure SetBufferCount(Value: Integer); virtual;
  1639. procedure UpdateData; virtual;
  1640. property VisualControl: Boolean read FVisualControl write FVisualControl;
  1641. property FirstRecord: Integer read FFirstRecord write FFirstRecord;
  1642. public
  1643. constructor Create;
  1644. destructor Destroy; override;
  1645. function Edit: Boolean;
  1646. procedure UpdateRecord;
  1647. function ExecuteAction(Action: TBasicAction): Boolean; virtual;
  1648. function UpdateAction(Action: TBasicAction): Boolean; virtual;
  1649. property Active: Boolean read FActive;
  1650. property ActiveRecord: Integer read GetActiveRecord write SetActiveRecord;
  1651. property BOF: Boolean read GetBOF;
  1652. property BufferCount: Integer read GetBufferCount write SetBufferCount;
  1653. property DataSet: TDataSet read GetDataSet;
  1654. property DataSource: TDataSource read FDataSource write SetDataSource;
  1655. property DataSourceFixed: Boolean read FDataSourceFixed write FDataSourceFixed;
  1656. property Editing: Boolean read FEditing;
  1657. property Eof: Boolean read GetEOF;
  1658. property ReadOnly: Boolean read FReadOnly write SetReadOnly;
  1659. property RecordCount: Integer read GetRecordCount;
  1660. end;
  1661. { TDetailDataLink }
  1662. TDetailDataLink = class(TDataLink)
  1663. protected
  1664. function GetDetailDataSet: TDataSet; virtual;
  1665. public
  1666. property DetailDataSet: TDataSet read GetDetailDataSet;
  1667. end;
  1668. { TMasterDataLink }
  1669. TMasterDataLink = class(TDetailDataLink)
  1670. private
  1671. FDetailDataSet: TDataSet;
  1672. FFieldNames: string;
  1673. FFields: TList;
  1674. FOnMasterChange: TNotifyEvent;
  1675. FOnMasterDisable: TNotifyEvent;
  1676. procedure SetFieldNames(const Value: string);
  1677. protected
  1678. procedure ActiveChanged; override;
  1679. procedure CheckBrowseMode; override;
  1680. function GetDetailDataSet: TDataSet; override;
  1681. procedure LayoutChanged; override;
  1682. procedure RecordChanged(Field: TField); override;
  1683. Procedure DoMasterDisable; virtual;
  1684. Procedure DoMasterChange; virtual;
  1685. public
  1686. constructor Create(ADataSet: TDataSet);virtual;
  1687. destructor Destroy; override;
  1688. property FieldNames: string read FFieldNames write SetFieldNames;
  1689. property Fields: TList read FFields;
  1690. property OnMasterChange: TNotifyEvent read FOnMasterChange write FOnMasterChange;
  1691. property OnMasterDisable: TNotifyEvent read FOnMasterDisable write FOnMasterDisable;
  1692. end;
  1693. { TMasterParamsDataLink }
  1694. TMasterParamsDataLink = Class(TMasterDataLink)
  1695. Private
  1696. FParams : TParams;
  1697. Procedure SetParams(AValue : TParams);
  1698. Protected
  1699. Procedure DoMasterDisable; override;
  1700. Procedure DoMasterChange; override;
  1701. Public
  1702. constructor Create(ADataSet: TDataSet); override;
  1703. Procedure RefreshParamNames; virtual;
  1704. Procedure CopyParamsFromMaster(CopyBound : Boolean); virtual;
  1705. Property Params : TParams Read FParams Write SetParams;
  1706. end;
  1707. { TDataSource }
  1708. TDataChangeEvent = procedure(Sender: TObject; Field: TField) of object;
  1709. TDataSource = class(TComponent)
  1710. private
  1711. FDataSet: TDataSet;
  1712. FDataLinks: TList;
  1713. FEnabled: Boolean;
  1714. FAutoEdit: Boolean;
  1715. FState: TDataSetState;
  1716. FOnStateChange: TNotifyEvent;
  1717. FOnDataChange: TDataChangeEvent;
  1718. FOnUpdateData: TNotifyEvent;
  1719. procedure DistributeEvent(Event: TDataEvent; Info: Ptrint);
  1720. procedure RegisterDataLink(DataLink: TDataLink);
  1721. Procedure ProcessEvent(Event : TDataEvent; Info : Ptrint);
  1722. procedure SetDataSet(ADataSet: TDataSet);
  1723. procedure SetEnabled(Value: Boolean);
  1724. procedure UnregisterDataLink(DataLink: TDataLink);
  1725. protected
  1726. Procedure DoDataChange (Info : Pointer);virtual;
  1727. Procedure DoStateChange; virtual;
  1728. Procedure DoUpdateData;
  1729. property DataLinks: TList read FDataLinks;
  1730. public
  1731. constructor Create(AOwner: TComponent); override;
  1732. destructor Destroy; override;
  1733. procedure Edit;
  1734. function IsLinkedTo(ADataSet: TDataSet): Boolean;
  1735. property State: TDataSetState read FState;
  1736. published
  1737. property AutoEdit: Boolean read FAutoEdit write FAutoEdit default True;
  1738. property DataSet: TDataSet read FDataSet write SetDataSet;
  1739. property Enabled: Boolean read FEnabled write SetEnabled default True;
  1740. property OnStateChange: TNotifyEvent read FOnStateChange write FOnStateChange;
  1741. property OnDataChange: TDataChangeEvent read FOnDataChange write FOnDataChange;
  1742. property OnUpdateData: TNotifyEvent read FOnUpdateData write FOnUpdateData;
  1743. end;
  1744. { TDBDataset }
  1745. TDBDatasetClass = Class of TDBDataset;
  1746. TDBDataset = Class(TDataset)
  1747. Private
  1748. FDatabase : TDatabase;
  1749. FTransaction : TDBTransaction;
  1750. Protected
  1751. Procedure SetDatabase (Value : TDatabase); virtual;
  1752. Procedure SetTransaction(Value : TDBTransaction); virtual;
  1753. Procedure CheckDatabase;
  1754. Public
  1755. Destructor destroy; override;
  1756. Property DataBase : TDatabase Read FDatabase Write SetDatabase;
  1757. Property Transaction : TDBTransaction Read FTransaction Write SetTransaction;
  1758. end;
  1759. { TDBTransaction }
  1760. TDBTransactionClass = Class of TDBTransaction;
  1761. TDBTransaction = Class(TComponent)
  1762. Private
  1763. FActive : boolean;
  1764. FDatabase : TDatabase;
  1765. FDataSets : TList;
  1766. FOpenAfterRead : boolean;
  1767. Function GetDataSetCount : Longint;
  1768. Function GetDataset(Index : longint) : TDBDataset;
  1769. procedure RegisterDataset (DS : TDBDataset);
  1770. procedure UnRegisterDataset (DS : TDBDataset);
  1771. procedure RemoveDataSets;
  1772. procedure SetActive(Value : boolean);
  1773. Protected
  1774. Function AllowClose(DS: TDBDataset): Boolean; virtual;
  1775. Procedure SetDatabase (Value : TDatabase); virtual;
  1776. procedure CloseTrans;
  1777. procedure OpenTrans;
  1778. Procedure CheckDatabase;
  1779. Procedure CheckActive;
  1780. Procedure CheckInactive;
  1781. procedure Commit; virtual;
  1782. procedure CommitRetaining; virtual;
  1783. procedure Rollback; virtual;
  1784. procedure RollbackRetaining; virtual;
  1785. procedure EndTransaction; virtual; abstract;
  1786. procedure StartTransaction; virtual; abstract;
  1787. procedure InternalHandleException; virtual;
  1788. procedure Loaded; override;
  1789. Public
  1790. constructor Create(AOwner: TComponent); override;
  1791. Destructor Destroy; override;
  1792. procedure CloseDataSets;
  1793. Property DataBase : TDatabase Read FDatabase Write SetDatabase;
  1794. published
  1795. property Active : boolean read FActive write setactive;
  1796. end;
  1797. { TCustomConnection }
  1798. TLoginEvent = procedure(Sender: TObject; Username, Password: string) of object;
  1799. TCustomConnection = class(TComponent)
  1800. private
  1801. FAfterConnect: TNotifyEvent;
  1802. FAfterDisconnect: TNotifyEvent;
  1803. FBeforeConnect: TNotifyEvent;
  1804. FBeforeDisconnect: TNotifyEvent;
  1805. FForcedClose: Boolean;
  1806. FLoginPrompt: Boolean;
  1807. FOnLogin: TLoginEvent;
  1808. FStreamedConnected: Boolean;
  1809. procedure SetAfterConnect(const AValue: TNotifyEvent);
  1810. procedure SetAfterDisconnect(const AValue: TNotifyEvent);
  1811. procedure SetBeforeConnect(const AValue: TNotifyEvent);
  1812. procedure SetBeforeDisconnect(const AValue: TNotifyEvent);
  1813. protected
  1814. procedure DoLoginPrompt; virtual;
  1815. procedure DoConnect; virtual;
  1816. procedure DoDisconnect; virtual;
  1817. function GetConnected : boolean; virtual;
  1818. Function GetDataset(Index : longint) : TDataset; virtual;
  1819. Function GetDataSetCount : Longint; virtual;
  1820. procedure GetLoginParams(out ADatabaseName, AUserName, APassword: string); virtual;
  1821. procedure InternalHandleException; virtual;
  1822. procedure Loaded; override;
  1823. procedure SetConnected (Value : boolean); virtual;
  1824. procedure SetLoginParams(const ADatabaseName, AUserName, APassword: string); virtual;
  1825. property ForcedClose : Boolean read FForcedClose write FForcedClose;
  1826. property StreamedConnected: Boolean read FStreamedConnected write FStreamedConnected;
  1827. public
  1828. procedure Close(ForceClose: Boolean=False);
  1829. destructor Destroy; override;
  1830. procedure Open;
  1831. property DataSetCount: Longint read GetDataSetCount;
  1832. property DataSets[Index: Longint]: TDataSet read GetDataSet;
  1833. published
  1834. property Connected: Boolean read GetConnected write SetConnected;
  1835. property LoginPrompt: Boolean read FLoginPrompt write FLoginPrompt;
  1836. property AfterConnect : TNotifyEvent read FAfterConnect write SetAfterConnect;
  1837. property AfterDisconnect : TNotifyEvent read FAfterDisconnect write SetAfterDisconnect;
  1838. property BeforeConnect : TNotifyEvent read FBeforeConnect write SetBeforeConnect;
  1839. property BeforeDisconnect : TNotifyEvent read FBeforeDisconnect write SetBeforeDisconnect;
  1840. property OnLogin: TLoginEvent read FOnLogin write FOnLogin;
  1841. end;
  1842. { TDatabase }
  1843. TDatabaseClass = Class Of TDatabase;
  1844. TDatabase = class(TCustomConnection)
  1845. private
  1846. FConnected : Boolean;
  1847. FDataBaseName : String;
  1848. FDataSets : TList;
  1849. FTransactions : TList;
  1850. FDirectory : String;
  1851. FKeepConnection : Boolean;
  1852. FParams : TStrings;
  1853. FSQLBased : Boolean;
  1854. FOpenAfterRead : boolean;
  1855. Function GetTransactionCount : Longint;
  1856. Function GetTransaction(Index : longint) : TDBTransaction;
  1857. procedure RegisterDataset (DS : TDBDataset);
  1858. procedure RegisterTransaction (TA : TDBTransaction);
  1859. procedure UnRegisterDataset (DS : TDBDataset);
  1860. procedure UnRegisterTransaction(TA : TDBTransaction);
  1861. procedure RemoveDataSets;
  1862. procedure RemoveTransactions;
  1863. procedure SetParams(AValue: TStrings);
  1864. protected
  1865. Procedure CheckConnected;
  1866. Procedure CheckDisConnected;
  1867. procedure DoConnect; override;
  1868. procedure DoDisconnect; override;
  1869. function GetConnected : boolean; override;
  1870. Function GetDataset(Index : longint) : TDataset; override;
  1871. Function GetDataSetCount : Longint; override;
  1872. Procedure DoInternalConnect; Virtual;Abstract;
  1873. Procedure DoInternalDisConnect; Virtual;Abstract;
  1874. public
  1875. constructor Create(AOwner: TComponent); override;
  1876. destructor Destroy; override;
  1877. procedure CloseDataSets;
  1878. procedure CloseTransactions;
  1879. // procedure ApplyUpdates;
  1880. procedure StartTransaction; virtual; abstract;
  1881. procedure EndTransaction; virtual; abstract;
  1882. property TransactionCount: Longint read GetTransactionCount;
  1883. property Transactions[Index: Longint]: TDBTransaction read GetTransaction;
  1884. property Directory: string read FDirectory write FDirectory;
  1885. property IsSQLBased: Boolean read FSQLBased;
  1886. published
  1887. property Connected: Boolean read FConnected write SetConnected;
  1888. property DatabaseName: string read FDatabaseName write FDatabaseName;
  1889. property KeepConnection: Boolean read FKeepConnection write FKeepConnection;
  1890. property Params : TStrings read FParams Write SetParams;
  1891. end;
  1892. const
  1893. FieldTypetoVariantMap : array[TFieldType] of Integer =
  1894. (
  1895. {ftUnknown} varError,
  1896. {ftString} varOleStr,
  1897. {ftSmallint} varSmallint,
  1898. {ftInteger} varInteger,
  1899. {ftWord} varSmallint,
  1900. {ftBoolean} varBoolean,
  1901. {ftFloat} varDouble,
  1902. {ftCurrency} varCurrency,
  1903. {ftBCD} varCurrency,
  1904. {ftDate} varDate,
  1905. {ftTime} varDate,
  1906. {ftDateTime} varDate,
  1907. {ftBytes} varOleStr,
  1908. {ftVarBytes} varOleStr,
  1909. {ftAutoInc} varInteger,
  1910. {ftBlob} varOleStr,
  1911. {ftMemo} varOleStr,
  1912. {ftGraphic} varOleStr,
  1913. {ftFmtMemo} varOleStr,
  1914. {ftParadoxOle} varOleStr,
  1915. {ftDBaseOle} varOleStr,
  1916. {ftTypedBinary} varOleStr,
  1917. {ftCursor} varError,
  1918. {ftFixedChar} varOleStr,
  1919. {ftWideString} varOleStr,
  1920. {ftLargeint} varint64,
  1921. {ftADT} varError,
  1922. {ftArray} varError,
  1923. {ftReference} varError,
  1924. {ftDataSet} varError,
  1925. {ftOraBlob} varOleStr,
  1926. {ftOraClob} varOleStr,
  1927. {ftVariant} varVariant,
  1928. {ftInterface} varUnknown,
  1929. {ftIDispatch} varDispatch,
  1930. {ftGuid} varOleStr,
  1931. {ftTimeStamp} varOleStr,
  1932. {ftFMTBcd} varDouble,
  1933. {ftFixedWideChar} varOleStr,
  1934. {ftWideMemo} varOleStr
  1935. );
  1936. Const
  1937. Fieldtypenames : Array [TFieldType] of String[15] =
  1938. (
  1939. {ftUnknown} 'Unknown',
  1940. {ftString} 'String',
  1941. {ftSmallint} 'Smallint',
  1942. {ftInteger} 'Integer',
  1943. {ftWord} 'Word',
  1944. {ftBoolean} 'Boolean',
  1945. {ftFloat} 'Float',
  1946. {ftCurrency} 'Currency',
  1947. {ftBCD} 'BCD',
  1948. {ftDate} 'Date',
  1949. {ftTime} 'Time',
  1950. {ftDateTime} 'DateTime',
  1951. {ftBytes} 'Bytes',
  1952. {ftVarBytes} 'VarBytes',
  1953. {ftAutoInc} 'AutoInc',
  1954. {ftBlob} 'Blob',
  1955. {ftMemo} 'Memo',
  1956. {ftGraphic} 'Graphic',
  1957. {ftFmtMemo} 'FmtMemo',
  1958. {ftParadoxOle} 'ParadoxOle',
  1959. {ftDBaseOle} 'DBaseOle',
  1960. {ftTypedBinary} 'TypedBinary',
  1961. {ftCursor} 'Cursor',
  1962. {ftFixedChar} 'FixedChar',
  1963. {ftWideString} 'WideString',
  1964. {ftLargeint} 'Largeint',
  1965. {ftADT} 'ADT',
  1966. {ftArray} 'Array',
  1967. {ftReference} 'Reference',
  1968. {ftDataSet} 'DataSet',
  1969. {ftOraBlob} 'OraBlob',
  1970. {ftOraClob} 'OraClob',
  1971. {ftVariant} 'Variant',
  1972. {ftInterface} 'Interface',
  1973. {ftIDispatch} 'IDispatch',
  1974. {ftGuid} 'Guid',
  1975. {ftTimeStamp} 'TimeStamp',
  1976. {ftFMTBcd} 'FMTBcd',
  1977. {ftFixedWideChar} 'FixedWideChar',
  1978. {ftWideMemo} 'WideMemo'
  1979. );
  1980. const
  1981. DefaultFieldClasses : Array [TFieldType] of TFieldClass =
  1982. (
  1983. { ftUnknown} Tfield,
  1984. { ftString} TStringField,
  1985. { ftSmallint} TSmallIntField,
  1986. { ftInteger} TLongintField,
  1987. { ftWord} TWordField,
  1988. { ftBoolean} TBooleanField,
  1989. { ftFloat} TFloatField,
  1990. { ftCurrency} TCurrencyField,
  1991. { ftBCD} TBCDField,
  1992. { ftDate} TDateField,
  1993. { ftTime} TTimeField,
  1994. { ftDateTime} TDateTimeField,
  1995. { ftBytes} TBytesField,
  1996. { ftVarBytes} TVarBytesField,
  1997. { ftAutoInc} TAutoIncField,
  1998. { ftBlob} TBlobField,
  1999. { ftMemo} TMemoField,
  2000. { ftGraphic} TGraphicField,
  2001. { ftFmtMemo} TBlobField,
  2002. { ftParadoxOle} TBlobField,
  2003. { ftDBaseOle} TBlobField,
  2004. { ftTypedBinary} TBlobField,
  2005. { ftCursor} Nil,
  2006. { ftFixedChar} TStringField,
  2007. { ftWideString} TWideStringField,
  2008. { ftLargeint} TLargeIntField,
  2009. { ftADT} Nil,
  2010. { ftArray} Nil,
  2011. { ftReference} Nil,
  2012. { ftDataSet} Nil,
  2013. { ftOraBlob} TBlobField,
  2014. { ftOraClob} TMemoField,
  2015. { ftVariant} TVariantField,
  2016. { ftInterface} Nil,
  2017. { ftIDispatch} Nil,
  2018. { ftGuid} TGuidField,
  2019. { ftTimeStamp} Nil,
  2020. { ftFMTBcd} TFMTBCDField,
  2021. { ftFixedWideString} TWideStringField,
  2022. { ftWideMemo} TWideMemoField
  2023. );
  2024. dsEditModes = [dsEdit, dsInsert, dsSetKey];
  2025. dsWriteModes = [dsEdit, dsInsert, dsSetKey, dsCalcFields, dsFilter,
  2026. dsNewValue, dsInternalCalc, dsRefreshFields];
  2027. // Correct list of all field types that are BLOB types.
  2028. // Please use this instead of checking TBlobType which will give
  2029. // incorrect results
  2030. ftBlobTypes = [ftBlob, ftMemo, ftGraphic, ftFmtMemo, ftParadoxOle,
  2031. ftDBaseOle, ftTypedBinary, ftOraBlob, ftOraClob, ftWideMemo];
  2032. var
  2033. LoginDialogExProc: function(const ADatabaseName: string; var AUserName, APassword: string; UserNameReadOnly: Boolean): Boolean = nil;
  2034. { Auxiliary functions }
  2035. Procedure DatabaseError (Const Msg : String); overload;
  2036. Procedure DatabaseError (Const Msg : String; Comp : TComponent); overload;
  2037. Procedure DatabaseErrorFmt (Const Fmt : String; Const Args : Array Of Const); overload;
  2038. Procedure DatabaseErrorFmt (Const Fmt : String; Const Args : Array Of Const; Comp : TComponent); overload;
  2039. Function ExtractFieldName(Const Fields: String; var Pos: Integer): String;
  2040. Function DateTimeRecToDateTime(DT: TFieldType; Data: TDateTimeRec): TDateTime;
  2041. Function DateTimeToDateTimeRec(DT: TFieldType; Data: TDateTime): TDateTimeRec;
  2042. procedure DisposeMem(var Buffer; Size: Integer);
  2043. function BuffersEqual(Buf1, Buf2: Pointer; Size: Integer): Boolean;
  2044. function SkipComments(var p: PChar; EscapeSlash, EscapeRepeat : Boolean) : boolean;
  2045. operator Enumerator(ADataSet: TDataSet): TDataSetEnumerator;
  2046. implementation
  2047. uses dbconst,typinfo;
  2048. { ---------------------------------------------------------------------
  2049. Auxiliary functions
  2050. ---------------------------------------------------------------------}
  2051. Procedure DatabaseError (Const Msg : String);
  2052. begin
  2053. Raise EDataBaseError.Create(Msg);
  2054. end;
  2055. Procedure DatabaseError (Const Msg : String; Comp : TComponent);
  2056. begin
  2057. if assigned(Comp) and (Comp.Name <> '') then
  2058. Raise EDatabaseError.CreateFmt('%s : %s',[Comp.Name,Msg])
  2059. else
  2060. DatabaseError(Msg);
  2061. end;
  2062. Procedure DatabaseErrorFmt (Const Fmt : String; Const Args : Array Of Const);
  2063. begin
  2064. Raise EDatabaseError.CreateFmt(Fmt,Args);
  2065. end;
  2066. Procedure DatabaseErrorFmt (Const Fmt : String; Const Args : Array Of Const;
  2067. Comp : TComponent);
  2068. begin
  2069. if assigned(comp) then
  2070. Raise EDatabaseError.CreateFmt(Format('%s : %s',[Comp.Name,Fmt]),Args)
  2071. else
  2072. DatabaseErrorFmt(Fmt, Args);
  2073. end;
  2074. function ExtractFieldName(const Fields: string; var Pos: Integer): string;
  2075. var
  2076. i: Integer;
  2077. FieldsLength: Integer;
  2078. begin
  2079. i:=Pos;
  2080. FieldsLength:=Length(Fields);
  2081. while (i<=FieldsLength) and (Fields[i]<>';') do Inc(i);
  2082. Result:=Trim(Copy(Fields,Pos,i-Pos));
  2083. if (i<=FieldsLength) and (Fields[i]=';') then Inc(i);
  2084. Pos:=i;
  2085. end;
  2086. { EUpdateError }
  2087. constructor EUpdateError.Create(NativeError, Context : String;
  2088. ErrCode, PrevError : integer; E: Exception);
  2089. begin
  2090. Inherited CreateFmt(NativeError,[Context]);
  2091. FContext := Context;
  2092. FErrorCode := ErrCode;
  2093. FPreviousError := PrevError;
  2094. FOriginalException := E;
  2095. end;
  2096. Destructor EUpdateError.Destroy;
  2097. begin
  2098. FOriginalException.Free;
  2099. Inherited;
  2100. end;
  2101. { TNamedItem }
  2102. function TNamedItem.GetDisplayName: string;
  2103. begin
  2104. Result := FName;
  2105. end;
  2106. procedure TNamedItem.SetDisplayName(const AValue: string);
  2107. Var TmpInd : Integer;
  2108. begin
  2109. if FName=AValue then exit;
  2110. if (AValue <> '') and (Collection is TFieldDefs ) then
  2111. begin
  2112. TmpInd := (TDefCollection(Collection).IndexOf(AValue));
  2113. if (TmpInd >= 0) and (TmpInd <> Index) then
  2114. DatabaseErrorFmt(SDuplicateName, [AValue, Collection.ClassName]);
  2115. end;
  2116. FName:=AValue;
  2117. inherited SetDisplayName(AValue);
  2118. end;
  2119. { TDefCollection }
  2120. procedure TDefCollection.SetItemName(AItem: TCollectionItem);
  2121. begin
  2122. with AItem as TNamedItem do
  2123. if Name = '' then
  2124. begin
  2125. if assigned(Dataset) then
  2126. Name := Dataset.Name + Copy(ClassName, 2, 5) + IntToStr(ID+1)
  2127. else
  2128. Name := Copy(ClassName, 2, 5) + IntToStr(ID+1);
  2129. end
  2130. else inherited SetItemName(AItem);
  2131. end;
  2132. constructor TDefCollection.create(ADataset: TDataset; AOwner: TPersistent;
  2133. AClass: TCollectionItemClass);
  2134. begin
  2135. inherited Create(AOwner,AClass);
  2136. FDataset := ADataset;
  2137. end;
  2138. function TDefCollection.Find(const AName: string): TNamedItem;
  2139. var i: integer;
  2140. begin
  2141. Result := Nil;
  2142. for i := 0 to Count - 1 do if AnsiSameText(TNamedItem(Items[i]).Name, AName) then
  2143. begin
  2144. Result := TNamedItem(Items[i]);
  2145. Break;
  2146. end;
  2147. end;
  2148. procedure TDefCollection.GetItemNames(List: TStrings);
  2149. var i: LongInt;
  2150. begin
  2151. for i := 0 to Count - 1 do
  2152. List.Add(TNamedItem(Items[i]).Name);
  2153. end;
  2154. function TDefCollection.IndexOf(const AName: string): Longint;
  2155. var i: LongInt;
  2156. begin
  2157. Result := -1;
  2158. for i := 0 to Count - 1 do
  2159. if AnsiSameText(TNamedItem(Items[i]).Name, AName) then
  2160. begin
  2161. Result := i;
  2162. Break;
  2163. end;
  2164. end;
  2165. { TIndexDef }
  2166. procedure TIndexDef.SetDescFields(const AValue: string);
  2167. begin
  2168. if FDescFields=AValue then exit;
  2169. if AValue <> '' then FOptions:=FOptions + [ixDescending];
  2170. FDescFields:=AValue;
  2171. end;
  2172. procedure TIndexDef.Assign(Source: TPersistent);
  2173. var idef : TIndexDef;
  2174. begin
  2175. idef := nil;
  2176. if Source is TIndexDef then idef := Source as TIndexDef;
  2177. if Assigned(idef) then
  2178. begin
  2179. FName := idef.Name;
  2180. FFields := idef.Fields;
  2181. FOptions := idef.Options;
  2182. FCaseinsFields := idef.CaseInsFields;
  2183. FDescFields := idef.DescFields;
  2184. FSource := idef.Source;
  2185. FExpression := idef.Expression;
  2186. end
  2187. else
  2188. inherited Assign(Source);
  2189. end;
  2190. function TIndexDef.GetExpression: string;
  2191. begin
  2192. Result := FExpression;
  2193. end;
  2194. procedure TIndexDef.SetExpression(const AValue: string);
  2195. begin
  2196. FExpression := AValue;
  2197. end;
  2198. procedure TIndexDef.SetCaseInsFields(const AValue: string);
  2199. begin
  2200. if FCaseinsFields=AValue then exit;
  2201. if AValue <> '' then FOptions:=FOptions + [ixCaseInsensitive];
  2202. FCaseinsFields:=AValue;
  2203. end;
  2204. constructor TIndexDef.Create(Owner: TIndexDefs; const AName, TheFields: string;
  2205. TheOptions: TIndexOptions);
  2206. begin
  2207. FName := aname;
  2208. inherited create(Owner);
  2209. FFields := TheFields;
  2210. FOptions := TheOptions;
  2211. end;
  2212. { TIndexDefs }
  2213. Function TIndexDefs.GetItem (Index : integer) : TIndexDef;
  2214. begin
  2215. Result:=(Inherited GetItem(Index)) as TIndexDef;
  2216. end;
  2217. Procedure TIndexDefs.SetItem(Index: Integer; Value: TIndexDef);
  2218. begin
  2219. Inherited SetItem(Index,Value);
  2220. end;
  2221. constructor TIndexDefs.Create(ADataSet: TDataSet);
  2222. begin
  2223. inherited create(ADataset, Owner, TIndexDef);
  2224. end;
  2225. Function TIndexDefs.AddIndexDef: TIndexDef;
  2226. begin
  2227. Result := inherited add as TIndexDef;
  2228. end;
  2229. procedure TIndexDefs.Add(const Name, Fields: string; Options: TIndexOptions);
  2230. Var
  2231. D : TIndexDef;
  2232. begin
  2233. D:=AddIndexDef;
  2234. D.Name:=Name;
  2235. D.Fields:=Fields;
  2236. D.Options:=Options;
  2237. end;
  2238. function TIndexDefs.Find(const IndexName: string): TIndexDef;
  2239. begin
  2240. Result := (inherited Find(IndexName)) as TIndexDef;
  2241. if (Result=Nil) Then
  2242. DatabaseErrorFmt(SIndexNotFound, [IndexName], FDataSet);
  2243. end;
  2244. function TIndexDefs.FindIndexForFields(const Fields: string): TIndexDef;
  2245. begin
  2246. //!! To be implemented
  2247. end;
  2248. function TIndexDefs.GetIndexForFields(const Fields: string;
  2249. CaseInsensitive: Boolean): TIndexDef;
  2250. var
  2251. i, FieldsLen: integer;
  2252. Last: TIndexDef;
  2253. begin
  2254. Last := nil;
  2255. FieldsLen := Length(Fields);
  2256. for i := 0 to Count - 1 do
  2257. begin
  2258. Result := Items[I];
  2259. if (Result.Options * [ixDescending, ixExpression] = []) and
  2260. (not CaseInsensitive or (ixCaseInsensitive in Result.Options)) and
  2261. AnsiSameText(Fields, Result.Fields) then
  2262. begin
  2263. Exit;
  2264. end else
  2265. if AnsiSameText(Fields, Copy(Result.Fields, 1, FieldsLen)) and
  2266. ((Length(Result.Fields) = FieldsLen) or
  2267. (Result.Fields[FieldsLen + 1] = ';')) then
  2268. begin
  2269. if (Last = nil) or
  2270. ((Last <> nil) And (Length(Last.Fields) > Length(Result.Fields))) then
  2271. Last := Result;
  2272. end;
  2273. end;
  2274. Result := Last;
  2275. end;
  2276. procedure TIndexDefs.Update;
  2277. begin
  2278. if (not updated) and assigned(Dataset) then
  2279. begin
  2280. Dataset.UpdateIndexDefs;
  2281. updated := True;
  2282. end;
  2283. end;
  2284. { TCheckConstraint }
  2285. procedure TCheckConstraint.Assign(Source: TPersistent);
  2286. begin
  2287. //!! To be implemented
  2288. end;
  2289. { TCheckConstraints }
  2290. Function TCheckConstraints.GetItem(Index : Longint) : TCheckConstraint;
  2291. begin
  2292. //!! To be implemented
  2293. Result := nil;
  2294. end;
  2295. Procedure TCheckConstraints.SetItem(index : Longint; Value : TCheckConstraint);
  2296. begin
  2297. //!! To be implemented
  2298. end;
  2299. function TCheckConstraints.GetOwner: TPersistent;
  2300. begin
  2301. //!! To be implemented
  2302. Result := nil;
  2303. end;
  2304. constructor TCheckConstraints.Create(AOwner: TPersistent);
  2305. begin
  2306. //!! To be implemented
  2307. inherited Create(TCheckConstraint);
  2308. end;
  2309. function TCheckConstraints.Add: TCheckConstraint;
  2310. begin
  2311. //!! To be implemented
  2312. Result := nil;
  2313. end;
  2314. { TLookupList }
  2315. constructor TLookupList.Create;
  2316. begin
  2317. FList := TFPList.Create;
  2318. end;
  2319. destructor TLookupList.Destroy;
  2320. begin
  2321. Clear;
  2322. FList.Destroy;
  2323. inherited Destroy;
  2324. end;
  2325. procedure TLookupList.Add(const AKey, AValue: Variant);
  2326. var LookupRec: PLookupListRec;
  2327. begin
  2328. New(LookupRec);
  2329. LookupRec^.Key := AKey;
  2330. LookupRec^.Value := AValue;
  2331. FList.Add(LookupRec);
  2332. end;
  2333. procedure TLookupList.Clear;
  2334. var i: integer;
  2335. begin
  2336. for i := 0 to FList.Count - 1 do Dispose(PLookupListRec(FList[i]));
  2337. FList.Clear;
  2338. end;
  2339. function TLookupList.FirstKeyByValue(const AValue: Variant): Variant;
  2340. var
  2341. i: Integer;
  2342. begin
  2343. for i := 0 to FList.Count - 1 do
  2344. with PLookupListRec(FList[i])^ do
  2345. if Value = AValue then
  2346. begin
  2347. Result := Key;
  2348. exit;
  2349. end;
  2350. Result := Null;
  2351. end;
  2352. function TLookupList.ValueOfKey(const AKey: Variant): Variant;
  2353. Function VarArraySameValues(VarArray1,VarArray2 : Variant) : Boolean;
  2354. // This only works for one-dimensional vararrays with a lower bound of 0
  2355. // and equal higher bounds wich only contains variants.
  2356. // The vararrays returned by GetFieldValues do apply.
  2357. var i : integer;
  2358. begin
  2359. Result := True;
  2360. if (VarArrayHighBound(VarArray1,1))<> (VarArrayHighBound(VarArray2,1)) then exit;
  2361. for i := 0 to VarArrayHighBound(VarArray1,1) do
  2362. begin
  2363. if VarArray1[i]<>VarArray2[i] then
  2364. begin
  2365. Result := false;
  2366. Exit;
  2367. end;
  2368. end;
  2369. end;
  2370. var I: Integer;
  2371. begin
  2372. Result := Null;
  2373. if VarIsNull(AKey) then Exit;
  2374. i := FList.Count - 1;
  2375. if VarIsArray(AKey) then
  2376. while (i >= 0) And not VarArraySameValues(PLookupListRec(FList.Items[I])^.Key,AKey) do Dec(i)
  2377. else
  2378. while (i >= 0) And (PLookupListRec(FList.Items[I])^.Key <> AKey) do Dec(i);
  2379. if i >= 0 then Result := PLookupListRec(FList.Items[I])^.Value;
  2380. end;
  2381. procedure TLookupList.ValuesToStrings(AStrings: TStrings);
  2382. var
  2383. i: Integer;
  2384. p: PLookupListRec;
  2385. begin
  2386. AStrings.Clear;
  2387. for i := 0 to FList.Count - 1 do
  2388. begin
  2389. p := PLookupListRec(FList[i]);
  2390. AStrings.AddObject(p^.Value, TObject(p));
  2391. end;
  2392. end;
  2393. procedure DisposeMem(var Buffer; Size: Integer);
  2394. begin
  2395. if Pointer(Buffer) <> nil then
  2396. begin
  2397. FreeMem(Pointer(Buffer), Size);
  2398. Pointer(Buffer) := nil;
  2399. end;
  2400. end;
  2401. function BuffersEqual(Buf1, Buf2: Pointer; Size: Integer): Boolean;
  2402. begin
  2403. Result:=CompareByte(Buf1,Buf2,Size)=0
  2404. end;
  2405. {$i dataset.inc}
  2406. {$i fields.inc}
  2407. {$i datasource.inc}
  2408. {$i database.inc}
  2409. {$i dsparams.inc}
  2410. end.