{Unit uniqueInstance;/t/t/t/t/t/t/t}
{/t/t/t/t/t/t/t/t/t}
{Проверьте, существует ли предыдущий экземпляр приложения, если да, предыдущий/t}
{экземпляр будет активным, а текущий экземпляр будет завершить ./T}
{/t/t/t/t/t/t/t/t/t}
{написано SaveTime, http://savetime.delphibbs.com 2004/6/27/t/t}
{/t/t/t/t/t/t/t/t/t}
{Usage:/t/t/t/t/t/t/t/t}
{Включите это устройство в ваш проект Delphi, больше нет работы ./T}
{/t/t/t/t/t/t/t/t/t}
{Важно:/t/t/t/t/t/t/t/t}
{Вы не должны удалять строку проекта: Application.initialize;/t}
{/t/t/t/t/t/t/t/t/t}
{Примечания:/T/T/T/T/T/T/T/T}
{Это устройство идентифицирует приложение от IT 'exe file name. Итак, если хотите}
{Чтобы указать другое уникальное имя приложения, вы должны изменить значение}
{UniqueAplicationName в проверке процедуры ./T/T}
{/t/t/t/t/t/t/t/t/t}
Уникальный подразделение;
интерфейс
использует классы, Sysutils, Windows, Forms;
выполнение
вар
Uniquemessageid: Uint;
UniqueMutexHandle: Thandle;
Предыдущий wndproc: tfnwndproc;
NextInitProc: указатель;
Function ApplicationWndProc (hwnd: hwnd; umsg: uint; wparam: wparam;
LPARAM: LPARAM): LRESULT; stdcall;
начинать
// Примечание: использовать "<>" может повысить скорость приложения.
Если umsg <> uniquemessageid, тогда
Результат: = callwindowproc (предыдущий wndproc, hwnd, umsg, wparam, lparam)
иначе начинается
Если isiconic (application.handle), то Application.Restore;
SetForegroundWindow (Application.Handle);
Результат: = 0;
конец;
конец;
Процедура привлечена
констант
BSMrecipients: dword = bsm_applications;
начинать
BroadcastSystemmessage (bsf_ignorecurrenttask или bsf_postmessage,
@Bsmrecipients, Uniquemessageid, 0, 0);
Остановиться;
конец;
Процедура подклассажа;
начинать
Предыдущий
Integer (@applicationwndproc)));
конец;
Процедура CheckPreviousInstance;
вар
UniqueAplicationName: PCHAR;
начинать
// уникальное имя приложения, по умолчанию установлено имя файла EXE,
// Вы можете изменить его на себя.
UniqueApplicationName: = pchar (ExtractFilEname (Application.Exename));
// зарегистрировать уникальный идентификатор сообщения
UniqueMessAgeId: = RegisterWindowMessage (UniqueApplicationName);
// Создать объект MUTEX
UniqueMutexHandle: = createMutex (nil, false, UniqueAplicationName);
// Создать неудачу MUTEX, завершить приложение
Если UniqueMutexHandle = 0, то
Остановка
// тот же самый названный мутекс существует, покажите предыдущий экземпляр
иначе, если getlasterror = error_alredy_exists тогда
Принесите
// нет предыдущего экземпляра, окно приложения подкласса
еще
SubClassApplication;
// звонок Next initProc
Если nextInitProc <> nil, то tprocedure (nextInitProc);
конец;
инициализация
// должен использовать initproc для проверки привилегического экземпляра,
// как причина приложения не была создана!
NextInitProc: = initProc;
InitProc: = @checkpreviousinstance;
завершение
// закрыть ручку мутекс
Если UniqueMutexHandle <> 0, то Nealshandle (UniqueMutexHandle);
конец.