home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TOOL_INC.ZIP / LOCKS.INC < prev    next >
Encoding:
Text File  |  1988-01-29  |  1.4 KB  |  77 lines
  1.  
  2. #log Resource management locks
  3.  
  4. (*
  5.  * locks - set and clear locks
  6.  *
  7.  * used to manage shared resources
  8.  *
  9.  * s.h.smith, 9-mar-87
  10.  *
  11.  *)
  12.  
  13. function lock_set(lock: anystring): boolean;
  14.    {check to see if a lock is already set by another process}
  15. var
  16.    fd: file;
  17. begin
  18.    assign(fd,lock);
  19.    {$i-}
  20.    reset(fd);
  21.    {$i+}
  22.  
  23.    if ioresult <> 0 then
  24.       lock_set := false
  25.    else
  26.  
  27.    begin
  28.       close(fd);
  29.       lock_set := true;
  30.    end;
  31. end;
  32.  
  33.  
  34. procedure set_lock(lock: anystring);
  35.    {set a lock; wait if lock is already present}
  36. var
  37.    fd:   file;
  38.    try:  integer;
  39.  
  40. begin
  41.    try := 0;
  42.    while lock_set(lock) do
  43.    begin
  44.       try := try + 1;
  45.       if try = 5 then
  46.       begin
  47.          writeln(con,'Lock present: ',lock,' - program aborted');
  48.          writeln(con,'This resource could be allocated to another program.');
  49.          writeln(con,'Delete the file ',lock,' to remove the lock.');
  50.          halt(1);
  51.       end
  52.       else
  53.       begin
  54.          write(con,'<WAIT>'^H^H^H^H^H^H);
  55.          delay(500);
  56.          write(con,'      '^H^H^H^H^H^H);
  57.       end;
  58.    end;
  59.  
  60.    assign(fd,lock);
  61.    rewrite(fd);
  62.    close(fd);
  63. end;
  64.  
  65.  
  66. procedure clear_lock(lock: anystring);
  67. var
  68.    fd: file;
  69. begin
  70.    assign(fd,lock);
  71.    {$i-}
  72.    erase(fd);
  73.    {$i+}
  74.    if ioresult <> 0 then
  75.       writeln(con,'Lock missing: ',lock);
  76. end;
  77.