Легенда:
 новое сообщение
 закрытая нитка
 новое сообщение
 в закрытой нитке
 старое сообщение
|
- Напоминаю, что масса вопросов по функционированию форума снимается после прочтения его описания.
- Новичкам также крайне полезно ознакомиться с данным документом.
Господа, будьте снисходительны, не бросайтесь сразу штрафовать за, как вам кажется, глупые вопросы - beginners на то и beginners.
| |
Там простые функции, проверьте ещё раз код. 19.07.06 10:23 Число просмотров: 2965
Автор: HandleX <Александр М.> Статус: The Elderman
|
|
В крайнем случае, можете управлять службой встроенной утилитой net start/stop <ИмяВашейСлужбы>.
|
|
<beginners>
|
создание и регистрация сервисов 17.07.06 13:03
Автор: prosto_Maria Статус: Незарегистрированный пользователь
|
написана программа, что не так - подскажите пожалуйста
program service_sample;
{$APPTYPE CONSOLE}
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;
// place for worktime
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);
// MessageBox()
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;
DispatchTable[0].lpServiceName := ServiceName;
DispatchTable[0].lpServiceProc := @ServiceProc;
DispatchTable[1].lpServiceName := nil;
DispatchTable[1].lpServiceProc := nil;
StartServiceCtrlDispatcher(DispatchTable[0]);
if not StartServiceCtrlDispatcher(DispatchTable[0]) then
LogError('StartServiceCtrlDispatcher Error');
// readln;
end.
|
|
прочитала про сервисы, почти всё получилось, регистрировать,... 18.07.06 16:13
Автор: prosto_Maria Статус: Незарегистрированный пользователь
|
|
прочитала про сервисы, почти всё получилось, регистрировать, удалять службу, только не получается написать функции ServiceStart и ServiceStop для запуска и остановки сервиса
|
| |
Там простые функции, проверьте ещё раз код. 19.07.06 10:23
Автор: HandleX <Александр М.> Статус: The Elderman
|
|
В крайнем случае, можете управлять службой встроенной утилитой net start/stop <ИмяВашейСлужбы>.
|
|
FAQ читали? Там есть примеры тестовых служб, можете глянуть... 17.07.06 14:07
Автор: HandleX <Александр М.> Статус: The Elderman
Отредактировано 17.07.06 14:07 Количество правок: 1
|
Из-за нехватки времени не могу проникнуться Вашим кодом, поэтому лучше проникнитесь Вы моим, что по ссылке ниже, возможно найдёте для себя что-нибудь полезное.
ЧАВО по службам NT
|
|
Выскажу своё авторитетное мнение: 17.07.06 13:21
Автор: NKritsky <Nickolay A. Kritsky> Статус: Elderman
|
Выскажу своё авторитетное мнение:
Если ты эту программу запускал, и она работает - значит скорее всего всё так. Если не работает - наверняка что-то не так.
|
|
|
подробно о проекте
Анализ криптографических сетевых...
