VPF::Запрет запуска дубля программы

mmv

Дата 7.2.2004, 01:16 (ссылка)

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

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 31
Регистрация: 28.1.2004
Где: г. Воронеж

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

Как запретить запуск дубля программы, не используя переменную THandle? Дело в том, что в моем приложении есть splash-заставка, использующая Application.ProcessMessages.

<Spawn>

Дата 7.2.2004, 06:56 (ссылка)

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

Загрузка ...

Око кары:)

Профиль
Группа: Экс. модератор
Сообщений: 2776
Регистрация: 29.1.2003
Где: Екатеринбург

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

Открой *.dpr своего проекта и ищи копию своей программы, например, используя FindWindow или Мьютексы(CreateMutex, OpenMutex и т.д.) в зависимости от результатов этих функций разрешай\запрещай запуск своей проги. Вот пример(*.dpr):

Код


 const
   MUTEX_NAME = 'Some_Mutex_Name';
 var
  hMutex: THandle;
begin
  hMutex := CreateMutex(nil, False, MUTEX_NAME);
  if GetLastError = ERROR_ALREADY_EXISTS then
    Halt;
...

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

"Для некоторых людей программирование является такой же внутренней потребностью, подобно тому, как коровы дают молоко, или писатели стремятся писать" - Николай Безруков.

Medved

Дата 7.2.2004, 11:02 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 7209
Регистрация: 15.9.2002
Где: Kazakhstan, Astan a

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

Еще один вариант:

Код


var
  CheckEvent: TEvent;

begin
  CheckEvent := TEvent.Create(nil, false, true, 'MYPROGA_N1_CHECKEXIST');
  if CheckEvent.WaitFor(10) <> wrSignaled then
  begin
    Application.Terminate;
  end;
end;

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

http://extreme.sport-express.ru/
...и неважно сколько падал, важно сколько ты вставал...

Illusion Dolphin

Дата 7.2.2004, 11:19 (ссылка)

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

Загрузка ...

Эксперт

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

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

Или же через семафары...

procedure dontruntwo(sSemaphore_name : string);
var hSemaphore:thandle;
begin
hSemaphore := CreateSemaphore( nil, 0, 1, pchar(name) );
IF ((hSemaphore <> 0) and (GetLastError = ERROR_ALREADY_EXISTS)) THEN
BEGIN
CloseHandle(hSemaphore);
Halt;
end;
end;

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

В мире всего две бесконечности: вселенная и человеческая глупость... На счёт вселенной я не уверен.
Шифрование и организация фотографий - Photo Database 4.5

GORI

Дата 22.1.2006, 15:07 (ссылка)

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

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 23
Регистрация: 29.10.2005
Где: Ukraine, Kharkov

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

Да способы хороши, но у меня тоже присутствует splash заставка и программа является редактором с MDI.
Мне бы еще параметры запуска передавать... имя файла например

Max111

Дата 22.1.2006, 19:52 (ссылка)

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

Загрузка ...

Новичок

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

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

Доброе утро,

Так речь то об файле проекта

если в нем поставить следующее

begin

// регистрация широковещательного сообщения

GroupManager.FM_MESSAGE_TO_FOX_COPY := RegisterWindowMessage('MyMessageToFox');
GroupManager.FM_TERMINATE_ID := RegisterWindowMessage('TerminateTests');

CreateFileMapping($FFFFFFFF,Nil,PAGE_READONLY,0,1,VERSION_NAME);
If GetLastError<>ERROR_ALREADY_EXISTS Then
Begin
// создание и прокрутка заставки

Form7 := TForm7.Create(Application);
Form7.Caption:=VERSION_NAME;
Form7.Show;
Form7.Update;

Else If GetLastError=ERROR_ALREADY_EXISTS Then
Begin
// посылка сообщения предыдущей копии открыть новый файл
VerifyofNextCopy;
End;

andrey_pst

Дата 22.1.2006, 20:10 (ссылка)

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

Загрузка ...

Новичок

Профиль
Группа: Awaiting Authorisation
Сообщений: 37
Регистрация: 24.4.2003
Где: Пермь

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

через мутекс:

в файле *.dpr пишем

Код


program ...;

uses
  OneHinst in 'OneHinst.pas',
  Forms,
  Controls,
  Main in 'Main.pas' {F_Main},
...

{$R *.res}

begin
   Application.Initialize;
   Application.CreateForm(TF_Main, F_Main);
   ...
   Application.Run;
end.

в uses GTHDJQ строкой должен быть модуль OneHinst

а вот и сам модуль:

Код


unit OneHinst;

interface

implementation

uses Windows;

var
  Mutex: THandle;

function StopLoading : boolean;
begin
  Mutex := CreateMutex(nil, false, 'myprogramm');
  Result := (Mutex = 0) or                          // Если мьютекс не удалось создать
            (GetLastError = ERROR_ALREADY_EXISTS);  // Если мьютекс уже существует
end;

initialization

  if StopLoading then begin
    MessageBox(0, 'Программа "Моя программа" уже запущена', 'Ошибка', MB_OK+MB_ICONSTOP);
    halt;
  end;

finalization

  if Mutex <> 0 then
    CloseHandle(Mutex);

end.

Akella

Дата 23.1.2006, 09:12 (ссылка)

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

Загрузка ...

Творец

Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

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

в файле dpr (меню Project->View Source)

Код


program SuperMarket;

uses
  Forms,
  Controls,
  Windows,
  SysUtils,
  Dialogs,
  uMain in 'uMain.pas' {fmMain},
  uDM in 'uDM.pas' {DM: TDataModule},
  uPass in 'uPass.pas' {fmPass},
  uChange in 'uChange.pas' {fmChange},
  uThreadBarCode in 'uThreadBarCode.pas',
  uCommon_ComPort in 'uCommon_ComPort.pas',
  uPreferences in 'uPreferences.pas' {fmPreferences},
  uFiskalRegInfo in 'uFiskalRegInfo.pas' {fmFiscalRegInfo},
  uCustomSelect in 'uCustomSelect.pas' {fmCustomSelect},
  uOnly_One in 'uOnly_One.pas',
  uDate in 'uDate.pas' {fmDate};

{$R *.RES}

//----------------------------------------------------------
//--------обрати внимание на это------------------
const
  UniqueString = 'SuperMarketMutex';
    {Может быть любое слово. Желательно латинскими буквами.Желательно уникальное}

Var
 hw : THandle;

//-------------------------------------------------------------


function Logon: Boolean;
begin
  fmPass := TfmPass.Create(Application);
  if ParamStr(1) = ''
  then
    Result :=  fmPass.Logon = mrOk
  else
    Result := fmPass.Logon2 = mrOk;
end;


begin
//----------------------------------------------------------
//--------обрати внимание на это------------------

 //проверка запуска программы
 //если запущена, то выводим на передний план
 if not init_mutex(UniqueString) then
 begin
   hw := findWindow('TApplication','Название приложения');
{Обрати внимание, что "Название приложения" нужно взять НЕ из
заголовка главного окна, а именно название приложения, т.е. ищи в Project->Options}
   if hw <> 0 then
   begin
     setForeGroundWindow(hw);
     ShowWindow(hw,SW_SHOWNORMAL);
    end;
   exit; {Выходим до инициализации, если мьютекс уже есть}
 end;
//------------------------------------------------------------------------------------------------
  Application.Initialize;
  Application.Title := 'Супермаркет';
  Application.HelpFile := 'sm.chm';
  Application.CreateForm(TDM, DM);
  if not Logon then
  begin
//    FreeAndNil(DM);
    Application.Terminate;
  end;
  dm.UpdateActiveStore;
  Application.CreateForm(TfmMain, fmMain);
  Application.CreateForm(TfmShow, fmShow);
  Application.Run;
end.

а теперь добавляем модуль в проект, просто дабавляем

Код


unit uOnly_One;

{
Особенности:
1. даже при "гибели" приложения все, относящиеся к нему мьютексы удаляются
с большой степенью вероятности.
2. Желательно "отметить" приложение в системе так, как указано в примере.
При таком подходе Ваше приложение почти со стапроцентной вероятностью
не будет запущено два раза.
}
interface

function Init_Mutex(mid: string): boolean;

implementation

uses Windows;

var
  mut: thandle;

function mut_id(s: string): string;
var
  f: integer;
begin
  result := s;
  for f := 1 to length(s) do
    if result[f] = '\' then
      result[f] := '_';
end;

function Init_Mutex(mid: string): boolean;
begin
  Mut := CreateMutex(nil, false, pchar(mut_id(mid)));
  Result := not ((Mut = 0) or (GetLastError = ERROR_ALREADY_EXISTS));
end;

initialization
  mut := 0;
finalization
  if mut <> 0 then
    CloseHandle(mut);
end.

Akella

Дата 23.1.2006, 09:46 (ссылка)

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

Загрузка ...

Творец

Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

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

Цитата(GORI @ 22.1.2006, 15:07

)

Мне бы еще параметры запуска передавать... имя файла например

по правилам форума - это нужно тебе создавать в новой теме, а лучше воспользоваться поиском, но... иногдап можно пошалить smile

Код


procedure TForm2.FormCreate(Sender: TObject);
Var
 i:integer;
begin
  //т.к. Params(0) - это путь и имя эксешника (C:\Folder\Maprog.exe), то пропускаем
//начнём с единицы, а не с нуля
  for I := 1 to ParamCount do
  begin

    //первый символ параметра удалить т.к. обычно параметры передают с - или /
    //можно ещё и проверку сделать
    system.Delete(ParamStr(i),1,1);
    if AnsiUpperCase(ParamStr(i)) = 'PARAM1' then
    procedure1;

    if AnsiUpperCase(ParamStr(i)) = 'PARAM2' then
    procedure2;

  end;


end;

Добавлено @ 09:49

Цитата(mmv @ 7.2.2004, 01:16

)

у меня тоже есть... ну не заставка, а форма логина...
проверь сначала
ведь это дискриптор приложения, а не главной формы

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