← Back to branch summary

~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

Viewing changes to fpcsrc/packages/extra/gdbm/gdbm.pp

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
http://bugs.debian.org/477743
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

Lines of Context:
fpcsrc/packages/extra/gdbm/gdbm.pp
 
1
{
 
2
    Copyright (c) 1999-2000 by Michael Van Canneyt, member of
 
3
    the Free Pascal development team
 
4
 
 
5
    gdbm database routines header translations.
 
6
 
 
7
    See the file COPYING.FPC, included in this distribution,
 
8
    for details about the copyright.
 
9
 
 
10
    This program is distributed in the hope that it will be useful,
 
11
    but WITHOUT ANY WARRANTY; without even the implied warranty of
 
12
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
13
 
 
14
 **********************************************************************}
 
15
 
 
16
{$h+}
 
17
 
 
18
unit gdbm;
 
19
 
 
20
 
 
21
 
 
22
interface
 
23
 
 
24
const
 
25
  External_library='gdbm';
 
26
 
 
27
{ Pointers to basic pascal types, inserted by h2pas conversion program.}
 
28
Type
 
29
  PLongint  = ^Longint;
 
30
  PSmallInt = ^SmallInt;
 
31
  PByte     = ^Byte;
 
32
  PWord     = ^Word;
 
33
  PDWord    = ^DWord;
 
34
  PDouble   = ^Double;
 
35
 
 
36
{$PACKRECORDS C}
 
37
 
 
38
const
 
39
  { Parameters to gdbm_open for READERS, WRITERS, and WRITERS who
 
40
    can create the database.  }
 
41
GDBM_READER = 0;
 
42
GDBM_WRITER = 1;
 
43
GDBM_WRCREAT = 2;
 
44
GDBM_NEWDB = 3;
 
45
GDBM_FAST = $10;
 
46
GDBM_DOSYNC = $20;  // Was GDBM_SYNC, but conflicts with gdbm_sync !!
 
47
GDBM_NOLOCK = $40;
 
48
GDBM_INSERT = 0;
 
49
GDBM_REPLACE = 1;
 
50
GDBM_CACHESIZE = 1;
 
51
GDBM_FASTMODE = 2;
 
52
GDBM_SYNCMODE = 3;
 
53
GDBM_CENTFREE = 4;
 
54
GDBM_COALESCEBLKS = 5;
 
55
{ Error Codes }
 
56
GDBM_NO_ERROR = 0;
 
57
GDBM_MALLOC_ERROR = 1;
 
58
GDBM_BLOCK_SIZE_ERROR = 2;
 
59
GDBM_FILE_OPEN_ERROR = 3;
 
60
GDBM_FILE_WRITE_ERROR = 4;
 
61
GDBM_FILE_SEEK_ERROR = 5;
 
62
GDBM_FILE_READ_ERROR = 6;
 
63
GDBM_BAD_MAGIC_NUMBER = 7;
 
64
GDBM_EMPTY_DATABASE = 8;
 
65
GDBM_CANT_BE_READER = 9;
 
66
GDBM_CANT_BE_WRITER = 10;
 
67
GDBM_READER_CANT_DELETE = 11;
 
68
GDBM_READER_CANT_STORE = 12;
 
69
GDBM_READER_CANT_REORGANIZE = 13;
 
70
GDBM_UNKNOWN_UPDATE = 14;
 
71
GDBM_ITEM_NOT_FOUND = 15;
 
72
GDBM_REORGANIZE_FAILED = 16;
 
73
GDBM_CANNOT_REPLACE = 17;
 
74
GDBM_ILLEGAL_DATA = 18;
 
75
GDBM_OPT_ALREADY_SET = 19;
 
76
GDBM_OPT_ILLEGAL = 29;
 
77
 
 
78
 
 
79
type
 
80
 
 
81
  TDatum = record
 
82
        dptr : Pchar;
 
83
        dsize : longint;
 
84
     end;
 
85
  PDatum = ^TDatum;
 
86
 
 
87
  TGDBM_FILE = record
 
88
    dummy : array[0..9] of longint;
 
89
  end;
 
90
  PGDBM_FILE = ^TGDBM_FILE;
 
91
 
 
92
  TGDBMErrorCallBack = Procedure;
 
93
 
 
94
 
 
95
 
 
96
var
 
97
  gdbm_version : Pchar;cvar; external; {name 'gdbm_version' not accepted ??}
 
98
 
 
99
function gdbm_open(para1:Pchar; para2:longint; para3:longint; para4:longint; para5:TGDBMErrorCallBack ):PGDBM_FILE;cdecl;external External_library name 'gdbm_open';
 
100
procedure gdbm_close(para1:PGDBM_FILE);cdecl;external External_library name 'gdbm_close';
 
101
function gdbm_store(para1:PGDBM_FILE; para2:TDatum; para3:TDatum; para4:longint):longint;cdecl;external External_library name 'gdbm_store';
 
102
function gdbm_fetch(para1:PGDBM_FILE; para2:TDatum):TDatum;cdecl;external External_library name 'gdbm_fetch';
 
103
function gdbm_delete(para1:PGDBM_FILE; para2:TDatum):longint;cdecl;external External_library name 'gdbm_delete';
 
104
function gdbm_firstkey(para1:PGDBM_FILE):TDatum;cdecl;external External_library name 'gdbm_firstkey';
 
105
function gdbm_nextkey(para1:PGDBM_FILE; para2:TDatum):TDatum;cdecl;external External_library name 'gdbm_nextkey';
 
106
function gdbm_reorganize(para1:PGDBM_FILE):longint;cdecl;external External_library name 'gdbm_reorganize';
 
107
procedure gdbm_sync(para1:PGDBM_FILE);cdecl;external External_library name 'gdbm_sync';
 
108
function gdbm_exists(para1:PGDBM_FILE; para2:TDatum):longint;cdecl;external External_library name 'gdbm_exists';
 
109
function gdbm_setopt(para1:PGDBM_FILE; para2:longint; para3:Plongint; para4:longint):longint;cdecl;external External_library name 'gdbm_setopt';
 
110
function gdbm_fdesc(para1:PGDBM_FILE):longint;cdecl;external External_library name 'gdbm_fdesc';
 
111
 
 
112
{ Easy Pascal access routines }
 
113
 
 
114
function gdbm_open(Const para1:string; para2:longint; para3:longint; para4:longint; para5:TGDBMErrorCallBack ):PGDBM_FILE;
 
115
function gdbm_store(para1:PGDBM_FILE; Const para2:string; Const para3:string; para4:longint):Boolean;
 
116
function gdbm_fetch(para1:PGDBM_FILE; Const para2:string):string;
 
117
function gdbm_delete(para1:PGDBM_FILE; Const para2:string):boolean;
 
118
procedure gdbm_firstkey(para1:PGDBM_FILE; var key :string);
 
119
function gdbm_nextkey(para1:PGDBM_FILE; Const para2:string):string;
 
120
function gdbm_exists(para1:PGDBM_FILE; Const para2:string):boolean;
 
121
 
 
122
 
 
123
type
 
124
   gdbm_error = longint;
 
125
  var
 
126
     gdbm_errno : gdbm_error;cvar;external{ 'gdbm_errno'};
 
127
 
 
128
function gdbm_strerror(para1:gdbm_error):Pchar;cdecl;external External_library name 'gdbm_strerror';
 
129
 
 
130
implementation
 
131
 
 
132
function gdbm_open(Const para1:string; para2:longint; para3:longint; para4:longint; para5:TGDBMErrorCallBack ):PGDBM_FILE;
 
133
 
 
134
begin
 
135
  gdbm_open:=gdbm_open(@para1[1],para2,para3,para4,para5);
 
136
end;
 
137
 
 
138
procedure cfree (P : pointer);cdecl; external 'c' name 'free';
 
139
 
 
140
Function DatumToString(Key : TDatum) : String;
 
141
 
 
142
begin
 
143
  SetLength(DatumToString,Key.dsize);
 
144
  If key.Dsize>0 then
 
145
    Move(key.dptr^,DatumToString[1],key.dsize);
 
146
  if key.dptr<>Nil then
 
147
    cfree(Key.dptr);
 
148
end;
 
149
 
 
150
Function StringToDatum(Value : String) : TDatum;
 
151
 
 
152
begin
 
153
  StringToDatum.dptr:=@Value[1];
 
154
  StringToDatum.dsize:=Length(Value);
 
155
end;
 
156
 
 
157
 
 
158
function gdbm_store(para1:PGDBM_FILE; Const para2:string; Const para3:string; para4:longint):Boolean;
 
159
 
 
160
Var
 
161
  Data,Key : TDatum;
 
162
 
 
163
begin
 
164
  Data:=StringToDatum(Para3);
 
165
  Key:=StringToDatum(Para2);
 
166
  gdbm_store:=gdbm_store(para1,key,data,para4)=0;
 
167
end;
 
168
 
 
169
function gdbm_fetch(para1:PGDBM_FILE; Const para2:string):string;
 
170
 
 
171
begin
 
172
  gdbm_fetch:=DatumToString(gdbm_fetch(para1,StringToDatum(Para2)));
 
173
end;
 
174
 
 
175
function gdbm_delete(para1:PGDBM_FILE; Const para2:string):boolean;
 
176
 
 
177
begin
 
178
  gdbm_delete:=gdbm_delete(Para1,StringToDatum(para2))=0;
 
179
end;
 
180
 
 
181
Procedure gdbm_firstkey(para1:PGDBM_FILE; var key : String);
 
182
 
 
183
begin
 
184
  Key:=DatumToString(gdbm_firstkey(para1));
 
185
end;
 
186
 
 
187
function gdbm_nextkey(para1:PGDBM_FILE; Const Para2 :string):string;
 
188
 
 
189
begin
 
190
  gdbm_nextkey:=DatumToString(gdbm_nextkey(para1,StringToDatum(para2)));
 
191
end;
 
192
 
 
193
function gdbm_exists(para1:PGDBM_FILE; const para2:string):boolean;
 
194
 
 
195
begin
 
196
  gdbm_exists:=gdbm_exists(para1,StringToDatum(para2))<>0;
 
197
end;
 
198
 
 
199
end.