Ожидание закрытия файла

[VirtUX]

На просторах интернета нашел такую функцию для Windows:

Код: Выделить всё

uses Windows;
...
function IsFileClosed(fname:string;wait:dword):boolean;
var h,i:DWORD;
begin
  Result:=false;
  i:=0;
  repeat
    h:=CreateFile(PChar(fname),GENERIC_READ or GENERIC_WRITE,0,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);
    If (h<>INVALID_HANDLE_VALUE) then
     begin
       CloseHandle(h);
       Result:=true;
       exit;
     end;
    Sleep(100);
    inc(i);
  until (i>wait) or (wait=0);
end;         

Позаоляет ожидать закрытия файла некоторое время.
Внимание вопрос!
А под Linux аналогичную функцию как организовать?

[Сквозняк]

В линуксе сначала нужно придумать, зачем для работы с нетипизованным файлом нужно что-то кроме fpopen:

Код: Выделить всё

uses
UNIX, BASEUNIX;
var
q,w:longint;
begin
q:=fpopen ('fyle', Open_RDONLY);
if q>=0 then begin
                 w:=FPLSEEK(q,0,SEEK_END); //длина файла
                 FPLSEEK(q,0,SEEK_SET); //прыгаем в начало файла
                 end;
fpclose(q);
end.


[VirtUX]

Мне нужно дождаться, пока другая программа не закончит запись в файл или переименование файла. И только затем приступить к собственному редактированию/чтению/удалению файла. И мне не важен его размер и тип, а так же прочие атрибуты - это и так заранее известно (он стандартизирован).
Я так понимаю (из выше приведенного кода), "q" будет больше либо равно нулю, если файл свободен для редактирования; и меньше нуля, если файл еще занят другим процессом?

[Сквозняк]

Я так понимаю (из выше приведенного кода), "q" будет больше либо равно нулю, если файл свободен для редактирования; и меньше нуля, если файл еще занят другим процессом?

Немного не так, "q=0" я никогда не встречал, сейчас возникли сомнения, поэтому уточнил в документации, там написано что файл свободен для редактирования при "q>0". Ошибочка вышла. А редактировать и читать в линуксе можно и незакрытый другой программой файл - многозадачность.
Можно перед открытием смотреть время последней модификации файла и сравнивать с текущим. http://www.linux.org.ru/forum/development/968919

[VirtUX]

А редактировать и читать в линуксе можно и незакрытый другой программой файл - многозадачность.

Вот это и не хорошо. Уже проверил. Если два процесса одновременно пишут и читают идин и тот же файл - получается белеберда. И записывается (первым процессом) неправильно, и читается (вторым процессом) не всё.

перед открытием смотреть время последней модификации файла и сравнивать с текущим

Дело в том, что время последней модификации может быть каким угодно! Это может быть и старый файл (но в данный момент активно редактируемый) и вновь созданный (еще не успевший отредактироваться). Да и вообще время последней модификации никак не подскажет: используется-ли файл в данный момент другим процессом. Ведь он может и просто быть открыт и потом закрыт без модифицирования.
Суть в том, чтоб отследить такую ситуацию, например:
Лежит себе файл в некотором каталоге. Мы его можем открыть, посмотреть, удалить, редактировать. Но если он, в момент попытки начать работать с ним, занят другим процессом (Например открыт в OpenOffice), то нужно дождаться, пока в нем другой процесс не закончит все свои изменения и не освободит. Иначе мы 100% будем работать с недоделанным файлом и хорошего тут ничего нет
В Windows есть возможность отследить занятость файла (см. выше приведенную функцию IsFileClosed), а в что делать в такой ситуации в Linux???

Добавлено спустя 1 минуту 42 секунды:
Ведь должна быть какая-то системная функция сообщающая об использовании в данный момент файла некоторым процессом... Ну не верю я в ее отсутствие!

Добавлено спустя 1 час 9 минут 1 секунду:
Нашел, что есть в Linux утилита lsof - показывает какие файлы, какими процессами открыты. Она же как-то добывает эту информацию из ОС!

[alex208210]

Код: Выделить всё

function Tform1.shellv(commd:string):ansistring;
var
S : TProcess;
Buf: ansistring;
Count : longint;
begin
S:=TProcess.Create(Nil);
S.Commandline:=commd;
S.Options:=[poUsePipes,poNoConsole];
S.execute;
SetLength(buf, 1000);
Repeat
Count:=s.output.read(buf[1], length(buf));
result:=result + Copy(buf, 1, Count-1);
until Count=0;
S.Free;
end;

function tform1.provpr(procs:string):boolean;
begin
result:=false;
if pos(procs,shellv('bash -c "ps -A|grep -i '+procs+'"'))<>0 then result:=true;

{либо так.. если с переменной не прокатит
if pos(procs,shellv('bash -c "ps -A"'))<>0 then result:=true;}
end;
дальше в обработчик timer эту строку:
if provpr('qmmp') = true then showmessage('qmmp запущен') else showmessage('qmmp выключен');



function tform1.provprlsof(procs:string; lsofstr:string):boolean;
var
parsstr,onepars:string;
begin
result:=false;
parsstr:=shellv('bash -c "lsof"');
while length(parsstr)<>0 do
  begin
   onepars:='';
   if pos(#10,parsstr)<>0 then
    begin
     onepars:=copy(parsstr,1,pos(#10,parsstr)-1);
     if (pos(procs,onepars)<>0) and (pos(lsofstr,onepars)<>0) then result:=true;
     delete(parsstr,1,pos(#10,parsstr));
    end else
    begin
     onepars:=copy(parsstr,1,length(parsstr));
     if (pos(procs,onepars)<>0) and (pos(lsofstr,onepars)<>0) then result:=true;
     delete(parsstr,1,length(parsstr));
    end;
  end;
end;
дальше в обработчик timer эту строку:
if provprlsof(nameproc,namefile) = true then showmessage(nameproc+' использует файл '+namefile);



код не компилил.. думаю все должно сработать)

первая функция аналог функции из поста первого.. ищет просто запущенные процессы..вторая функция ищет процесс и какой файл использует этот процесс

[Mr.Smart]

VirtUX Смотрите исходники утилиты.

[VirtUX]

через TProcess конечно можно, но не совсем удобно. Хотя это пока единственный удобоваримый вариант.

Исходники lsof скачал, начал смотреть, глаза поплзли в разные стороны, в районе третьего глаза возросло напряжение - чувствую скоро побегу за пивом Не уверен, что быстро найду нужный участок кода, да и в Си я не очень...

Где же ты - простое решение проблемы?............

[Brainenjii]

если нужно просто решить - то парсинг вывода lsof - вариант ^_^

[VirtUX]

парсинг вывода lsof

Видать от этого никуда не деться Можно, в принципе и не парсить:

Код: Выделить всё

lsof -F c /path/to/file
или
lsof -F p /path/to/file

Но все же надеюсь на вариант без TProcess...

[alex208210]

не понимаю почему не нравится тпроцесс)0 но можно и такие грабли сделать..

uses unix;
shell('lsof > /tmp/parsfile');
assignfile(parsfile,'/tmp/parsfile');
reset(parsfile);
while not eof(parsfile) do
begin
readln(parsfile,parsstr);
if pos('.....',parsstr)<>0 then profit!
end;
closefile(parsfile);

[Mr.Smart]

VirtUX

Здесь в игру вступает псевдо-фс /proc. Каждый процесс на этой файловой системе имеет свой каталог, в котором есть много всего, в том числе подкаталог fd ("file descriptor"), содержащий ссылки на все узлы открытых файлов, даже если они уже были удалены - их копия будет здесь:

/proc/process id/fd/file descriptor

Взято тут http://www.ylsoftware.com/news/123.

[rdtt69]

Воспользуйтесь inotify. Эта фичность ядра позволяет отслеживать любые изменения в ФС.

[VirtUX]

Воспользуйтесь inotify

как этим воспользоваться в FPC?

[coyot.rush]

http://www.freepascal.ru/forum/viewtopic.php?f=13&t=6641&st=0&sk=t&sd=a&start=15

Код: Выделить всё

{

function CheckRunningServer(): Boolean;
var
  FileHandle, Tvar: Integer;
  LockVar: TFlock;
  smode: Byte;
  FileAccessRights:integer;
begin
  Result :=False;
  FileAccessRights:=S_IRUSR or S_IWUSR or S_IRGRP or S_IWGRP or S_IROTH or S_IWOTH;
  begin
    FileHandle := open(PChar(GetEnvironmentVariable('HOME')+'/.'+FIDServer+'.lock'),O_CREAT or O_TRUNC or O_RDWR, FileAccessRights);
    if FileHandle = -1 then  Exit;
    begin
      with LockVar do
      begin
        l_whence := SEEK_SET;
        l_start := 0;
        l_len := 0;
        l_type :=F_WRLCK ;
      end;
      Tvar :=  fcntl(FileHandle, F_SETLK, LockVar);
      if Tvar = -1 then
      begin
        Result:=True;
        __close(FileHandle);
        Exit;
      end;
    end;
    Result :=False;
  end;
end;


fcntl http://www.opennet.ru/man.shtml?topic=fcntl&category=2