home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / network.swg / 0026_Networking.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-08-25  |  8.1 KB  |  278 lines
  1. {
  2. I'm still looking for help with these networking routines. I've revised
  3. them again to make a full standing unit. This NETWORK unit will compile
  4. stand-alone with TP 6.0. I still get an error 162 when using these
  5. routines, which from the manual says MACHINE FAILURE or hardware. I have
  6. run it on at least 10 different machines and get the same problem.
  7.  
  8. If *ANYONE* has a better way of keeping another node from accessing a
  9. file, please, PLEASE let me know! I have an ENTIRE project (10,000+
  10. lines) on hold until I get these networking routines done.
  11. }
  12.   UNIT NETWORK;
  13.  
  14.   interface uses dos;
  15.  
  16.   const
  17.     max_timeout=10; { seconds to time out on network timeout }
  18.     max_nodes=25;
  19.  
  20.   type
  21.     string80=string[80];
  22.     networkrecord=record { basic makeup of the actual user }
  23.       x_username:string[5];           { network name of user }
  24.       x_active:boolean;               { * IMPORTANT * : if node is active }
  25.     end;
  26.  
  27.   var
  28.     netfile:file of networkrecord;
  29.     netdata:networkrecord;
  30.     network_node:integer;
  31.     time1,time2,time3,date1,date2,date3:string[15];
  32.     incom,incom1,out,out1:string[255];
  33.     _retval:integer;
  34.     _retbol:boolean;
  35.  
  36.     function  network_exist(filename1:string80):byte;
  37.     procedure node_status(filename1:string80);
  38.     procedure lock_file(filename2:string80);
  39.     procedure unlock_file(filename3:string80);
  40.     procedure make_nodes;
  41.     procedure update_node;
  42.     procedure log_node;
  43.     procedure log_off_node;
  44.  
  45.   implementation
  46.  
  47. (*═════════════════════════════════════════════════════════════════════════*)
  48.  
  49.    procedure timedate;
  50.    var
  51.      ax1,ax2,ax3,ax4:word;
  52.      year,month,mil,day,hour,hour1,minute,second:string[20];
  53.    begin
  54.      time1:=''; { 22:00:00 }
  55.      date1:=''; { 03/03/88 }
  56.      time2:=''; { 02:03am  }
  57.      time3:=''; { 00:00 }
  58.      date2:=''; { wednesday, january 25th, 1988 }
  59.      gettime(ax1,{ hour } ax2,{ minute } ax3, { second }ax4); { milli-second }
  60.      str(ax1,hour);
  61.      if ax1<=12 then str(ax1,hour1) else str(ax1-12,hour1);
  62.      if length(hour1)=1 then insert('0',hour1,1);
  63.      str(ax2,minute);
  64.      str(ax3,second);
  65.      if length(minute)=1 then insert('0',minute,1);
  66.      if length(second)=1 then insert('0',second,1);
  67.      if length(hour)=1 then insert('0',hour,1);
  68.      time1:=hour+':'+minute+':'+second;
  69.      case ax1 of
  70.        0..11:out1:='AM'
  71.          else out1:='PM';
  72.      end;
  73.      time2:=hour1+':'+minute+' '+out1;
  74.      time3:=hour1+':'+minute;
  75.      getdate(ax1, { year  }ax2, { month }ax3, { day }ax4);{ day of week }
  76.      str(ax3,day);
  77.      if length(day)=1 then insert('0',day,1);
  78.      str(ax1,year);
  79.      str(ax2,month);
  80.      if length(month)=1 then insert('0',month,1);
  81.      date1:=month+'-'+day+'-'+copy(year,3,2);
  82.    end;
  83.  
  84. (*═════════════════════════════════════════════════════════════════════════*)
  85.  
  86.     function network_exist(filename1:string80):byte;
  87.     var
  88.       net_file:file;
  89.     begin
  90.       network_exist:=$0;
  91.       assign(net_file,filename1);
  92.       {$i-} reset(net_file) {$i+};
  93.       case ioresult of
  94.         0:close(net_file);
  95.         1:network_exist:=$1; { nothing }
  96.         2:network_exist:=$2; { file not found }
  97.         5:network_exist:=$5; { access denied }
  98.       end;
  99.     end;
  100.  
  101. (*═════════════════════════════════════════════════════════════════════════*)
  102.  
  103.     procedure node_status(filename1:string80);
  104.     var
  105.       do_wait:boolean;
  106.       s_time,c_time:string[2];
  107.       d_timeout,d_wait,d_count:integer;
  108.       _retbyte:byte;
  109.       erfile:text;
  110.     begin
  111.       filename1:=filename1+'.lck';
  112.       do_wait:=false;
  113.       timedate;
  114.       s_time:=copy(time1,7,2);
  115.       d_wait:=0;
  116.       d_timeout:=0;
  117.       while not do_wait do
  118.         begin
  119.           _retbyte:=network_exist('LOCK\'+filename1);
  120.           case _retbyte of
  121.             $0:write('.');
  122.             $5:write('.');
  123.             $1:do_wait:=true;
  124.             $2:do_wait:=true;
  125.           end;
  126.           if do_wait=true then d_timeout:=0;
  127.           timedate;
  128.           c_time:=copy(time1,7,2);
  129.           if c_time<>s_time then
  130.             begin
  131.               s_time:=c_time;
  132.               d_count:=d_count+1;
  133.               d_timeout:=d_timeout+1;
  134.             end;
  135.           if d_timeout>max_timeout then
  136.             begin
  137.               writeln('NETWORK TIMEOUT...   NOTE_STATUS');
  138.               halt;
  139.             end;
  140.         end;
  141.     end;
  142.  
  143. (*═════════════════════════════════════════════════════════════════════════*)
  144.  
  145.     procedure lock_file(filename2:string80);
  146.     var
  147.       fvar2:text;
  148.     begin
  149.       if pos('.',filename2)>0 then
  150.         delete(filename2,pos('.',filename2),length(filename2));
  151.       filename2:=filename2+'.LCK';
  152.       node_status(filename2);
  153.       assign(fvar2,'LOCK\'+filename2);
  154.       rewrite(fvar2);
  155.       write(fvar2,'A');
  156.       close(fvar2);
  157.     end;
  158.  
  159. (*═════════════════════════════════════════════════════════════════════════*)
  160.  
  161.     procedure unlock_file(filename3:string80);
  162.     var
  163.       fvar3:text;
  164.     begin
  165.       if pos('.',filename3)>0 then
  166.         delete(filename3,pos('.',filename3),length(filename3));
  167.       filename3:=filename3+'.LCK';
  168.       if network_exist('LOCK\'+filename3)=$0 then
  169.         begin
  170.           assign(fvar3,'LOCK\'+filename3);
  171.           erase(fvar3);
  172.         end;
  173.     end;
  174.  
  175. (*═════════════════════════════════════════════════════════════════════════*)
  176.  
  177.     procedure make_nodes;
  178.     begin
  179.       case network_exist('LOCK\'+'NETWORK.SYS') of
  180.         $2:begin
  181.              lock_file('NETWORK');
  182.              assign(netfile,'LOCK\'+'NETWORK.SYS');
  183.              rewrite(netfile);
  184.              netdata.x_username:='';
  185.              netdata.x_active:=false;
  186.              for _retval:=0 to max_nodes do
  187.                begin
  188.                  seek(netfile,_retval);
  189.                  write(netfile,netdata);
  190.                end;
  191.              close(netfile);
  192.              unlock_file('NETWORK');
  193.            end;
  194.       end;
  195.     end;
  196.  
  197. (*═════════════════════════════════════════════════════════════════════════*)
  198.  
  199.     procedure update_node;
  200.     begin
  201.       with netdata do
  202.         begin
  203.           x_username:='MSH';
  204.           x_active:=true;
  205.         end;
  206.       lock_file('NETWORK');
  207.       assign(netfile,'LOCK\'+'NETWORK.SYS');
  208.       {$i-} reset(netfile); {$i+}
  209.       if ioresult>=1 then
  210.         begin
  211.           writeln('NETWORK ERROR: UPDATE_NODE');
  212.           halt;
  213.         end;
  214.       seek(netfile,network_node);
  215.       write(netfile,netdata);
  216.       close(netfile);
  217.       unlock_file('NETWORK');
  218.     end;
  219.  
  220. (*═════════════════════════════════════════════════════════════════════════*)
  221.  
  222.     procedure log_node;
  223.     begin
  224.       network_node:=-1;
  225.       lock_file('NETWORK');
  226.       assign(netfile,'LOCK\'+'NETWORK.SYS');
  227.       {$i-} reset(netfile) {$i+};
  228.       if ioresult>=1 then
  229.         begin
  230.           writeln('NETWORK ERROR: LOG_NODE');
  231.           halt;
  232.         end;
  233.       for _retval:=filesize(netfile)-1 downto 0 do
  234.         begin
  235.           seek(netfile,_retval);
  236.           {$i-} read(netfile,netdata); {$i+}
  237.           if ioresult>=1 then
  238.             begin
  239.               writeln('NETWORK ERROR: LOG_NODE');
  240.               halt;
  241.             end;
  242.           if NOT netdata.x_active then network_node:=_retval;
  243.         end;
  244.       if network_node=-1 then
  245.         begin
  246.           writeln('NETWORK ERROR: LOG_NODE');
  247.           halt;
  248.         end;
  249.       seek(netfile,network_node);
  250.       write(netfile,netdata);
  251.       close(netfile);
  252.       unlock_file('NETWORK');
  253.     end;
  254.  
  255. (*═════════════════════════════════════════════════════════════════════════*)
  256.  
  257.     procedure log_off_node;
  258.     begin
  259.       lock_file('NETWORK');
  260.       assign(netfile,'LOCK\'+'NETWORK.SYS');
  261.       {$i-} reset(netfile) {$i+};
  262.       if ioresult>=1 then
  263.         begin
  264.           writeln('NETWORK ERROR: LOG_OFF_NODE');
  265.           halt;
  266.         end;
  267.       netdata.x_username:='';
  268.       netdata.x_active:=false;
  269.       seek(netfile,network_node);
  270.       write(netfile,netdata);
  271.       close(netfile);
  272.       unlock_file('NETWORK');
  273.     end;
  274.  
  275. (*═════════════════════════════════════════════════════════════════════════*)
  276.  
  277.   END.
  278.