Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > Разное
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 17.07.2006, 12:19
prosto_Maria prosto_Maria вне форума
Прохожий
 
Регистрация: 17.07.2006
Сообщения: 1
Репутация: 10
По умолчанию создание и регситрация

написана программа, вроде как сервис, но, не получается что-то видимо с регистрацией? - пожалуйста, подскажите в чём дело.
uses
Windows,
WinSvc,
sysutils;

const ServiceName = 'ServiceName';

var DispatchTable : array [0..1] of _SERVICE_TABLE_ENTRYA;
hThread: THandle;
ServiceStatus : SERVICE_STATUS;
ServiceStatusHandle : SERVICE_STATUS_HANDLE;

procedure LogError(text: string);
begin
end;

procedure ServiceCtrlHandler(Opcode: Cardinal); stdcall;
var
Status: Cardinal;
begin
case Opcode of
SERVICE_CONTROL_PAUSE:
begin
ServiceStatus.dwCurrentState := SERVICE_PAUSED;
end;
SERVICE_CONTROL_CONTINUE:
begin
ServiceStatus.dwCurrentState := SERVICE_RUNNING;
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;

function MainServiceThread(p: Pointer): DWORD; stdcall;
var hWinSta, hDesktop, hOldWinSta, hOldDesktop: THandle;
begin
sleep(INFINITE);
end;

procedure ServiceProc(argc: DWORD; var argv: array of PChar); stdcall;
var
Status: DWORD;
SpecificError: DWORD;
thID: cardinal;
begin
ServiceStatus.dwServiceType := SERVICE_WIN32;
ServiceStatus.dwCurrentState := SERVICE_START_PENDING;
ServiceStatus.dwControlsAccepted := SERVICE_ACCEPT_STOP
or SERVICE_ACCEPT_PAUSE_CONTINUE;
ServiceStatus.dwWin32ExitCode := 0;
ServiceStatus.dwServiceSpecificExitCode := 0;
ServiceStatus.dwCheckPoint := 0;
ServiceStatus.dwWaitHint := 0;

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

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');
exit;
end;

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

if not SetServiceStatus(ServiceStatusHandle, ServiceStatus) then
begin
Status := GetLastError;
LogError('SetServiceStatus');
exit;
end;
// WORK HERE


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

WaitForSingleObject(hThread, INFINITE);

CloseHandle(hThread);

end;

function CreateNTService(ExecutablePath, ServiceName: string): boolean;
var
hNewService, hSCMgr: SC_HANDLE;
FuncRetVal: Boolean;
begin
FuncRetVal := 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_DEMAND_START, SERVICE_ERROR_NORMAL,
PChar(ExecutablePath), nil, nil, nil, nil, nil);
CloseServiceHandle(hSCMgr);
if (hNewService <> 0) then
FuncRetVal := true
else
FuncRetVal := false;
end;
CreateNTService := FuncRetVal;
// CloseServiceHandle(hNewService);
writeln('Service Started successfully');

end;

function DeleteNTService(ServiceName: string): boolean;
var
hServiceToDelete, hSCMgr: SC_HANDLE;
RetVal: LongBool;
FunctRetVal: Boolean;
begin
FunctRetVal := false;
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);
FunctRetVal := RetVal;
end;
DeleteNTService := FunctRetVal;
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),
SERVICE_START or SERVICE_QUERY_STATUS);
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

if (paramcount = 2) then
begin
if (lowercase(paramstr(1)) = '/i') then
begin
CreateNTService(paramstr(0), paramstr(2));
// writeln('Service Started successfully');
exit;
end;

if (lowercase(paramstr(1)) = '/u') then
begin
DeleteNTService(paramstr(2));
// writeln('Service Stoped successfully');
exit;
end;

if (lowercase(paramstr(1)) = '/ir') then
begin
CreateNTService(paramstr(0), paramstr(2));
ServiceStart('', paramstr(2));
// writeln('Service Started successfully');
exit;
end;

if (lowercase(paramstr(1)) = '/su') then
begin
DeleteNTService(paramstr(2));
ServiceStop('', paramstr(2));
// writeln('Service Stopped successfully');
exit;
end;
end;
StartServiceCtrlDispatcher(DispatchTable[0]);
DispatchTable[0].lpServiceName := ServiceName;
DispatchTable[0].lpServiceProc := @ServiceProc;

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

if not StartServiceCtrlDispatcher(DispatchTable[0]) then
LogError('StartServiceCtrlDispatcher Error');
readln;
end.
Ответить с цитированием
  #2  
Старый 17.07.2006, 13:23
Аватар для Майняк
Майняк Майняк вне форума
Начинающий
 
Регистрация: 03.02.2006
Адрес: Киров
Сообщения: 198
Репутация: 50
По умолчанию

вот рабочий пример
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 21:02.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter