На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Поиск Участники Календарь Избранное RSS
msm.ru
Модераторы: jack128, Rouse_, Krid
Ссылки по теме:
  
    > Запрет запуска второй копии программы
    s-mike
    Сообщ. #1 ,
      Unregistered
      Способ 1. Простой, но не самый надежный.
      ExpandedWrap disabled
        var
          Wnd: HWND;
          ClassName: array [0..12] of Char;
          WindowName: array [0..MAX_PATH -1] of Char;
        begin
          CreateMutex(nil, True, 'Delivery Update NoManyCopy Mutex');
          if GetLastError = ERROR_ALREADY_EXISTS then
          begin
            if MessageBox(0,
              'Запуск второй копии приложения запрещен, активизировать предыдущую копию?',
              'Ошибка', MB_YESNO + MB_ICONERROR + MB_DEFBUTTON1) = ID_NO then
              PostQuitMessage(0)
            else
            begin
              Wnd := GetWindow(Application.Handle, GW_HWNDFIRST);
              while Wnd <> 0 do
              begin
                if Wnd <> Application.Handle then
                begin
                  GetClassName(Wnd, ClassName, SizeOf(ClassName));
                  if ClassName[1] = 'A' then
                  if StrComp(ClassName, 'TApplication'#0) = 0 then
                  begin
                    GetWindowText(Wnd, WindowName, SizeOf(WindowName));
                    if StrComp(WindowName, 'Delivery'#0) = 0 then
                    begin
                      SendMessage(Wnd, WM_SETFOCUS, Wnd, 0);
                      ShowWindow(Wnd, SW_NORMAL);
                      Exit;
                    end;
                  end;
                end;
                Wnd := GetWindow(Wnd, GW_HWNDNEXT);
              end;
            end;      
          end
          else
          begin
            Application.Initialize;
            Application.CreateForm(TfrmMain, frmMain);
            Application.CreateForm(TdlgPrintSetting, dlgPrintSetting);
            Application.Run;
          end;
        end.


      Способ 2.       Немного сложнее, но гораздо надежнее и универсальнее

      Скажем, в общем вот такой подход будет универсален для приложений:

      Это DPR:
      ExpandedWrap disabled
        program Project1;
         
        uses
          Windows,
          Forms,
          Unit1 in 'Unit1.pas' {Form1};
         
        {$R *.res}
         
        var
          RestoreOldInstance: Cardinal;
        begin
          CreateMutex(nil, True, '{C68C1DD9-2CB0-4B2F-9A6A-29F4ADE5707D}');
          if GetLastError = ERROR_ALREADY_EXISTS then
          begin
            if MessageBox(0,
              'Запуск второй копии приложения запрещен, активизировать предыдущую копию?',
              'Ошибка', MB_YESNO + MB_ICONERROR + MB_DEFBUTTON1) = ID_YES then
            begin
              RestoreOldInstance :=
                RegisterWindowMessage('{FC9D27F6-D173-4CF6-8A9A-3A2197C72390}');
              PostMessage(HWND_BROADCAST, RestoreOldInstance, 0, 0); // y-soft
            end;
            Exit;
          end;
          Application.Initialize;
          Application.CreateForm(TForm1, Form1);
          Application.Run;
        end.

      А это код в форме:
      ExpandedWrap disabled
        unit Unit1;
         
        interface
         
        uses
          Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
          Dialogs;
         
        type
          TForm1 = class(TForm)
            procedure FormCreate(Sender: TObject);
          private
            RestoreOldInstance: Cardinal;
            function ApplicationMessage(var Message: TMessage): Boolean;
          end;
         
        var
          Form1: TForm1;
         
        implementation
         
        {$R *.dfm}
         
        function TForm1.ApplicationMessage(var Message: TMessage): Boolean;
        var
          hWnd, hCurWnd, dwThreadID, dwCurThreadID: THandle;
          OldTimeOut: Cardinal;
          AResult: Boolean;
        begin
          Result := False;
          if Message.Msg = RestoreOldInstance then
          begin
            Application.Restore; // y-soft
            hWnd := Application.Handle;
            SystemParametersInfo(SPI_GETFOREGROUNDLOCKTIMEOUT, 0, @OldTimeOut, 0);
            SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0, Pointer(0), 0);
            SetWindowPos(hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);
            hCurWnd := GetForegroundWindow;
            AResult := False;
            while not AResult do
            begin
              dwThreadID := GetCurrentThreadId;
              dwCurThreadID := GetWindowThreadProcessId(hCurWnd);
              AttachThreadInput(dwThreadID, dwCurThreadID, True);
              AResult := SetForegroundWindow(hWnd);
              AttachThreadInput(dwThreadID, dwCurThreadID, False);
            end;
            SetWindowPos(hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);
            SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0, Pointer(OldTimeOut), 0);
          end;
          inherited;
        end;
         
        procedure TForm1.FormCreate(Sender: TObject);
        begin
          RestoreOldInstance :=
            RegisterWindowMessage('{FC9D27F6-D173-4CF6-8A9A-3A2197C72390}');
          Application.HookMainWindow(ApplicationMessage);
        end;
         
        end.



      Автор: Rouse_
      0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
      0 пользователей:


        Рейтинг@Mail.ru
        [ Script execution time: 0,0170 ]   [ 16 queries used ]   [ Generated: 2.05.24, 19:36 GMT ]  
        Powered by Invision Power Board(U) v1.2 © 2003  IPS, Inc.