Предотвращение запуска второй копии программы

[minoshi]

Доброго времени суток!

Я автор проигрывателя xelplayer (обсуждение здесь на сайте ).

Вопрос вот в чем, предположим проигрыватель уже запущен, а пользователь запускает на проигрывание другой медиа-файл или плей-лист. Как предотвратить запуск второй копии программы, а выбранный медиа-файл передать первой копии? Так ведет себя, например, проигрывать totem.

пока, что мне пришло на ум следующий алгоритм:

-в событии oncreate проверять список запущенных программ (например через tprocess запускать утилиту ps и анализировать ее вывод)
-если программа уже запущена, то прерывать запуск, а выбранный медиа-файл или плейлист записывать в определенный файл-флаг.
-в самой программе предусмотреть мониторинг появления файл-флага (ну например через ttimer) и если он появился, то загружать из него плей-лист.


Топорно как-то, может есть чего поизящнее?

[Odyssey]

Конечно есть: http://wiki.lazarus.freepascal.org/UniqueInstance

[minoshi]

хм , а под MSE ?

Добавлено спустя 8 минут 51 секунду:
хотя есть от чего копать http://lazarusroad.blogspot.com/2006/12 ... tance.html

[coyot.rush]

-в событии oncreate проверять список запущенных программ (например через tprocess запускать утилиту ps и анализировать ее вывод)

Не в onCreate, а в

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

program xelplayer;
{$ifdef FPC}{$mode objfpc}{$h+}{$endif}
{$ifdef FPC}
{$ifdef mswindows}{$apptype gui}{$endif}
{$endif}
uses
{$ifdef FPC}{$ifdef linux}cthreads,{$endif}{$endif}msegui,mseforms,main, openunit;
begin
//Проверка на запуск второй копии
application.createform(tmainfo,mainfo);
application.createform(topenunitfo,openunitfo); 
application.run;
end.

Лучше всего использовать Lock файл (opera так поступает) в папке /tmp (Linux)

в самой программе предусмотреть мониторинг появления файл-флага (ну например через ttimer) и если он появился, то загружать из него плей-лист

Из FIFO файла (Linux)
Вот мой пример использования FIFO,использую для динамической отладки (слегка недоделан )

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

unit LogPFPC;
//Небольшой локальный клиент-север для отладки
{$ifdef FPC}{$mode objfpc}{$h+}{$endif}
{$WEAKPACKAGEUNIT OFF}
interface

uses
  Classes, SysUtils, libc;

const
  LevelLigth  = 'L';
  LevelNormal = 'N';
  LevelMax    = 'M';

type

  { TLogDPFPC }

  TLogDPFPC = class(TObject)
    constructor Create();
    destructor Destroy; override;
    procedure AddInLog(Text: string; DebugLevel: char = LevelNormal;
      DebugFlag: boolean = True);
  private
    HP:   integer;
    Path: string;
    PApplicationName: string;
  end;

  { TLogRPFPC }

  TLogRPFPC = class(TObject)
    Path: string;
    constructor Create(ApplicationName: string);
    destructor Destroy; override;
    function ReadLog(DebugLevel: char): string;
  private
    HP: integer;
  end;

const
  a = 0400;
  MarkerCr = #10;
  MarkerDebugFlag = #10;

var
  LogDP: TLogDPFPC;

implementation


//const

constructor TLogDPFPC.Create();
begin
  PApplicationName := ExtractFileName(ParamStr(0));
  Path := GetEnvironmentVariable('HOME') + '/.' + 'debug.pipes.' + PApplicationName;
  if libc.mkfifo(PChar(Path), a) = 0 then
    writeln('Create Pipes');
  Writeln('Open Pipes ' + Path);
  HP := Open(PChar(Path), O_RDWR);
  //insert some code
end;

destructor TLogDPFPC.Destroy;
begin
  libc.__close(HP);
  inherited Destroy;
end;


procedure TLogDPFPC.AddInLog(Text: string; DebugLevel: char = LevelNormal;
  DebugFlag: boolean = True);
var
  buf:  array of char;
  l, i: integer;
begin
  if DebugFlag = True then
  begin
    L := Length(Text);
    SetLength(buf, L);
    for I := 0 to L - 1 do
    begin
      if Text[ i + 1]=#13 then Text[i + 1]:='_';
      buf[i] := Text[i + 1];
    end;
    libc.__write(HP, buf[0], L);
    SetLength(buf, 2);
    buf[0] := DebugLevel;
    Buf[1] := MarkerCr;
    libc.__write(HP, buf[0], 2);
  end;
end;



{ TLogRPFPC }

constructor TLogRPFPC.Create(ApplicationName: string);
begin
  Path := GetEnvironmentVariable('HOME') + '/.' + 'debug.pipes.' + ApplicationName;
  writeln('Open Pipes ' + Path);
  HP := Open(PChar(Path), O_RDWR);
end;

destructor TLogRPFPC.Destroy;
begin
  libc.__close(HP);
  inherited Destroy;
end;

function TLogRPFPC.ReadLog(DebugLevel: char): string;
var
  c:      char;
  tmpstr: string;
begin
  DebugLevel := 'N';
  tmpstr     := '';
  while c <> MarkerCr do
  begin
    if libc.__read(HP, c, 1) > 0 then
    begin
      tmpstr := tmpstr + c;
    end;
  end;
  Result     := Copy(tmpstr, 1, Length(tmpstr) - 2);
  DebugLevel :=Copy(tmpstr, Length(tmpstr), Length(tmpstr))[1];
end;



end.


Конечно есть: http://wiki.lazarus.freepascal.org/UniqueInstance

Как минимум лишний код , и скорее всего лишний тормоз

[Иван Шихалев]

Из FIFO файла (Linux)

А не будет ли достаточным проверять, не создан ли FIFO-файл? Без отдельного lock-файла?

[coyot.rush]

А не будет ли достаточным проверять, не создан ли FIFO-файл? Без отдельного lock-файла?

Отвечал по мере прочтения поста
Конечно да.
Не подскажите чем можно заменить FIFO файл в Windows

[Иван Шихалев]

Зачем заменить? там же есть named pipes... Правда, как оно там работает — понятия не имею.

Добавлено спустя 3 минуты 45 секунд:
Ну и на сокетах данный механизм можно реализовать... Тогда сразу можно будет и с другой машины подавать плейлист/команды

[coyot.rush]

Зачем заменить? там же есть named pipes... Правда, как оно там работает — понятия не имею.

Имелось ввиду аналог
named pipes http://msdn.microsoft.com/en-us/library/aa365590.aspx

Ну и на сокетах данный механизм можно реализовать... Тогда сразу можно будет и с другой машины подавать плейлист/команды

Интересная идея Трех зайцев одним ударом

[Иван Шихалев]

Имелось ввиду аналог
named pipes http://msdn.microsoft.com/en-us/library/aa365590.aspx

В смысле — аналог для других систем? Я не понял, чего не хватает-то?

[coyot.rush]

В смысле — аналог для других систем?

Да
Примеры уже нашел
"Что такое Named Pipes и как с ними бороться" http://www.delphimaster.ru/articles/named_pipes/

[minoshi]

Простите если я сморозю глупость (просто со сферой пайпов я вообще пока не сталкивался), но я так понял, что кроссплатформенного решения нет?

[Nik]

Простите если я сморозю глупость (просто со сферой пайпов я вообще пока не сталкивался), но я так понял, что кроссплатформенного решения нет?

Конечно есть: http://wiki.lazarus.freepascal.org/UniqueInstance

[coyot.rush]

Конечно есть: http://wiki.lazarus.freepascal.org/UniqueInstance

Ссылка на закачку компонента битая
UniqueInstance https://svn.bountysource.com/luipack/trunk/uniqueinstance/

[Vadim]

Простите если я сморозю глупость (просто со сферой пайпов я вообще пока не сталкивался), но я так понял, что кроссплатформенного решения нет?

Можно куда-нибудь, в определённое место закидывать файл с pid-ом процесса. Вполне кроссплатформенно. Правда не спасает от ошибок, когда предыдущий запуск программы был аварийно завершён.

[Odyssey]

Не понимаю, зачем изобретать велосипед. UniqueInstance использует уже имеющийся в FPC кроссплатформенный механизм взаимодействия процессов -- SimpleIPC. Если не устраивает привязка компонента к LCL, из него можно выковырять значимый код -- создание SimpleIPC сервера и подключение к нему. Никаких платформозависимых решений, никаких временных файлов.
С сокетами идея интересная -- задач с ней можно решить побольше, но она и потруднее, и возможно потребует сторонних библиотек.