units/strdb/StrDB.pas

   1 unit StrDB;
   2 {*
   3   StrDb.pas is an attempt at a small database engine for KOL Objects.
   4 It provides database functionality to the TStrList KOL Object.
   5 As in KOL, the emphasis is on small. The test program, TestStrDB.exe is 29K.
   6 |<br>
   7 |<br>
   8
   9 The records are fixed width strings.
  10 The fields are fixed width substrings of the records.
  11 This simpifies the database functions since everything is stored as a string
  12  including floats, dates etc.
  13 |<br>
  14 |<br>
  15
  16 The TStrTable object encapsulates:
  17 |<br>
  18  An array of Field Definition records (FldDefArray)
  19 |<br>
  20  A TStrList containing all the records (RecList)
  21 |<br>
  22  A string holding the current record (RecStr)
  23 |<br>
  24  A Current Record Number integer (fCurrRecNum)
  25 |<br>
  26  Several Database functions and procedures (AddFldDef, First, EditRec, etc)
  27
  28 |<br>
  29 |<br>
  30 The TStrTable is created with the NewStrTable function.
  31 |<br>
  32 Field Definitions are then added which provides the Field Name and Field Width.
  33 |<br>
  34 The table can be populated manually then saved. (See TestStDb.dpr)
  35 |<br>
  36  Alternately, fixed width data can be exported from an existing database or
  37  spreadsheet.
  38 |<br>
  39 Data is copied into the Current Record string (RecStr) via named fields.
  40 |<br>
  41   Ex:     SetFld('Name',E1.Text);
  42 |<br>
  43           SetFld('EMail',E2.Text);
  44 |<br>
  45           SetFld('URL',E3.Text);
  46 |<br>
  47 When complete, RecStr is stored in the TStrList (RecList) via Insert or AddRec.
  48 |<br>
  49 The First, Prior, Next, Last and SetCurrRec procedures copy the indexed RecList
  50  string into RecStr (the current record).
  51 |<br>
  52 The data is retrieved from RecStr via GetFld('Name'), etc.
  53 |<br>
  54 This can then be modified and stored back in RecList via PostRec.
  55 |<br>
  56 This manner of adding and editing records is different from the normal methods:
  57 |<br>
  58   (Insert, Fill Fields, Post -and- Edit, Modify Fields, Post)
  59 |<br>
  60 This method is better suited to the StrTable object.
  61 |<br>
  62 If desired, the user interface can be programmed to work normally:
  63 |<br>
  64   (Insert a Blank Record, Make That Field Current, Enter the Data, Post Record
  65 |<br>
  66     or Delete the Blank Record if the User Cancels.)
  67 |<br>
  68 |<br>
  69 Access to all the TStrList's methods and properties are available via
  70  TStrTable.RecList.???
  71 |<br>
  72 In this way Sorting, LoadFromFile, SaveToFile etc can be accomplished.
  73 |<br>
  74 Incidently, Windows API appears to simplify sorting the listview by columns via
  75  LVM_SORTITEMS.
  76
  77 |<br>
  78 |<br>
  79 A typical program stores and loads it's table via RecList.LoadFromFile and RecList.SaveToFile. Note that data is entered into RecList is not saved to disk until RecList.SaveToFile is executed.
  80
  81 |<br>
  82 |<br>
  83 LoadFromFile is only one means of loading the RecList.
  84 |<br>
  85 If only certain records in a file are needed, a file could be opened via
  86  TFileStream, filtering could be done and the desired records can be Added
  87  to RecList.
  88
  89 |<br>
  90 |<br>
  91 Additionally, two procedures are provided to automatically load a TListView
  92  object from a StrTable:
  93 |<br>
  94   FillListView adds columns with the same names as the field names. It then calls:
  95 |<br>
  96   FillListGrid which adds the records found in the RecList as items.
  97 |<br>
  98    FillListGrid can be called as required to repaint the grid and reflect RecList.
  99 |<br>
 100   The column width is currently 4pixels * the field width.
 101 |<br>
 102    This can be adjusted after the Listview is loaded (even to 0 to hide the column). }
 103
 104 interface
 105
 106 uses
 107   windows,
 108   messages,
 109   kol;
 110
 111 type
 112
 113   TFldDefRec = record
 114 {* Record stored in FldDefArray containing Field Definitions for TStrTable}
 115     FldName: string;
 116     FldStart: integer;
 117     FldWidth: integer;
 118   end;
 119
 120   PStrTable = ^TStrTable;
 121   TStrTable = object( TObj )
 122 {* String Table object for accessing fields as substrings from a record string}
 123   private
 124     fBOF, fEOF: boolean;
 125     fCurrRecNum: integer; //Used by Next, Prior, Post, InsertRec, DeleteRec
 126   protected
 127     FldDefArray: array of TFldDefRec;
 128 {* Array of Field Def Records - one FldDefRec for each Field in table}
 129     destructor Destroy; virtual;
 130   public
 131     RecList: PStrList;
 132 {* StringList of all string records}
 133     RecStr: string;
 134 {* String containing record to get or set data from ( = current record)}
 135     procedure AddFldDef(const FieldName: string; FieldWidth: integer);
 136 {* Used To Add Field Definitions}
 137     function GetFld(const FieldName: string): string;
 138 {* This is used to retrieve data from a record. Returns Data as substring of RecStr based on FieldName in Field Defs (see FldDefArray)}
 139     procedure SetFld(const FieldName, Data: string);
 140 {* This is used to modify data in a record. Replaces substring of RecStr with Data based on FieldName in Field Defs. (see FldDefArray)}
 141     procedure First;
 142 {* Goto First Record - Loads RecStr with First string from RecList and updates CurrRecNum }
 143     procedure Last;
 144 {* Goto Last Record - Loads RecStr with Last string from RecList and updates CurrRecNum }
 145     procedure Next;
 146 {* Goto Next Record - Loads RecStr with Next string from RecList and updates CurrRecNum }
 147     procedure Prior;
 148 {* Goto Prior Record - Loads RecStr with Prior string from RecList and updates CurrRecNum }
 149     procedure SetCurrRec(RecNum: integer);
 150 {* Goto RecNum Record - Loads RecStr with RecNum string from RecList and updates CurrRecNum }
 151     property CurrRecNum: integer read fCurrRecNum write SetCurrRec;
 152 {* Current index of string in RecList - Assigning sets current record}
 153     property EOF: boolean read fEOF;
 154 {* End Of File Indicator}
 155     property BOF: boolean read fBOF;
 156 {* Beginning File Indicator}
 157     procedure PostRec;
 158 {* Saves RecStr (current record) into RecList at CurrRecNum}
 159     procedure InsertRec;
 160 {* Inserts RecStr (current record) into RecList before CurrRecNum}
 161     procedure AddRec;
 162 {* Adds RecStr to end of RecList}
 163     procedure DeleteRec;
 164 {* Deletes string in RecList of index CurrRecNum
 165  TStrTable.First is then executed to keep CurrRecNum in sync}
 166   end;
 167 {* Notes:
 168 |<br>
 169 1. Editing and Inserting records operate differently than in TDataSet
 170 |<br>
 171   To Edit: SetCurrRec then SetFld(s) then PostRec - There is no Edit proc.
 172 |<br>
 173   To Insert: SetCurrRec then SetFld(s) then InsertRec - Do not use PostRec
 174 |<br>
 175   To Append: SetFld(s) then AddRec - CurrRecNum is not used
 176 |<br>
 177 2. Any database that can connect to fixed width text files can link to tables generated by TStrTable. For Example:
 178 |<br>
 179 a) Save the table via TStrList.RecList.SavetoFile to a filename.asc.
 180 |<br>
 181 b) Link to the table in MS Access as a Text file - Fixed width.
 182 |<br>
 183 c) MS Access can use this ISAM linked table in a limited manner:
 184 |<br>
 185   --  New records can be added, existing records can be read - but not edited or
 186      deleted.
 187 |<br>
 188   --  For import into MS Access, records can be copied to another table if editing
 189      is required.
 190 |<br>
 191   --  For export into a StrTable, an update query can copy data to the linked table.
 192 |<br>
 193   --  Select queries etc. in MS Access should be no problem.
 194
 195 }
 196
 197 function NewStrTable: PStrTable;
 198 {* Creates a new TStrTable}
 199
 200 procedure FillListView( GivenListView: PControl; GivenStrTable: PStrTable);
 201 {* Automatically adds columns to GivenListView with the same names as the field names found in GivenStrTable. It then calls FillListGrid. The column width is currently 4pixels * the field width. This can be adjusted after the Listview is loaded (even to 0 to hide the column).}
 202
 203 procedure FillListGrid( GivenListView: PControl; GivenStrTable: PStrTable);
 204 {* FillListGrid adds the records found in GivenStrTable.RecList as items to GivenListView. FillListView should be called first to set up the columns. FillListGrid can be called as required to repaint the grid and reflect RecList.}
 205
 206 implementation
 207
 208 function NewStrTable: PStrTable;
 209 begin
 210   New( Result, Create );
 211   Result.RecList := NewStrList;
 212   setlength(result.FldDefArray,0);
 213   Result.fBOF := true;
 214   Result.fEOF := true;
 215   Result.fCurrRecNum := 0;
 216 end;
 217
 218 procedure FillListView( GivenListView: PControl; GivenStrTable: PStrTable);
 219 var
 220   NoOfCols, f: integer;
 221 begin
 222   NoOfCols := length(GivenStrTable.FldDefArray);
 223   GivenListView.Width := ( GivenStrTable.FldDefArray[NoOfCols - 1].FldStart +
 224     GivenStrTable.FldDefArray[NoOfCols - 1].FldWidth) * 4 + 20;
 225   for f := 1 to NoOfCols do
 226   begin
 227     GivenListView.LVColAdd(GivenStrTable.FldDefArray[f-1].FldName, taLeft,
 228       GivenStrTable.FldDefArray[f-1].FldWidth * 4);
 229   end;
 230   FillListGrid(GivenListView, GivenStrTable);
 231 end;
 232
 233 procedure FillListGrid( GivenListView: PControl; GivenStrTable: PStrTable);
 234 var
 235   CurRecNo, NoOfCols, NoOfRecs, f, g: integer;
 236 begin
 237   CurRecNo := GivenStrTable.CurrRecNum;
 238   NoOfCols := length(GivenStrTable.FldDefArray);
 239   NoOfRecs := GivenStrTable.RecList.Count;
 240   GivenListView.Clear;
 241   GivenStrTable.First;
 242   for f := 0 to NoOfRecs - 1 do
 243   with GivenListView^, GivenStrTable^ do
 244   begin
 245     LVAdd( '', 0, [ ], 0, 0, 0 );
 246     for g := 0 to NoOfCols - 1 do
 247     begin
 248       LVItems[ f, g ] := GetFld(FldDefArray[g].FldName);
 249     end;
 250     Next;
 251   end;
 252   GivenStrTable.CurrRecNum := CurRecNo;
 253 end;
 254
 255 procedure TStrTable.AddFldDef(const FieldName: string; FieldWidth: integer);
 256 var
 257   count, FieldStart: integer;
 258 begin
 259   count := length(FldDefArray);
 260   if count > 0 then
 261     FieldStart := FldDefArray[count - 1].FldStart
 262      + FldDefArray[count - 1].FldWidth
 263   else
 264     FieldStart := 0;
 265   setlength(FldDefArray, count + 1);
 266   with FldDefArray[count] do
 267   begin
 268     FldName := FieldName;
 269     FldStart := FieldStart;
 270     FldWidth := FieldWidth;
 271   end;
 272 end;
 273
 274 function TStrTable.GetFld(const FieldName: string): string;
 275 var
 276   f, TotFDs: integer;
 277 begin
 278   result := '';
 279   TotFDs := length(FldDefArray);
 280   for f := 0 to TotFDs - 1 do
 281   begin
 282     if FldDefArray[f].FldName = FieldName then
 283     begin
 284       result := copy(RecStr, FldDefArray[f].FldStart + 1,
 285        FldDefArray[f].FldWidth);
 286       exit;
 287     end;
 288   end;
 289 end;
 290
 291 procedure TStrTable.SetFld(const FieldName, Data: string);
 292 var
 293   f, TotFDs: integer;
 294 begin
 295   TotFDs := length(FldDefArray);
 296   for f := 0 to TotFDs - 1 do
 297   with FldDefArray[f] do
 298   begin
 299     if FldName = FieldName then
 300     begin
 301       RecStr := copy(RecStr, 1, FldStart) +
 302         copy (Data + stringofchar(' ',FldWidth), 1, FldWidth) +
 303         copy (RecStr, FldStart + FldWidth + 1,
 304          length(RecStr) - FldStart + FldWidth);
 305       exit;
 306     end;
 307   end;
 308 end;
 309
 310 procedure TStrTable.First;
 311 begin
 312   fBOF := true;
 313   fCurrRecNum := 0;
 314   if RecList.Count = 0 then
 315     fEOF := true
 316   else
 317   begin
 318     fEOF := false;
 319     RecStr := RecList.Items[0];
 320   end;
 321 end;
 322
 323 procedure TStrTable.Last;
 324 begin
 325   fEOF := true;
 326   if RecList.Count = 0 then
 327   begin
 328     fBOF := true;
 329     fCurrRecNum := 0;
 330   end
 331   else
 332   begin
 333     fBOF := false;
 334     fCurrRecNum := RecList.Count - 1;
 335     RecStr := RecList.Items[fCurrRecNum];
 336   end;
 337 end;
 338
 339 procedure TStrTable.Prior;
 340 begin
 341   if RecList.Count = 0 then
 342   begin
 343     fBOF := true;
 344     fEOF := true;
 345     fCurrRecNum := 0;
 346   end
 347   else
 348     if fCurrRecNum = 0 then
 349       fBOF := true
 350     else
 351   begin
 352     fBOF := false;
 353     fEOF := false;
 354     fCurrRecNum := fCurrRecNum - 1;
 355     RecStr := RecList.Items[fCurrRecNum];
 356   end;
 357 end;
 358
 359 procedure TStrTable.Next;
 360 begin
 361   if RecList.Count = 0 then
 362   begin
 363     fBOF := true;
 364     fEOF := true;
 365     fCurrRecNum := 0;
 366   end
 367   else
 368     if fCurrRecNum = RecList.Count - 1 then
 369       fEOF := true
 370     else
 371       begin
 372         fBOF := false;
 373         fEOF := false;
 374         fCurrRecNum := fCurrRecNum + 1;
 375         RecStr := RecList.Items[fCurrRecNum];
 376       end;
 377 end;
 378
 379 procedure TStrTable.SetCurrRec(RecNum: integer);
 380 begin
 381   if RecList.Count = 0 then
 382   begin
 383     fBOF := true;
 384     fEOF := true;
 385     fCurrRecNum := 0;
 386   end
 387   else
 388     if RecNum >= RecList.Count then
 389       fEOF := true
 390     else
 391       if RecNum < 0 then
 392         fBOF := true
 393       else
 394         begin
 395           fBOF := false;
 396           fEOF := false;
 397           fCurrRecNum := RecNum;
 398           RecStr := RecList.Items[fCurrRecNum];
 399         end;
 400 end;
 401
 402 procedure TStrTable.PostRec;
 403 begin
 404   RecList.Items[fCurrRecNum] := RecStr;
 405 end;
 406
 407 procedure TStrTable.InsertRec;
 408 begin
 409   RecList.Insert(fCurrRecNum, RecStr);
 410 end;
 411
 412 procedure TStrTable.AddRec;
 413 begin
 414   RecList.Add(RecStr);
 415 end;
 416
 417 procedure TStrTable.DeleteRec;
 418 begin
 419   RecList.Delete(fCurrRecNum);
 420   self.First;
 421 end;
 422
 423 destructor TStrTable.Destroy;
 424 begin
 425   RecList.Free;
 426   setlength(FldDefArray,0);
 427   inherited;
 428 end;
 429
 430 end.