[Back to NETWORK SWAG index] [Back to Main SWAG index] [Original]
{
I'm still looking for help with these networking routines. I've revised
them again to make a full standing unit. This NETWORK unit will compile
stand-alone with TP 6.0. I still get an error 162 when using these
routines, which from the manual says MACHINE FAILURE or hardware. I have
run it on at least 10 different machines and get the same problem.
If *ANYONE* has a better way of keeping another node from accessing a
file, please, PLEASE let me know! I have an ENTIRE project (10,000+
lines) on hold until I get these networking routines done.
}
UNIT NETWORK;
interface uses dos;
const
max_timeout=10; { seconds to time out on network timeout }
max_nodes=25;
type
string80=string[80];
networkrecord=record { basic makeup of the actual user }
x_username:string[5]; { network name of user }
x_active:boolean; { * IMPORTANT * : if node is active }
end;
var
netfile:file of networkrecord;
netdata:networkrecord;
network_node:integer;
time1,time2,time3,date1,date2,date3:string[15];
incom,incom1,out,out1:string[255];
_retval:integer;
_retbol:boolean;
function network_exist(filename1:string80):byte;
procedure node_status(filename1:string80);
procedure lock_file(filename2:string80);
procedure unlock_file(filename3:string80);
procedure make_nodes;
procedure update_node;
procedure log_node;
procedure log_off_node;
implementation
(*ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ*)
procedure timedate;
var
ax1,ax2,ax3,ax4:word;
year,month,mil,day,hour,hour1,minute,second:string[20];
begin
time1:=''; { 22:00:00 }
date1:=''; { 03/03/88 }
time2:=''; { 02:03am }
time3:=''; { 00:00 }
date2:=''; { wednesday, january 25th, 1988 }
gettime(ax1,{ hour } ax2,{ minute } ax3, { second }ax4); { milli-second }
str(ax1,hour);
if ax1<=12 then str(ax1,hour1) else str(ax1-12,hour1);
if length(hour1)=1 then insert('0',hour1,1);
str(ax2,minute);
str(ax3,second);
if length(minute)=1 then insert('0',minute,1);
if length(second)=1 then insert('0',second,1);
if length(hour)=1 then insert('0',hour,1);
time1:=hour+':'+minute+':'+second;
case ax1 of
0..11:out1:='AM'
else out1:='PM';
end;
time2:=hour1+':'+minute+' '+out1;
time3:=hour1+':'+minute;
getdate(ax1, { year }ax2, { month }ax3, { day }ax4);{ day of week }
str(ax3,day);
if length(day)=1 then insert('0',day,1);
str(ax1,year);
str(ax2,month);
if length(month)=1 then insert('0',month,1);
date1:=month+'-'+day+'-'+copy(year,3,2);
end;
(*ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ*)
function network_exist(filename1:string80):byte;
var
net_file:file;
begin
network_exist:=$0;
assign(net_file,filename1);
{$i-} reset(net_file) {$i+};
case ioresult of
0:close(net_file);
1:network_exist:=$1; { nothing }
2:network_exist:=$2; { file not found }
5:network_exist:=$5; { access denied }
end;
end;
(*ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ*)
procedure node_status(filename1:string80);
var
do_wait:boolean;
s_time,c_time:string[2];
d_timeout,d_wait,d_count:integer;
_retbyte:byte;
erfile:text;
begin
filename1:=filename1+'.lck';
do_wait:=false;
timedate;
s_time:=copy(time1,7,2);
d_wait:=0;
d_timeout:=0;
while not do_wait do
begin
_retbyte:=network_exist('LOCK\'+filename1);
case _retbyte of
$0:write('.');
$5:write('.');
$1:do_wait:=true;
$2:do_wait:=true;
end;
if do_wait=true then d_timeout:=0;
timedate;
c_time:=copy(time1,7,2);
if c_time<>s_time then
begin
s_time:=c_time;
d_count:=d_count+1;
d_timeout:=d_timeout+1;
end;
if d_timeout>max_timeout then
begin
writeln('NETWORK TIMEOUT... NOTE_STATUS');
halt;
end;
end;
end;
(*ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ*)
procedure lock_file(filename2:string80);
var
fvar2:text;
begin
if pos('.',filename2)>0 then
delete(filename2,pos('.',filename2),length(filename2));
filename2:=filename2+'.LCK';
node_status(filename2);
assign(fvar2,'LOCK\'+filename2);
rewrite(fvar2);
write(fvar2,'A');
close(fvar2);
end;
(*ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ*)
procedure unlock_file(filename3:string80);
var
fvar3:text;
begin
if pos('.',filename3)>0 then
delete(filename3,pos('.',filename3),length(filename3));
filename3:=filename3+'.LCK';
if network_exist('LOCK\'+filename3)=$0 then
begin
assign(fvar3,'LOCK\'+filename3);
erase(fvar3);
end;
end;
(*ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ*)
procedure make_nodes;
begin
case network_exist('LOCK\'+'NETWORK.SYS') of
$2:begin
lock_file('NETWORK');
assign(netfile,'LOCK\'+'NETWORK.SYS');
rewrite(netfile);
netdata.x_username:='';
netdata.x_active:=false;
for _retval:=0 to max_nodes do
begin
seek(netfile,_retval);
write(netfile,netdata);
end;
close(netfile);
unlock_file('NETWORK');
end;
end;
end;
(*ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ*)
procedure update_node;
begin
with netdata do
begin
x_username:='MSH';
x_active:=true;
end;
lock_file('NETWORK');
assign(netfile,'LOCK\'+'NETWORK.SYS');
{$i-} reset(netfile); {$i+}
if ioresult>=1 then
begin
writeln('NETWORK ERROR: UPDATE_NODE');
halt;
end;
seek(netfile,network_node);
write(netfile,netdata);
close(netfile);
unlock_file('NETWORK');
end;
(*ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ*)
procedure log_node;
begin
network_node:=-1;
lock_file('NETWORK');
assign(netfile,'LOCK\'+'NETWORK.SYS');
{$i-} reset(netfile) {$i+};
if ioresult>=1 then
begin
writeln('NETWORK ERROR: LOG_NODE');
halt;
end;
for _retval:=filesize(netfile)-1 downto 0 do
begin
seek(netfile,_retval);
{$i-} read(netfile,netdata); {$i+}
if ioresult>=1 then
begin
writeln('NETWORK ERROR: LOG_NODE');
halt;
end;
if NOT netdata.x_active then network_node:=_retval;
end;
if network_node=-1 then
begin
writeln('NETWORK ERROR: LOG_NODE');
halt;
end;
seek(netfile,network_node);
write(netfile,netdata);
close(netfile);
unlock_file('NETWORK');
end;
(*ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ*)
procedure log_off_node;
begin
lock_file('NETWORK');
assign(netfile,'LOCK\'+'NETWORK.SYS');
{$i-} reset(netfile) {$i+};
if ioresult>=1 then
begin
writeln('NETWORK ERROR: LOG_OFF_NODE');
halt;
end;
netdata.x_username:='';
netdata.x_active:=false;
seek(netfile,network_node);
write(netfile,netdata);
close(netfile);
unlock_file('NETWORK');
end;
(*ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ*)
END.
[Back to NETWORK SWAG index] [Back to Main SWAG index] [Original]