Другие языки программирования и технологии

Как запретить второй запуск программы?

Как в Delphi запретить второй запуск программы тоесть один раз запустил второй раз что бы уже нельзя было запускать её?
var
AtomText: array [0..31] of Char;

procedure LookForPreviousInstance;
var
PreviousInstanceWindow : hWnd;
AppName : array[0..30] of char;
FoundAtom : TAtom;
begin
// помещаем имя приложения в AtomText
StrFmt(AtomText, 'OnlyOne%s', [Copy(Application.Title,1,20)]);
// Проверяем, не создано ли уже атома с таким именем приложения
FoundAtom := GlobalFindAtom(AtomText);
if FoundAtom <> 0 then { эта копия приложения уже запущена }
begin
StrFmt(AppName,'%s', [Application.Title]);
// изменяем текущий заголовок, чтобы FindWindow не видела его
Application.ShowMainForm := false;
Application.Title := 'destroy me';
// ищем предыдущую копию приложения
PreviousInstanceWindow := FindWindow(nil,AppName);
// Передаём фокус на предыдущую копию приложения
// завершаем текущую копию
Application.Terminate;

if PreviousInstanceWindow <> 0 then
if IsIconic(PreviousInstanceWindow) then
ShowWindow(PreviousInstanceWindow,SW_RESTORE)
else
SetForegroundWindow(PreviousInstanceWindow);
end;
// создаём глобальный атом, чтобы предотвратить
// запуск другой копии приложения
FoundAtom := GlobalAddAtom(AtomText);
end;

constructor TForm.Create(AOwner: TComponent);
begin
inherited;
LookForPreviousInstance;
end;

destructor TForm.Destroy;
var
FoundAtom : TAtom;
ValueReturned : word;
begin
// не забудьте удалить глобальный атом
FoundAtom := GlobalFindAtom(AtomText);
if FoundAtom <> 0 then
ValueReturned := GlobalDeleteAtom(FoundAtom);
inherited Destroy;
end;
Каиржан Мендигалиев
Каиржан Мендигалиев
5 549
Лучший ответ
Не умеещь гуглом пользоваться?
Дмитрий Ежов
Дмитрий Ежов
4 389
Через Мютексы:

//check for duplex run
function AppExists:boolean;
const AppName:Pchar='App_name';
begin
HM:=OpenMutex(MUTANT_ALL_ACCESS,false,AppName);
Result:=HM<>0;
if HM=0 then HM:=CreateMutex(nil,false,AppName);
end;

begin
if AppExists then exit;
Application.Initialize;
...
Application.Run;
end.
При запуске в реестр добавь запись и проверяй, опять же при запуске, если она есть, то Application.Terminate(); Или файлик создай текстовый, к примеру "c:\windows\system32\Уже запускалась. txt" вроде того и проверяй есть ли он.

Как я понял, приложение должно запускаться всего 1 раз, а не одна копия, как все другие поняли :)
AK
Alexandr Kushner
2 279
procedure UniqueApplication;
var
UniqueMapping: THandle;
begin
UniqueMapping:=CreateFileMapping($ffffffff, nil, PAGE_READONLY, 0, 32, 'MyMap');
if UniqueMapping = 0 then
begin
Application.MessageBox(PChar(SysErrorMessage(GetLastError)), nil, MB_OK);
Halt;
end
else if GetLastError = ERROR_ALREADY_EXISTS then
begin
Application.MessageBox('Программа уже запущена', nil, MB_OK);
Halt;
end;
end;