createds.pp 1.9 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485
  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.6 2000-01-07 01:24:32 peter
  61. * updated copyright to 2000
  62. Revision 1.5 2000/01/06 01:20:32 peter
  63. * moved out of packages/ back to topdir
  64. Revision 1.1 2000/01/03 19:33:05 peter
  65. * moved to packages dir
  66. Revision 1.3 1999/11/11 17:31:09 michael
  67. + Added Checks for all simple field types.
  68. + Initial implementation of Insert/Append
  69. Revision 1.2 1999/10/24 17:07:54 michael
  70. + Added copyright header
  71. }