Форум программистов [Powered by Invision Power Board]

Код


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.

Код


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.

Код


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.

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

)

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

Код


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;

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

)

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