home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 2000 March / pcp161b.iso / full / delphi / RUNIMAGE / DELPHI30 / DEMOS / DB / TEXTDATA / TEXTDATA.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-08-04  |  14.8 KB  |  461 lines

  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Delphi Text DataSet Sample                      }
  5. {                                                       }
  6. {       Copyright (c) 1997 Borland International        }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit TextData;
  11.  
  12. {
  13.    This file contains a very basic TDataSet implementation which works with
  14.  text files.  For simplicity, the text file is interpreted as a single column,
  15.  multiple row table.
  16.  
  17.    Currently, the notes in this source file represent the only documnentation
  18.  on how to create a TDataSet implentation.  For more information you can
  19.  refer to TBDEDataSet in DBTABLES.PAS which represents a complete TDataSet
  20.  implementation and provides a good example of what methods can be overridden
  21.  and what they should do.
  22.  
  23.    Any TDataSet implementation must provide Bookmark capabilities and
  24.  implement all functions which directly access the record buffer.  The base
  25.  TDataSet manages a group of record buffers, but has no requirements regarding
  26.  what is contained in each record buffer.  The base TDataSet also manages
  27.  the communcation with any attached TDataSource components and the respective
  28.  data aware controls.
  29.  
  30. }
  31.  
  32. interface
  33.  
  34. uses
  35.   DB, Classes;
  36.  
  37. const
  38.   MaxStrLen = 240; { This is an arbitrary limit }
  39.  
  40. type
  41.  
  42. { TRecInfo }
  43.  
  44. {   This structure is used to access additional information stored in
  45.   each record buffer which follows the actual record data.
  46.  
  47.     Buffer: PChar;
  48.    ||
  49.    \/
  50.     --------------------------------------------
  51.     |  Record Data  | Bookmark | Bookmark Flag |
  52.     --------------------------------------------
  53.                     ^-- PRecInfo = Buffer + FRecInfoOfs
  54.  
  55.   Keep in mind that this is just an example of how the record buffer
  56.   can be used to store additional information besides the actual record
  57.   data.  There is no requirement that TDataSet implementations do it this
  58.   way.
  59.  
  60.   For the purposes of this demo, the bookmark format used is just an integer
  61.   value.  For an actual implementation the bookmark would most likely be
  62.   a native bookmark type (as with BDE), or a fabricated bookmark for
  63.   data providers which do not natively support bookmarks (this might be
  64.   a variant array of key values for instance).
  65.  
  66.   The BookmarkFlag is used to determine if the record buffer contains a
  67.   valid bookmark and has special values for when the dataset is positioned
  68.   on the "cracks" at BOF and EOF. }
  69.  
  70.   PRecInfo = ^TRecInfo;
  71.   TRecInfo = packed record
  72.     Bookmark: Integer;
  73.     BookmarkFlag: TBookmarkFlag;
  74.   end;
  75.  
  76. { TTextDataSet }
  77.  
  78.   TTextDataSet = class(TDataSet)
  79.   private
  80.     FData: TStrings;
  81.     FRecBufSize: Integer;
  82.     FRecInfoOfs: Integer;
  83.     FCurRec: Integer;
  84.     FFileName: string;
  85.     FLastBookmark: Integer;
  86.     FSaveChanges: Boolean;
  87.   protected
  88.     { Overriden abstract methods (required) }
  89.     function AllocRecordBuffer: PChar; override;
  90.     procedure FreeRecordBuffer(var Buffer: PChar); override;
  91.     procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
  92.     function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
  93.     function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
  94.     function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
  95.     function GetRecordSize: Word; override;
  96.     procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
  97.     procedure InternalClose; override;
  98.     procedure InternalDelete; override;
  99.     procedure InternalFirst; override;
  100.     procedure InternalGotoBookmark(Bookmark: Pointer); override;
  101.     procedure InternalHandleException; override;
  102.     procedure InternalInitFieldDefs; override;
  103.     procedure InternalInitRecord(Buffer: PChar); override;
  104.     procedure InternalLast; override;
  105.     procedure InternalOpen; override;
  106.     procedure InternalPost; override;
  107.     procedure InternalSetToRecord(Buffer: PChar); override;
  108.     function IsCursorOpen: Boolean; override;
  109.     procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
  110.     procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
  111.     procedure SetFieldData(Field: TField; Buffer: Pointer); override;
  112.   protected
  113.     { Additional overrides (optional) }
  114.     function GetRecordCount: Integer; override;
  115.     function GetRecNo: Integer; override;
  116.     procedure SetRecNo(Value: Integer); override;
  117.   published
  118.     property FileName: string read FFileName write FFileName;
  119.     property Active;
  120.   end;
  121.  
  122. procedure Register;
  123.  
  124. implementation
  125.  
  126. uses Windows, SysUtils, Forms;
  127.  
  128. { TTextDataSet }
  129.  
  130. { This method is called by TDataSet.Open and also when FieldDefs need to
  131.   be updated (usually by the DataSet designer).  Everything which is
  132.   allocated or initialized in this method should also be freed or
  133.   uninitialized in the InternalClose method. }
  134.  
  135. procedure TTextDataSet.InternalOpen;
  136. var
  137.   I: Integer;
  138. begin
  139.   { Load the textfile into a stringlist }
  140.   FData := TStringList.Create;
  141.   FData.LoadFromFile(FileName);
  142.  
  143.   { Fabricate integral bookmark values }
  144.   for I := 1 to FData.Count do
  145.     FData.Objects[I-1] := Pointer(I);
  146.   FLastBookmark := FData.Count;
  147.  
  148.   { Initialize our internal position.
  149.     We use -1 to indicate the "crack" before the first record. }
  150.   FCurRec := -1;
  151.  
  152.   { Initialize an offset value to find the TRecInfo in each buffer }
  153.   FRecInfoOfs := MaxStrLen;
  154.  
  155.   { Calculate the size of the record buffers.
  156.     Note: This is NOT the same as the RecordSize property which
  157.     only gets the size of the data in the record buffer }
  158.   FRecBufSize := FRecInfoOfs + SizeOf(TRecInfo);
  159.  
  160.   { Tell TDataSet how big our Bookmarks are (REQUIRED) }
  161.   BookmarkSize := SizeOf(Integer);
  162.  
  163.   { Initialize the FieldDefs }
  164.   InternalInitFieldDefs;
  165.  
  166.   { Create TField components when no persistent fields have been created }
  167.   if DefaultFields then CreateFields;
  168.  
  169.   { Bind the TField components to the physical fields }
  170.   BindFields(True);
  171. end;
  172.  
  173. procedure TTextDataSet.InternalClose;
  174. begin
  175.   { Write any edits to disk and free the managing string list }
  176.   if FSaveChanges then FData.SaveToFile(FileName);
  177.   FData.Free;
  178.   FData := nil;
  179.  
  180.   { Destroy the TField components if no persistent fields }
  181.   if DefaultFields then DestroyFields;
  182.  
  183.   { Reset these internal flags }
  184.   FLastBookmark := 0;
  185.   FCurRec := -1;
  186. end;
  187.  
  188. { This property is used while opening the dataset.
  189.   It indicates if data is available even though the
  190.   current state is still dsInActive. }
  191.  
  192. function TTextDataSet.IsCursorOpen: Boolean;
  193. begin
  194.   Result := Assigned(FData);
  195. end;
  196.  
  197. { For this simple example we just create one FieldDef, but a more complete
  198.   TDataSet implementation would create multiple FieldDefs based on the
  199.   actual data. }
  200.  
  201. procedure TTextDataSet.InternalInitFieldDefs;
  202. begin
  203.   FieldDefs.Clear;
  204.   TFieldDef.Create(FieldDefs, 'Line', ftString, MaxStrLen, False, 1);
  205. end;
  206.  
  207. { This is the exception handler which is called if an exception is raised
  208.   while the component is being stream in or streamed out.  In most cases this
  209.   should be implemented useing the application exception handler as follows. }
  210.   
  211. procedure TTextDataSet.InternalHandleException;
  212. begin
  213.   Application.HandleException(Self);
  214. end;
  215.  
  216. { Bookmarks }
  217. { ========= }
  218.  
  219. { In this sample the bookmarks are stored in the Object property of the
  220.   TStringList holding the data.  Positioning to a bookmark just requires
  221.   finding the offset of the bookmark in the TStrings.Objects and using that
  222.   value as the new current record pointer. }
  223.  
  224. procedure TTextDataSet.InternalGotoBookmark(Bookmark: Pointer);
  225. var
  226.   Index: Integer;
  227. begin
  228.   Index := FData.IndexOfObject(TObject(PInteger(Bookmark)^));
  229.   if Index <> -1 then
  230.     FCurRec := Index else
  231.     DatabaseError('Bookmark not found');
  232. end;
  233.  
  234. { This function does the same thing as InternalGotoBookmark, but it takes
  235.   a record buffer as a parameter instead }
  236.  
  237. procedure TTextDataSet.InternalSetToRecord(Buffer: PChar);
  238. begin
  239.   InternalGotoBookmark(@PRecInfo(Buffer + FRecInfoOfs).Bookmark);
  240. end;
  241.  
  242. { Bookmark flags are used to indicate if a particular record is the first
  243.   or last record in the dataset.  This is necessary for "crack" handling.
  244.   If the bookmark flag is bfBOF or bfEOF then the bookmark is not actually
  245.   used; InternalFirst, or InternalLast are called instead by TDataSet. }
  246.  
  247. function TTextDataSet.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
  248. begin
  249.   Result := PRecInfo(Buffer + FRecInfoOfs).BookmarkFlag;
  250. end;
  251.  
  252. procedure TTextDataSet.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
  253. begin
  254.   PRecInfo(Buffer + FRecInfoOfs).BookmarkFlag := Value;
  255. end;
  256.  
  257. { These methods provide a way to read and write bookmark data into the
  258.   record buffer without actually repositioning the current record }
  259.  
  260. procedure TTextDataSet.GetBookmarkData(Buffer: PChar; Data: Pointer);
  261. begin
  262.   PInteger(Data)^ := PRecInfo(Buffer + FRecInfoOfs).Bookmark;
  263. end;
  264.  
  265. procedure TTextDataSet.SetBookmarkData(Buffer: PChar; Data: Pointer);
  266. begin
  267.   PRecInfo(Buffer + FRecInfoOfs).Bookmark := PInteger(Data)^;
  268. end;
  269.  
  270. { Record / Field Access }
  271. { ===================== }
  272.  
  273. { This method returns the size of just the data in the record buffer.
  274.   Do not confuse this with RecBufSize which also includes any additonal
  275.   structures stored in the record buffer (such as TRecInfo). }
  276.  
  277. function TTextDataSet.GetRecordSize: Word;
  278. begin
  279.   Result := MaxStrLen;
  280. end;
  281.  
  282. { TDataSet calls this method to allocate the record buffer.  Here we use
  283.   FRecBufSize which is equal to the size of the data plus the size of the
  284.   TRecInfo structure. }
  285.  
  286. function TTextDataSet.AllocRecordBuffer: PChar;
  287. begin
  288.   GetMem(Result, FRecBufSize);
  289. end;
  290.  
  291. { Again, TDataSet calls this method to free the record buffer.
  292.   Note: Make sure the value of FRecBufSize does not change before all
  293.   allocated buffers are freed. }
  294.  
  295. procedure TTextDataSet.FreeRecordBuffer(var Buffer: PChar);
  296. begin
  297.   FreeMem(Buffer, FRecBufSize);
  298. end;
  299.  
  300. { This multi-purpose function does 3 jobs.  It retrieves data for either
  301.   the current, the prior, or the next record.  It must return the status
  302.   (TGetResult), and raise an exception if DoCheck is True. }
  303.  
  304. function TTextDataSet.GetRecord(Buffer: PChar; GetMode: TGetMode;
  305.   DoCheck: Boolean): TGetResult;
  306. begin
  307.   if FData.Count < 1 then
  308.     Result := grEOF else
  309.   begin
  310.     Result := grOK;
  311.     case GetMode of
  312.       gmNext:
  313.         if FCurRec >= RecordCount - 1  then
  314.           Result := grEOF else
  315.           Inc(FCurRec);
  316.       gmPrior:
  317.         if FCurRec <= 0 then
  318.           Result := grBOF else
  319.           Dec(FCurRec);
  320.       gmCurrent:
  321.         if (FCurRec < 0) or (FCurRec >= RecordCount) then
  322.           Result := grError;
  323.     end;
  324.     if Result = grOK then
  325.     begin
  326.       StrLCopy(Buffer, PChar(FData[FCurRec]), MaxStrLen);
  327.       with PRecInfo(Buffer + FRecInfoOfs)^ do
  328.       begin
  329.         BookmarkFlag := bfCurrent;
  330.         Bookmark := Integer(FData.Objects[FCurRec]);
  331.       end;
  332.     end else
  333.       if (Result = grError) and DoCheck then DatabaseError('No Records');
  334.   end;
  335. end;
  336.  
  337. { This routine is called to initialize a record buffer.  In this sample,
  338.   we fill the buffer with zero values, but we might have code to initialize
  339.   default values or do other things as well. }
  340.  
  341. procedure TTextDataSet.InternalInitRecord(Buffer: PChar);
  342. begin
  343.   FillChar(Buffer^, RecordSize, 0);
  344. end;
  345.  
  346. { Here we copy the data from the record buffer into a field's buffer.
  347.   This function, and SetFieldData, are more complex when supporting
  348.   calculated fields, filters, and other more advanced features.
  349.   See TBDEDataSet for a more complete example. }
  350.  
  351. function TTextDataSet.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
  352. begin
  353.   StrLCopy(Buffer, ActiveBuffer, Field.Size);
  354.   Result := PChar(Buffer)^ <> #0;
  355. end;
  356.  
  357. procedure TTextDataSet.SetFieldData(Field: TField; Buffer: Pointer);
  358. begin
  359.   StrLCopy(ActiveBuffer, Buffer, Field.Size);
  360.   DataEvent(deFieldChange, Longint(Field));
  361. end;
  362.  
  363. { Record Navigation / Editing }
  364. { =========================== }
  365.  
  366. { This method is called by TDataSet.First.  Crack behavior is required.
  367.   That is we must position to a special place *before* the first record.
  368.   Otherwise, we will actually end up on the second record after Resync
  369.   is called. }
  370.   
  371. procedure TTextDataSet.InternalFirst;
  372. begin
  373.   FCurRec := -1;
  374. end;
  375.  
  376. { Again, we position to the crack *after* the last record here. }
  377.  
  378. procedure TTextDataSet.InternalLast;
  379. begin
  380.   FCurRec := FData.Count;
  381. end;
  382.  
  383. { This method is called by TDataSet.Post.  Most implmentations would write
  384.   the changes directly to the associated datasource, but here we simply set
  385.   a flag to write the changes when we close the dateset. }
  386.  
  387. procedure TTextDataSet.InternalPost;
  388. begin
  389.   FSaveChanges := True;
  390.   { For inserts, just update the data in the string list }
  391.   if State = dsEdit then FData[FCurRec] := ActiveBuffer else
  392.   begin
  393.     { If inserting (or appending), increment the bookmark counter and
  394.       store the data }
  395.     Inc(FLastBookmark);
  396.     FData.InsertObject(FCurRec, ActiveBuffer, Pointer(FLastBookmark));
  397.   end;
  398. end;
  399.  
  400. { This method is similar to InternalPost above, but the operation is always
  401.   an insert or append and takes a pointer to a record buffer as well. }
  402.  
  403. procedure TTextDataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean);
  404. begin
  405.   FSaveChanges := True;
  406.   Inc(FLastBookmark);
  407.   if Append then InternalLast;
  408.   FData.InsertObject(FCurRec, PChar(Buffer), Pointer(FLastBookmark));
  409. end;
  410.  
  411. { This method is called by TDataSet.Delete to delete the current record }
  412.  
  413. procedure TTextDataSet.InternalDelete;
  414. begin
  415.   FSaveChanges := True;
  416.   FData.Delete(FCurRec);
  417.   if FCurRec >= FData.Count then
  418.     Dec(FCurRec);
  419. end;
  420.  
  421. { Optional Methods }
  422. { ================ }
  423.  
  424. { The following methods are optional.  When provided they will allow the
  425.   DBGrid and other data aware controls to track the current cursor postion
  426.   relative to the number of records in the dataset.  Because we are dealing
  427.   with a small, static data store (a stringlist), these are very easy to
  428.   implement.  However, for many data sources (SQL servers), the concept of
  429.   record numbers and record counts do not really apply. }
  430.  
  431. function TTextDataSet.GetRecordCount: Longint;
  432. begin
  433.   Result := FData.Count;
  434. end;
  435.  
  436. function TTextDataSet.GetRecNo: Longint;
  437. begin
  438.   UpdateCursorPos;
  439.   if (FCurRec = -1) and (RecordCount > 0) then
  440.     Result := 1 else
  441.     Result := FCurRec + 1;
  442. end;
  443.  
  444. procedure TTextDataSet.SetRecNo(Value: Integer);
  445. begin
  446.   if (Value >= 0) and (Value < FData.Count) then
  447.   begin
  448.     FCurRec := Value - 1;
  449.     Resync([]);
  450.   end;
  451. end;
  452.  
  453. { This procedure is used to register this component on the component palette }
  454.  
  455. procedure Register;
  456. begin
  457.   RegisterComponents('Data Access', [TTextDataSet]);
  458. end;
  459.  
  460. end.
  461.