Skip to content

Commit da692a0

Browse files
author
dosworld
committed
Update. Added RC4 encryption, DBU files.
1 parent 26a482b commit da692a0

4 files changed

Lines changed: 269 additions & 148 deletions

File tree

‎DBU.PAS‎

Lines changed: 188 additions & 143 deletions
Original file line numberDiff line numberDiff line change
@@ -22,201 +22,246 @@ SOFTWARE.
2222
}
2323
{$A+,I-,S-,R-,D-,L-,Q-,F-,G-,O-,B-}
2424
UNIT DBU;
25-
25+
{ =========================================================================
26+
This is unit implements dbu files (like a .dbt) - container for memo fields.
27+
========================================================================= }
2628
INTERFACE
2729

2830
USES System2;
2931

32+
CONST
33+
DBU_BLOCK_SIZE = 512;
34+
3035
TYPE
36+
DBU_REC = RECORD
37+
next : LONGINT;
38+
size : WORD;
39+
END;
40+
3141
PDBUFile = ^DBUFile;
3242
DBUFile=RECORD
33-
f : PBFILE;
34-
idx : PBFIle;
35-
first_free : WORD;
43+
f : BFILE;
44+
header : DBU_REC;
45+
crec : DBU_REC;
46+
crecno : LONGINT;
47+
needupdate : BOOLEAN;
48+
data : PCHAR;
3649
END;
3750

38-
PROCEDURE DBU_Reset(VAR d : DBUFile; VAR f, idx : BFile);
39-
PROCEDURE DBU_ReWrite(VAR d : DBUFile; VAR f, idx : BFile);
40-
FUNCTION DBU_IsOpen(VAR d : DBUFile) : BOOLEAN;
41-
FUNCTION DBU_Create(VAR d : DBUFile) : WORD;
42-
PROCEDURE DBU_Read(VAR d : DBUFile; h : WORD; ofs : DWORD; VAR mem; size : WORD);
43-
PROCEDURE DBU_Write(VAR d : DBUFile; h : WORD; ofs : DWORD; VAR mem; size : WORD);
44-
PROCEDURE DBU_Free(VAR d : DBUFile; h : WORD);
45-
PROCEDURE DBU_Close(VAR d : DBUFile);
51+
PROCEDURE dbu_reset(VAR f : DBUFile; fname : STRING; blk_size : WORD);
52+
PROCEDURE dbu_rewrite(VAR f : DBUFile; fname : STRING; blk_size : WORD);
53+
PROCEDURE dbu_rewrite_memfile(VAR f : DBUFile; blk_size : WORD);
4654

47-
IMPLEMENTATION
55+
FUNCTION dbu_isopen(VAR f : DBUFile) : BOOLEAN;
4856

49-
CONST
50-
BLOCK_SIZE_KB = 16;
51-
BLOCK_SIZE = BLOCK_SIZE_KB * 1024;
57+
PROCEDURE dbu_get(VAR f : DBUFile; rec : LONGINT; VAR b; size : WORD);
58+
FUNCTION dbu_put(VAR f : DBUFile; VAR b; size : WORD) : LONGINT;
59+
FUNCTION dbu_size(VAR f : DBUFile; rec : LONGINT) : LONGINT;
5260

53-
PROCEDURE L_Append(VAR d : DBUFile);
54-
VAR i : INTEGER;
55-
n : ARRAY[1..1024] OF CHAR;
61+
PROCEDURE dbu_free(VAR f : DBUFile; rec : LONGINT);
62+
63+
PROCEDURE dbu_close(VAR f : DBUFile);
64+
65+
IMPLEMENTATION
66+
67+
PROCEDURE dbu_load(VAR f : DBUFile);
5668
BEGIN
57-
FillChar(n, SizeOf(n), #0);
58-
FOR i := 1 TO BLOCK_SIZE_KB DO BlockWrite(d.f^, n, SizeOf(n));
69+
Seek(f.f, f.crecno * f.header.size);
70+
BlockRead(f.f, f.crec, SizeOf(DBU_REC));
71+
BlockRead(f.f, f.data[0], f.header.size - SizeOf(DBU_REC));
72+
f.needupdate := FALSE;
5973
END;
6074

61-
FUNCTION L_Size(VAR d : DBUFile) : WORD;
62-
VAR r1 : WORD;
63-
r2 : WORD;
75+
PROCEDURE dbu_update(VAR f : DBUFile);
6476
BEGIN
65-
r1 := FileSize(d.f^) SHR 14;
66-
r2 := FileSize(d.idx^) SHR 2;
67-
IF r1 > r2 THEN L_Size := r2 ELSE L_Size := r1;
77+
IF (f.needupdate) AND (f.crecno <> 0) THEN BEGIN
78+
Seek(f.f, f.crecno * f.header.size);
79+
BlockWrite(f.f, f.crec, SizeOf(DBU_REC));
80+
BlockWrite(f.f, f.data[0], f.header.size - SizeOf(DBU_REC));
81+
END;
82+
f.needupdate := FALSE;
6883
END;
6984

70-
PROCEDURE L_Seek(VAR d : DBUFile; page : WORD);
71-
VAR npage : WORD;
72-
sz : WORD;
85+
PROCEDURE dbu_go(VAR f : DBUFile; recno : LONGINT);
86+
VAR
87+
nofs : LONGINT;
7388
BEGIN
74-
sz := L_Size(d);
75-
IF (sz < page) THEN BEGIN
76-
Seek(d.f^, sz SHL 14);
77-
Seek(d.idx^, sz SHL 1);
78-
WHILE sz <= page DO BEGIN
79-
L_Append(d);
80-
WriteWord(d.idx^, d.first_free);
81-
d.first_free := sz;
82-
sz := L_Size(d);
83-
END;
89+
IF recno = f.crecno THEN EXIT;
90+
dbu_update(f);
91+
nofs := recno * f.header.size;
92+
FillChar(f.data[0], f.header.size - SizeOf(DBUFile), #0);
93+
f.crec.next := 0;
94+
f.crec.size := 0;
95+
WHILE nofs > FileSize(f.f) DO BEGIN
96+
Seek(f.f, (FileSize(f.f) DIV f.header.size) * f.header.size);
97+
BlockWrite(f.f, f.crec, SizeOf(DBU_REC));
98+
BlockWrite(f.f, f.data[0], f.header.size - SizeOf(DBU_REC));
8499
END;
85-
Seek(d.f^, page SHL 14);
86-
Seek(d.idx^, page SHL 1);
100+
f.crecno := recno;
101+
dbu_load(f);
87102
END;
88103

89-
PROCEDURE DBU_Reset(VAR d : DBUFile; VAR f, idx : BFile);
104+
PROCEDURE dbu_reset(VAR f : DBUFile; fname : STRING; blk_size : WORD);
90105
BEGIN
91-
FillChar(d, SizeOf(DBUFile), #0);
92-
d.f := @f;
93-
d.idx := @idx;
94-
IF (NOT EOF(d.f^)) AND (NOT EOF(d.idx^)) THEN BEGIN
95-
Seek(d.idx^, 0);
96-
d.first_free := ReadWord(d.idx^);
97-
END ELSE DBU_ReWrite(d, f, idx);
106+
FillChar(f, SizeOf(DBUFile), #0);
107+
Assign(f.f, fname);
108+
Reset(f.f);
109+
IF NOT IsOpen(f.f) THEN dbu_rewrite(f, fname, blk_size)
110+
ELSE IF SizeOf(DBU_REC) <> BlockRead(f.f, f.header, SizeOf(DBU_REC)) THEN BEGIN
111+
Close(f.f);
112+
dbu_rewrite(f, fname, blk_size);
113+
END ELSE BEGIN
114+
GetMem(f.data, blk_size - SizeOf(DBUFile));
115+
FillChar(f.data[0], f.header.size - SizeOf(DBUFile), #0);
116+
BlockWrite(f.f, f.data[0], f.header.size - SizeOf(DBU_REC));
117+
END;
98118
END;
99119

100-
FUNCTION DBU_IsOpen(VAR d : DBUFile) : BOOLEAN;
120+
PROCEDURE dbu_rewrite(VAR f : DBUFile; fname : STRING; blk_size : WORD);
101121
BEGIN
102-
DBU_IsOpen := IsOpen(d.f^) AND IsOpen(d.idx^);
122+
FillChar(f, SizeOf(DBUFile), #0);
123+
Assign(f.f, fname);
124+
ReWrite(f.f);
125+
IF IsOpen(f.f) THEN BEGIN
126+
f.header.next := 0;
127+
f.header.size := blk_size;
128+
GetMem(f.data, f.header.size - SizeOf(DBUFile));
129+
FillChar(f.data[0], f.header.size - SizeOf(DBUFile), #0);
130+
Seek(f.f, 0);
131+
BlockWrite(f.f, f.header, SizeOf(DBU_REC));
132+
BlockWrite(f.f, f.data[0], f.header.size - SizeOf(DBU_REC));
133+
END;
103134
END;
104135

105-
PROCEDURE DBU_ReWrite(VAR d : DBUFile; VAR f, idx : BFile);
136+
PROCEDURE dbu_rewrite_memfile(VAR f : DBUFile; blk_size : WORD);
106137
BEGIN
107-
FillChar(d, SizeOf(DBUFile), #0);
108-
d.f := @f;
109-
d.idx := @idx;
110-
111-
Seek(d.f^, 0);
112-
L_Append(d);
113-
Truncate(d.f^);
114-
115-
Seek(d.idx^, 0);
116-
WriteWord(d.idx^, 0);
117-
Truncate(d.idx^);
138+
FillChar(f, SizeOf(DBUFile), #0);
139+
ReWriteMemFile (f.f);
140+
IF IsOpen(f.f) THEN BEGIN
141+
f.header.next := 0;
142+
f.header.size := blk_size;
143+
GetMem(f.data, f.header.size - SizeOf(DBUFile));
144+
FillChar(f.data[0], f.header.size - SizeOf(DBUFile), #0);
145+
Seek(f.f, 0);
146+
BlockWrite(f.f, f.header, SizeOf(DBU_REC));
147+
BlockWrite(f.f, f.data[0], f.header.size - SizeOf(DBU_REC));
148+
END;
118149
END;
119150

120-
PROCEDURE DBU_Close(VAR d : DBUFile);
151+
FUNCTION dbu_isopen(VAR f : DBUFile) : BOOLEAN;
121152
BEGIN
122-
Seek(d.idx^, 0);
123-
WriteWord(d.idx^, d.first_free);
124-
Close(d.f^);
125-
Close(d.idx^);
153+
dbu_isopen := IsOpen(f.f);
126154
END;
127155

128-
FUNCTION DBU_Create(VAR d : DBUFile) : WORD;
129-
VAR r : WORD;
156+
PROCEDURE dbu_close(VAR f : DBUFile);
130157
BEGIN
131-
IF d.first_free = 0 THEN L_Seek(d, L_Size(d) + 1);
132-
r := d.first_free;
133-
L_Seek(d, r);
134-
WriteWord(d.idx^, 0);
135-
Seek(d.idx^, FilePos(d.idx^) - SizeOf(WORD));
136-
DBU_Create := r;
158+
IF NOT IsOpen(f.f) THEN EXIT;
159+
dbu_update(f);
160+
Seek(f.f, 0);
161+
FillChar(f.data[0], f.header.size - SizeOf(DBUFile), #0);
162+
BlockWrite(f.f, f.header, SizeOf(DBU_REC));
163+
BlockWrite(f.f, f.data[0], f.header.size - SizeOf(DBU_REC));
164+
Close(f.f);
165+
IF f.data <> NIL THEN FreeMem(f.data, f.header.size - SizeOf(DBUFile));
166+
FillChar(f, SizeOf(DBUFile), #0);
137167
END;
138168

139-
140-
PROCEDURE DBU_Free(VAR d : DBUFile; h : WORD);
141-
VAR next : WORD;
169+
PROCEDURE dbu_free(VAR f : DBUFile; rec : LONGINT);
170+
VAR n : LONGINT;
142171
BEGIN
143-
WHILE h <> 0 DO BEGIN
144-
next := GetWord(d.idx^, h SHL 1);
145-
SetWord(d.idx^, h SHL 1, d.first_free);
146-
d.first_free := h;
147-
h := next;
172+
IF NOT IsOpen(f.f) THEN EXIT;
173+
WHILE rec <> 0 DO BEGIN
174+
dbu_go(f, rec);
175+
n := f.crec.next;
176+
f.crec.next := f.header.next;
177+
f.crec.size := 0;
178+
f.needupdate := TRUE;
179+
f.header.next := rec;
180+
rec := n;
148181
END;
149182
END;
150183

151-
FUNCTION next_page(VAR d : DBUFile; cpage : WORD) : WORD;
152-
VAR npage : WORD;
184+
FUNCTION dbu_alloc(VAR f : DBUFile) : LONGINT;
185+
VAR r : LONGINT;
153186
BEGIN
154-
Seek(d.idx^, cpage SHL 2);
155-
npage := ReadWord(d.idx^);
156-
IF npage = 0 THEN BEGIN
157-
IF d.first_free = 0 THEN L_Seek(d, (L_Size(d) + 1));
158-
npage := d.first_free;
159-
Seek(d.idx^, d.first_free SHL 1);
160-
d.first_free := ReadWord(d.idx^);
161-
Seek(d.idx^, d.first_free SHL 1);
162-
WriteWord(d.idx^, 0);
163-
Seek(d.idx^, cpage SHL 1);
164-
WriteWord(d.idx^, npage);
187+
IF f.header.next <> 0 THEN BEGIN
188+
r := f.header.next;
189+
dbu_go(f, r);
190+
f.header.next := f.crec.next;
191+
END ELSE BEGIN
192+
r := FileSize(f.f) DIV f.header.size;
165193
END;
166-
next_page := npage;
194+
dbu_go(f, r);
195+
f.crec.next := 0;
196+
f.crec.size := 0;
197+
f.needupdate := TRUE;
198+
dbu_alloc := r;
167199
END;
168200

169-
PROCEDURE DBU_Write(VAR d : DBUFile; h : WORD; ofs : DWORD; VAR mem; size : WORD);
170-
VAR page : WORD;
171-
pofs : WORD;
172-
p : PCHAR;
173-
s : WORD;
201+
FUNCTION dbu_size(VAR f : DBUFile; rec : LONGINT) : LONGINT;
202+
VAR r : LONGINT;
174203
BEGIN
175-
page := ofs SHR 14;
176-
pofs := ofs AND $3FFF;
177-
p := @mem;
178-
WHILE page <> 0 DO BEGIN
179-
h := next_page(d, h);
180-
Dec(page);
181-
END;
182-
WHILE size <> 0 DO BEGIN
183-
L_Seek(d, h);
184-
s := size;
185-
IF s > (BLOCK_SIZE - pofs) THEN s := BLOCK_SIZE - pofs;
186-
IF pofs <> 0 THEN Seek(d.f^, FilePos(d.f^) + pofs);
187-
BlockWrite(d.f^, p[0], s);
188-
pofs := 0;
189-
Dec(size, s);
190-
Inc(p, s);
191-
h := next_page(d, h);
204+
r := 0;
205+
IF IsOpen(f.f) THEN BEGIN
206+
WHILE rec <> 0 DO BEGIN
207+
dbu_go(f, rec);
208+
Inc(r, f.crec.size);
209+
rec := f.crec.next;
210+
END;
192211
END;
212+
dbu_size := r;
193213
END;
194214

195-
PROCEDURE DBU_Read(VAR d : DBUFile; h : WORD; ofs : DWORD; VAR mem; size : WORD);
196-
VAR page : WORD;
197-
pofs : WORD;
198-
p : PCHAR;
199-
s : WORD;
200-
r : WORD;
215+
PROCEDURE dbu_get(VAR f : DBUFile; rec : LONGINT; VAR b; size : WORD);
216+
VAR p : PCHAR;
217+
g : WORD;
201218
BEGIN
202-
page := ofs SHR 14;
203-
pofs := ofs AND $3FFF;
204-
p := @mem;
205-
WHILE page <> 0 DO BEGIN
206-
h := next_page(d, h);
207-
Dec(page);
219+
IF NOT IsOpen(f.f) THEN EXIT;
220+
p := @b;
221+
WHILE (size <> 0) AND (rec <> 0) DO BEGIN
222+
dbu_go(f, rec);
223+
g := f.crec.size;
224+
IF g > size THEN g := size;
225+
Move(f.data[0], p[0], g);
226+
Dec(size, g);
227+
Inc(p, g);
228+
rec := f.crec.next;
208229
END;
209-
WHILE size <> 0 DO BEGIN
210-
L_Seek(d, h);
211-
s := size;
212-
IF s > (BLOCK_SIZE - pofs) THEN s := BLOCK_SIZE - pofs;
213-
IF pofs <> 0 THEN Seek(d.f^, FilePos(d.f^) + pofs);
214-
BlockRead(d.f^, p[0], s);
215-
pofs := 0;
216-
Dec(size, s);
217-
Inc(p, s);
218-
h := next_page(d, h);
230+
END;
231+
232+
FUNCTION dbu_put(VAR f : DBUFile; VAR b; size : WORD) : LONGINT;
233+
VAR r, pr, c : LONGINT;
234+
p : PCHAR;
235+
g : WORD;
236+
bs : WORD;
237+
BEGIN
238+
r := 0;
239+
IF IsOpen(f.f) THEN BEGIN
240+
p := @b;
241+
bs := f.header.size - SizeOf(DBUFile);
242+
r := dbu_alloc(f);
243+
pr := r;
244+
g := size;
245+
IF g > bs THEN g := bs;
246+
Move(p, f.data[0], g);
247+
Dec(size, g);
248+
Inc(p, g);
249+
WHILE size <> 0 DO BEGIN
250+
c := dbu_alloc(f);
251+
dbu_go(f, pr);
252+
f.crec.next := c;
253+
f.needupdate := TRUE;
254+
dbu_go(f, c);
255+
g := size;
256+
IF g > bs THEN g := bs;
257+
Move(p, f.data[0], g);
258+
f.crec.size := g;
259+
Dec(size, g);
260+
Inc(p, g);
261+
f.needupdate := TRUE;
262+
END;
219263
END;
264+
dbu_put := r;
220265
END;
221266

222267
END.

0 commit comments

Comments
 (0)