скрыть

скрыть

  Форум  

Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Google  
 

Как определить работает ли уже данное приложение или это его первая копия



Сидит программист в столовой, обедает, суп ест. В очках такой, задумчивый, программу думает. Народу никого, все уже поели, ушли. Подходит к нему официантка и заигрывает:
- Если Вы хотите хорошо провести время, то меня зовут Маша!
Программист медленно возвращается на землю и смотрит на официантку отрешенным взглядом и на автопилоте спрашивает:
- А если не хочу, то как Вас зовут?!

Каждый экземпляр программы имеет ссылку на свою предыдущую копию - hPrevInst: hWnd. Ее можно проверить перед созданием приложения и при необходимости отреагировать соответствующим образом. Если запущена только одна копия, то эта ссылка равна нулю. Только для Delphi 1. Пример использования hPrevInst:


procedure TForm1.FormCreate(Sender: TObject);
begin
  // Проверяем есть ли указатель на предыдущую копию приложения
  if hPrevInst <> 0 then begin
    // Если есть, то выдаем сообщение и выходим
    MessageDlg('Программа уже запущена!', mtError, [mbOk], 0);
    Application.Terminate;
  end;
  // Иначе - ничего не делаем (не мешаем созданию формы)
end;

Другой способ - по списку загруженных приложений


procedure TForm1.FormCreate(Sender: TObject);
var
  Wnd : hWnd;
  buff : array[0.. 127] of Char;
begin
  //Получили указатель на первое окно
  Wnd := GetWindow(Handle, gw_HWndFirst);
  // Поиск
  while Wnd <> 0 do begin
    // Это окно предыдущей копии ?
    if (Wnd <> Application.Handle) and (GetWindow(Wnd, gw_Owner) = 0) then
    begin
      GetWindowText (Wnd, buff, sizeof (buff ));
      if StrPas (buff) = Application.Title then
      begin
        MessageDlg('Приложение уже загружено', mtWarning, [mbOk], 0);
        Halt;
      end;
    end;
    Wnd := GetWindow (Wnd, gw_hWndNext);
  end;
end;

Данный пример не всегда применим - часто заголовок приложения меняется при каждом старте, поэтому рассмотрим более надежный способ - через FileMapping

Дело в том, что можно в памяти создавать временные файлы. При перезагрузке они теряются, а так существуют. Кстати, этот метод можно использовать и для обмена информацией между вашими приложениями. Пример с использованием FileMapping:


program Project1;
uses
  Windows, // Обязательно
  Forms,
  Unit1 in 'Unit1.pas' {Form1};

{$R *.RES}
const
  MemFileSize = 1024;
  MemFileName = 'one_inst_demo_memfile';
var
  MemHnd : HWND;
begin
  // Попытаемся создать файл в памяти
  MemHnd := CreateFileMapping(HWND($FFFFFFFF),
    nil, PAGE_READWRITE, 0, MemFileSize, MemFileName);
  // Если файл не существовал запускаем приложение
  if GetLastError<>ERROR_ALREADY_EXISTS then
  begin
    Application.Initialize;
    Application.CreateForm(TForm1, Form1);
    Application.Run;
  end;
  CloseHandle(MemHnd);
end.

Часто при работе у пользователя может быть открыто 5-20 окон и сообщение о том, что программа уже запущено приводит к тому, что он вынужден полчаса искать ранее запущенную копию. Выход из положения - найдя копию программы активировать ее, для чего в последнем примере перед HALT необходимо добавить строку : SetForegroundWindow(Wnd);

Пример:


program Project0;
uses
  Windows, // !!!
  Forms,
  Unit0 in 'Unit0.pas' {Form1};

var
  Handle1 : LongInt;
  Handle2 : LongInt;

{$R *.RES}

begin
  Application.Initialize;
  Handle1 := FindWindow('TForm1',nil);
  if handle1 = 0 then
  begin
    Application.CreateForm(TForm1, Form1);
    Application.Run;
  end
  else
  begin
    Handle2 := GetWindow(Handle1,GW_OWNER);
    //Чтоб заметили :)
    ShowWindow(Handle2,SW_HIDE); ShowWindow(Handle2,SW_RESTORE);
    SetForegroundWindow(Handle1); // Активизируем
  end;
end.

Блокировка запуска второй копии при помощи Mutex На мой взгляд, это один из самых простых и надежных способов.


procedure TForm1.FormCreate(Sender: TObject);
var
  hMutex : THandle;
begin
  hMutex := CreateMutex(0, true , 'My application name');
  if GetLastError = ERROR_ALREADY_EXISTS then
  begin
    CloseHandle(hMutex);
    Application.Terminate;
  end;
end;

В данном примере при старте приложения создается мьютекс с некоторым уникальным именем (у каждого приложения оно должно бять свое !!). Если хоть одна копия приложения запущена, то в системе уже будет мьютекс с таким именем и возникнет ошибка ERROR_ALREADY_EXISTS. В противном случае мьютекс создается и существует, пока работает данная копия приложения Задать вопрос






Copyright © 2004-2016 "Delphi Sources". Delphi World FAQ




Группа ВКонтакте   Ссылка на Twitter   Группа на Facebook