VPF::Запрет повторного запуска приложения

Alexzz

Дата 23.7.2008, 14:15 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 87
Регистрация: 9.4.2007
Где: Латвия

Репутация: 1
Всего: 1

Есть програмка, которая обеспечивает работу склада з.ч. Написал я её уже давно, и не было проблем пока вчера мой работник не умудрился открыть вторую копию и сделать в ней некоторые действия. Не буду вдаваться в подробности работы программы, но она не рассчитана на многопользовательский доступ к файлам, и второй дубль программы вызвал большую неразбериху в базе данных. Самым простым решением на данный момент я вижу запрет запуска второго дубля программы.

Вопрос: Как сделать, чтобы приложение нельзя было запустить более 1 раза? Ну тоесть если одно уже запущено, то второе чтобы не запускалось, или сразу закрывалось.

Это сообщение отредактировал(а) Alexzz - 23.7.2008, 14:15

VICTAR

Дата 23.7.2008, 14:18 (ссылка)

(голосов:1)

Загрузка ...

Эксперт

Профиль
Группа: Участник
Сообщений: 1108
Регистрация: 6.10.2006

Репутация: 10
Всего: 80

drkb, поиск. все уже было много-много раз

Poseidon

Дата 23.7.2008, 15:06 (ссылка)

(нет голосов)

Загрузка ...

Delphi developer

Профиль
Группа: Комодератор
Сообщений: 5273
Регистрация: 4.2.2005
Где: Гомель, Беларусь

Репутация: 9
Всего: 133

Цитата(VICTAR @ 23.7.2008, 14:18

)

уже было много-много раз

Вот это уж точно!

Код


unit Not2Run;

interface

uses
    Windows
  , SysUtils
  , Forms
  ;

procedure CheckOneInstance(const ApplicationName: String);
 // Проверяет что программа с идентификатором ApplicationName уже запущена.
 // Если это так, то предыдущий экземпляр "выталкивается" на поверхность и
 // выполняется Halt(1)

type
{ WIN32 Helper Classes }

{ tHandledObject }

  tHandledObject = class(tObject)
  protected
    fName  : String;
    fHandle: tHandle;
    fCreated: Boolean;
    procedure SetHandle(const aName :String; aHandle: tHandle);
    procedure ErrorCreate;
  public
    destructor Destroy; override;
    property Name: string read fName;
    property Handle: tHandle read fHandle;
    property Created: Boolean read fCreated;
  end;

{ tSharedMem }

  tSharedMem = class(tHandledObject)
  private
    fSize: Integer;
    fDataPtr: Pointer;
  public
    constructor Create(const aName: string; aSize: Integer);
    destructor Destroy; override;
    property Size: Integer read fSize;
    property DataPtr: Pointer read fDataPtr;
  end;

type
  eSharedResources = class(Exception);

implementation

{ tHandledObject }

destructor tHandledObject.Destroy;
begin
  if fHandle <> 0 then CloseHandle(fHandle);
end;

procedure tHandledObject.ErrorCreate;
begin
  raise eSharedResources.Create(Format('Ошибка создания %s(%s):'^M^J'%s',[ClassName,fName,SysErrorMessage(GetLastError)]));
end;

procedure tHandledObject.SetHandle(const aName :String; aHandle: tHandle);
begin
  fName:= aName;
  if aHandle = 0 then ErrorCreate;
  fHandle:= aHandle;
  fCreated:= GetLastError = 0;
end;

{ tSharedMem }

constructor tSharedMem.Create(const aName: string; aSize: Integer);
begin
  fSize:= aSize;
  SetHandle(aName,CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, aSize, PChar(aName)));
  fDataPtr := MapViewOfFile(fHandle, FILE_MAP_WRITE, 0, 0, aSize);
  if fDataPtr = nil then ErrorCreate;
end;

destructor TSharedMem.Destroy;
begin
  if fDataPtr <> nil then UnmapViewOfFile(fDataPtr);
  inherited Destroy;
end;

var
  FirstInstance :tSharedMem;

procedure CheckOneInstance(const ApplicationName: String);
 // Проверяет что программа с идентификатором ApplicationName уже запущена.
 // Если это так, то предыдущий экземпляр "выталкивается" на поверхность и
 // выполняется Halt(1)
var HPtr: pHandle;
begin
  FirstInstance:= tSharedMem.Create('Alex&Co_FirstInstace_'
       +AnsiUpperCase(StringReplace(ApplicationName,'\','/',[rfReplaceAll])),
                                         SizeOf(Application.Handle));
  HPtr:= pHandle(FirstInstance.DataPtr);
  if HPtr^ = 0  then  // это первый экземпляр программы в памяти?
    HPtr^:= Application.Handle  //да
  else begin  // нет, не первый. Вытащим первый на поверхность
    if IsIconic(HPtr^) then ShowWindow(HPtr^, SW_RESTORE);
    SetForegroundWindow(HPtr^);
    Halt(1); // и отваливаем
  end;
end;

initialization

finalization
  if FirstInstance <> nil then FirstInstance.Free;
end.




program Project1;

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

{$R *.res}

begin
  // Запущена или нет уже программа
  CheckOneInstance('Name_Program');
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.







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;
     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;

Цитата(Alexzz @ 23.7.2008, 14:15

)

Не буду вдаваться в подробности работы программы, но она не рассчитана на многопользовательский доступ к файлам, и второй дубль программы вызвал большую неразбериху в базе данных.

Я так же не хочу вдаваться в подробности, но все же лучше было бы проверять целостность и неизменность данных перед записью. Мало ли что? Может не твоя программа, а еще чья что-то там накуралесит.

--------------------

Если хочешь, что бы что-то работало - используй написанное,
если хочешь что-то понять - пиши сам...

Felan

Дата 24.7.2008, 07:03 (ссылка)

(голосов:1)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 284
Регистрация: 2.8.2007
Где: Самара

Репутация: 2
Всего: 7

Есть еще такой вариант.
http://forum.sources.ru/index.php?showtopi...t&p=1207290

--------------------

// Любая сложная система - это темный лес. Каждый в этом лесу протаптывает свои тропинки, по ним и бегает. Лишь изредка, сходя с них, мы находим много интересного, а порою и страшного.

Alexzz

Дата 24.7.2008, 07:46 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 87
Регистрация: 9.4.2007
Где: Латвия

Репутация: 1
Всего: 1

Цитата(Felan @ 24.7.2008, 07:03)

Есть еще такой вариант.
http://forum.sources.ru/index.php?showtopi...t&p=1207290

Спасибо!
Использовал первый вариант по ссылке, всё работает.

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Для новичков \| Следующая тема »