memds.pp 22 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937
  1. {
  2. $Id$
  3. This file is part of the Free Component Library (FCL)
  4. Copyright (c) 1999-2000 by the Free Pascal development team
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. {$mode objfpc}
  12. {$H+}
  13. {
  14. TMemDataset : In-memory dataset.
  15. - Has possibility to copy Structure/Data from other dataset.
  16. - Can load/save to/from stream.
  17. Ideas taken from THKMemTab Component by Harri Kasulke - Hamburg/Germany
  18. E-mail: [email protected]
  19. }
  20. unit memds;
  21. interface
  22. uses
  23. SysUtils, Classes, DB;
  24. Const
  25. // Stream Markers.
  26. MarkerSize = SizeOf(Integer);
  27. smEOF = 0;
  28. smFieldDefs = 1;
  29. smData = 2;
  30. type
  31. MDSError=class(Exception);
  32. PRecInfo=^TMTRecInfo;
  33. TMTRecInfo=record
  34. Bookmark: Longint;
  35. BookmarkFlag: TBookmarkFlag;
  36. end;
  37. PInteger = ^Integer;
  38. PSmallInt = ^SmallInt;
  39. PInt64 = ^Int64;
  40. PFloat = ^Extended;
  41. PBoolean = ^Boolean;
  42. TMemDataset=class(TDataSet)
  43. private
  44. FOpenStream : TStream;
  45. FFileName : String;
  46. FModified : Boolean;
  47. FStream: TMemoryStream;
  48. FRecInfoOffset: integer;
  49. FRecInfoSize: integer;
  50. FRecCount: integer;
  51. FRecSize: integer;
  52. FRecBufferSize: integer;
  53. FCurrRecNo: integer;
  54. FIsOpen: boolean;
  55. FFilterBuffer: PChar;
  56. protected
  57. // Mandatory
  58. function AllocRecordBuffer: PChar; override;
  59. procedure FreeRecordBuffer(var Buffer: PChar); override;
  60. procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
  61. function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
  62. function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
  63. function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
  64. function GetRecordSize: Word; override;
  65. procedure InternalAddRecord(Buffer: Pointer; DoAppend: Boolean); override;
  66. procedure InternalClose; override;
  67. procedure InternalDelete; override;
  68. procedure InternalFirst; override;
  69. procedure InternalGotoBookmark(ABookmark: Pointer); override;
  70. procedure InternalHandleException; override;
  71. procedure InternalInitFieldDefs; override;
  72. procedure InternalInitRecord(Buffer: PChar); override;
  73. procedure InternalLast; override;
  74. procedure InternalOpen; override;
  75. procedure InternalPost; override;
  76. procedure InternalSetToRecord(Buffer: PChar); override;
  77. function IsCursorOpen: Boolean; override;
  78. procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
  79. procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
  80. procedure SetFieldData(Field: TField; Buffer: Pointer); override;
  81. // Optional.
  82. function GetRecordCount: Integer; override;
  83. procedure SetRecNo(Value: Integer); override;
  84. function GetRecNo: Integer; override;
  85. // Own.
  86. Procedure RaiseError(Fmt : String; Args : Array of const);
  87. Procedure CheckMarker(F : TStream; Marker : Integer);
  88. Procedure WriteMarker(F : TStream; Marker : Integer);
  89. procedure ReadFieldDefsFromStream(F : TStream);
  90. procedure SaveFieldDefsToStream(F : TStream);
  91. // These should be overridden if you want to load more data.
  92. // E.g. index defs.
  93. Procedure LoadDataFromStream(F : TStream); virtual;
  94. // If SaveData=False, a size 0 block should be written.
  95. Procedure SaveDataToStream(F : TStream; SaveData : Boolean); virtual;
  96. private
  97. function MDSGetRecordOffset(ARecNo: integer): longint;
  98. function MDSGetFieldOffset(FieldNo: integer): integer;
  99. function MDSGetFieldSize(FieldNo: integer): integer;
  100. function MDSGetActiveBuffer(var Buffer: PChar): Boolean;
  101. procedure MDSReadRecord(Buffer:PChar;ARecNo:Integer);
  102. procedure MDSWriteRecord(Buffer:PChar;ARecNo:Integer);
  103. procedure MDSAppendRecord(Buffer:PChar);
  104. function MDSFilterRecord(Buffer: PChar): Boolean;
  105. public
  106. constructor Create(AOwner:tComponent); override;
  107. destructor Destroy; override;
  108. procedure CreateTable;
  109. Function DataSize : Integer;
  110. procedure Clear(ClearDefs : Boolean);
  111. procedure Clear;
  112. Procedure SaveToFile(AFileName : String);
  113. Procedure SaveToFile(AFileName : String; SaveData : Boolean);
  114. Procedure SaveToStream(F : TStream);
  115. Procedure SaveToStream(F : TStream; SaveData : Boolean);
  116. Procedure LoadFromStream(F : TStream);
  117. Procedure LoadFromFile(AFileName : String);
  118. Procedure CopyFromDataset(DataSet : TDataSet);
  119. Procedure CopyFromDataset(DataSet : TDataSet; CopyData : Boolean);
  120. Property Modified : Boolean Read FModified;
  121. published
  122. Property FileName : String Read FFileName Write FFileName;
  123. property Filtered;
  124. Property Active;
  125. Property FieldDefs;
  126. property BeforeOpen;
  127. property AfterOpen;
  128. property BeforeClose;
  129. property AfterClose;
  130. property BeforeInsert;
  131. property AfterInsert;
  132. property BeforeEdit;
  133. property AfterEdit;
  134. property BeforePost;
  135. property AfterPost;
  136. property BeforeCancel;
  137. property AfterCancel;
  138. property BeforeDelete;
  139. property AfterDelete;
  140. property BeforeScroll;
  141. property AfterScroll;
  142. property OnDeleteError;
  143. property OnEditError;
  144. property OnNewRecord;
  145. property OnPostError;
  146. property OnFilterRecord;
  147. end;
  148. implementation
  149. ResourceString
  150. SErrFieldTypeNotSupported = 'Fieldtype of Field "%s" not supported.';
  151. SErrBookMarkNotFound = 'Bookmark %d not found.';
  152. SErrInvalidDataStream = 'Error in data stream at position %d';
  153. SErrInvalidMarkerAtPos = 'Wrong data stream marker at position %d. Got %d, expected %d';
  154. SErrNoFileName = 'Filename must not be empty.';
  155. { ---------------------------------------------------------------------
  156. Stream functions
  157. ---------------------------------------------------------------------}
  158. Function ReadInteger(S : TStream) : Integer;
  159. begin
  160. S.ReadBuffer(Result,SizeOf(Result));
  161. end;
  162. Function ReadString(S : TStream) : String;
  163. Var
  164. L : Integer;
  165. begin
  166. L:=ReadInteger(S);
  167. Setlength(Result,L);
  168. If (L<>0) then
  169. S.ReadBuffer(Result[1],L);
  170. end;
  171. Procedure WriteInteger(S : TStream; Value : Integer);
  172. begin
  173. S.WriteBuffer(Value,SizeOf(Value));
  174. end;
  175. Procedure WriteString(S : TStream; Value : String);
  176. Var
  177. L : Integer;
  178. begin
  179. L:=Length(Value);
  180. WriteInteger(S,Length(Value));
  181. If (L<>0) then
  182. S.WriteBuffer(Value[1],L);
  183. end;
  184. { ---------------------------------------------------------------------
  185. TMemDataset
  186. ---------------------------------------------------------------------}
  187. constructor TMemDataset.Create(AOwner:tComponent);
  188. begin
  189. inherited create(aOwner);
  190. FStream:=TMemoryStream.Create;
  191. FRecInfoSize:=SizeOf(TMTRecInfo);
  192. FRecCount:=0;
  193. FRecSize:=0;
  194. FRecBufferSize:=0;
  195. FRecInfoOffset:=0;
  196. FCurrRecNo:=-1;
  197. FIsOpen:=False;
  198. end;
  199. Destructor TMemDataset.Destroy;
  200. begin
  201. FStream.Free;
  202. inherited Destroy;
  203. end;
  204. function TMemDataset.MDSGetRecordOffset(ARecNo: integer): longint;
  205. begin
  206. Result:=FRecSize*ARecNo
  207. end;
  208. function TMemDataset.MDSGetFieldOffset(FieldNo: integer): integer;
  209. var
  210. I : integer;
  211. begin
  212. Result:=0;
  213. for I:=1 to FieldNo-1 do
  214. Result:=Result+MDSGetFieldSize(I);
  215. end;
  216. Procedure TMemDataset.RaiseError(Fmt : String; Args : Array of const);
  217. begin
  218. Raise MDSError.CreateFmt(Fmt,Args);
  219. end;
  220. function TMemDataset.MDSGetFieldSize(FieldNo: integer): integer;
  221. begin
  222. case FieldDefs.Items[FieldNo-1].Datatype of
  223. ftString: result:=FieldDefs.Items[FieldNo-1].Size+1;
  224. ftBoolean: result:=SizeOf(Boolean);
  225. ftFloat: result:=SizeOf(Extended);
  226. ftLargeInt: result:=SizeOf(int64);
  227. ftSmallInt: result:=SizeOf(SmallInt);
  228. ftInteger: result:=SizeOf(Integer);
  229. ftDate: result:=SizeOf(TDateTime);
  230. ftTime: result:=SizeOf(TDateTime);
  231. else
  232. RaiseError(SErrFieldTypeNotSupported,[FieldDefs.Items[FieldNo-1].Name]);
  233. end;
  234. end;
  235. function TMemDataset.MDSGetActiveBuffer(var Buffer: PChar): Boolean;
  236. begin
  237. case State of
  238. dsBrowse:
  239. if IsEmpty then
  240. Buffer:=nil
  241. else
  242. Buffer:=ActiveBuffer;
  243. dsEdit,
  244. dsInsert:
  245. Buffer:=ActiveBuffer;
  246. dsFilter:
  247. Buffer:=FFilterBuffer;
  248. else
  249. Buffer:=nil;
  250. end;
  251. Result:=(Buffer<>nil);
  252. end;
  253. procedure TMemDataset.MDSReadRecord(Buffer:PChar;ARecNo:Integer); //Reads a Rec from Stream in Buffer
  254. begin
  255. FStream.Position:=MDSGetRecordOffset(ARecNo);
  256. FStream.ReadBuffer(Buffer^, FRecSize);
  257. end;
  258. procedure TMemDataset.MDSWriteRecord(Buffer:PChar;ARecNo:Integer); //Writes a Rec from Buffer to Stream
  259. begin
  260. FStream.Position:=MDSGetRecordOffset(ARecNo);
  261. FStream.WriteBuffer(Buffer^, FRecSize);
  262. FModified:=True;
  263. end;
  264. procedure TMemDataset.MDSAppendRecord(Buffer:PChar); //Appends a Rec (from Buffer) to Stream
  265. begin
  266. FStream.Position:=MDSGetRecordOffset(FRecCount);
  267. FStream.WriteBuffer(Buffer^, FRecSize);
  268. FModified:=True;
  269. end;
  270. //Abstract Overrides
  271. function TMemDataset.AllocRecordBuffer: PChar;
  272. begin
  273. GetMem(Result,FRecBufferSize);
  274. end;
  275. procedure TMemDataset.FreeRecordBuffer (var Buffer: PChar);
  276. begin
  277. FreeMem(Buffer);
  278. end;
  279. procedure TMemDataset.InternalInitRecord(Buffer: PChar);
  280. var
  281. I : integer;
  282. begin
  283. for I:=1 to FieldCount do
  284. case FieldDefs.Items[I-1].Datatype of
  285. ftString: pChar(Buffer+MDSGetFieldOffset(I))^:=#0;
  286. ftBoolean: pBoolean(Buffer+MDSGetFieldOffset(I))^:=False;
  287. ftFloat: pFloat(Buffer+MDSGetFieldOffset(I))^:=0;
  288. ftLargeint: PInt64(Buffer+MDSGetFieldOffset(I))^:=0;
  289. ftSmallInt: pSmallInt(Buffer+MDSGetFieldOffset(I))^:=0;
  290. ftInteger: pInteger(Buffer+MDSGetFieldOffset(I))^:=0;
  291. ftCurrency: pFloat(Buffer+MDSGetFieldOffset(I))^:=0;
  292. ftDate: pFloat(Buffer+MDSGetFieldOffset(I))^:=0;
  293. ftTime: pFloat(Buffer+MDSGetFieldOffset(I))^:=0;
  294. ftDateTime: pFloat(Buffer+MDSGetFieldOffset(I))^:=0;
  295. end;
  296. end;
  297. procedure TMemDataset.InternalDelete;
  298. Var
  299. TS : TMemoryStream;
  300. OldPos,NewPos,CopySize1,CopySize2 : Cardinal;
  301. begin
  302. if (FCurrRecNo<0) or (FCurrRecNo>=FRecCount) then
  303. Exit;
  304. // Very inefficient. We should simply move the last part closer to the beginning in
  305. // The FStream.
  306. TS:=TMemoryStream.Create;
  307. Try
  308. if FCurrRecNo>0 then
  309. begin
  310. FStream.Position:=MDSGetRecordOffset(0); //Delete Rec
  311. if FCurrRecNo<FRecCount-1 then
  312. begin
  313. TS.CopyFrom(FStream, MDSGetRecordOffset(FCurrRecNo)-MDSGetRecordOffset(0));
  314. FStream.Position:=MDSGetRecordOffset(FCurrRecNo+1);
  315. TS.CopyFrom(FStream,(MDSGetRecordOffset(FRecCount))-MDSGetRecordOffset(FCurrRecNo+1));
  316. end
  317. else
  318. TS.CopyFrom(FStream,MDSGetRecordOffset(FRecCount-1));
  319. end
  320. else
  321. begin //Delete first Rec
  322. FStream.Position:=MDSGetRecordOffset(FCurrRecNo+1);
  323. TS.CopyFrom(FStream,(MDSGetRecordOffset(FRecCount))-MDSGetRecordOffset(FCurrRecNo+1));
  324. end;
  325. FStream.loadFromStream(TS);
  326. Dec(FRecCount);
  327. if FRecCount=0 then
  328. FCurrRecNo:=-1
  329. else
  330. if FCurrRecNo>=FRecCount then FCurrRecNo:=FRecCount-1;
  331. Finally
  332. TS.Free;
  333. end;
  334. FModified:=True;
  335. end;
  336. procedure TMemDataset.InternalInitFieldDefs;
  337. begin
  338. If (FOpenStream<>Nil) then
  339. ReadFieldDefsFromStream(FOpenStream);
  340. end;
  341. Procedure TMemDataset.CheckMarker(F : TStream; Marker : Integer);
  342. Var
  343. I,P : Integer;
  344. begin
  345. P:=F.Position;
  346. If F.Read(I,MarkerSize)<>MarkerSize then
  347. RaiseError(SErrInvalidDataStream,[P])
  348. else
  349. if (I<>Marker) then
  350. RaiseError(SErrInvalidMarkerAtPos,[P,I,Marker]);
  351. end;
  352. procedure TMemDataset.ReadFieldDefsFromStream(F : TStream);
  353. Var
  354. I,ACount : Integer;
  355. FN : String;
  356. FS : Integer;
  357. B : Boolean;
  358. FT : TFieldType;
  359. begin
  360. CheckMarker(F,smFieldDefs);
  361. FieldDefs.Clear;
  362. ACount:=ReadInteger(F);
  363. For I:=1 to ACount do
  364. begin
  365. FN:=ReadString(F);
  366. FS:=ReadInteger(F);
  367. FT:=TFieldType(ReadInteger(F));
  368. B:=ReadInteger(F)<>0;
  369. TFieldDef.Create(FieldDefs,FN,ft,FS,B,I);
  370. end;
  371. CreateTable;
  372. end;
  373. procedure TMemDataset.InternalFirst;
  374. begin
  375. FCurrRecNo:=-1;
  376. end;
  377. procedure TMemDataset.InternalLast;
  378. begin
  379. FCurrRecNo:=FRecCount;
  380. end;
  381. procedure TMemDataset.InternalOpen;
  382. begin
  383. If (FFileName<>'') then
  384. FOpenStream:=TFileStream.Create(FFileName,fmOpenRead);
  385. Try
  386. InternalInitFieldDefs;
  387. if DefaultFields then
  388. CreateFields;
  389. BindFields(True);
  390. FCurrRecNo:=-1;
  391. If (FOpenStream<>Nil) then
  392. begin
  393. LoadDataFromStream(FOpenStream);
  394. CheckMarker(FOpenStream,smEOF);
  395. end;
  396. Finally
  397. FreeAndNil(FOpenStream);
  398. end;
  399. FIsOpen:=True;
  400. end;
  401. Procedure TMemDataSet.LoadDataFromStream(F : TStream);
  402. Var
  403. Size : Integer;
  404. begin
  405. CheckMarker(F,smData);
  406. Size:=ReadInteger(F);
  407. FStream.Clear;
  408. FStream.CopyFrom(F,Size);
  409. FRecCount:=Size div FRecSize;
  410. FCurrRecNo:=-1;
  411. end;
  412. Procedure TMemDataSet.LoadFromStream(F : TStream);
  413. begin
  414. Close;
  415. ReadFieldDefsFromStream(F);
  416. LoadDataFromStream(F);
  417. CheckMarker(F,smEOF);
  418. FModified:=False;
  419. end;
  420. Procedure TMemDataSet.LoadFromFile(AFileName : String);
  421. Var
  422. F : TFileStream;
  423. begin
  424. F:=TFileStream.Create(AFileName,fmOpenRead);
  425. Try
  426. LoadFromStream(F);
  427. Finally
  428. F.Free;
  429. end;
  430. end;
  431. Procedure TMemDataset.SaveToFile(AFileName : String);
  432. begin
  433. SaveToFile(AFileName,True);
  434. end;
  435. Procedure TMemDataset.SaveToFile(AFileName : String; SaveData : Boolean);
  436. Var
  437. F : TFileStream;
  438. begin
  439. If (AFileName='') then
  440. RaiseError(SErrNoFileName,[]);
  441. F:=TFileStream.Create(AFileName,fmCreate);
  442. try
  443. SaveToStream(F,SaveData);
  444. Finally
  445. F.Free;
  446. end;
  447. end;
  448. Procedure TMemDataset.WriteMarker(F : TStream; Marker : Integer);
  449. begin
  450. Writeinteger(F,Marker);
  451. end;
  452. Procedure TMemDataset.SaveToStream(F : TStream);
  453. begin
  454. SaveToStream(F,True);
  455. end;
  456. Procedure TMemDataset.SaveToStream(F : TStream; SaveData : Boolean);
  457. begin
  458. SaveFieldDefsToStream(F);
  459. If SaveData then
  460. SaveDataToStream(F,SaveData);
  461. WriteMarker(F,smEOF);
  462. end;
  463. Procedure TMemDataset.SaveFieldDefsToStream(F : TStream);
  464. Var
  465. I,ACount : Integer;
  466. FN : String;
  467. FS : Integer;
  468. B : Boolean;
  469. FT : TFieldType;
  470. FD : TFieldDef;
  471. begin
  472. WriteMarker(F,smFieldDefs);
  473. WriteInteger(F,FieldDefs.Count);
  474. For I:=1 to FieldDefs.Count do
  475. begin
  476. FD:=FieldDefs[I-1];
  477. WriteString(F,FD.Name);
  478. WriteInteger(F,FD.Size);
  479. WriteInteger(F,Ord(FD.DataType));
  480. WriteInteger(F,Ord(FD.Required));
  481. end;
  482. end;
  483. Procedure TMemDataset.SaveDataToStream(F : TStream; SaveData : Boolean);
  484. begin
  485. if SaveData then
  486. begin
  487. WriteMarker(F,smData);
  488. WriteInteger(F,FStream.Size);
  489. FStream.Position:=0;
  490. F.CopyFrom(FStream,FStream.Size);
  491. FModified:=False;
  492. end
  493. else
  494. begin
  495. WriteMarker(F,smData);
  496. WriteInteger(F,0);
  497. end;
  498. end;
  499. procedure TMemDataset.InternalClose;
  500. begin
  501. if (FModified) and (FFileName<>'') then
  502. SaveToFile(FFileName,True);
  503. FIsOpen:=False;
  504. FModified:=False;
  505. BindFields(False);
  506. if DefaultFields then
  507. DestroyFields;
  508. end;
  509. procedure TMemDataset.InternalPost;
  510. begin
  511. CheckActive;
  512. if ((State<>dsEdit) and (State<>dsInsert)) then
  513. Exit;
  514. if (State=dsEdit) then
  515. MDSWriteRecord(ActiveBuffer, FCurrRecNo)
  516. else
  517. InternalAddRecord(ActiveBuffer,True);
  518. end;
  519. function TMemDataset.IsCursorOpen: Boolean;
  520. begin
  521. Result:=FIsOpen;
  522. end;
  523. function TMemDataset.GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
  524. var
  525. Accepted: Boolean;
  526. begin
  527. Result:=grOk;
  528. Accepted:=False;
  529. if (FRecCount<1) then
  530. begin
  531. Result:=grEOF;
  532. exit;
  533. end;
  534. repeat
  535. case GetMode of
  536. gmCurrent:
  537. if (FCurrRecNo>=FRecCount) or (FCurrRecNo<0) then
  538. Result:=grError;
  539. gmNext:
  540. if (FCurrRecNo<FRecCount-1) then
  541. Inc(FCurrRecNo)
  542. else
  543. Result:=grEOF;
  544. gmPrior:
  545. if (FCurrRecNo>0) then
  546. Dec(FCurrRecNo)
  547. else
  548. result:=grBOF;
  549. end;
  550. if result=grOK then
  551. begin
  552. MDSReadRecord(Buffer, FCurrRecNo);
  553. PRecInfo(Buffer+FRecInfoOffset)^.Bookmark:=FCurrRecNo;
  554. PRecInfo(Buffer+FRecInfoOffset)^.BookmarkFlag:=bfCurrent;
  555. if (Filtered) then
  556. Accepted:=MDSFilterRecord(Buffer) //Filtering
  557. else
  558. Accepted:=True;
  559. if (GetMode=gmCurrent) and not Accepted then
  560. result:=grError;
  561. end;
  562. until (result<>grOK) or Accepted;
  563. end;
  564. function TMemDataset.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
  565. var
  566. SrcBuffer: PChar;
  567. begin
  568. result:=False;
  569. if not MDSGetActiveBuffer(SrcBuffer) then
  570. Exit;
  571. if (Field.FieldNo>0) and (Assigned(Buffer)) and (Assigned(SrcBuffer)) then
  572. begin
  573. Move((SrcBuffer+MDSGetFieldOffset(Field.FieldNo))^, Buffer^, MDSGetFieldSize(Field.FieldNo));
  574. result:=True;
  575. end;
  576. end;
  577. procedure TMemDataset.SetFieldData(Field: TField; Buffer: Pointer);
  578. var
  579. DestBuffer: PChar;
  580. begin
  581. MDSGetActiveBuffer(DestBuffer);
  582. if (Field.FieldNo>0) and (Assigned(Buffer)) and (Assigned(DestBuffer)) then
  583. Move(Buffer^,(DestBuffer+MDSGetFieldOffset(Field.FieldNo))^, MDSGetFieldSize(Field.FieldNo));
  584. end;
  585. function TMemDataset.GetRecordSize: Word;
  586. begin
  587. Result:=FRecSize;
  588. end;
  589. procedure TMemDataset.InternalGotoBookmark(ABookmark: Pointer);
  590. var
  591. ReqBookmark: integer;
  592. begin
  593. ReqBookmark:=PInteger(ABookmark)^;
  594. if (ReqBookmark>=0) and (ReqBookmark<FRecCount) then
  595. FCurrRecNo:=ReqBookmark
  596. else
  597. RaiseError(SErrBookMarkNotFound,[ReqBookmark]);
  598. end;
  599. procedure TMemDataset.InternalSetToRecord(Buffer: PChar);
  600. var
  601. ReqBookmark: integer;
  602. begin
  603. ReqBookmark:=PRecInfo(Buffer+FRecInfoOffset)^.Bookmark;
  604. InternalGotoBookmark (@ReqBookmark);
  605. end;
  606. function TMemDataset.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
  607. begin
  608. Result:=PRecInfo(Buffer+FRecInfoOffset)^.BookmarkFlag;
  609. end;
  610. procedure TMemDataset.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
  611. begin
  612. PRecInfo(Buffer+FRecInfoOffset)^.BookmarkFlag := Value;
  613. end;
  614. procedure TMemDataset.GetBookmarkData(Buffer: PChar; Data: Pointer);
  615. begin
  616. if Data<>nil then
  617. PInteger(Data)^:=PRecInfo(Buffer+FRecInfoOffset)^.Bookmark;
  618. end;
  619. procedure TMemDataset.SetBookmarkData(Buffer: PChar; Data: Pointer);
  620. begin
  621. if Data<>nil then
  622. PRecInfo(Buffer+FRecInfoOffset)^.Bookmark:=PInteger(Data)^
  623. else
  624. PRecInfo(Buffer+FRecInfoOffset)^.Bookmark:=0;
  625. end;
  626. function TMemDataset.MDSFilterRecord(Buffer: PChar): Boolean;
  627. var
  628. SaveState: TDatasetState;
  629. begin
  630. Result:=True;
  631. if not Assigned(OnFilterRecord) then
  632. Exit;
  633. SaveState:=SetTempState(dsFilter);
  634. FFilterBuffer:=Buffer;
  635. OnFilterRecord(Self,Result);
  636. RestoreState(SaveState);
  637. end;
  638. Function TMemDataset.DataSize : Integer;
  639. begin
  640. Result:=FStream.Size;
  641. end;
  642. procedure TMemDataset.InternalHandleException;
  643. begin
  644. // Application.HandleException(Self);
  645. end;
  646. procedure TMemDataset.Clear;
  647. begin
  648. Clear(True);
  649. end;
  650. procedure TMemDataset.Clear(ClearDefs : Boolean);
  651. begin
  652. FStream.Clear;
  653. FRecCount:=0;
  654. FCurrRecNo:=-1;
  655. if Active then
  656. Resync([]);
  657. If ClearDefs then
  658. begin
  659. Close;
  660. FieldDefs.Clear;
  661. end;
  662. end;
  663. procedure TMemDataset.CreateTable;
  664. var
  665. I : integer;
  666. begin
  667. FStream.Clear;
  668. FRecCount:=0;
  669. FCurrRecNo:=-1;
  670. FIsOpen:=False;
  671. FRecSize:=0;
  672. for I:=1 to FieldDefs.Count do
  673. FRecSize:=FRecSize+MDSGetFieldSize(I);
  674. FRecInfoOffset:=FRecSize;
  675. FRecSize:=FRecSize+FRecInfoSize;
  676. FRecBufferSize:=FRecSize;
  677. end;
  678. procedure TMemDataset.InternalAddRecord(Buffer: Pointer; DoAppend: Boolean);
  679. begin
  680. MDSAppendRecord(ActiveBuffer);
  681. InternalLast;
  682. Inc(FRecCount);
  683. end;
  684. procedure TMemDataset.SetRecNo(Value: Integer);
  685. begin
  686. CheckBrowseMode;
  687. if (Value>1) and (Value<=FRecCount) then
  688. begin
  689. FCurrRecNo:=Value-1;
  690. Resync([]);
  691. end;
  692. end;
  693. Function TMemDataset.GetRecNo: Longint;
  694. begin
  695. UpdateCursorPos;
  696. if (FCurrRecNo<0) then
  697. Result:=1
  698. else
  699. Result:=FCurrRecNo+1;
  700. end;
  701. Function TMemDataset.GetRecordCount: Longint;
  702. begin
  703. CheckActive;
  704. Result:=FRecCount;
  705. end;
  706. Procedure TMemDataset.CopyFromDataset(DataSet : TDataSet);
  707. begin
  708. CopyFromDataset(Dataset,True);
  709. end;
  710. Procedure TMemDataset.CopyFromDataset(DataSet : TDataSet; CopyData : Boolean);
  711. Var
  712. I : Integer;
  713. F,F1,F2 : TField;
  714. L1,L2 : TList;
  715. N : String;
  716. begin
  717. Clear(True);
  718. // NOT from fielddefs. The data may not be available in buffers !!
  719. For I:=0 to Dataset.FieldCount-1 do
  720. begin
  721. F:=Dataset.Fields[I];
  722. TFieldDef.Create(FieldDefs,F.FieldName,F.DataType,F.Size,F.Required,F.FieldNo);
  723. end;
  724. CreateTable;
  725. If CopyData then
  726. begin
  727. Open;
  728. L1:=TList.Create;
  729. Try
  730. L2:=TList.Create;
  731. Try
  732. For I:=0 to FieldDefs.Count-1 do
  733. begin
  734. N:=FieldDefs[I].Name;
  735. F1:=FieldByName(N);
  736. F2:=DataSet.FieldByName(N);
  737. L1.Add(F1);
  738. L2.Add(F2);
  739. end;
  740. Dataset.DisableControls;
  741. Try
  742. Dataset.Open;
  743. While not Dataset.EOF do
  744. begin
  745. Append;
  746. For I:=0 to L1.Count-1 do
  747. begin
  748. F1:=TField(L1[i]);
  749. F2:=TField(L2[I]);
  750. Case F1.DataType of
  751. ftString : F1.AsString:=F2.AsString;
  752. ftBoolean : F1.AsBoolean:=F2.AsBoolean;
  753. ftFloat : F1.AsFloat:=F2.AsFloat;
  754. ftLargeInt : F1.AsInteger:=F2.AsInteger;
  755. ftSmallInt : F1.AsInteger:=F2.AsInteger;
  756. ftInteger : F1.AsInteger:=F2.AsInteger;
  757. ftDate : F1.AsDateTime:=F2.AsDateTime;
  758. ftTime : F1.AsDateTime:=F2.AsDateTime;
  759. end;
  760. end;
  761. Try
  762. Post;
  763. except
  764. Cancel;
  765. Raise;
  766. end;
  767. Dataset.Next;
  768. end;
  769. Finally
  770. Dataset.EnableControls;
  771. end;
  772. finally
  773. L2.Free;
  774. end;
  775. finally
  776. l1.Free;
  777. end;
  778. end;
  779. end;
  780. end.