[Skip]
L_>я делал так, если запускать программу командная строка ... -> /install — то всё ок. L_>а если автоматически, то уже не запускается.
Значит плохо определяется что програма запущена из под менеджера сервисов...
Попробуйте такой вот вариант:
program Project1;
uses
SvcMgr,
Unit1 in'Unit1.pas'{MyFirstService: TService},
SysUtils,
WinSvc,
TlHelp32,
Windows,
Classes;
{$R *.RES}type
TServiceApplicationAccess = class (TServiceApplication);
function IsService: Boolean;
var
aSnapProcHandle: THandle;
aProcessEntry: TProcessEntry32;
aNext: Boolean;
aCurrentProcessID : Cardinal;
aSvcManagerIDs : TStringList;
aParentProcessID : Integer;
begin
Result := False;
aCurrentProcessID := GetCurrentProcessId;
aParentProcessID := 0;
aSnapProcHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if aSnapProcHandle <> THandle(-1) then begin
try
aSvcManagerIDs := TStringList.Create;
try
aSvcManagerIDs.Sorted := True;
aSvcManagerIDs.Duplicates := dupIgnore;
aProcessEntry.dwSize := Sizeof(aProcessEntry);
aNext := Process32First(aSnapProcHandle, aProcessEntry);
while aNext do
begin
if aProcessEntry.th32ProcessID = aCurrentProcessID then
aParentProcessID := aProcessEntry.th32ParentProcessID
else
if SameText (aProcessEntry.szExeFile, 'services.exe') then
aSvcManagerIDs.Add(IntToStr (aProcessEntry.th32ProcessID));
aNext := Process32Next(aSnapProcHandle, aProcessEntry);
end;
Result := (aParentProcessID > 0) and (aSvcManagerIDs.IndexOf(IntToStr(aParentProcessID)) >= 0);
finally
FreeAndNil (aSvcManagerIDs);
end;
finally
CloseHandle(aSnapProcHandle);
end;
end;
end;
function IsServiceInstalled (ServiceName : string) : Boolean;
var
Svc: Integer;
SvcMgr: Integer;
begin
Result := False;
SvcMgr := OpenSCManager(nil, nil, SC_MANAGER_CONNECT);
if SvcMgr = 0 then Exit;
try
Svc := OpenService (SvcMgr, PChar (ServiceName), SERVICE_QUERY_STATUS);
Result := Svc <> 0;
if Result then
CloseServiceHandle(Svc);
finally
CloseServiceHandle(SvcMgr);
end;
end;
begin
Application.Initialize;
Application.CreateForm(TMyFirstService, MyFirstService);
if not (FindCmdLineSwitch('INSTALL', ['-', '/'], True) or FindCmdLineSwitch('UNINSTALL', ['-', '/'], True)) then
begin
if not IsService {not started from service manager}then
begin
if not IsServiceInstalled (MyFirstService.Name) then
TServiceApplicationAccess (Application).RegisterServices (True, False);
Exit;
end;
end;
Application.Run;
end.
Здравствуйте, 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. Проще сделать так, чтобы процесс можно было запускать и как севрвис, и как приложение, и отлаживать все это как обычное приложение.
Здравствуйте, Danchik, Вы писали:
D>Здравствуйте, Levin_610, Вы писали:
D>>>А в теги форматирования pascal слобо обернуть? ЧЕРТОВСКИ мерзко читается
L_>>что сделать?)
D>Почитайте, очень полезно D>Оформляем сообщения красиво
{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);
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;
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');}
я создал сервис, нормально регистрируется,но выдаёт ошибку: "StartServiceCtrlDispatcher Error 1053(427) Процесс службы не может установить связь с контроллером службы". И не запускается нормально.Чем это вызвано и как можно это справить?
Здравствуйте, Levin_610, Вы писали:
L_>я создал сервис, нормально регистрируется,но выдаёт ошибку: "StartServiceCtrlDispatcher Error 1053(427) Процесс службы не может установить связь с контроллером службы". И не запускается нормально.Чем это вызвано и как можно это справить?
Ровно то и значит, что написано — уж не из-под IDE Вы его запускаете ?
В отладке сервиса есть небольшие ньюансы.
Здравствуйте, xentry, Вы писали:
X>Здравствуйте, Levin_610, Вы писали:
L_>>я создал сервис, нормально регистрируется,но выдаёт ошибку: "StartServiceCtrlDispatcher Error 1053(427) Процесс службы не может установить связь с контроллером службы". И не запускается нормально.Чем это вызвано и как можно это справить? X>Ровно то и значит, что написано — уж не из-под IDE Вы его запускаете ? X>В отладке сервиса есть небольшие ньюансы.
А как насчёт 2ой части вопроса? И я не знаю, что значит: "уж не из-под IDE Вы его запускаете ?"
Здравствуйте, 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
Здравствуйте, 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. Код показать стесняемся ?
Здравствуйте, xentry, Вы писали:
X>Здравствуйте, Levin_610, Вы писали:
L_>>боюсь, что я уже читал это и не раз X>Еще раз: StartServiceCtrlDispatcher и должен завершится с ошибкой ERROR_FAILED_SERVICE_CONTROLLER_CONNECT если процесс запущен как обычное приложение. По крайней мере других причин я не знаю. X>PS. Код показать стесняемся ?
{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);
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;
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;
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');}
Здравствуйте, Danchik, Вы писали:
D>Здравствуйте, Levin_610, Вы писали:
D>[Skip]
D>А в теги форматирования pascal слобо обернуть? ЧЕРТОВСКИ мерзко читается
Тчерт побери. Есть кнопочка Предосмотр. Глянули насладились, а не послали черт знает что.
Есть кнопочки внизу [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) dobegin
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;
//procedurefunction 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.
Здравствуйте, 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
Мне нужно создать самоустанавливающийся сервис. С возможностями старта, паузы, продолжения, остановки.
D>Созданный таким образом сервис умеет Инсталится и Деинсталится автоматически. Это делается посредством ключей /install и /unitsnall. D>D>Что еще надо?
Дело в том, что я не знаю, как так сделать, есть какой-нить пример или где-нить прочитать про это?
[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
Здравствуйте, Danchik, Вы писали:
D>Здравствуйте, Levin_610, Вы писали:
D>[Skip]
L_>>Дело в том, что я не знаю, как так сделать, есть какой-нить пример или где-нить прочитать про это?
D>Да какой пример!!!! D>Елы палы.
D>
D>Втыкнули в Меню Delphi. D>Нашли пункт File. D>Нашли подпункт New> D>Открылось подменю. Нашли Other... — тыкнули, желательно мышкой D>О чудо — появилось окно. Называется New Items. D>В закладочке New ищем Service Application. Отмечаем и со страшной дури жмем [OK] D>Идем в Unit1. Смотрим на DataModule, внимательно так. Посмотрели, насладились. Активировали Object Inspector, переименовали DataModule — это название и будет названием вашено сервиса в Service Manager. Например, MyFirstService D>Теперь жмем Save All и называем нашу программу service_sample D>Компилим — честно нужно D>Зпускаем CMD.exe / Far / Total Commander / черти знает какой shell D>Запускаем нашу программу service_sample.exe /install — и, о чудо, наша программа сама себя проинсталировала D>Тепрь осталось запустить. В той же консоли: net start MyFirstService D>
D>Включаем мозги, а то я уже начал скучать...
Делов том, что это ни есть автоматическая установка. Мне нужно сделать так, чтоб я запускал экзешник и сервис регистрировался.
[Skip]
L_>Делов том, что это ни есть автоматическая установка. Мне нужно сделать так, чтоб я запускал экзешник и сервис регистрировался.
Эт...
Для того чтобы определить запускается ли наша программа ручками или через сервис манагер есть такой вот С++ код http://win32.mvps.org/security/is_svc.html. Переведу на досуге... Но я когда то придумал свое простенькое решение. Для вас DPR будет выглядеть так:
program Project1;
uses
SvcMgr,
Unit1 in'Unit1.pas'{Service1: TService},
SysUtils,
WinSvc;
{$R *.RES}type
TServiceApplicationAccess = class (TServiceApplication);
function IsServiceRunning (ServiceName : string) : Boolean;
var
Svc: Integer;
SvcMgr: Integer;
ServSt : TServiceStatus;
begin{ самое простое что могу предложить }
Result := False;
SvcMgr := OpenSCManager(nil, nil, SC_MANAGER_CONNECT);
if SvcMgr = 0 then Exit;
try
Svc := OpenService (SvcMgr, PChar (ServiceName), SERVICE_QUERY_STATUS);
if Svc = 0 then Exit;
try
if not QueryServiceStatus (Svc, ServSt) then Exit;
Result := (ServSt.dwCurrentState = SERVICE_RUNNING) or (ServSt.dwCurrentState = SERVICE_START_PENDING);
finally
CloseServiceHandle(Svc);
end;
finally
CloseServiceHandle(SvcMgr);
end;
end;
begin
Application.Initialize;
Application.CreateForm(TService1, Service1);
if not (FindCmdLineSwitch('INSTALL', ['-', '/'], True) or FindCmdLineSwitch('UNINSTALL', ['-', '/'], True)) then
begin
if not IsServiceRunning ('MyFirstService') {not started from service manager}then
begin
TServiceApplicationAccess (Application).RegisterServices (True, False); // инсталим!
Exit;
end;
end;
Application.Run;
end.
Здравствуйте, Danchik, Вы писали:
D>Здравствуйте, Levin_610, Вы писали:
D>[Skip]
L_>>Делов том, что это ни есть автоматическая установка. Мне нужно сделать так, чтоб я запускал экзешник и сервис регистрировался.
D>Эт...
D>Для того чтобы определить запускается ли наша программа ручками или через сервис манагер есть такой вот С++ код http://win32.mvps.org/security/is_svc.html. Переведу на досуге... Но я когда то придумал свое простенькое решение. Для вас DPR будет выглядеть так: D>
D>program Project1;
D>uses
D> SvcMgr,
D> Unit1 in'Unit1.pas'{Service1: TService},
D> SysUtils,
D> WinSvc;
D>{$R *.RES}
D>type
D> TServiceApplicationAccess = class (TServiceApplication);
D>function IsServiceRunning (ServiceName : string) : Boolean;
D>var
D> Svc: Integer;
D> SvcMgr: Integer;
D> ServSt : TServiceStatus;
D>begin
D> { самое простое что могу предложить }
D> Result := False;
D> SvcMgr := OpenSCManager(nil, nil, SC_MANAGER_CONNECT);
D> if SvcMgr = 0 then Exit;
D> try
D> Svc := OpenService (SvcMgr, PChar (ServiceName), SERVICE_QUERY_STATUS);
D> if Svc = 0 then Exit;
D> try
D> if not QueryServiceStatus (Svc, ServSt) then Exit;
D> Result := (ServSt.dwCurrentState = SERVICE_RUNNING) or (ServSt.dwCurrentState = SERVICE_START_PENDING);
D> finally
D> CloseServiceHandle(Svc);
D> end;
D> finally
D> CloseServiceHandle(SvcMgr);
D> end;
D>end;
D>begin
D> Application.Initialize;
D> Application.CreateForm(TService1, Service1);
D> if not (FindCmdLineSwitch('INSTALL', ['-', '/'], True) or FindCmdLineSwitch('UNINSTALL', ['-', '/'], True)) then
D> begin
D> if not IsServiceRunning ('MyFirstService') {not started from service manager}then
D> begin
D> TServiceApplicationAccess (Application).RegisterServices (True, False); // инсталим!
D> Exit;
D> end;
D> end;
D> Application.Run;
D>end.
D>
Здравствуйте, Danchik, Вы писали:
D>Здравствуйте, Levin_610, Вы писали:
D>[Skip]
L_>>Делов том, что это ни есть автоматическая установка. Мне нужно сделать так, чтоб я запускал экзешник и сервис регистрировался.
D>Эт...
D>Для того чтобы определить запускается ли наша программа ручками или через сервис манагер есть такой вот С++ код http://win32.mvps.org/security/is_svc.html. Переведу на досуге... Но я когда то придумал свое простенькое решение. Для вас DPR будет выглядеть так: D>
D>program Project1;
D>uses
D> SvcMgr,
D> Unit1 in'Unit1.pas'{Service1: TService},
D> SysUtils,
D> WinSvc;
D>{$R *.RES}
D>type
D> TServiceApplicationAccess = class (TServiceApplication);
D>function IsServiceRunning (ServiceName : string) : Boolean;
D>var
D> Svc: Integer;
D> SvcMgr: Integer;
D> ServSt : TServiceStatus;
D>begin
D> { самое простое что могу предложить }
D> Result := False;
D> SvcMgr := OpenSCManager(nil, nil, SC_MANAGER_CONNECT);
D> if SvcMgr = 0 then Exit;
D> try
D> Svc := OpenService (SvcMgr, PChar (ServiceName), SERVICE_QUERY_STATUS);
D> if Svc = 0 then Exit;
D> try
D> if not QueryServiceStatus (Svc, ServSt) then Exit;
D> Result := (ServSt.dwCurrentState = SERVICE_RUNNING) or (ServSt.dwCurrentState = SERVICE_START_PENDING);
D> finally
D> CloseServiceHandle(Svc);
D> end;
D> finally
D> CloseServiceHandle(SvcMgr);
D> end;
D>end;
D>begin
D> Application.Initialize;
D> Application.CreateForm(TService1, Service1);
D> if not (FindCmdLineSwitch('INSTALL', ['-', '/'], True) or FindCmdLineSwitch('UNINSTALL', ['-', '/'], True)) then
D> begin
D> if not IsServiceRunning ('MyFirstService') {not started from service manager}then
D> begin
D> TServiceApplicationAccess (Application).RegisterServices (True, False); // инсталим!
D> Exit;
D> end;
D> end;
D> Application.Run;
D>end.
D>
только теперь другая проблема устанавливаться, то устанавливается, но теперь, как и у меня раньше не запускается
Замечание. Не занимайтесь оверквотингом. Мне и никому из здесь присутствующих нафиг не интересно смотреть на код запостаный до того. Просто вырезайте лишнее и пишите [Skip]. Нету модератора, а то бы он вам это замечание сделал.
L_>только теперь другая проблема устанавливаться, то устанавливается, но теперь, как и у меня раньше не запускается
Здравствуйте, Danchik, Вы писали:
D>Здравствуйте, Levin_610, Вы писали:
D>[Skip]
D>Замечание. Не занимайтесь оверквотингом. Мне и никому из здесь присутствующих нафиг не интересно смотреть на код запостаный до того. Просто вырезайте лишнее и пишите [Skip]. Нету модератора, а то бы он вам это замечание сделал.
L_>>только теперь другая проблема устанавливаться, то устанавливается, но теперь, как и у меня раньше не запускается
D>Как вы его запускаете?
Мда .... Невнимательно Вы видимо читали "это всё". Я местами Ваш код честно говоря "не осилил", поэтому вот вам работающий пример, (по мотивам вашего кода), который даже компилится, и запускается. Обработка ошибок, и проч. не относящиеся к делу вещи — выброшены:
program service_sample;
uses
Windows,
WinSvc,
Messages,
SysUtils,
Classes;
const
SServiceName = 'project1';
SName = 'muSuperEvent';
var
DispatchTable: array[0..1] of _SERVICE_TABLE_ENTRYA;
ServiceStatus: SERVICE_STATUS;
ServiceStatusHandle: SERVICE_STATUS_HANDLE;
procedure ServiceCtrlHandler(Opcode: Cardinal); stdcall;
var
lEvent: THandle;
begin
case Opcode of
SERVICE_CONTROL_STOP:
begin
lEvent := CreateEvent(nil, false, true, SName);
SetEvent(lEvent);
CloseHandle(lEvent);
end;
end;
end;
procedure ServiceMain(argc: DWORD; var argv: array of PChar); stdcall;
var
lEvent: THandle;
begin
ServiceStatusHandle :=
RegisterServiceCtrlHandler(SName, @ServiceCtrlHandler);
ZeroMemory(@ServiceStatus, SizeOf(ServiceStatus));
ServiceStatus.dwServiceType := SERVICE_WIN32_OWN_PROCESS;
ServiceStatus.dwCurrentState := SERVICE_START_PENDING;
SetServiceStatus(ServiceStatusHandle, ServiceStatus);
{ .... }
ServiceStatus.dwCurrentState := SERVICE_RUNNING;
ServiceStatus.dwControlsAccepted := SERVICE_ACCEPT_STOP;
SetServiceStatus(ServiceStatusHandle, ServiceStatus);
lEvent := CreateEvent(nil, false, false, SName);
WaitForSingleObject(lEvent, INFINITE);
CloseHandle(lEvent);
ServiceStatus.dwCurrentState := SERVICE_STOPPED;
SetServiceStatus(ServiceStatusHandle, ServiceStatus);
end;
function CreateNTService(ExecutablePath, ServiceName: string): boolean;
var
hSCMgr: SC_HANDLE;
begin
hSCMgr := OpenSCManager(nil, nil, SC_MANAGER_CREATE_SERVICE);
Result := hSCMgr <> 0;
if Result then
begin
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);
CloseServiceHandle(hSCMgr);
end;
end;
procedure DeleteNTService(ServiceName: string);
var
hServiceToDelete, hSCMgr: SC_HANDLE;
begin
hSCMgr := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
if (hSCMgr <> 0) then
begin
hServiceToDelete := OpenService(hSCMgr, PChar(ServiceName),
SERVICE_ALL_ACCESS);
DeleteService(hServiceToDelete);
CloseServiceHandle(hSCMgr);
end;
end;
begin
if FindCmdLineSwitch('install', true) then
CreateNTService(ParamStr(0), SServiceName)
else
if FindCmdLineSwitch('remove', true) then
DeleteNTService(SServiceName)
else
begin
DispatchTable[0].lpServiceName := SName;
DispatchTable[0].lpServiceProc := @ServiceMain;
DispatchTable[1].lpServiceName := nil;
DispatchTable[1].lpServiceProc := nil;
StartServiceCtrlDispatcher(DispatchTable[0]);
end;
end.
Здравствуйте, xentry, Вы писали:
X>Здравствуйте, Levin_610, Вы писали:
X>Мда .... Невнимательно Вы видимо читали "это всё". Я местами Ваш код честно говоря "не осилил", поэтому вот вам работающий пример, (по мотивам вашего кода), который даже компилится, и запускается. Обработка ошибок, и проч. не относящиеся к делу вещи — выброшены:
Спасибо за код, но:
Я по идее могу сделать: CreateNTService('c:\temp\caracurta', SServiceName), т.е. самому автоматически задать параметры? и по идее должно всё запускаться, так?
[Skip]
L_>>>только теперь другая проблема устанавливаться, то устанавливается, но теперь, как и у меня раньше не запускается
D>>Как вы его запускаете?
L_>Администрирование -> службы -> запуск службы
Здравствуйте, Danchik, Вы писали:
D>Здравствуйте, Levin_610, Вы писали:
D>[Skip]
L_>>>>только теперь другая проблема устанавливаться, то устанавливается, но теперь, как и у меня раньше не запускается
D>>>Как вы его запускаете?
L_>>Администрирование -> службы -> запуск службы
D>И что говорит? D>В OnStart попадает?
говорит следующее: "Не удалось запустить службу на локальный компьютер — ошибка 1053 — служба не ответила на вопрос своевременно"
[Skip]
L_>>>Администрирование -> службы -> запуск службы
D>>И что говорит? D>>В OnStart попадает?
L_>говорит следующее: "Не удалось запустить службу на локальный компьютер — ошибка 1053 — служба не ответила на вопрос своевременно"
Начинаем от противного
Коментим лишнее и смотрим что мешает работать. Не буду же я вас учить как искать ошибки...
Здравствуйте, Danchik, Вы писали:
D>Здравствуйте, Levin_610, Вы писали:
D>[Skip]
L_>>>>Администрирование -> службы -> запуск службы
D>>>И что говорит? D>>>В OnStart попадает?
L_>>говорит следующее: "Не удалось запустить службу на локальный компьютер — ошибка 1053 — служба не ответила на вопрос своевременно"
D>Начинаем от противного D>Коментим лишнее и смотрим что мешает работать. Не буду же я вас учить как искать ошибки...
я делал так, если запускать программу командная строка ... -> /install — то всё ок.
а если автоматически, то уже не запускается.
Здравствуйте, Danchik, Вы писали:
D>Здравствуйте, Levin_610, Вы писали:
D>[Skip]
L_>>>>Администрирование -> службы -> запуск службы
D>>>И что говорит? D>>>В OnStart попадает?
L_>>говорит следующее: "Не удалось запустить службу на локальный компьютер — ошибка 1053 — служба не ответила на вопрос своевременно"
D>Начинаем от противного D>Коментим лишнее и смотрим что мешает работать. Не буду же я вас учить как искать ошибки...
Здравствуйте, Levin_610, Вы писали:
L_>Здравствуйте, Danchik, Вы писали:
D>>Здравствуйте, Levin_610, Вы писали:
D>>[Skip]
L_>>>>>Администрирование -> службы -> запуск службы
D>>>>И что говорит? D>>>>В OnStart попадает?
L_>>>говорит следующее: "Не удалось запустить службу на локальный компьютер — ошибка 1053 — служба не ответила на вопрос своевременно"
D>>Начинаем от противного D>>Коментим лишнее и смотрим что мешает работать. Не буду же я вас учить как искать ошибки...
L_>Application.Run; — у меня не проходит вот это.
Насчёт этого вопрос снят, т.е. при /install всё работает при регистрации из проги нет.
Здравствуйте, Danchik, Вы писали:
D>Здравствуйте, Levin_610, Вы писали:
D>[Skip]
L_>>я делал так, если запускать программу командная строка ... -> /install — то всё ок. L_>>а если автоматически, то уже не запускается.
D>Значит плохо определяется что програма запущена из под менеджера сервисов... D>Попробуйте такой вот вариант:
D>
D>program Project1;
D>uses
D> SvcMgr,
D> Unit1 in'Unit1.pas'{MyFirstService: TService},
D> SysUtils,
D> WinSvc,
D> TlHelp32,
D> Windows,
D> Classes;
D>{$R *.RES}
D>type
D> TServiceApplicationAccess = class (TServiceApplication);
D>function IsService: Boolean;
D>var
D> aSnapProcHandle: THandle;
D> aProcessEntry: TProcessEntry32;
D> aNext: Boolean;
D> aCurrentProcessID : Cardinal;
D> aSvcManagerIDs : TStringList;
D> aParentProcessID : Integer;
D>begin
D> Result := False;
D> aCurrentProcessID := GetCurrentProcessId;
D> aParentProcessID := 0;
D> aSnapProcHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
D> if aSnapProcHandle <> THandle(-1) then begin
D> try
D> aSvcManagerIDs := TStringList.Create;
D> try
D> aSvcManagerIDs.Sorted := True;
D> aSvcManagerIDs.Duplicates := dupIgnore;
D> aProcessEntry.dwSize := Sizeof(aProcessEntry);
D> aNext := Process32First(aSnapProcHandle, aProcessEntry);
D> while aNext do
D> begin
D> if aProcessEntry.th32ProcessID = aCurrentProcessID then
D> aParentProcessID := aProcessEntry.th32ParentProcessID
D> else
D> if SameText (aProcessEntry.szExeFile, 'services.exe') then
D> aSvcManagerIDs.Add(IntToStr (aProcessEntry.th32ProcessID));
D> aNext := Process32Next(aSnapProcHandle, aProcessEntry);
D> end;
D> Result := (aParentProcessID > 0) and (aSvcManagerIDs.IndexOf(IntToStr(aParentProcessID)) >= 0);
D> finally
D> FreeAndNil (aSvcManagerIDs);
D> end;
D> finally
D> CloseHandle(aSnapProcHandle);
D> end;
D> end;
D>end;
D>function IsServiceInstalled (ServiceName : string) : Boolean;
D>var
D> Svc: Integer;
D> SvcMgr: Integer;
D>begin
D> Result := False;
D> SvcMgr := OpenSCManager(nil, nil, SC_MANAGER_CONNECT);
D> if SvcMgr = 0 then Exit;
D> try
D> Svc := OpenService (SvcMgr, PChar (ServiceName), SERVICE_QUERY_STATUS);
D> Result := Svc <> 0;
D> if Result then
D> CloseServiceHandle(Svc);
D> finally
D> CloseServiceHandle(SvcMgr);
D> end;
D>end;
D>begin
D> Application.Initialize;
D> Application.CreateForm(TMyFirstService, MyFirstService);
D> if not (FindCmdLineSwitch('INSTALL', ['-', '/'], True) or FindCmdLineSwitch('UNINSTALL', ['-', '/'], True)) then
D> begin
D> if not IsService {not started from service manager}then
D> begin
D> if not IsServiceInstalled (MyFirstService.Name) then
D> TServiceApplicationAccess (Application).RegisterServices (True, False);
D> Exit;
D> end;
D> end;
D> Application.Run;
D>end.
D>
Здравствуйте, Danchik, Вы писали:
D>Здравствуйте, Levin_610, Вы писали:
D>[Skip]
L_>>Всё работает — спасибо огромное!
D>Я смотрю вы не хотите учится — вытереть кусок сообщения надо! Прекращайте оверквотить. D>Спасибо здесь говорят через оценки.