testgdbm2.pp 1.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263
  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
  5. the Free Pascal development team
  6. Test strings interface to gdbm library
  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 testgdbm2;
  14. {$mode objfpc}
  15. {$h+}
  16. uses sysutils,gdbm;
  17. Var
  18. dbf : pgdbm_file;
  19. A,B : String;
  20. i : longint;
  21. begin
  22. dbf:=gdbm_open('test.dat',512,GDBM_NEWDB,432,nil);
  23. If dbf=Nil then
  24. Writeln('Error when creating database');
  25. for I:=1 to 10 do
  26. begin
  27. A:=Format('data for string %d',[i]);
  28. B:=Format('string %d',[i]);
  29. if not gdbm_store(dbf,B,A,gdbm_insert) then
  30. Writeln('Error inserting data')
  31. else
  32. Writeln('Inserted string ',i)
  33. end;
  34. gdbm_firstkey(dbf,B);
  35. I:=0;
  36. While B<>'' do
  37. begin
  38. inc(i);
  39. A:=gdbm_fetch(dbf,B);
  40. writeln('Data for key ',i,' (',B,') : ',A);
  41. B:=gdbm_nextkey(dbf,B);
  42. end;
  43. gdbm_close(dbf);
  44. end.
  45. {
  46. $Log$
  47. Revision 1.2 2002-09-07 15:42:57 peter
  48. * old logs removed and tabs fixed
  49. Revision 1.1 2002/01/29 17:55:03 peter
  50. * splitted to base and extra
  51. }