(* Программа lockit -- блокировка при помощи вызова fcntl *)
uses linux,stdio;

var
  fd:integer;
  my_lock:flockrec;
begin
  (* Установка параметров блокировки записи *)
  my_lock.l_type := F_WRLCK;
  my_lock.l_whence := SEEK_SET;
  my_lock.l_start := 0;
  my_lock.l_len := 10;
  (* Открыть файл *)
  fd := fdopen ('locktest', Open_RDWR);
  (* Заблокировать первые десять байт *)
  fcntl (fd, F_SETLKW, longint(@my_lock));
  if linuxerror > 0 then
  begin
    perror ('parent: locking');
    halt (1);
  end;
  writeln('Родительский процесс: блокировка установлена');
  case fork of
    -1:			(* ошибка *)
    begin
      perror ('Ошибка вызова fork');
      halt (1);
    end;
    0:			
    begin
      my_lock.l_len := 5;
      fcntl (fd, F_SETLKW, longint(@my_lock));
      if linuxerror > 0 then
      begin
        perror ('Дочерний процесс: установка блокировки');
        halt (1);
      end;
      writeln ('Дочерний процесс: блокировка установлена');
      writeln ('Дочерний процесс: выход');
      halt (0);
    end;
  end;
  (* родительский процесс *)
  sleep (5);
  (* Выход, который автоматически снимет блокировку. *)
  writeln ('Родительский процесс: выход');
  halt (0);
end.
