| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Один инстанс

Страницы:   < 1 2 >

vecna ©   (2004-07-06 15:19:00) 

народ, подкиньте ссылок, где разобраны варианты с не запуском более чем N копий программы одновременно.

---

y-soft   (2004-07-07 15:34:00) [21]

Одно старенькое решение:

http://www.delphimaster.ru/articles/limit.html

Недостаток: не работает, если приложение запускается из разных директорий

unit LimHinst;
//****************************************************************************
// Usage: модуль необходимо указать ПЕРВЫМ в списке uses файла .DPR проекта
// и установить необходимые значения констант HinstLimit и WaitPause.
//****************************************************************************
interface

const
  //Установите необходимые значения!!!
 HinstLimit = 1;
 WaitPause = 50;

implementation
uses
 Windows;
var
 Semaphore : THandle;
 SemaphoreName : array[0..260] of Char;
 IncCnt : integer;

function StopLoading : boolean;
var
 L,I : integer;
begin
 // В качестве уникального имени семафора используем полный путь
 // к исполняемому файлу приложения (по определению уникален!!!)
 L := GetModuleFileName(MainInstance,SemaphoreName,SizeOf(SemaphoreName));
 // В имени семафора нельзя использовать обратные слэши, поэтому
 // заменяем их на прямые (или еще на что-нибудь кроме #0)
 for I := 0 to L - 1 do
   if SemaphoreName[I] = '\' then
     SemaphoreName[I] := '/';

 Semaphore := CreateSemaphore(nil,HinstLimit,HinstLimit,SemaphoreName);

 Result := (Semaphore = 0) or // Если семафор не удалось создать
 (WaitForSingleObject(Semaphore,WaitPause) <> WAIT_OBJECT_0); // Если семафор занят
end;

procedure ShowErrMsg;
const
 PROGRAM_ALREADY_RUN = 'Лимит исчерпан';

begin
MessageBox(0, PROGRAM_ALREADY_RUN, SemaphoreName, MB_ICONSTOP or
MB_OK);
end;

initialization
 IncCnt := 0;
 if StopLoading then
 begin
   ShowErrMsg;
   halt;
 end
 else
   IncCnt := 1;
finalization
 if Semaphore <> 0 then
 begin
   ReleaseSemaphore(Semaphore, IncCnt, nil);
   CloseHandle(Semaphore);
 end;
end.

---

KADAN   (2004-07-07 15:32:00) [22]

> evvcom ©   (07.07.04 15:24) [14]

> А если приложение еще не создало очередь и не может принимать
> сообщение?

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

---

Игорь Шевченко   (2004-07-07 15:25:00) [23]

Кстати, буквально сегодня встала задача ограничить число одновременно работающих экземпляров приложения до некоторого числа (связано с ограничениями серверов, с которыми это приложение соединяется).

Сделали очень просто:

var
 SemHandle: THandle;
.....
 SemHandle := CreateSemaphore (nil, MaxInstanceCount, MaxInstanceCount, SGlobalSemaphoreName);
 if SemHandle = 0 then
   RaiseLastWin32Error;
 WaitForSingleObject(SemHandle, INFINITE);
 try
..... код приложения ....
 finally
   ReleaseSemaphore(SemHandle, 1, nil);
   CloseHandle(SemHandle);
 end;

---

evvcom   (2004-07-07 15:24:00) [24]

> KADAN ©

А если приложение еще не создало очередь и не может принимать сообщение? Однозначно такие задачи - через глобальные объекты синхронизации, для этого случая лучше семафор.

---

KADAN   (2004-07-07 14:59:00) [25]

ну тады тока семафорами... или делать processmessages в "тяжелых" местах программы.

---

NAlexey   (2004-07-07 14:55:00) [26]

>KADAN ©   (07.07.04 14:52) [11]
Ну так, хм... А если один из экземляров приложений в данный момент занят какими нибудь расчетами, и не может ответить?

---

KADAN   (2004-07-07 14:52:00) [27]

вообще-то это правда делается семафорами, хотя еще можно через сообщения. Прога запускается делает BroadCast всем приложениям, типа "есть ли здесь такие же как я?", а те ей отвечают: "тута мы". а она считает скока их накопилось уже, и если много - тогда завершается... аварийно... :)

---

NAlexey   (2004-07-07 13:57:00) [28]

У себя я сделал так:

 
 PInstanceData = ^TInstanceData;
 TInstanceData = record
   Handle: HWND;
   UserName: string[255];
   SysDBName: string[255];
   DocDBName: string[255];
 end;

 PInstancesData = ^TInstancesData;
 TInstancesData = record
   InstancesCount: Integer;
   Instances: array[0..255] of TInstanceData;
 end;

function SameInstanceExists(const UserName: string): boolean;

var
 MapFile: THandle;
 InstancesData: PInstancesData;

const
 INSTANCES_LIST_NAME = 'INSTANCES_LIST';

procedure MapFileMemory;
var
 ZeroMem: boolean;
begin
 MapFile := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0,
    SizeOf(TInstancesData), INSTANCES_LIST_NAME);
 if (MapFile = 0) then
 begin
   MessageBox(Application.Handle, 'Could not create file map object.',
     'Ошибка', MB_OK);
 end else begin
   ZeroMem := GetLastError <> ERROR_ALREADY_EXISTS;
   InstancesData := MapViewOfFile(MapFile, FILE_MAP_ALL_ACCESS, 0, 0,
      SizeOf(TInstancesData));
   if (InstancesData = nil) then
   begin
     CloseHandle(MapFile);
     MessageBox(Application.Handle, Could not map file.',
       'Ошибка', MB_OK);
   end else if ZeroMem then
     FillChar(InstancesData^, SizeOf(TInstancesData), #0);
 end;
end;

procedure UnmapFileMemory;
begin
 if (InstancesData <> nil) then
 begin
   UnMapViewOfFile(InstancesData);
   InstancesData := nil;
 end;

 if (MapFile <> 0) then
 begin
   CloseHandle(MapFile);
   MapFile := 0;
 end;
end;

procedure AddCurrInstance(const UserName: string);
var
 CurrInstance: TInstanceData;
begin
 if (InstancesData <> nil) then
 begin
   FillChar(CurrInstance, SizeOf(TInstanceData), #0);
   CurrInstance.Handle := Application.Handle;
   CurrInstance.UserName := UserName;
   CurrInstance.SysDBName := SystemAlias;
   CurrInstance.DocDBName := DataAlias;
   InstancesData^.Instances[InstancesData^.InstancesCount] := CurrInstance;
   Inc(InstancesData^.InstancesCount);
 end;
end;

procedure RemoveInstance(Wnd: HWND);
var
 I: integer;
begin
 if (InstancesData <> nil) then
   for I := 0 to InstancesData^.InstancesCount - 1 do
     if InstancesData^.Instances[I].Handle = Wnd then
     begin
       if I < InstancesData^.InstancesCount - 1 then
         Move(InstancesData^.Instances[I + 1], InstancesData^.Instances[I],
            (InstancesData^.InstancesCount - I - 1) * SizeOf(TInstanceData));
       Dec(InstancesData^.InstancesCount);
       Break;
     end;
end;

function SameInstanceExists(const UserName: string): boolean;
var
 I: Integer;
begin
 Result := False;
 MapFileMemory;
 if (InstancesData <> nil) then
 begin
   with InstancesData^ do
   begin
     for I := 0 to InstancesData^.InstancesCount - 1 do
       if (AnsiUpperCase(InstancesData^.Instances[I].UserName) = AnsiUpperCase(UserName)) and
         (InstancesData^.Instances[I].SysDBName = SystemAlias) and
         (InstancesData^.Instances[I].DocDBName = DataAlias)
       then begin
         Result := True;
         MessageBox(Application.Handle, PChar('Пользователь с именем "' + UserName +
           '" уже подключен к базам "' + SystemAlias + '" и "' + DataAlias + '".'),
           'Ошибка', MB_OK or MB_ICONEXCLAMATION);
         Exit;
       end;
   end;
   AddCurrInstance(UserName);
 end;
end;

function SameInstanceExists(const UserName: string): boolean;
var
 I: Integer;
begin
 Result := False;
 MapFileMemory;
 if (InstancesData <> nil) then
 begin
   with InstancesData^ do
   begin
     for I := 0 to InstancesData^.InstancesCount - 1 do
       if (AnsiUpperCase(InstancesData^.Instances[I].UserName) = AnsiUpperCase(UserName)) and
         (InstancesData^.Instances[I].SysDBName = SystemAlias) and
         (InstancesData^.Instances[I].DocDBName = DataAlias)
       then begin
         Result := True;
         MessageBox(Application.Handle, PChar('Пользователь с именем "' + UserName +
           '" уже подключен к базам "' + SystemAlias + '" и "' + DataAlias + '".'),
           'Ошибка', MB_OK or MB_ICONEXCLAMATION);
         Exit;
       end;
   end;
   AddCurrInstance(UserName);
 end;
end;


---

evvcom   (2004-07-07 11:22:00) [29]

> каким образом мутексами модно добиться запуска не более
> 3-х экземпляров программы

В цикле искать свободный из 3-х. :))) Явно здесь семафор удобнее.

---

cae   (2004-07-07 11:05:00) [30]

Я делал через EnumWindows (несколько для других целей)

---

Игорь Шевченко   (2004-07-07 10:47:00) [31]

OSokin   (06.07.04 21:19) [5]


> Да можно и не только семафором, но и мутексами


Мне было бы очень интересно узнать, каким образом мутексами модно добиться запуска не более 3-х экземпляров программы

---

DeadMeat   (2004-07-06 21:49:00) [32]

> можно осознать есть копия или нет, а сколько их запушено?

Дж. Рихтер, "Windows для профессионалов", стр. 417. Там описание программы AppInst. Чуть назад принцип её работы... Насколько понял, там надо работать с заголовком *.EXE файла...

---
...Death Is Only The Begining...

---

OSokin   (2004-07-06 21:19:00) [33]

Да можно и не только семафором, но и мутексами.

---

Тимохов   (2004-07-06 16:17:00) [34]

> оповешения ранее созданых инстансов что добавился еще один

про это вы и не спрашивали.
> для каждого приложения придумывать уникальную строку - это
> плохо,

у вас с этим проблемы? guid не подойдет.

действительно, вмето mutex используейте самафор и нормально будет.

---

vecna   (2004-07-06 16:14:00) [35]

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

---

Игорь Шевченко   (2004-07-06 16:13:00) [36]

Тимохов ©   (06.07.04 15:21)


>  с не запуском более чем N копий программы одновременно.


Эт тогда семафор

---

Тимохов   (2004-07-06 15:21:00) [37]

www.delphimaster.ru + фак
поиск createmutex

---

Страницы:   < 1 2 >

Наверх