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 2001-03-02 11:54:02 michael
  48. + Merged from fixbranch
  49. Revision 1.1.2.1 2001/03/02 11:49:44 michael
  50. + Initial implementation
  51. }