This repository was archived by the owner on Oct 11, 2022. It is now read-only.
forked from nickelsworth/swag
-
Notifications
You must be signed in to change notification settings - Fork 0
Expand file tree
/
Copy path0053.pas
More file actions
172 lines (145 loc) · 3.88 KB
/
Copy path0053.pas
File metadata and controls
172 lines (145 loc) · 3.88 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
{
This is a demonstration of a network unit capable of locking
pascal records or any set of bytes on a file.
Programmer: Ronen Magid, Qiyat-Ono Israel.
Contributed to the SWAG.
}
Unit Network;
Interface
Uses Dos;
Var
Regs : Registers;
RegSize : Byte;
RecSize : Longint;
OffSet : LongInt;
FileHandle : word;
Const
SH_COMPAT = $0000;
SH_DENYRW = $0010;
SH_DENYWR = $0020;
SH_DENYRD = $0030;
SH_DENYNONE = $0040;
SH_DENYNO = SH_DENYNONE;
O_RDONLY = $0;
O_WRITE = $1;
O_RDWR = $2;
function Lock(Var Handle: Word; Var Offset, BufLen: Longint): Word;
function Unlock(Var Handle: Word; Var OffSet, BufLen: Longint): Word;
Implementation
function Lock(var handle: word; var offset, buflen: longint): word;
var
TempOffset:longint;
begin
Lock := 0;
TempOffset:=1000000000+Offset;
fillchar(regs, sizeof(regs), 0);
regs.ah := $5C; { Lock file access }
regs.al := 0;
regs.bx := handle;
regs.cx := TempOffset shr RegSize; {and $ffff;}
regs.dx := TempOffset and $ffff;
regs.si := buflen shr RegSize; {and $ffff;}
regs.di := buflen and $ffff;
MsDos(regs);
if (regs.Flags and 1) <> 0 then
Lock := regs.ax;
end;
function Unlock(var handle: word; var offset, buflen: longint): word;
var
TempOffset:longint;
begin
Unlock := 0;
TempOffset:=1000000000+Offset;
regs.ah := $5C; { Unlock file access }
regs.al := 1;
regs.bx := handle;
regs.cx := TempOffset shr RegSize; {and $ffff;}
regs.dx := TempOffset and $ffff;
regs.si := buflen shr RegSize; {and $ffff;}
regs.di := buflen and $ffff;
MsDos(regs);
if (regs.Flags and 1) <> 0 then
Unlock := regs.ax;
end;
End.
{ --------------------- TEST CODE ... CUT HERE -------------------}
{
This demonstartion will show how to use the NETWORK file-lock
unit to allow lock and lock-check of records in a regular
pascal database file.
Programmer: Ronen Magid, Qiyat-Ono Israel.
Contributed to the SWAG.
}
Program NetTest;
uses Dos,Network;
Type
PhoneRecord = Record
Name : String[30];
Address : String[35];
Phone : String[15];
End;
Var
PhoneRec : PhoneRecord;
PhoneFile : File of PhoneRecord;
FileHandle : word;
LockStatus : Word;
I : Byte;
Ok : Boolean;
Function LockPhoneRec(which: LongInt): Boolean;
Begin
recsize := SizeOf(PhoneRec);
OffSet := RecSize * Which - Recsize;
FileHandle := FileRec(PhoneFile).handle;
LockStatus := Lock(FileHandle, offset, recsize);
if LockStatus = 0 then
begin
LockPhoneRec:=True;
end else
begin
LockPhoneRec:=False;
end;
end;
function UnLockPhoneRec(Which: Byte): boolean;
var
ok: boolean;
begin
recsize := SizeOf(PhoneRec);
OffSet := Which * RecSize - RecSize;
FileHandle := FileRec(PhoneFile).handle;
LockStatus := Unlock(FileHandle, offset, recsize);
if LockStatus <> 0 then
begin
UnlockPhoneRec := false;
end else
begin
UnlockPhoneRec := true;
end;
end;
begin
Assign(Phonefile,'PHONE.SMP');
Rewrite(Phonefile);
For I:=1 to 5 do Write(Phonefile,phoneRec);
Close(Phonefile);
FileMode := SH_DENYNO + O_RDWR; {Important, Before RESET!}
Reset(Phonefile);
{ And now lets begin to lock... }
Ok:=LockPhoneRec(2);
{Locking phone rec 2}
{Now lets see if its locked... }
Ok:=LockPhoneRec(2);
{a record is already locked if we
cant lock it. This locking procedure
can be performed by other PCs & other
tasks.}
If Not Ok then writeln('#2 locked');
Ok:=UnlockPhoneRec(2);
{ lets release it. This will enable
other tasks or LAN PCs to lock
(& obtain) this record again...}
If Ok then Writeln('Rec #2 unlocked');
{thats it...}
Ok:=LockPhoneRec(2);
If Ok then Writeln('And since its free we can relock it !');
Close(phoneFile);
End.