Модераторы: Snowy, bartram, MetalFan, bems, Poseidon, Riply

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> ShellExecute из сервиса, неизвестное программное исключение 
V
    Опции темы
Cashey
Дата 21.7.2008, 16:34 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бессмертный
****


Профиль
Группа: Завсегдатай
Сообщений: 3441
Регистрация: 13.11.2002
Где: в столице

Репутация: нет
Всего: 60
смысл примерно такой
Код

procedure TRunAgent.ServiceStart(Sender: TService; var Started: Boolean);
begin
  ThrTimer := TThreadTimer.Create(True);
  ThrTimer.FreeOnTerminate := True;
  try
    Started := True;
  except
    ThrTimer.Terminate;
    Started := False;
  end;
  ThrTimer.Resume;
end;

procedure TThreadTimer.Execute;
var
nExe : Cardinal;
begin
  while not Terminated do
  begin
  nExe := 0;
    try
      nExe := ShellExecute({ThrTimer.Handle}0,nil,'<путь к файлу>.exe',nil,nil,SW_RESTORE);
      Sleep(5000);
    except
 //   MessageBox(0, pchar('Ошибка запуска № '+inttostr(nExe)), 'Ошибка сервиса', MB_OK);
    end;
  end;
end;


но при запуске из менеджера сервисов генерится ошибка - Неизвестное программное исключение.
предпологаю, что не нравится хэндл для ShellExecute.
И паралельно вопрос, есть ли в Дельфи команда для запуска на исполнение внешнего файла, иная чем апишная ShellExecute?


--------------------
библия учит любить ближнего, а камасутра обучает как именно
PM Jabber   Вверх
Qu1nt
Дата 21.7.2008, 16:51 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 5
Всего: 50
WinExec, CreateProcess...
PM MAIL   Вверх
CodeMonkey
Дата 21.7.2008, 18:31 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1839
Регистрация: 24.6.2008
Где: Россия, Тверь

Репутация: 16
Всего: 89
А чего вы хотите достичь такой странной конструкцией?


--------------------
Опытный программист на C++ легко решает любые не существующие в Паскале проблемы.
PM MAIL WWW ICQ Skype GTalk Jabber   Вверх
Virtuals
Дата 22.7.2008, 05:39 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 4
Всего: 11
Код

//------------------------------------------------------------------------------
function Start(const CmdLine: string; Visibility : integer;winsta,dsk:pchar): integer;
var
   zCmdLine:array[0..512] of char;
   zCurDir:array[0..255] of char;
   WorkDir:String;
   StartupInfo:TStartupInfo;
   ProcessInfo:TProcessInformation;
//   r: DWord;
begin
   StrPCopy(zCmdLine,CmdLine);
   GetDir(0,WorkDir);
   StrPCopy(zCurDir,WorkDir);
   FillChar(StartupInfo,Sizeof(StartupInfo),#0);
   StartupInfo.cb := Sizeof(StartupInfo);
   StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
   StartupInfo.wShowWindow := Visibility;
   StartupInfo.lpDesktop:=PChar(WinSta+'\'+dsk);
   StartupInfo.lpTitle:= PChar('SYSTEM');
   if not CreateProcess(
      nil,
      zCmdLine,                      { pointer to command line string }
      nil,                           { pointer to process security attributes}
      nil,                           { pointer to thread security attributes }
      false,                         { handle inheritance flag }
      {CREATE_NEW_CONSOLE or}          { creation flags }
      NORMAL_PRIORITY_CLASS,
      nil,                           { pointer to new environment block }
      nil,                           { pointer to current directory name }
      StartupInfo,                   { pointer to STARTUPINFO }
      ProcessInfo) then Result := -1 { pointer to PROCESS_INF }
   else
   begin

//исправленно по просьбе Riply, для будущих поколений  :crazy 
      CloseHandle(ProcessInfo.hThread);
      CloseHandle(ProcessInfo.hProcess);
      Result := 0;

{      CloseHandle(ProcessInfo.hThread);
      WaitforSingleObject(ProcessInfo.hProcess,INFINITE);
      CloseHandle(ProcessInfo.hProcess);
      GetExitCodeProcess(ProcessInfo.hProcess,r);}
//      Result := ProcessInfo.hProcess;
   end;
end;
//------------------------
procedure CreateX;
begin
 Start(cMmd, SW_SHOWNORMAL,CreateProcDEFWINSTATION,CreateProcDEFDESKTOP);
end;

//================
function MainServiceThread(p:Pointer):DWORD;stdcall;
begin
SleepEx(500,ServiceStatus.dwCurrentState = SERVICE_STOPPED);
CreateX;
repeat
SleepEx(100,ServiceStatus.dwCurrentState = SERVICE_STOPPED);
until ServiceStatus.dwCurrentState = SERVICE_STOPPED;
result:=0;
ExitThread(0);
end;

//================
procedure ServiceCtrlHandler(Opcode : Cardinal);stdcall;
//var
// Status : Cardinal;
begin
 case Opcode of
  SERVICE_CONTROL_PAUSE    :
   begin
    ServiceStatus.dwCurrentState := SERVICE_PAUSED;
    SuspendThread(hThread); // приостанавливаем поток
   end;
  SERVICE_CONTROL_CONTINUE :
   begin
    ServiceStatus.dwCurrentState := SERVICE_RUNNING;
    ResumeThread(hThread); // возобновляем поток
   end;
  SERVICE_CONTROL_STOP     :
   begin
    ServiceStatus.dwWin32ExitCode:=0;
    ServiceStatus.dwCurrentState := SERVICE_STOPPED;
    ServiceStatus.dwCheckPoint   :=0;
    ServiceStatus.dwWaitHint     :=0;

    if not SetServiceStatus (ServiceStatusHandle,ServiceStatus)
     then begin
   ERRLog('*'+SysErrorMessage(GetLastError));
      Exit;
     end;
     exit;
   end;

  SERVICE_CONTROL_INTERROGATE : ;
 end;

 if not SetServiceStatus (ServiceStatusHandle, ServiceStatus)
  then begin
   ERRLog('*'+SysErrorMessage(GetLastError));
   Exit;
  end;
end;
//================
procedure ServiceProc(argc : DWORD;var argv : array of PChar);stdcall;

begin
  ServiceStatus.dwServiceType      := SERVICE_WIN32;
  ServiceStatus.dwCurrentState     := SERVICE_START_PENDING;
  ServiceStatus.dwControlsAccepted := SERVICE_ACCEPT_STOP
    or SERVICE_ACCEPT_PAUSE_CONTINUE;
  ServiceStatus.dwWin32ExitCode           := 0;
  ServiceStatus.dwServiceSpecificExitCode := 0;
  ServiceStatus.dwCheckPoint              := 0;
  ServiceStatus.dwWaitHint                := 0;

  ServiceStatusHandle := 
           RegisterServiceCtrlHandler(ServiceName,@ServiceCtrlHandler);
  if ServiceStatusHandle = 0 then WriteLn('RegisterServiceCtrlHandler Error');

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

   if not SetServiceStatus (ServiceStatusHandle,ServiceStatus)
    then begin
   ERRLog('*'+SysErrorMessage(GetLastError));
     exit;
    end;

hThread:=CreateThread(nil,0,@MainServiceThread,nil,0,ThID);

WaitForSingleObject(hThread,INFINITE);
//закрывая после этого его дескриптор
CloseHandle(hThread);

end;
var NDR:string;
begin
NDR:='0mliackiserv';
if ParamCount=1 then
if pos('INSTAL',UpperCase(ParamStr(1)) )>0 then
 begin
 if not Installdrv(NDR, '"'+ParamStr(0)+'"',SERVICE_WIN32_OWN_PROCESS
                                            or SERVICE_INTERACTIVE_PROCESS,SERVICE_AUTO_START)
 then ERRLog('*'+SysErrorMessage(GetLastError));
 end else
if pos('START',UpperCase(ParamStr(1)) )>0 then
 begin
 if not Startdrv(NDR)
 then ERRLog('*'+SysErrorMessage(GetLastError));
 end else
if pos('STOP',UpperCase(ParamStr(1)) )>0 then
 begin
if not Stopdrv(NDR)
 then ERRLog('*'+SysErrorMessage(GetLastError));
 end else
if pos('DELETE',UpperCase(ParamStr(1)) )>0 then
 begin
if not DeInstalldrv(NDR)
 then ERRLog('*'+SysErrorMessage(GetLastError));
 end else
 begin
 DispatchTable[0].lpServiceName:=ServiceName;
 DispatchTable[0].lpServiceProc:=@ServiceProc;
 DispatchTable[1].lpServiceName:=nil;
 DispatchTable[1].lpServiceProc:=nil;
 if not StartServiceCtrlDispatcher(DispatchTable[0])
  then ERRLog('StartServiceCtrlDispatcher Error');
 end else
  begin
 DispatchTable[0].lpServiceName:=ServiceName;
 DispatchTable[0].lpServiceProc:=@ServiceProc;
 DispatchTable[1].lpServiceName:=nil;
 DispatchTable[1].lpServiceProc:=nil;
 if not StartServiceCtrlDispatcher(DispatchTable[0])
  then ERRLog('StartServiceCtrlDispatcher Error');
 end;
end.




ну вот так работать будет, почему так? ... ну что вспомню:
а. важно:
SleepEx(500,ServiceStatus.dwCurrentState = SERVICE_STOPPED);
CreateX;


Это сообщение отредактировал(а) Virtuals - 22.7.2008, 12:27
PM MAIL ICQ   Вверх
Riply
Дата 22.7.2008, 09:48 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Комодератор
Сообщений: 572
Регистрация: 27.3.2007
Где: St. Petersburg

Репутация: 21
Всего: 32
Цитата(Virtuals @  22.7.2008,  05:39 Найти цитируемый пост)
ну вот так работать будет


Я бы воздержалась от столь сомнительного утверждения smile

P.S.
 Начала смотреть код, и как только увидела, что процедура CreateX исключает всякую возможность
 закрыть после нее открытые Handl`ы, поняла, что дальше можно не смотреть,
 ибо будущий баг профессионально заложен в первых же строчках.  smile 

P.P.S.
 А потом еще спрашивают: "как такое модет быть ? Мой сервис стабильно работает,
 но через (час, день, неделю падает). Ошибок в нем нет, ведь первый час работает !"



--------------------
Решение задач под заказ
PM MAIL   Вверх
Virtuals
Дата 22.7.2008, 10:27 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 4
Всего: 11
Riply, 
это не сомнительное утверждение, а кусок кода из рабочего проекта

 smile 
а мне и ненужно было стабильной работы сервиса, в данном примере реализованно только запустить процесс с правами систем smile 
и открытые Handl`ы мне побарабану были, этож только пример а не готовое прилизанное решение, и в нем хорошо просматриваются многие грабли, на которые нестоит наступать.
ну для примера вот про это многие забывают, почемуто...
Код

CreateProcDEFWINSTATION = 'WinSta0';
CreateProcDEFDESKTOP    = 'winlogon';


StartupInfo.lpDesktop:=PChar(WinSta+'\'+dsk);

а при старте из сервиса, это ой как важно

ЗЫ хотя если честно сервис стабилен и невылетает., имхо у мну принцип - отлаживаю куски в маненьких демках и только после этого переписываю все в проект. smile 

Это сообщение отредактировал(а) Virtuals - 22.7.2008, 10:33
PM MAIL ICQ   Вверх
Riply
Дата 22.7.2008, 10:43 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Комодератор
Сообщений: 572
Регистрация: 27.3.2007
Где: St. Petersburg

Репутация: 21
Всего: 32
Цитата(Virtuals @  22.7.2008,  10:27 Найти цитируемый пост)
а мне и ненужно было стабильной работы сервиса, в данном примере реализованно только запустить процесс с правами систем  
и открытые Handl`ы мне побарабану были, этож только пример а не готовое прилизанное решение


Но надо учитывать, что выложенный тобой пример, кто-то будет использовать при помощи тупого копи/пайста,
поэтому , тогда уж предупреждай: "ребята, мне было лень заниматься уборкой, сделайте это сами".

И еще:
 Мне совершенно непонятно почему все боятся утечки памяти (ловят ее, тратят на это силы),
 и в то же время наплевательски относятся к утечке Handl`ов ?
 Она не менее страшна чем утечка памяти, а может даже и более.
 Просто для получения эффекта от нее должно пройти больше "итераций",
 а память может "переполнится" довольно быстро, если большими кусками smile




--------------------
Решение задач под заказ
PM MAIL   Вверх
Virtuals
Дата 22.7.2008, 11:53 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 4
Всего: 11
Riply, 
так лучше? smile 
Код

...
   else
   begin
      CloseHandle(ProcessInfo.hThread);
      CloseHandle(ProcessInfo.hProcess);
      Result := 0;
   end;
...
PM MAIL ICQ   Вверх
Riply
Дата 22.7.2008, 12:06 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Комодератор
Сообщений: 572
Регистрация: 27.3.2007
Где: St. Petersburg

Репутация: 21
Всего: 32
Цитата(Virtuals @  22.7.2008,  11:53 Найти цитируемый пост)
так лучше?


Угу. Только пусть функция возвращает Boolean (что и получила от CreateProcess), меньше путаницы будет  smile 



--------------------
Решение задач под заказ
PM MAIL   Вверх
Virtuals
Дата 22.7.2008, 12:29 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 4
Всего: 11
Riply, фиг мне так больше нравится smile 
кстати дополнил примерчик ради полноты картины
PM MAIL ICQ   Вверх
Cashey
Дата 22.7.2008, 15:00 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бессмертный
****


Профиль
Группа: Завсегдатай
Сообщений: 3441
Регистрация: 13.11.2002
Где: в столице

Репутация: нет
Всего: 60
Цитата(Riply @  22.7.2008,  11:43 Найти цитируемый пост)
Но надо учитывать, что выложенный тобой пример, кто-то будет использовать при помощи тупого копи/пайста,

я лично всегда разбираю код, а не использую тупое капи\паст smile

Virtuals, не поверишь, но по факту не работает smile
я так понял ты создавал сервис вручную, я же использую TService.

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


--------------------
библия учит любить ближнего, а камасутра обучает как именно
PM Jabber   Вверх
Virtuals
Дата 22.7.2008, 15:13 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 4
Всего: 11
Cashey, а файл точно не запускается? может бонально пути неправильные?
и как это не получается отрейсить? ну понятно что дебуг здесь не в помощь но посмотри внимательно мой пример, и вот те недостающая но нужная часть
 smile  smile  smile 
Код

function SysErrorMessage(ErrorCode: Integer): string;
var
  Len: Integer;
  Buffer: array[0..255] of Char;
begin
  Len := FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM or
    FORMAT_MESSAGE_ARGUMENT_ARRAY, nil, ErrorCode, 0, Buffer,
    SizeOf(Buffer), nil);
  while (Len > 0) and (Buffer[Len - 1] in [#0..#32, '.']) do Dec(Len);
  SetString(Result, Buffer, Len);
end;
function FileIsThere(FileName: string): Boolean;
{ Boolean function that returns True if the file exists; otherwise,
  it returns False. Closes the file if it exists. }
 var
  F: file;
begin
  {$I-}
  AssignFile(F, FileName);
  FileMode := 0;  {Set file access to read only }
  Reset(F);
  CloseFile(F);
  {$I+}
  FileIsThere := (IOResult = 0) and (FileName <> '');
end;  { FileIsThere }

 procedure ERRLog(S:String);
  Var Ft:TextFile;
  begin
    AssignFile(Ft,'c:\LogSSR.log');
if FileIsThere('c:\LogSSR.log')
  then Append(Ft)
  else ReWrite(Ft);
  Writeln(Ft,S);
  close(Ft);
 end;
//==================



ЗЫ если нужно могу весь код скинуть позже...
PM MAIL ICQ   Вверх
Cashey
Дата 22.7.2008, 15:59 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бессмертный
****


Профиль
Группа: Завсегдатай
Сообщений: 3441
Регистрация: 13.11.2002
Где: в столице

Репутация: нет
Всего: 60
Цитата(Virtuals @  22.7.2008,  16:13 Найти цитируемый пост)
Cashey, а файл точно не запускается? может бонально пути неправильные?

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


--------------------
библия учит любить ближнего, а камасутра обучает как именно
PM Jabber   Вверх
Riply
Дата 22.7.2008, 16:12 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Комодератор
Сообщений: 572
Регистрация: 27.3.2007
Где: St. Petersburg

Репутация: 21
Всего: 32
Цитата(Cashey @  22.7.2008,  15:00 Найти цитируемый пост)
я лично всегда разбираю код, а не использую тупое капи\паст 



Cashey,  а я тебя и не имела ввиду, ветка то открыта для всех. Мало ли кто сюда забредет  smile 


--------------------
Решение задач под заказ
PM MAIL   Вверх
CodeMonkey
Дата 22.7.2008, 16:21 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1839
Регистрация: 24.6.2008
Где: Россия, Тверь

Репутация: 16
Всего: 89
Цитата(Virtuals @  22.7.2008,  15:13 Найти цитируемый пост)
ну понятно что дебуг здесь не в помощь

Да ладно.
Компилируем службу с включенной отладочной информацией, включая инфу TD32. Устанавливаем Output Directory в свойствах проекта в ту папку, где у вас лежит установленная служба (C:\Windows\System32?). Отбилдили, службу запустили. Далее в меню Delphi: Run/Attach to Process. Всё. Ставим на паузу, расставляем бряки, потом возобновляем процесс и отлаживаемся.
Вроде ничего не забыл.

Cashey, может быть вы прокомментируете, что вы хотите добиться? Просто запустить процесс из службы? Запустить процесс из службы для какого-то пользователя? Запустить процесс из службы для интерактивного пользователя? Может быть уведомить пользователя о каком-то событии (у меня вызвал подозрение флаг SW_RESTORE)? Что из этого? Или ещё что-то? 
Какая у вас служба? Интерактивная или нет? Под XP или под Vista? Дайте же информацию. 

Если это не является слишком уж большим секретом, то расскажите про свою задачу. Возможно, в этом случае Вы получите более толковый ответ. А то белиберда может получиться. Грубо говоря, если играешь в рулетку, то иметь 36 различных рекомендаций по тому, на какой номер ставить, -- это все равно, что не иметь ни одной © Geo.


--------------------
Опытный программист на C++ легко решает любые не существующие в Паскале проблемы.
PM MAIL WWW ICQ Skype GTalk Jabber   Вверх
Cashey
Дата 22.7.2008, 16:34 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бессмертный
****


Профиль
Группа: Завсегдатай
Сообщений: 3441
Регистрация: 13.11.2002
Где: в столице

Репутация: нет
Всего: 60
Опаньки....
А функция то отробатывается. В Таск Менеджере процесс появляется, но визуально программа не появилась, хотя имеет визуальный интерфейс...


--------------------
библия учит любить ближнего, а камасутра обучает как именно
PM Jabber   Вверх
CodeMonkey
Дата 22.7.2008, 16:37 (ссылка) | (голосов:1) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1839
Регистрация: 24.6.2008
Где: Россия, Тверь

Репутация: 16
Всего: 89
Cashey, не в обиду будет сказано, но, может быть, предварительно стоит почитать что-то про службы? Вот, например, для начала: http://www.delphikingdom.ru/asp/viewitem.asp?catalogid=1348


--------------------
Опытный программист на C++ легко решает любые не существующие в Паскале проблемы.
PM MAIL WWW ICQ Skype GTalk Jabber   Вверх
Cashey
Дата 22.7.2008, 16:38 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бессмертный
****


Профиль
Группа: Завсегдатай
Сообщений: 3441
Регистрация: 13.11.2002
Где: в столице

Репутация: нет
Всего: 60
Цитата(CodeMonkey @  22.7.2008,  17:21 Найти цитируемый пост)
Cashey, может быть вы прокомментируете, что вы хотите добиться? Просто запустить процесс из службы? Запустить процесс из службы для какого-то пользователя? Запустить процесс из службы для интерактивного пользователя? 

конечный смысл такой, служба должна отслеживать запущен ли конкретный файл и если его выгрузили то запустить заново.
Программа при старте сворачивается в трей и мониторит действия пользователя.
Под ХР для текущего пользователя.
в кратце все.

Добавлено через 2 минуты и 4 секунды
Цитата(CodeMonkey @  22.7.2008,  17:37 Найти цитируемый пост)
Cashey, не в обиду будет сказано, но, может быть, предварительно стоит почитать что-то про службы? Вот, например, для начала: http://www.delphikingdom.ru/asp/viewitem.asp?catalogid=1348 

спасибо. сейчас ознакомлюсь...


--------------------
библия учит любить ближнего, а камасутра обучает как именно
PM Jabber   Вверх
CodeMonkey
Дата 22.7.2008, 17:06 (ссылка) | (голосов:1) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1839
Регистрация: 24.6.2008
Где: Россия, Тверь

Репутация: 16
Всего: 89
Вам нужно понимать, чем работа сервиса отличается от работы простого приложения. В частности, хоть немного про то, под каким пользователем что работает, кто такие "сеансы", и чем интерактивный сервис отличается от не-интерактивного.

А после того, как вы это поняли - осознать, что сейчас вы пытаетесь написать криворукого монстра. Я серьёзно, лучше отказаться от этой затеи. Особенно, если учесть, что службы относятся к высоконадёжной доверенной части системы. И любые кривые службы (поверьте, ваша первая будет именно такой) будут очень негативно сказываться на работе всей машине. Видимая простота создания служб в Delphi создаёт впечатление, что создавать службы - легко и просто. Поверьте: это не так.

Я не буду касаться темы unkillable app (просто почитать: http://blogs.msdn.com/oldnewthing/archive/...2/16/73780.aspx , http://blog.delphi-jedi.net/2008/03/17/you...-undestroyable/ ), но скажу, что это действительно неблагодарная тема.

Почему вы думаете, что пользователь не остановит службу? Если ему не дадут это сделать какие-то права, то почему бы не запустить обычное приложение с теми же правами? Тогда пользователь не сможет его закрыть.
Ещё вариант - запуск приложения и его копии. Пусть две копии следят друг за другом.
Под Vista вообще оптимальное решение - использовать новые API ( http://msdn.microsoft.com/en-us/library/bb525421(VS.85).aspx ). Но, правда, это только как защита от вылетов приложения.

Если вам уж так сильно приспичит именно сервис (я действительно рекомендую подумать ещё раз), то попробуйте ещё посмотреть: 
http://www.delphikingdom.ru/table/search.a...B2&Count=50

Это сообщение отредактировал(а) CodeMonkey - 22.7.2008, 17:09


--------------------
Опытный программист на C++ легко решает любые не существующие в Паскале проблемы.
PM MAIL WWW ICQ Skype GTalk Jabber   Вверх
Virtuals
Дата 22.7.2008, 18:25 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 4
Всего: 11
Cashey, 
ну блин какой особенный smile 
Цитата


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

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

а может ну его TService, и ручками? ведь красявше получается и кода кот наплакал.
...
1. между begin и  StartServiceCtrlDispatcher должно пройти минимум времени и тут файловыми операциями лучше не заниматся!

Добавлено через 9 минут и 11 секунд
Cashey, блин а для кого я здесь распинался с 
Код

CreateProcDEFWINSTATION = 'WinSta0';
CreateProcDEFDESKTOP    = 'winlogon';


StartupInfo.lpDesktop:=PChar(WinSta+'\'+dsk);

и еще отдельно пометил про эту постоянную ошибку!!!
нука быстро учить матчасть про столы и оконные станции smile  smile  smile 
а нафига у тя в коде
 
Sleep(5000);

чтобы менеджер сервисов гарантированно неувидел???
Код

Started := True;


Добавлено через 12 минут и 54 секунды
кстати стол пользователя по умолчанию обычно "Default"
PM MAIL ICQ   Вверх
Virtuals
Дата 22.7.2008, 19:11 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 4
Всего: 11
Cashey,
и еще появилось чувство дежавю smile и о точно наш любимый форум сам поискал нужные темки 
а нука пролистни страницу в самый низ и глянь

А здесь смотрели?

особо почитай

Работа с ActiveX из NT сервиса, [?]

да и остальные темы думаю составят интерес.
PM MAIL ICQ   Вверх
Cashey
Дата 23.7.2008, 08:26 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бессмертный
****


Профиль
Группа: Завсегдатай
Сообщений: 3441
Регистрация: 13.11.2002
Где: в столице

Репутация: нет
Всего: 60
Цитата(Virtuals @  22.7.2008,  19:25 Найти цитируемый пост)
CreateProcDEFWINSTATION = 'WinSta0';
CreateProcDEFDESKTOP    = 'winlogon';

что это такое?


--------------------
библия учит любить ближнего, а камасутра обучает как именно
PM Jabber   Вверх
CodeMonkey
Дата 23.7.2008, 09:30 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1839
Регистрация: 24.6.2008
Где: Россия, Тверь

Репутация: 16
Всего: 89
Есть предложение ознакомится с MSDN - Window Stations and Desktops.


--------------------
Опытный программист на C++ легко решает любые не существующие в Паскале проблемы.
PM MAIL WWW ICQ Skype GTalk Jabber   Вверх
Virtuals
Дата 23.7.2008, 10:18 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 4
Всего: 11
Cashey, кто тут давеча хвалился?
Цитата

я лично всегда разбираю код, а не использую тупое капи\паст 


а теперь

function Start(const CmdLine: string; Visibility : integer;winsta,dsk:pchar)

где winsta,dsk это имя_оконной_станции и рабочий_

и после этого станет

CreateProcDEFWINSTATION = 'WinSta0';
CreateProcDEFDESKTOP    = 'winlogon';

Start(cMmd, SW_SHOWNORMAL,CreateProcDEFWINSTATION,CreateProcDEFDESKTOP);
StartupInfo.lpDesktop:=PChar(WinSta+'\'+dsk);

WinSta0\winlogon = 

Цитата

lpDesktop

Windows NT only: Points to a zero-terminated string that specifies either the name of the desktop only or the name of both the window station and desktop for this process. A backslash in the string pointed to by lpDesktop indicates that the string includes both desktop and window station names. Otherwise, the lpDesktop string is interpreted as a desktop name. If lpDesktop is NULL, the new process inherits the window station and desktop of its parent process.


короче место где откроются окошки вашего приложения!!!

WinSta0\winlogon это где ctrl alt del жмете
WinSta0\Default это где юзер жить будет
PM MAIL ICQ   Вверх
Cashey
Дата 23.7.2008, 10:34 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бессмертный
****


Профиль
Группа: Завсегдатай
Сообщений: 3441
Регистрация: 13.11.2002
Где: в столице

Репутация: нет
Всего: 60
Цитата(Virtuals @  23.7.2008,  11:18 Найти цитируемый пост)
WinSta0\Default это где юзер жить будет

во! то что доктор прописал!!!!!!
огромный плюс ))))


--------------------
библия учит любить ближнего, а камасутра обучает как именно
PM Jabber   Вверх
Virtuals
Дата 23.7.2008, 13:41 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 4
Всего: 11
Cashey, и всетаки подучи матчасть о этих волшебных вещах
WINSTATION
DESKTOP
так как чует мое сердце что следующие грабли, на которые наступиш это
че буш делать когда твой сервис уже работает а узер еще не залогинился smile учти что WINSTATION
DESKTOP 
WinSta0\Default будут находится в очень неприятном состоянии smile 
PM MAIL ICQ   Вверх
Страницы: (2) [Все] 1 2 
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: WinAPI и системное программирование"
Snowybartram
MetalFanbems
PoseidonRrader
Riply

Запрещено:

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Delphi обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи
  • 99% ответов по WinAPI можно найти в MSDN Library, оставшиеся 1% здесь

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, bartram, MetalFan, bems, Poseidon, Rrader, Riply.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: WinAPI и системное программирование | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0926 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.