Сервис - Delphi & Builder

я создал сервис, нормально регистрируется,но выдаёт ошибку: "StartServiceCtrlDispatcher Error 1053(427) Процесс службы не может установить связь с контроллером службы". И не запускается нормально.Чем это вызвано и как можно это справить?

Здравствуйте, Levin_610, Вы писали:

L_>я создал сервис, нормально регистрируется,но выдаёт ошибку: "StartServiceCtrlDispatcher Error 1053(427) Процесс службы не может установить связь с контроллером службы". И не запускается нормально.Чем это вызвано и как можно это справить?
Ровно то и значит, что написано — уж не из-под IDE Вы его запускаете ?
В отладке сервиса есть небольшие ньюансы.

... << RSDN@Home 1.1.4 stable SR1 rev. 568>>

Здравствуйте, xentry, Вы писали:

X>Здравствуйте, Levin_610, Вы писали:

L_>>я создал сервис, нормально регистрируется,но выдаёт ошибку: "StartServiceCtrlDispatcher Error 1053(427) Процесс службы не может установить связь с контроллером службы". И не запускается нормально.Чем это вызвано и как можно это справить?
X>Ровно то и значит, что написано — уж не из-под IDE Вы его запускаете ?
X>В отладке сервиса есть небольшие ньюансы.

А как насчёт 2ой части вопроса? И я не знаю, что значит: "уж не из-под IDE Вы его запускаете ?"

Здравствуйте, Levin_610, Вы писали:

L_>А как насчёт 2ой части вопроса? И я не знаю, что значит: "уж не из-под IDE Вы его запускаете ?"
нажимаем f1, читаем раздел TService -> Using TService -> Debugging service applications:

On Windows NT systems, you can use another approach for debugging service applications. However, this approach can be tricky, because it requires short time intervals:
1 First, launch the application in the debugger. Wait a few seconds until it has finished loading.
2 Quickly start the service from the control panel or from the command line:
start MyServ

или способ 2
Запускаем Delphi.
Меню Run->Attach to process... (находим процесс, соответствующий сервису).
Потом View->Debug windows->Modules.
Выбираем нужный модуль.

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

... << RSDN@Home 1.1.4 stable SR1 rev. 568>>

Здравствуйте, xentry, Вы писали:

X>Здравствуйте, Levin_610, Вы писали:

L_>>А как насчёт 2ой части вопроса? И я не знаю, что значит: "уж не из-под IDE Вы его запускаете ?"
X>нажимаем f1, читаем раздел TService -> Using TService -> Debugging service applications:
X>

X>On Windows NT systems, you can use another approach for debugging service applications. However, this approach can be tricky, because it requires short time intervals:
X>1 First, launch the application in the debugger. Wait a few seconds until it has finished loading.
X>2 Quickly start the service from the control panel or from the command line:
X>start MyServ

X>или способ 2
X>Запускаем Delphi.
X>Меню Run->Attach to process... (находим процесс, соответствующий сервису).
X>Потом View->Debug windows->Modules.
X>Выбираем нужный модуль.

X>Сам я не пробывал оба способа, т.к никогда не пользовался TService. Проще сделать так, чтобы процесс можно было запускать и как севрвис, и как приложение, и отлаживать все это как обычное приложение.

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

Здравствуйте, Levin_610, Вы писали:

L_>Я просто запускаю свою программу, как обычное приложение и она у меня сначала регистрируется, как сервис, а вот работать уже не хочет, видима из-за вышеупомянутой ошибки.
Перед тем, как искать ошибку у себя в коде, советую всё-таки прочитать, как это все работает:
http://www.rsdn.ru/article/baseserv/services_details.xml

... << RSDN@Home 1.1.4 stable SR1 rev. 568>>

Здравствуйте, xentry, Вы писали:

X>Здравствуйте, Levin_610, Вы писали:

L_>>Я просто запускаю свою программу, как обычное приложение и она у меня сначала регистрируется, как сервис, а вот работать уже не хочет, видима из-за вышеупомянутой ошибки.
X>Перед тем, как искать ошибку у себя в коде, советую всё-таки прочитать, как это все работает:
X>http://www.rsdn.ru/article/baseserv/services_details.xml

боюсь, что я уже читал это и не раз

Здравствуйте, Levin_610, Вы писали:

L_>боюсь, что я уже читал это и не раз
Еще раз: StartServiceCtrlDispatcher и должен завершится с ошибкой ERROR_FAILED_SERVICE_CONTROLLER_CONNECT если процесс запущен как обычное приложение. По крайней мере других причин я не знаю.
PS. Код показать стесняемся ?

... << RSDN@Home 1.1.4 stable SR1 rev. 568>>

Здравствуйте, xentry, Вы писали:

X>Здравствуйте, Levin_610, Вы писали:

L_>>боюсь, что я уже читал это и не раз
X>Еще раз: StartServiceCtrlDispatcher и должен завершится с ошибкой ERROR_FAILED_SERVICE_CONTROLLER_CONNECT если процесс запущен как обычное приложение. По крайней мере других причин я не знаю.
X>PS. Код показать стесняемся ?

да, я очень стесняюсь), но всё таки вот:

program service_sample;

{$APPTYPE CONSOLE}

uses
Windows,
WinSvc,
Messages,
SysUtils,
Variants,
Classes,
Graphics,
Controls,
Forms,
Dialogs,
ShellAPI,
Menus,
StdCtrls,
PSAPI,
TlHelp32,
ExtCtrls,
Unit1 in 'Unit1.pas';
// Unit2 in 'Unit2.pas' {Service2: TService};

type
// TSysCharSet=set of Char;
TCurrentStatus=(csStopped,csStartPending,csStopPending,csRunning,
csContinuePending,csPausePending,csPaused);

const ServiceName = 'ServiceName';

var
DispatchTable : array [0..1] of _SERVICE_TABLE_ENTRYA;
hThread: THandle;
hThread2 : THandle;
ServiceStatus : SERVICE_STATUS;
ServiceStatusHandle : SERVICE_STATUS_HANDLE;
ErrCode : Cardinal;
FStatusHandle:DWord;
Name:string;
OldExitProc:Pointer;
Status:TCurrentStatus;
AppStart:Boolean;
thID: cardinal;

{procedure ReportStatus;
const
LastStatus:TCurrentStatus = csStartPending;
NTServiceStatus: array[TCurrentStatus] of Integer =
(SERVICE_STOPPED,SERVICE_START_PENDING,
SERVICE_STOP_PENDING,SERVICE_RUNNING,
SERVICE_CONTINUE_PENDING,SERVICE_PAUSE_PENDING,SERVICE_PAUSED);
PendingStatus: set of TCurrentStatus = [csStartPending,csStopPending,
csContinuePending,csPausePending];
var
ServiceStatus: TServiceStatus;
begin
with ServiceStatus do
begin
dwWaitHint:=5000;
dwServiceType:=SERVICE_WIN32_OWN_PROCESS;
if Status=csStartPending then dwControlsAccepted:=0 else
dwControlsAccepted:=SERVICE_ACCEPT_SHUTDOWN or SERVICE_ACCEPT_STOP or SERVICE_ACCEPT_PAUSE_CONTINUE;
if (Status in PendingStatus)and(Status=LastStatus) then
Inc(dwCheckPoint) else dwCheckPoint:=0;
dwCurrentState:=NTServiceStatus[Status];
dwWin32ExitCode:=0;
dwServiceSpecificExitCode:=0;
SetServiceStatus(FStatusHandle, ServiceStatus);
end;
end;
}
procedure LogError(text: string);

begin
writeln(text);
end;

{function ServiceGetStatus(sMachine, sService: string ): DWord;
var
h_manager,h_service: SC_Handle;
service_status : TServiceStatus;
hStat : DWord;
h_svc : Cardinal;
begin
hStat := 1;
h_manager := OpenSCManager(PChar(sMachine) ,Nil,
SC_MANAGER_CONNECT);

if h_manager > 0 then
begin
h_svc := OpenService(h_manager,PChar(sService),
SERVICE_QUERY_STATUS);

if h_svc > 0 then
begin
if(QueryServiceStatus(h_svc, service_status)) then
hStat := service_status.dwCurrentState;

CloseServiceHandle(h_svc);
end;
CloseServiceHandle(h_manager);
end;

Result := hStat;
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
Status := GetLastError;
LogError('SetServiceStatus');
Exit;
end;
exit;
end;

SERVICE_CONTROL_INTERROGATE: ;
end;

if not SetServiceStatus(ServiceStatusHandle, ServiceStatus) then
begin
Status := GetLastError;
LogError('SetServiceStatus');
Exit;
end;
end;

function ServiceInitialization(argc: DWORD; var argv: array of PChar; se: DWORD): integer;
begin
result := NO_ERROR;
end;

procedure MainServiceThread(p: Pointer);//: DWORD; stdcall;
// var hWinSta, hDesktop, hOldWinSta, hOldDesktop: THandle;
begin

//while(true) do
begin
sleep(INFINITE);
end;
end;

procedure ServiceMain(argc: DWORD; var argv: array of PChar); stdcall;
var
Status: DWORD;
SpecificError: DWORD;
thID: cardinal;
begin
ServiceStatusHandle :=
RegisterServiceCtrlHandler(ServiceName, @ServiceCtrlHandler);
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 := 2000;

while(true) do
begin
sleep(1000);
SetServiceStatus(ServiceStatusHandle,ServiceStatus);
ServiceStatus.dwCheckPoint := ServiceStatus.dwCheckPoint + 1;
break;
end;
if ServiceStatusHandle = 0 then
WriteLn('RegisterServiceCtrlHandler Error');

Status := ServiceInitialization(argc, argv, SpecificError);
if Status <> NO_ERROR then
begin
ServiceStatus.dwCurrentState := SERVICE_STOPPED;
ServiceStatus.dwCheckPoint := 0;
ServiceStatus.dwWaitHint := 0;
ServiceStatus.dwWin32ExitCode := Status;
ServiceStatus.dwServiceSpecificExitCode := SpecificError;

SetServiceStatus(ServiceStatusHandle, ServiceStatus);
LogError('ServiceInitialization');
// ShowMessage('tak i est komandir');
exit;
end;

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

WaitForSingleObject(hThread, 2000);

CloseHandle(hThread);

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

if not SetServiceStatus(ServiceStatusHandle, ServiceStatus) then
begin
Status := GetLastError;
LogError('SetServiceStatus');
// ShowMessage('"2" tak i est komandir');
exit;
end;

end;

//procedure
function CreateNTService(ExecutablePath, ServiceName: string):boolean;
var
hNewService, hSCMgr: SC_HANDLE;
indcreate : boolean;
begin
indcreate := false;
hSCMgr := OpenSCManager(nil, nil, SC_MANAGER_CREATE_SERVICE);
if (hSCMgr <> 0) then
begin
hNewService := CreateService(hSCMgr, PChar(ServiceName), PChar(ServiceName),
SC_MANAGER_CREATE_SERVICE , SERVICE_WIN32_OWN_PROCESS,
SERVICE_AUTO_START, SERVICE_ERROR_NORMAL,
PChar(ExecutablePath), nil, nil, nil, nil, nil);
// ServiceController(ServiceGetStatus('','ServiceName'));
CloseServiceHandle(hSCMgr);
if (hNewService <> 0) then
begin
indcreate := True;
end;
end;
CreateNTservice := indcreate;
end;
procedure DeleteNTService(ServiceName: string);
var
hServiceToDelete, hSCMgr: SC_HANDLE;
RetVal : LongBool;
begin
hSCMgr := OpenSCManager(nil, nil, SC_MANAGER_CREATE_SERVICE);
if (hSCMgr <> 0) then
begin
hServiceToDelete := OpenService(hSCMgr, PChar(ServiceName),
SERVICE_ALL_ACCESS);
RetVal := DeleteService(hServiceToDelete);
CloseServiceHandle(hSCMgr);
end;
end;

{function ServiceStart(aMachine, aServiceName: string ): boolean;
var
h_manager,h_svc: SC_Handle;
svc_status: TServiceStatus;
Temp: PChar;
dwCheckPoint: DWord;
begin
svc_status.dwCurrentState := 1;
h_manager := OpenSCManager(PChar(aMachine), nil, SC_MANAGER_CONNECT);
if h_manager > 0 then
begin
h_svc := OpenService(h_manager, PChar(aServiceName), Generic_read);
h_svc := OpenService(h_manager, PChar(aServiceName),
SERVICE_START or SERVICE_QUERY_STATUS);
//ControlService(SERVICE_CONTROL_INTERROGATE,)
if h_svc > 0 then
begin
temp := nil;
if (StartService(h_svc,0,temp)) then
if (QueryServiceStatus(h_svc,svc_status)) then
begin
while (SERVICE_RUNNING <> svc_status.dwCurrentState) do
begin
dwCheckPoint := svc_status.dwCheckPoint;
Sleep(svc_status.dwWaitHint);
if (not QueryServiceStatus(h_svc,svc_status)) then
break;
if (svc_status.dwCheckPoint < dwCheckPoint) then
begin
break;
end;
end;
end;
CloseServiceHandle(h_svc);
end;
CloseServiceHandle(h_manager);
end;
Result := SERVICE_RUNNING = svc_status.dwCurrentState;
end;

function ServiceStop(aMachine,aServiceName: string ): boolean;
var
h_manager, h_svc: SC_Handle;
svc_status: TServiceStatus;
dwCheckPoint: DWord;
begin
h_manager:=OpenSCManager(PChar(aMachine),nil, SC_MANAGER_CONNECT);
if h_manager > 0 then
begin
h_svc := OpenService(h_manager,PChar(aServiceName),
SERVICE_STOP or SERVICE_QUERY_STATUS);
if h_svc > 0 then
begin
if(ControlService(h_svc,SERVICE_CONTROL_STOP, svc_status))then
begin
if(QueryServiceStatus(h_svc,svc_status))then
begin
while(SERVICE_STOPPED <> svc_status.dwCurrentState)do
begin
dwCheckPoint := svc_status.dwCheckPoint;
Sleep(svc_status.dwWaitHint);
if(not QueryServiceStatus(h_svc,svc_status))then
begin
// couldn't check status
break;
end;
if(svc_status.dwCheckPoint < dwCheckPoint)then
break;
end;
end;
end;
CloseServiceHandle(h_svc);
end;
CloseServiceHandle(h_manager);
end;
Result := SERVICE_STOPPED = svc_status.dwCurrentState;
end;

}
begin

DispatchTable[0].lpServiceName := ServiceName;
DispatchTable[0].lpServiceProc := @ServiceMain;
DispatchTable[1].lpServiceName := nil;
DispatchTable[1].lpServiceProc := nil;
hThread2 := CreateThread(nil, 0, @MainServiceThread, nil, 0, ThID);

WaitForSingleObject(hThread, INFINITE);

if not StartServiceCtrlDispatcher(DispatchTable[0]) then begin
ErrCode:=GetLastError();
MessageBox(0,
PChar('StartServiceCtrlDispatcher Error '+format('%d(%x) %s', [ErrCode, ErrCode, SysErrorMessage(ErrCode)])),
'Start Service Error ',
MB_OK or MB_ICONERROR or MB_SERVICE_NOTIFICATION);
end;
CloseHandle(hThread);

//if (CreateNTService('C:\temp\project1.exe', 'project1') = true) then
//ShowMessage('have been created');
//DeleteNTService('project1');
// ZeroMemory(@DispatchTable, SizeOf(DispatchTable));

{if not StartServiceCtrlDispatcher(DispatchTable[0]) then
LogError('StartServiceCtrlDispatcher Error');}

readln;
end.

Здравствуйте, Levin_610, Вы писали:

[Skip]

А в теги форматирования pascal слобо обернуть? ЧЕРТОВСКИ мерзко читается

Здравствуйте, Danchik, Вы писали:

D>Здравствуйте, Levin_610, Вы писали:

D>[Skip]

D>А в теги форматирования pascal слобо обернуть? ЧЕРТОВСКИ мерзко читается

что сделать?)

Здравствуйте, Levin_610, Вы писали:

D>>А в теги форматирования pascal слобо обернуть? ЧЕРТОВСКИ мерзко читается

L_>что сделать?)

Почитайте, очень полезно

Оформляем сообщения красиво

Здравствуйте, Danchik, Вы писали:

D>Здравствуйте, Levin_610, Вы писали:

D>>>А в теги форматирования pascal слобо обернуть? ЧЕРТОВСКИ мерзко читается

L_>>что сделать?)

D>Почитайте, очень полезно

D>Оформляем сообщения красиво

program service_sample;

{$APPTYPE CONSOLE}

uses
Windows,
WinSvc,
Messages,
SysUtils,
Variants,
Classes,
Graphics,
Controls,
Forms,
Dialogs,
ShellAPI,
Menus,
StdCtrls,
PSAPI,
TlHelp32,
ExtCtrls,
Unit1 in 'Unit1.pas';
// Unit2 in 'Unit2.pas' {Service2: TService};

type
// TSysCharSet=set of Char;
TCurrentStatus=(csStopped,csStartPending,csStopPending,csRunning,
csContinuePending,csPausePending,csPaused);

const ServiceName = 'ServiceName';

var
DispatchTable : array [0..1] of _SERVICE_TABLE_ENTRYA;
hThread: THandle;
hThread2 : THandle;
ServiceStatus : SERVICE_STATUS;
ServiceStatusHandle : SERVICE_STATUS_HANDLE;
ErrCode : Cardinal;
FStatusHandle:DWord;
Name:string;
OldExitProc:Pointer;
Status:TCurrentStatus;
AppStart:Boolean;
thID: cardinal;

{procedure ReportStatus;
const
LastStatus:TCurrentStatus = csStartPending;
NTServiceStatus: array[TCurrentStatus] of Integer =
(SERVICE_STOPPED,SERVICE_START_PENDING,
SERVICE_STOP_PENDING,SERVICE_RUNNING,
SERVICE_CONTINUE_PENDING,SERVICE_PAUSE_PENDING,SERVICE_PAUSED);
PendingStatus: set of TCurrentStatus = [csStartPending,csStopPending,
csContinuePending,csPausePending];
var
ServiceStatus: TServiceStatus;
begin
with ServiceStatus do
begin
dwWaitHint:=5000;
dwServiceType:=SERVICE_WIN32_OWN_PROCESS;
if Status=csStartPending then dwControlsAccepted:=0 else
dwControlsAccepted:=SERVICE_ACCEPT_SHUTDOWN or SERVICE_ACCEPT_STOP or SERVICE_ACCEPT_PAUSE_CONTINUE;
if (Status in PendingStatus)and(Status=LastStatus) then
Inc(dwCheckPoint) else dwCheckPoint:=0;
dwCurrentState:=NTServiceStatus[Status];
dwWin32ExitCode:=0;
dwServiceSpecificExitCode:=0;
SetServiceStatus(FStatusHandle, ServiceStatus);
end;
end;
}
procedure LogError(text: string);

begin
writeln(text);
end;

{function ServiceGetStatus(sMachine, sService: string ): DWord;
var
h_manager,h_service: SC_Handle;
service_status : TServiceStatus;
hStat : DWord;
h_svc : Cardinal;
begin
hStat := 1;
h_manager := OpenSCManager(PChar(sMachine) ,Nil,
SC_MANAGER_CONNECT);

if h_manager > 0 then
begin
h_svc := OpenService(h_manager,PChar(sService),
SERVICE_QUERY_STATUS);

if h_svc > 0 then
begin
if(QueryServiceStatus(h_svc, service_status)) then
hStat := service_status.dwCurrentState;

CloseServiceHandle(h_svc);
end;
CloseServiceHandle(h_manager);
end;

Result := hStat;
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
Status := GetLastError;
LogError('SetServiceStatus');
Exit;
end;
exit;
end;

SERVICE_CONTROL_INTERROGATE: ;
end;

if not SetServiceStatus(ServiceStatusHandle, ServiceStatus) then
begin
Status := GetLastError;
LogError('SetServiceStatus');
Exit;
end;
end;

function ServiceInitialization(argc: DWORD; var argv: array of PChar; se: DWORD): integer;
begin
result := NO_ERROR;
end;

procedure MainServiceThread(p: Pointer);//: DWORD; stdcall;
// var hWinSta, hDesktop, hOldWinSta, hOldDesktop: THandle;
begin

//while(true) do
begin
sleep(INFINITE);
end;
end;

procedure ServiceMain(argc: DWORD; var argv: array of PChar); stdcall;
var
Status: DWORD;
SpecificError: DWORD;
thID: cardinal;
begin
ServiceStatusHandle :=
RegisterServiceCtrlHandler(ServiceName, @ServiceCtrlHandler);
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 := 2000;

while(true) do
begin
sleep(1000);
SetServiceStatus(ServiceStatusHandle,ServiceStatus);
ServiceStatus.dwCheckPoint := ServiceStatus.dwCheckPoint + 1;
break;
end;
if ServiceStatusHandle = 0 then
WriteLn('RegisterServiceCtrlHandler Error');

Status := ServiceInitialization(argc, argv, SpecificError);
if Status <> NO_ERROR then
begin
ServiceStatus.dwCurrentState := SERVICE_STOPPED;
ServiceStatus.dwCheckPoint := 0;
ServiceStatus.dwWaitHint := 0;
ServiceStatus.dwWin32ExitCode := Status;
ServiceStatus.dwServiceSpecificExitCode := SpecificError;

SetServiceStatus(ServiceStatusHandle, ServiceStatus);
LogError('ServiceInitialization');
// ShowMessage('tak i est komandir');
exit;
end;

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

WaitForSingleObject(hThread, 2000);

CloseHandle(hThread);

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

if not SetServiceStatus(ServiceStatusHandle, ServiceStatus) then
begin
Status := GetLastError;
LogError('SetServiceStatus');
// ShowMessage('"2" tak i est komandir');
exit;
end;

end;

//procedure
function CreateNTService(ExecutablePath, ServiceName: string):boolean;
var
hNewService, hSCMgr: SC_HANDLE;
indcreate : boolean;
begin
indcreate := false;
hSCMgr := OpenSCManager(nil, nil, SC_MANAGER_CREATE_SERVICE);
if (hSCMgr <> 0) then
begin
hNewService := CreateService(hSCMgr, PChar(ServiceName), PChar(ServiceName),
SC_MANAGER_CREATE_SERVICE , SERVICE_WIN32_OWN_PROCESS,
SERVICE_AUTO_START, SERVICE_ERROR_NORMAL,
PChar(ExecutablePath), nil, nil, nil, nil, nil);
// ServiceController(ServiceGetStatus('','ServiceName'));
CloseServiceHandle(hSCMgr);
if (hNewService <> 0) then
begin
indcreate := True;
end;
end;
CreateNTservice := indcreate;
end;
procedure DeleteNTService(ServiceName: string);
var
hServiceToDelete, hSCMgr: SC_HANDLE;
RetVal : LongBool;
begin
hSCMgr := OpenSCManager(nil, nil, SC_MANAGER_CREATE_SERVICE);
if (hSCMgr <> 0) then
begin
hServiceToDelete := OpenService(hSCMgr, PChar(ServiceName),
SERVICE_ALL_ACCESS);
RetVal := DeleteService(hServiceToDelete);
CloseServiceHandle(hSCMgr);
end;
end;

{function ServiceStart(aMachine, aServiceName: string ): boolean;
var
h_manager,h_svc: SC_Handle;
svc_status: TServiceStatus;
Temp: PChar;
dwCheckPoint: DWord;
begin
svc_status.dwCurrentState := 1;
h_manager := OpenSCManager(PChar(aMachine), nil, SC_MANAGER_CONNECT);
if h_manager > 0 then
begin
h_svc := OpenService(h_manager, PChar(aServiceName), Generic_read);
h_svc := OpenService(h_manager, PChar(aServiceName),
SERVICE_START or SERVICE_QUERY_STATUS);
//ControlService(SERVICE_CONTROL_INTERROGATE,)
if h_svc > 0 then
begin
temp := nil;
if (StartService(h_svc,0,temp)) then
if (QueryServiceStatus(h_svc,svc_status)) then
begin
while (SERVICE_RUNNING <> svc_status.dwCurrentState) do
begin
dwCheckPoint := svc_status.dwCheckPoint;
Sleep(svc_status.dwWaitHint);
if (not QueryServiceStatus(h_svc,svc_status)) then
break;
if (svc_status.dwCheckPoint < dwCheckPoint) then
begin
break;
end;
end;
end;
CloseServiceHandle(h_svc);
end;
CloseServiceHandle(h_manager);
end;
Result := SERVICE_RUNNING = svc_status.dwCurrentState;
end;

function ServiceStop(aMachine,aServiceName: string ): boolean;
var
h_manager, h_svc: SC_Handle;
svc_status: TServiceStatus;
dwCheckPoint: DWord;
begin
h_manager:=OpenSCManager(PChar(aMachine),nil, SC_MANAGER_CONNECT);
if h_manager > 0 then
begin
h_svc := OpenService(h_manager,PChar(aServiceName),
SERVICE_STOP or SERVICE_QUERY_STATUS);
if h_svc > 0 then
begin
if(ControlService(h_svc,SERVICE_CONTROL_STOP, svc_status))then
begin
if(QueryServiceStatus(h_svc,svc_status))then
begin
while(SERVICE_STOPPED <> svc_status.dwCurrentState)do
begin
dwCheckPoint := svc_status.dwCheckPoint;
Sleep(svc_status.dwWaitHint);
if(not QueryServiceStatus(h_svc,svc_status))then
begin
// couldn't check status
break;
end;
if(svc_status.dwCheckPoint < dwCheckPoint)then
break;
end;
end;
end;
CloseServiceHandle(h_svc);
end;
CloseServiceHandle(h_manager);
end;
Result := SERVICE_STOPPED = svc_status.dwCurrentState;
end;

}
begin

DispatchTable[0].lpServiceName := ServiceName;
DispatchTable[0].lpServiceProc := @ServiceMain;
DispatchTable[1].lpServiceName := nil;
DispatchTable[1].lpServiceProc := nil;
if not StartServiceCtrlDispatcher(DispatchTable[0]) then begin
ErrCode:=GetLastError();
MessageBox(0,
PChar('StartServiceCtrlDispatcher Error '+format('%d(%x) %s', [ErrCode, ErrCode, SysErrorMessage(ErrCode)])),
'Start Service Error ',
MB_OK or MB_ICONERROR or MB_SERVICE_NOTIFICATION);
end;
//if (CreateNTService('C:\temp\project1.exe', 'project1') = true) then
//ShowMessage('have been created');
//DeleteNTService('project1');
// ZeroMemory(@DispatchTable, SizeOf(DispatchTable));

{if not StartServiceCtrlDispatcher(DispatchTable[0]) then
LogError('StartServiceCtrlDispatcher Error');}

// readln;
end.

Здравствуйте, Levin_610, Вы писали:

[Skip]

Тчерт побери. Есть кнопочка Предосмотр. Глянули насладились, а не послали черт знает что.
Есть кнопочки внизу [pascal] — отметили код и нажали на нее — автоматически обернет в нужные теги...
Ладно показываю...

program service_sample;

{$APPTYPE CONSOLE}

uses
  Windows,
  WinSvc,
  Messages,
  SysUtils,
  Variants,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,
  ShellAPI,
  Menus,
  StdCtrls,
  PSAPI,
  TlHelp32,
  ExtCtrls,
  Unit1 in 'Unit1.pas';
//  Unit2 in 'Unit2.pas' {Service2: TService};

 type
// TSysCharSet=set of Char;
 TCurrentStatus=(csStopped,csStartPending,csStopPending,csRunning,
                 csContinuePending,csPausePending,csPaused);


  const ServiceName = 'ServiceName';

  var
    DispatchTable : array [0..1] of _SERVICE_TABLE_ENTRYA;
    hThread: THandle;
    hThread2 : THandle;
    ServiceStatus : SERVICE_STATUS;
    ServiceStatusHandle : SERVICE_STATUS_HANDLE;
    ErrCode : Cardinal;
    FStatusHandle:DWord;
    Name:string;
    OldExitProc:Pointer;
    Status:TCurrentStatus;
    AppStart:Boolean;
    thID: cardinal;

{procedure ReportStatus;
const
 LastStatus:TCurrentStatus = csStartPending;
 NTServiceStatus: array[TCurrentStatus] of Integer =
                  (SERVICE_STOPPED,SERVICE_START_PENDING,
                   SERVICE_STOP_PENDING,SERVICE_RUNNING,
                   SERVICE_CONTINUE_PENDING,SERVICE_PAUSE_PENDING,SERVICE_PAUSED);
 PendingStatus: set of TCurrentStatus = [csStartPending,csStopPending,
                                         csContinuePending,csPausePending];
var
  ServiceStatus: TServiceStatus;
begin
 with ServiceStatus do
  begin
   dwWaitHint:=5000;
   dwServiceType:=SERVICE_WIN32_OWN_PROCESS;
   if Status=csStartPending then dwControlsAccepted:=0 else
    dwControlsAccepted:=SERVICE_ACCEPT_SHUTDOWN or SERVICE_ACCEPT_STOP or SERVICE_ACCEPT_PAUSE_CONTINUE;
   if (Status in PendingStatus)and(Status=LastStatus) then
    Inc(dwCheckPoint) else dwCheckPoint:=0;
   dwCurrentState:=NTServiceStatus[Status];
   dwWin32ExitCode:=0;
   dwServiceSpecificExitCode:=0;
   SetServiceStatus(FStatusHandle, ServiceStatus);
  end;
end;
}
    procedure LogError(text: string);

    begin
      writeln(text);
    end;



{function ServiceGetStatus(sMachine, sService: string ): DWord;
var
  h_manager,h_service: SC_Handle;
  service_status     : TServiceStatus;
  hStat : DWord;
  h_svc : Cardinal;
begin
  hStat := 1;
  h_manager := OpenSCManager(PChar(sMachine) ,Nil,
                             SC_MANAGER_CONNECT);

  if h_manager > 0 then
  begin
    h_svc := OpenService(h_manager,PChar(sService),
                      SERVICE_QUERY_STATUS);

    if h_svc > 0 then
    begin
      if(QueryServiceStatus(h_svc, service_status)) then
        hStat := service_status.dwCurrentState;

      CloseServiceHandle(h_svc);
    end;
    CloseServiceHandle(h_manager);
  end;

  Result := hStat;
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
            Status := GetLastError;
            LogError('SetServiceStatus');
            Exit;
          end;
            exit;
        end;

    SERVICE_CONTROL_INTERROGATE: ;
    end;

    if not SetServiceStatus(ServiceStatusHandle, ServiceStatus) then
      begin
        Status := GetLastError;
        LogError('SetServiceStatus');
        Exit;
      end;
    end;

  function ServiceInitialization(argc: DWORD; var argv: array of PChar; se: DWORD): integer;
  begin
    result := NO_ERROR;
  end;

  procedure MainServiceThread(p: Pointer);//: DWORD; stdcall;
//  var hWinSta, hDesktop, hOldWinSta, hOldDesktop: THandle;
  begin


  //while(true) do
    begin
  sleep(INFINITE);
    end;
  end;

  procedure ServiceMain(argc: DWORD; var argv: array of PChar); stdcall;
  var
    Status: DWORD;
    SpecificError: DWORD;
    thID: cardinal;
  begin
     ServiceStatusHandle :=
      RegisterServiceCtrlHandler(ServiceName, @ServiceCtrlHandler);
    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 := 2000;

      while(true) do
        begin
        sleep(1000);
        SetServiceStatus(ServiceStatusHandle,ServiceStatus);
        ServiceStatus.dwCheckPoint := ServiceStatus.dwCheckPoint + 1;
        break;
        end;
    if ServiceStatusHandle = 0 then
        WriteLn('RegisterServiceCtrlHandler Error');



      Status := ServiceInitialization(argc, argv, SpecificError);
      if Status <> NO_ERROR then
      begin
        ServiceStatus.dwCurrentState := SERVICE_STOPPED;
        ServiceStatus.dwCheckPoint := 0;
        ServiceStatus.dwWaitHint := 0;
        ServiceStatus.dwWin32ExitCode := Status;
        ServiceStatus.dwServiceSpecificExitCode := SpecificError;

        SetServiceStatus(ServiceStatusHandle, ServiceStatus);
        LogError('ServiceInitialization');
//      ShowMessage('tak i est komandir');
        exit;
      end;

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

     WaitForSingleObject(hThread, 2000);

     CloseHandle(hThread);


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

      if not SetServiceStatus(ServiceStatusHandle, ServiceStatus) then
      begin
        Status := GetLastError;
        LogError('SetServiceStatus');
//      ShowMessage('"2" tak i est komandir');
        exit;
      end;



  end;

//procedure
  function CreateNTService(ExecutablePath, ServiceName: string):boolean;
  var
    hNewService, hSCMgr: SC_HANDLE;
    indcreate : boolean;
  begin
    indcreate := false;
    hSCMgr := OpenSCManager(nil, nil, SC_MANAGER_CREATE_SERVICE);
    if (hSCMgr <> 0) then
    begin
      hNewService := CreateService(hSCMgr, PChar(ServiceName), PChar(ServiceName),
        SC_MANAGER_CREATE_SERVICE , SERVICE_WIN32_OWN_PROCESS,
        SERVICE_AUTO_START, SERVICE_ERROR_NORMAL,
        PChar(ExecutablePath), nil, nil, nil, nil, nil);
//     ServiceController(ServiceGetStatus('','ServiceName'));
      CloseServiceHandle(hSCMgr);
      if (hNewService <> 0) then
      begin
        indcreate := True;
      end;
    end;
    CreateNTservice := indcreate;
  end;
  procedure DeleteNTService(ServiceName: string);
  var
    hServiceToDelete, hSCMgr: SC_HANDLE;
    RetVal : LongBool;
  begin
    hSCMgr := OpenSCManager(nil, nil, SC_MANAGER_CREATE_SERVICE);
    if (hSCMgr <> 0) then
    begin
      hServiceToDelete := OpenService(hSCMgr, PChar(ServiceName),
        SERVICE_ALL_ACCESS);
      RetVal := DeleteService(hServiceToDelete);
      CloseServiceHandle(hSCMgr);
    end;
  end;

{function ServiceStart(aMachine, aServiceName: string ): boolean;
var
  h_manager,h_svc: SC_Handle;
  svc_status: TServiceStatus;
  Temp: PChar;
  dwCheckPoint: DWord;
begin
  svc_status.dwCurrentState := 1;
  h_manager := OpenSCManager(PChar(aMachine), nil, SC_MANAGER_CONNECT);
  if h_manager > 0 then
  begin
    h_svc := OpenService(h_manager, PChar(aServiceName), Generic_read);
    h_svc := OpenService(h_manager, PChar(aServiceName),
    SERVICE_START or SERVICE_QUERY_STATUS);
    //ControlService(SERVICE_CONTROL_INTERROGATE,)
    if h_svc > 0 then
    begin
      temp := nil;
      if (StartService(h_svc,0,temp)) then
        if (QueryServiceStatus(h_svc,svc_status)) then
        begin
          while (SERVICE_RUNNING <> svc_status.dwCurrentState) do
          begin
            dwCheckPoint := svc_status.dwCheckPoint;
            Sleep(svc_status.dwWaitHint);
            if (not QueryServiceStatus(h_svc,svc_status)) then
              break;
            if (svc_status.dwCheckPoint < dwCheckPoint) then
            begin
                 break;
            end;
          end;
        end;
      CloseServiceHandle(h_svc);
    end;
    CloseServiceHandle(h_manager);
  end;
  Result := SERVICE_RUNNING = svc_status.dwCurrentState;
end;


function ServiceStop(aMachine,aServiceName: string ): boolean;
var
  h_manager, h_svc: SC_Handle;
  svc_status: TServiceStatus;
  dwCheckPoint: DWord;
begin
  h_manager:=OpenSCManager(PChar(aMachine),nil, SC_MANAGER_CONNECT);
  if h_manager > 0 then
  begin
    h_svc := OpenService(h_manager,PChar(aServiceName),
    SERVICE_STOP or SERVICE_QUERY_STATUS);
    if h_svc > 0 then
    begin
      if(ControlService(h_svc,SERVICE_CONTROL_STOP, svc_status))then
      begin
        if(QueryServiceStatus(h_svc,svc_status))then
        begin
          while(SERVICE_STOPPED <> svc_status.dwCurrentState)do
          begin
            dwCheckPoint := svc_status.dwCheckPoint;
            Sleep(svc_status.dwWaitHint);
            if(not QueryServiceStatus(h_svc,svc_status))then
            begin
              // couldn't check status
              break;
            end;
            if(svc_status.dwCheckPoint < dwCheckPoint)then
              break;
          end;
        end;
      end;
      CloseServiceHandle(h_svc);
    end;
    CloseServiceHandle(h_manager);
  end;
  Result := SERVICE_STOPPED = svc_status.dwCurrentState;
end;


 }
begin

    DispatchTable[0].lpServiceName := ServiceName;
    DispatchTable[0].lpServiceProc := @ServiceMain;
    DispatchTable[1].lpServiceName := nil;
    DispatchTable[1].lpServiceProc := nil;
        if not StartServiceCtrlDispatcher(DispatchTable[0]) then begin
  ErrCode:=GetLastError();
  MessageBox(0,
    PChar('StartServiceCtrlDispatcher Error '+format('%d(%x) %s', [ErrCode, ErrCode, SysErrorMessage(ErrCode)])),
    'Start Service Error ',
    MB_OK or MB_ICONERROR or MB_SERVICE_NOTIFICATION);
  end;
    //if (CreateNTService('C:\temp\project1.exe', 'project1') = true) then
  //ShowMessage('have been created');
//DeleteNTService('project1');
 //   ZeroMemory(@DispatchTable, SizeOf(DispatchTable));

    {if not StartServiceCtrlDispatcher(DispatchTable[0]) then
      LogError('StartServiceCtrlDispatcher Error');}


//    readln;
end.

Здравствуйте, Levin_610, Вы писали:

[Skip]

Я что то не понимаю. Вы супер сильно разбираетесь в сервисах?
Чем вам не понравилось стандартное решение:
File\New\Other...Service Application

Создает работающий сервис с полпинка...

Регистрируется (все работает сразу) service_sample.exe /install
Анинсталится service_sample.exe /uninstall

Здравствуйте, Danchik, Вы писали:

D>Здравствуйте, Levin_610, Вы писали:

D>[Skip]

D>Я что то не понимаю. Вы супер сильно разбираетесь в сервисах?
D>Чем вам не понравилось стандартное решение:
D>File\New\Other...Service Application

D>Создает работающий сервис с полпинка...

D>Регистрируется (все работает сразу) service_sample.exe /install
D>Анинсталится service_sample.exe /uninstall

Мне нужно создать самоустанавливающийся сервис. С возможностями старта, паузы, продолжения, остановки.

Здравствуйте, Levin_610, Вы писали:

[Skip]

L_>Мне нужно создать самоустанавливающийся сервис. С возможностями старта, паузы, продолжения, остановки.

По порядку:

Delphi генерит Service Application
Создается DataModule порожденный от TService

На DataModule есть события — выбирайте

AfterInstall
AfterUninstall
BeforeInstall
BeforeUninstall
OnContinue
OnExecute
OnPause
OnShutdown
OnStart
OnStop

Созданный таким образом сервис умеет Инсталится и Деинсталится автоматически. Это делается посредством ключей /install и /unitsnall.

Что еще надо?

Здравствуйте, Danchik, Вы писали:

D>Здравствуйте, Levin_610, Вы писали:

D>[Skip]

L_>>Мне нужно создать самоустанавливающийся сервис. С возможностями старта, паузы, продолжения, остановки.

D>По порядку:
D>

D>

Delphi генерит Service Application
D>

Создается DataModule порожденный от TService
D>

На DataModule есть события — выбирайте
D>

D>AfterInstall
D>AfterUninstall
D>BeforeInstall
D>BeforeUninstall
D>OnContinue
D>OnExecute
D>OnPause
D>OnShutdown
D>OnStart
D>OnStop
D>

D>

Созданный таким образом сервис умеет Инсталится и Деинсталится автоматически. Это делается посредством ключей /install и /unitsnall.
D>

D>Что еще надо?

Дело в том, что я не знаю, как так сделать, есть какой-нить пример или где-нить прочитать про это?

пожалуйста

Здравствуйте, Levin_610, Вы писали:

[Skip]

L_>Дело в том, что я не знаю, как так сделать, есть какой-нить пример или где-нить прочитать про это?

Да какой пример!!!!
Елы палы.

Втыкнули в Меню Delphi.
Нашли пункт File.
Нашли подпункт New>
Открылось подменю. Нашли Other... — тыкнули, желательно мышкой
О чудо — появилось окно. Называется New Items.
В закладочке New ищем Service Application. Отмечаем и со страшной дури жмем [OK]
Идем в Unit1. Смотрим на DataModule, внимательно так. Посмотрели, насладились. Активировали Object Inspector, переименовали DataModule — это название и будет названием вашено сервиса в Service Manager. Например, MyFirstService
Теперь жмем Save All и называем нашу программу service_sample
Компилим — честно нужно
Зпускаем CMD.exe / Far / Total Commander / черти знает какой shell
Запускаем нашу программу service_sample.exe /install — и, о чудо, наша программа сама себя проинсталировала
Тепрь осталось запустить. В той же консоли: net start MyFirstService

Включаем мозги, а то я уже начал скучать...

	От:	Levin_610
	Дата:	21.07.06 05:14
	Оценка:

	От:	xentry
	Дата:	21.07.06 06:14
	Оценка:

	От:	Levin_610
	Дата:	21.07.06 06:19
	Оценка:

	От:	xentry
	Дата:	21.07.06 07:24
	Оценка:	1 (1)

	От:	Levin_610
	Дата:	21.07.06 08:11
	Оценка: