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

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Сервис на Api с использование форм 
V
    Опции темы
Ak47black
  Дата 1.1.2008, 20:27 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


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

Репутация: нет
Всего: 0
Здравствуйте, с НВ!
Подскажите пожалуйста кто знает в чём тут дело, уже весь интернет перерыл но не смог найти ответа.
Делаю сервис, вот такой у меня код получился
Код

program TestService;

uses
  Windows,
  Forms,
  WinSvc,
  SvcMgr,
  SysUtils,
  ServiceInstallation,
  Unit1 in 'Unit1.pas' {Form1};

var
  ServiceStatusHandle : SERVICE_STATUS_HANDLE;
  CurStatus: Cardinal;
  hThread : THandle;
  ThID : Cardinal;
  
procedure ShowMessageC(const text : string);
begin
  MessageBox(0, PChar(text), 'Message', MB_OK or MB_SERVICE_NOTIFICATION);
end;

procedure ReportStatus(Status: Cardinal);
var
  ServiceStatus: TServiceStatus;
begin
  CurStatus:= Status;
  with ServiceStatus do
  begin
    dwServiceType := (SERVICE_WIN32_OWN_PROCESS or SERVICE_INTERACTIVE_PROCESS);
    dwCurrentState:= Status;
    dwControlsAccepted:= (SERVICE_ACCEPT_SHUTDOWN or SERVICE_ACCEPT_STOP);
    dwWin32ExitCode:= 0;
    dwServiceSpecificExitCode:= 0;
    dwCheckPoint:= 0;    
    dwWaitHint := 5000;
{    if Status = SERVICE_START_PENDING then
      dwControlsAccepted := 0
    else
      dwControlsAccepted := SERVICE_ACCEPT_SHUTDOWN or SERVICE_ACCEPT_STOP;
    if (Status in PendingStatus) and (Status = LastStatus) then
      Inc(dwCheckPoint)
    else}
  end;
  SetServiceStatus(ServiceStatusHandle, ServiceStatus);
end;

procedure ServiceCtrlHandler(fdwControl: Cardinal); stdcall;
begin
  ShowMessageC('in ServiceCtrlHandler');
  case fdwControl of
    SERVICE_CONTROL_STOP: begin
      ReportStatus(SERVICE_STOP_PENDING);
      TerminateThread(hThread, 0);
    end;
    SERVICE_CONTROL_SHUTDOWN: begin
      ReportStatus(SERVICE_STOP_PENDING);
      TerminateThread(hThread, 0);
   end;
    SERVICE_CONTROL_INTERROGATE: ReportStatus(CurStatus);
  end;
end;

function MainServiceThread(p:Pointer):DWORD; stdcall;
var
  hDesktop: THandle;
begin
  hDesktop:= OpenInputDesktop(0, false, GENERIC_ALL);
  SetThreadDesktop(hDesktop);
  MessageBox(0, 'Hello', 'Interactive', MB_OK or MB_ICONWARNING);
  Form1:= TForm1.Create(nil);
  Form1.ShowModal;
  FreeAndNil(Form1);  
end;

procedure ServiceProc(argc: DWORD; var argv: array of PChar); stdcall;
begin
  ShowMessageC('in ServiceProc');
  ReportStatus(SERVICE_START_PENDING);
  ServiceStatusHandle :=
    RegisterServiceCtrlHandler(ServiceName, @ServiceCtrlHandler);
  if ServiceStatusHandle = 0 then begin
    ShowMessageC('TestService start failed: ' + SysErrorMessage(GetLastError));
    exit;
  end;
  ReportStatus(SERVICE_RUNNING);
  hThread:= CreateThread(nil, 0, @MainServiceThread, nil, 0, ThID);
  ShowMessageC('Thread was created');
  WaitForSingleObject(hThread, INFINITE);
  CloseHandle(hThread);
  ShowMessageC('After CloseHandle(hThread)');
  ReportStatus(SERVICE_STOPPED);
end;

var
  DispatchTable : array [0..1] of _SERVICE_TABLE_ENTRYA;
begin
  if FindCmdLineSwitch('INSTALL', ['-','/'], true) then begin
    if not RegisterServices(true) then
      MessageBox(0, PChar(SysErrorMessage(GetLastError)), PChar('Error'), MB_OK);
    exit;
  end else if FindCmdLineSwitch('UNINSTALL', ['-','/'], true) then begin
    if not RegisterServices(false) then
      MessageBox(0, PChar(SysErrorMessage(GetLastError)), PChar('Error'), MB_OK);
    exit;
  end;
  DispatchTable[0].lpServiceName := PChar(ServiceName);
  DispatchTable[0].lpServiceProc := @ServiceProc;
  DispatchTable[1].lpServiceName := nil;
  DispatchTable[1].lpServiceProc := nil;
  StartServiceCtrlDispatcher(DispatchTable[0]);
end.

Код

unit ServiceInstallation;

interface

const
  ServiceName    = 'TestService';
  ServiceDisplay = 'Test Service :) !!!';

function RegisterServices(Install : Boolean) : boolean;

implementation

uses
  Windows, WinSvc, SysUtils;

function RegisterServices(Install : Boolean) : boolean;
  function InstallService(SvcMgr: Integer) : boolean;
  var
    Svc: THandle;
    Path: string;
  begin
    Path := ParamStr(0);
    Svc := CreateService(SvcMgr, PChar(ServiceName), PChar(ServiceDisplay),
      SERVICE_ALL_ACCESS, SERVICE_WIN32_OWN_PROCESS or SERVICE_INTERACTIVE_PROCESS,
      SERVICE_AUTO_START, SERVICE_ERROR_NORMAL, PChar(Path), nil, nil, nil, nil,
      nil);
    result := Svc <> 0;      
    if not result then
      exit;
    CloseServiceHandle(Svc);
  end;
  function UninstallService(SvcMgr: Integer) : boolean;
  var
    Svc: THandle;
    
  begin
    result := false;
    Svc := OpenService(SvcMgr, PChar(ServiceName), SERVICE_ALL_ACCESS);
    if Svc = 0 then
      exit;
    Result := DeleteService(Svc);
    CloseServiceHandle(Svc);
  end;
var
  SvcMgr: THandle;
begin
  Result := False;
  SvcMgr := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  if SvcMgr = 0 then
    exit;
  if Install then
    Result := InstallService(SvcMgr)
  else
    Result := UninstallService(SvcMgr);
  CloseServiceHandle(SvcMgr);
end;

end.

Проблема заключается в следующем
Если запустить этот сервис то вот на этом месте
Код

  MessageBox(0, 'Hello', 'Interactive', MB_OK or MB_ICONWARNING);
  Form1:= TForm1.Create(nil);
  Form1.ShowModal;
  FreeAndNil(Form1);  

Появляется вначале MessageBox но а после закрытия Form1 не появляется. 
Подскажите пожалуйста в чем тут дело? Форма не появляется изза того что я пытаюсь в потоке показать или тут как по другому в сервисах делается?  smile 

Это сообщение отредактировал(а) Ak47black - 1.1.2008, 20:28

Присоединённый файл ( Кол-во скачиваний: 6 )
Присоединённый файл  SampleService.rar 3,57 Kb
PM MAIL   Вверх
bartram
Дата 1.1.2008, 22:57 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Комодератор
Сообщений: 1606
Регистрация: 22.2.2004
Где: Russia, Samara

Репутация: 3
Всего: 29
Ak47black, ты пробовал отлаживать? Форма не появляется или не создается? Если просто не появляется, то попробуй включить взаимодействие сервиса с рабочим столом. 

Это сообщение отредактировал(а) bartram - 1.1.2008, 22:58


--------------------
В каждом из нас спит гений, но с каждым днем все крепче ;-)
bartram.ru
Twitter
user posted image 
PM MAIL ICQ   Вверх
Ak47black
Дата 1.1.2008, 23:56 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


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

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

попробуй включить взаимодействие сервиса с рабочим столом. 

Включен. Если-бы он был выключен, то 
Код

  MessageBox(0, 'Hello', 'Interactive', MB_OK or MB_ICONWARNING);

Не познавался-бы.

Добавлено через 7 минут и 11 секунд
Посмотрел под отладчиком.
Форма создаётся но показываться нехочет.
PM MAIL   Вверх
MetalFan
Дата 2.1.2008, 10:09 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Аццкий Сотона
****


Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 16
Всего: 128
форма то наверняка показывается, да на текущем дектопе ее не видно


--------------------
There are always someone smarter than you...
PM MAIL   Вверх
Ak47black
Дата 2.1.2008, 13:44 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


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

Репутация: нет
Всего: 0
MetalFan, 
Мммм перед показом я делаю
Код

  hDesktop:= OpenInputDesktop(0, false, GENERIC_ALL);
  SetThreadDesktop(hDesktop);

Что ставит поток на Desktop ввода.
При этом MessageBox показывается
Код

  MessageBox(0, 'Hello', 'Interactive', MB_OK or MB_ICONWARNING);

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


Это сообщение отредактировал(а) Ak47black - 2.1.2008, 13:51
PM MAIL   Вверх
MetalFan
Дата 2.1.2008, 15:00 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Аццкий Сотона
****


Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 16
Всего: 128
Цитата(Ak47black @  2.1.2008,  13:44 Найти цитируемый пост)
Что ставит поток на Desktop ввода.

а ты уверен, что этот код отрабатывает верно?
ни одной проверки на ошибки не сделано

Это сообщение отредактировал(а) MetalFan - 2.1.2008, 15:00


--------------------
There are always someone smarter than you...
PM MAIL   Вверх
Ak47black
Дата 2.1.2008, 15:54 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


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

Репутация: нет
Всего: 0
MetalFan, да
вот так сделал
Код

  hDesktop:= OpenInputDesktop(0, false, GENERIC_ALL);
  if hDesktop <> 0 then
    SetThreadDesktop(hDesktop);

Под отладчиком OpenInputDesktop возвращает не 0.

Это сообщение отредактировал(а) Ak47black - 2.1.2008, 15:55
PM MAIL   Вверх
MetalFan
Дата 2.1.2008, 16:01 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Аццкий Сотона
****


Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 16
Всего: 128
а вторая что возвращает?

Добавлено через 32 секунды
да и зачем вообще мешать VCL и сервис на WinApi? чем тебя TService не устраивает?


--------------------
There are always someone smarter than you...
PM MAIL   Вверх
Ak47black
Дата 2.1.2008, 17:46 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


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

Репутация: нет
Всего: 0
Хочу не сдаваться и добить с Api всетаки  smile .
Поток может быть привязан только к одному Deskyopу. Поэтому если
Код

MessageBox(0, 'Hello', 'Interactive', MB_OK or MB_ICONWARNING);

показывает, значит поток привязан к Interactive Desktop.
И если он привязан Interactive Desktop то нигде кроме него и показать он неможет.
Хотя убеждения возможно ошибочны.
PM MAIL   Вверх
drkot
Дата 6.1.2008, 21:03 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Ищущий
***


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

Репутация: нет
Всего: 8
Tform.parent:=....


--------------------
Ошибка не становится истиной по причине широкого распространения,
как и Истина не становится Ошибкой из-за того, что никто её не видит.
PM   Вверх
MetalFan
Дата 7.1.2008, 15:01 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Аццкий Сотона
****


Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 16
Всего: 128
а при чем тут парент?


--------------------
There are always someone smarter than you...
PM MAIL   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "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.0535 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


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

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