Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Войти
 
Страницы: 1
RSS
тема про Vista Win 7 и мюйтексы в них, может кому не жалко коротенький примерчик желательно на Delphi но можно и на С++
 
Перекопала кучу примеров в сети, хотела бы спросить практиков, кто нибудь писал программы с использованием Mutex под вистообразное чудовище, под XP все замечательно работает а вот под Vista тормозит, зла нехватает просто!!

Если кому то приходилось програмировать задачи с использованием этих конструкций не могли бы кинуть кусочек кода касающегося ньансов написания.
 
Cобственно неплохо был бы конкретизировать.
1) Тормозит всё-таки под Vista или Win 7?
2) Почему обвиняются именно мьютексы? Профилирование проводилось?
3) Исходник в студию.

Пока что могу лишь посоветовать, что если синхронизация идёт только в рамках одного процесса - никогда не используйте мьютексы. Только критические секции.
 
Код

program _Serv;


uses
  Windows,
  WinSvc,
  SysUtils,
  Utils   in 'Utils.pas',
  
  mTree   in 'mTree.pas';

Const MutexName     = 'ServiceMutex';
Const c_ServiceName = '_SystemProtect';

{*********************************}

var hMutex : THandle;

{********************************}

var DispatchTable : array [0..1] of _SERVICE_TABLE_ENTRYA;
var sst           : SERVICE_STATUS;
var sstHandle     : SERVICE_STATUS_HANDLE;
var ss            : _SERVICE_STATUS;
var mst           : array [0..177] of Byte;

///////////////////////////////////////////////////////////////////////

procedure SetServiceStatus1;
begin
  if not SetServiceStatus(sstHandle,sst) then
  RaiseLastOSError;
end;

///////////////////////////////////////////////////////////////////////

procedure ServiceCtrlHandler(Opcode : Cardinal);stdcall;
begin
 case Opcode of

  SERVICE_CONTROL_STOP:
   begin
    sst.dwWin32ExitCode :=0;
    sst.dwCurrentState  := SERVICE_STOPPED;
    sst.dwCheckPoint    :=0;
    sst.dwWaitHint      :=0;
    SetServiceStatus1;
    exit;
   end;

  SERVICE_CONTROL_INTERROGATE : ;
 end;

 SetServiceStatus1;
end;


///////////////////////////////////////////////////////////////////////



procedure ServiceProc(argc : DWORD;var argv : array of PChar);stdcall;
var
  hMut    : THandle;
begin
  try

  sst.dwServiceType      := SERVICE_WIN32;
  sst.dwCurrentState     := SERVICE_START_PENDING;
  sst.dwControlsAccepted := SERVICE_ACCEPT_STOP;
  sst.dwWin32ExitCode           := 0;
  sst.dwServiceSpecificExitCode := 0;
  sst.dwCheckPoint              := 0;
  sst.dwWaitHint                := 0;

  sstHandle := RegisterServiceCtrlHandler(c_ServiceName,@ServiceCtrlHandler);

  if sstHandle = 0 then RaiseLastOSError;

   sst.dwCurrentState :=SERVICE_RUNNING;
   sst.dwCheckPoint   :=0;
   sst.dwWaitHint     :=0;

   SetServiceStatus1;


    _SendMail('1');

  hMut:=CreateMutex(nil,False,MutexName);

  finally
    begin
      ReleaseMutex(hMut);
      CloseHandle(hMut);
    end;
  end;

  repeat
    Sleep(100);
  until sst.dwCurrentState = SERVICE_STOPPED;

end;

///////////////////////////////////////////////////////////////////////

var
 schService, schSCManager: SC_HANDLE;
 p : PChar = nil;

procedure StartServ();
begin
   schSCManager := OpenSCManager(
   nil,                    // local machine
   nil,                    // ServicesActive database
   SC_MANAGER_ALL_ACCESS);  // full access rights

   if schSCManager=0 then RaiseLastOSError;

   schService := OpenService(
   schSCManager,       // SCManager database
   c_ServiceName,       // name of service
   SERVICE_ALL_ACCESS);

   if schService <> 0 then
     begin
       Winsvc.StartService(schService, 0, p)
     end;
end;


begin
  
  if ParamStr(1) = '-Run' then
    begin

     DispatchTable[0].lpServiceName:=c_ServiceName;
     DispatchTable[0].lpServiceProc:=@ServiceProc;

     DispatchTable[1].lpServiceName:=nil;
     DispatchTable[1].lpServiceProc:=nil;

     if not StartServiceCtrlDispatcher(DispatchTable[0]) then
       RaiseLastOSError;

     exit;
   end;

  if ParamStr(1) = '-Start' then
    begin
      StartServ;
      exit;
    end;

    binExe:=pchar(ParamStr(0) + ' -Run');
    schSCManager := OpenSCManager(
    nil,                    // local machine
    nil,                    // ServicesActive database
    SC_MANAGER_ALL_ACCESS);  // full access rights

    if schSCManager=0 then RaiseLastOSError;

    schService := OpenService(
        schSCManager,       // SCManager database
        c_ServiceName,       // name of service
        SERVICE_ALL_ACCESS);

    if schService <> 0 then
      begin

        if not DeleteService(schService) then
          RaiseLastOSError;

        if not CloseServiceHandle(schService) then
          RaiseLastOSError;
          exit;

      end;

    schService := CreateService(
        schSCManager,              // SCManager database
        c_ServiceName,               // name of service
        c_ServiceName,           // service name to display
        SERVICE_ALL_ACCESS,        // desired access
        SERVICE_WIN32_OWN_PROCESS, // service type
        SERVICE_DEMAND_START,      // start type

        //************* => ERROR IGNORE!!!!

        SERVICE_ERROR_IGNORE,     // DEBUG!!!
        binExe,                   // service's binary
        nil,                      // no load ordering group
        nil,                      // no tag identifier
        nil,                      // no dependencies
        nil,                      // LocalSystem account
        nil);                     // no password



     if schService=0 then
       RaiseLastOSError;

     StartService(schService, 0, p);


     while true do
      begin
        hMut:=CreateMutex(nil,False,MutexName);

        if GetLastError <> ERROR_ALREADY_EXISTS then
          begin
            ReleaseMutex(hMut);
            CloseHandle(hMut);
            break;
          end;

      end;

     Winsvc.ControlService(schService,SERVICE_CONTROL_STOP,SS);
     DeleteService(schService);

     if not CloseServiceHandle(schService) then
       RaiseLastOSError;
end.

 
Нада ожидать отправку письма после которой нада останавливать и удалять службу из списка. А выгрузка не происходит.

Только критические секции не вариант.
Может pipe? подойдет?
 
Мьютексы никто так не использует.
Читать про события в Рихтере. Подозреваю, что получиться нечто подобное:

Код
// в главной программе
StartService(schService, 0, p);
h_event = CreateEvent(psa, TRUE, FALSE, "xxxevent");
WaitForSingleObject(h_event);
DeleteService(schService);
Winsvc.ControlService(schService,SERVICE_CONTROL_STOP,SS); 
DeleteService(schService); 
if not CloseServiceHandle(schService) then 
   RaiseLastOSError;


Код
// в ServiceProc
h_event = CreateEvent(psa, TRUE, FALSE, "xxxevent");
_SendMail('1');
SetEvent(h_event);


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

P.S. Я бы ещё посмотрел в сторону QueryServiceStatusEx().
Изменено: Soldier of Fortune - 21.02.2010 15:17:30
Страницы: 1
Читают тему