createds.pp 2.0 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 1999-2000 by Michael Van Canneyt, member of the
  5. Free Pascal development team
  6. Creates a flat datafile for use with testds.
  7. See the file COPYING.FPC, included in this distribution,
  8. for details about the copyright.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  12. **********************************************************************}
  13. program createds;
  14. {$mode delphi}
  15. uses ddg_rec,sysutils;
  16. Type IndexFile = File Of Longint;
  17. Var F : TDDGDataFile;
  18. I : Integer;
  19. S : String;
  20. L : IndexFile;
  21. TableName : String;
  22. IndexName : String;
  23. ARec : TDDGData;
  24. begin
  25. If ParamCount<>1 then
  26. begin
  27. Writeln('Usage: createds tablename');
  28. Halt(1);
  29. end;
  30. TableName:=ChangeFileExt(paramstr(1),'.ddg');
  31. IndexName:=ChangeFileExt(TableName,'.ddx');
  32. Assign(F,TableName);
  33. Rewrite(F);
  34. For I:=1 to 100 do
  35. begin
  36. S:=Format('This is person %d.',[i]);
  37. With Arec Do
  38. begin
  39. Name:=S;
  40. height:=I*0.001;
  41. LongField:=i*4;
  42. ShoeSize:=I;
  43. WordField:=i*2;
  44. DateTimeField:=Now;
  45. TimeField:=Time;
  46. DateField:=Date;
  47. Even:=(I mod 2) = 0
  48. end;
  49. Write(F,ARec);
  50. end;
  51. Close(F);
  52. Assign(L,IndexName);
  53. Rewrite(L);
  54. For I:=0 to 100-1 do
  55. Write(L,I);
  56. Close(L);
  57. end.
  58. {
  59. $Log$
  60. Revision 1.1 2000-09-01 22:02:10 peter
  61. * build also db
  62. Revision 1.1 2000/07/13 06:31:27 michael
  63. + Initial import
  64. Revision 1.6 2000/01/07 01:24:32 peter
  65. * updated copyright to 2000
  66. Revision 1.5 2000/01/06 01:20:32 peter
  67. * moved out of packages/ back to topdir
  68. Revision 1.1 2000/01/03 19:33:05 peter
  69. * moved to packages dir
  70. Revision 1.3 1999/11/11 17:31:09 michael
  71. + Added Checks for all simple field types.
  72. + Initial implementation of Insert/Append
  73. Revision 1.2 1999/10/24 17:07:54 michael
  74. + Added copyright header
  75. }