Оригинальный DVD-ROM: eXeL@B DVD !
eXeL@B ВИДЕОКУРС !

ВИДЕОКУРС
выпущен 4 ноября!


УЗНАТЬ БОЛЬШЕ >>
Домой | Статьи | RAR-cтатьи | FAQ | Форум | Скачать | Видеокурс
Новичку | Ссылки | Программирование | Интервью | Архив | Связь

БОЛЬШОЙ FAQ ПО DELPHI



Как поставить запрет, чтобы не запустить EXE дважды

Программистские проекты бывают трех основных типов:
1. Неудачный проект первого рода - когда не удалось заключить контракт.
2. Неудачный проект второго рода - когда удалось заключить контракт.
3. Удачный проект, или проект с предоплатой.

Предоставленное разработчиками Delphi 2 Пачекой (Pacheco) и Тайхайрой (Teixeira) и значительно переработанное.


 unit multinst;
 {
 
 Применение:
 Необходимый код в исходном проекте
 
 if InitInstance then
 begin
 Application.Initialize;
 Application.CreateForm(TFrmSelProject, FrmSelProject);
 Application.Run;
 end;
 Это все понятно (я надеюсь)
 }
 
 interface
 
 uses Forms, Windows, Dialogs, SysUtils;
 
 const
 
   MI_NO_ERROR = 0;
   MI_FAIL_SUBCLASS = 1;
   MI_FAIL_CREATE_MUTEX = 2;
 
   { Проверка правильности запуска приложения с помощью описанных ниже функций. }
   { Количество флагов ошибок MI_* может быть более одного. }
 
 function GetMIError: Integer;
 function InitInstance: Boolean;
 
 implementation
 
 const
 
   UniqueAppStr: PChar; {Различное для каждого приложения}
 
 var
 
   MessageId: Integer;
   WProc: TFNWndProc = nil;
   MutHandle: THandle = 0;
   MIError: Integer = 0;
 
 function GetMIError: Integer;
 begin
 
   Result := MIError;
 end;
 
 function NewWndProc(Handle: HWND; Msg: Integer; wParam,
 
   lParam: Longint): Longint; stdcall;
 begin
 
   { Если это - сообщение о регистрации... }
 
   if Msg = MessageID then
   begin
     { если основная форма минимизирована, восстанавливаем ее }
 
 { передаем фокус приложению }
     if IsIconic(Application.Handle) then
     begin
       Application.MainForm.WindowState := wsNormal;
       ShowWindow(Application.Mainform.Handle, sw_restore);
     end;
     SetForegroundWindow(Application.MainForm.Handle);
   end
     { В противном случае посылаем сообщение предыдущему окну }
   else
     Result := CallWindowProc(WProc, Handle, Msg, wParam, lParam);
 end;
 
 procedure SubClassApplication;
 begin
 
   { Обязательная процедура. Необходима, чтобы обработчик }
   { Application.OnMessage был доступен для использования. }
   WProc := TFNWndProc(SetWindowLong(Application.Handle, GWL_WNDPROC,
     Longint(@NewWndProc)));
   { Если происходит ошибка, устанавливаем подходящий флаг }
   if WProc = nil then
     MIError := MIError or MI_FAIL_SUBCLASS;
 end;
 
 procedure DoFirstInstance;
 begin
 
   SubClassApplication;
   MutHandle := CreateMutex(nil, False, UniqueAppStr);
   if MutHandle = 0 then
     MIError := MIError or MI_FAIL_CREATE_MUTEX;
 end;
 
 procedure BroadcastFocusMessage;
 { Процедура вызывается, если уже имеется запущенная копия Вашей программы. }
 var
 
   BSMRecipients: DWORD;
 begin
   { Не показываем основную форму }
 
   Application.ShowMainForm := False;
   { Посылаем другому приложению сообщение и информируем о необходимости }
   { перевести фокус на себя }
   BSMRecipients := BSM_APPLICATIONS;
   BroadCastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE,
     @BSMRecipients, MessageID, 0, 0);
 end;
 
 function InitInstance: Boolean;
 begin
 
   MutHandle := OpenMutex(MUTEX_ALL_ACCESS, False, UniqueAppStr);
   if MutHandle = 0 then
   begin
     { Объект Mutex еще не создан, означая, что еще не создано }
 
 { другое приложение. }
     ShowWindow(Application.Handle, SW_ShowNormal);
     Application.ShowMainForm := True;
     DoFirstInstance;
     result := True;
   end
   else
   begin
     BroadcastFocusMessage;
     result := False;
   end;
 end;
 
 initialization
   begin
 
     UniqueAppStr := Application.Exexname;
     MessageID := RegisterWindowMessage(UniqueAppStr);
     ShowWindow(Application.Handle, SW_Hide);
     Application.ShowMainForm := FALSE;
   end;
 
 finalization
   begin
 
     if WProc <> nil then
       { Приводим приложение в исходное состояние }
 
       SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(WProc));
   end;
 end.
 




<< ВЕРНУТЬСЯ В ОГЛАВЛЕНИЕ



Материалы находятся на сайте https://exelab.ru/pro/



Оригинальный DVD-ROM: eXeL@B DVD !


Вы находитесь на EXELAB.rU
Проект ReactOS