| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Как грамотно запретить запуск второй копии программы? [D7, WinXP]

mm0 ©   (2006-01-27 17:25:00) 

Я сделал несколькиим способами - но у них есть недостаток:Если в процессе работы программы возникла недопустимая ошибка(Окошко Windows с отчетом и кнопкой закрыть) ,то программа уже не запуститься.У меня создавался дискриптор в памяти(см. ниже)

Как грамотно сделать,чтобы учесть эту ситуацию?

function CheckThis: boolean;//Запущена одна копия программы?
var Atom: THandle;
begin
 Atom := GlobalFindAtom('MyPr');
 Result := Atom <> 0;
 if not Result then  GlobalAddAtom('MyPr');
end;
begin
 Application.Initialize;
 if CheckThis then
 begin
   MessageBox(0, 'Нельзя запустить две копии программы!', 'MyPr', 0);
   Application.Terminate;
   Exit;
 end;
...

и так пытался:
const
 MemFileSize=127;
 MemFileName='MyPr';
var
 MemHnd:HWND;
begin
 MemHnd:=CreateFileMapping(HWND($FFFFFFFF),nil,
 PAGE_READWRITE,0,MemFileSize,MemFileName);
 if GetLastError<>ERROR_ALREADY_EXISTS then
 begin
 ...
 end elseApplication.MessageBox('Приложение уже запущено (возможно оно свёрнуто на панели задач): Нажмите кнопку ОК для продолжения работы','MyPr',MB_OK);
 CloseHandle(MemHnd);

---

sicilla   (2006-01-28 20:31:00) [1]

Удалено модератором
Примечание: Выражения выбираем

---

kaZaNoVa   (2006-01-28 20:12:00) [2]

sicilla ©   (28.01.06 20:00) [6]
program ****;
почему звёздочки? этот код был примером из одного троянчика :)))) а по теме, findwindow  я бы не сказал, что очень надёжная функция .. например она не найдет программу, запущенную на другом декстопе .. (на этом же компе)

---

sicilla   (2006-01-28 20:00:00) [3]

Вот мой способ:
program ****;

uses
 Forms,
 windows,
 Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

var hwnd: THandle;

begin
    hwnd := findwindow('TForm1','Название');
    if hwnd = 0 then
       begin
            Application.Initialize;
            Application.Title := 'Название';
            Application.CreateForm(TForm1, Form1);
            Application.Run;
       end
    else SetForegroundWindow(hwnd);
end.
Во время запуска рабочее название формы должно отличаться от Название. Иначе не запустить
Работает отлично

---

VirEx   (2006-01-28 10:29:00) [4]

мьютекс убивается когда приложение выгружается, а атом остаётся до перезагрузки ОС, хм... может быть и до выхода юзверя из сеанса (посмотри), либо после GlobalDeleteAtom

---

Kot_   (2006-01-27 23:23:00) [5]

{$R *.res}
begin
// проверка на вторую копию
CreateMutex(nil, True, '{C68C1DD9-2CB0-4B2F-9A6A-29F4ADE5707D}');
if GetLastError = ERROR_ALREADY_EXISTS then
begin
  MessageBox(0,'Приложение уже запущенно. Запуск второй копии запрещен!','Ошибка',MB_OK + MB_ICONERROR + MB_DEFBUTTON1);
  Exit;
end;

 Application.Initialize;
 Application.CreateForm(TFormPredpr, FormPredpr);
 Application.CreateForm(TFormIdentif, FormIdentif);
 Application.Run;
end.

у меня такой код, работает под WinXP, на других системах не проверял

---

tesseract   (2006-01-27 22:23:00) [6]

Через MUTEX. Содран из рабочего проекта лишнее удали :-)

{$R *.res}
 var  fMutex:Cardinal;
begin
 FMutex:= CreateMutex(nil, false, 'Cheese DB');
 if (Fmutex = 0) or (FMutex=INVALID_HANDLE_VALUE) then fMutex:=0;
 if GetLastError=ERROR_ALREADY_EXISTS then begin  ReleaseMutex(fMutex); Fmutex:=0; end;

if fMutex<>0 then
begin
 Application.Initialize;
 Path:=ExtractFileDir(Application.ExeName);
 if not InitApplication then
  begin
    ReleaseMutex(fMutex);
    CloseApplication;
  end;
 Application.Title := 'База данных';
 Application.CreateForm(TfmMain, fmMain);
 Application.CreateForm(TdmData, dmData);
 Application.CreateForm(TfmLogin, fmLogin);
 Application.CreateForm(TfmNewCheese, fmNewCheese);
 Application.Run;
 CloseApplication;
 ReleaseMutex(fMutex);
end;
end.


---

NightAngel   (2006-01-27 21:31:00) [7]

Можно создать временный файл с атрибутами system+hidden+FILE_FLAG_DELETE_ON_CLOSE. В начале программы нужно только создать файл и все:

...
 hFile:=CreateFile(PChar('prog_start.tmp'),GENERIC_WRITE,0,0,
                   CREATE_ALWAYS,FILE_ATTRIBUTE_HIDDEN or
                   FILE_FLAG_DELETE_ON_CLOSE,0);
 if (hFile=INVALID_HANDLE_VALUE) then
   MessageBox(0,'Program is Already Running!','Error',MB_ICONERROR);
...

Этот временный файл в программе даже закрывать не требуется.

---

Игорь Шевченко   (2006-01-27 17:28:00) [8]

try
except
end
в секции except удалять atom или что там


> и так пытался:


А вот это странно, потому что объекты должны удаляться при завершении процесса.

---

Наверх