Re[27]: Сервис
От: Danchik Украина  
Дата: 24.07.06 11:13
Оценка: 3 (1)
Здравствуйте, Levin_610, Вы писали:

[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.
Re[3]: Сервис
От: xentry  
Дата: 21.07.06 07:24
Оценка: 1 (1)
Здравствуйте, 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>>
Re[12]: Сервис
От: Levin_610  
Дата: 21.07.06 12:14
Оценка: :)
Здравствуйте, 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  
Дата: 21.07.06 05:14
Оценка:
я создал сервис, нормально регистрируется,но выдаёт ошибку: "StartServiceCtrlDispatcher Error 1053(427) Процесс службы не может установить связь с контроллером службы". И не запускается нормально.Чем это вызвано и как можно это справить?
Re: Сервис
От: xentry  
Дата: 21.07.06 06:14
Оценка:
Здравствуйте, Levin_610, Вы писали:

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

Ровно то и значит, что написано — уж не из-под IDE Вы его запускаете ?
В отладке сервиса есть небольшие ньюансы.
... << RSDN@Home 1.1.4 stable SR1 rev. 568>>
Re[2]: Сервис
От: Levin_610  
Дата: 21.07.06 06:19
Оценка:
Здравствуйте, xentry, Вы писали:

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


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

X>Ровно то и значит, что написано — уж не из-под IDE Вы его запускаете ?
X>В отладке сервиса есть небольшие ньюансы.

А как насчёт 2ой части вопроса? И я не знаю, что значит: "уж не из-под IDE Вы его запускаете ?"
Re[4]: Сервис
От: Levin_610  
Дата: 21.07.06 08:11
Оценка:
Здравствуйте, 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. Проще сделать так, чтобы процесс можно было запускать и как севрвис, и как приложение, и отлаживать все это как обычное приложение.


Я просто запускаю свою программу, как обычное приложение и она у меня сначала регистрируется, как сервис, а вот работать уже не хочет, видима из-за вышеупомянутой ошибки.
Re[5]: Сервис
От: xentry  
Дата: 21.07.06 08:53
Оценка:
Здравствуйте, Levin_610, Вы писали:

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

Перед тем, как искать ошибку у себя в коде, советую всё-таки прочитать, как это все работает:
http://www.rsdn.ru/article/baseserv/services_details.xml
Автор(ы): Сергей Холодилов
Дата: 22.06.2003
В статье описаны некоторые детали программирования служб Windows NT/2000/XP. Большая часть содержащихся в статье утверждений описывает реакцию Windows на какие-то действия службы. Если вы написали первую службу и хотите двигаться дальше, эта статья вам поможет.
... << RSDN@Home 1.1.4 stable SR1 rev. 568>>
Re[6]: Сервис
От: Levin_610  
Дата: 21.07.06 09:59
Оценка:
Здравствуйте, xentry, Вы писали:

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


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

X>Перед тем, как искать ошибку у себя в коде, советую всё-таки прочитать, как это все работает:
X>http://www.rsdn.ru/article/baseserv/services_details.xml
Автор(ы): Сергей Холодилов
Дата: 22.06.2003
В статье описаны некоторые детали программирования служб Windows NT/2000/XP. Большая часть содержащихся в статье утверждений описывает реакцию Windows на какие-то действия службы. Если вы написали первую службу и хотите двигаться дальше, эта статья вам поможет.


боюсь, что я уже читал это и не раз
Re[7]: Сервис
От: xentry  
Дата: 21.07.06 11:27
Оценка:
Здравствуйте, Levin_610, Вы писали:

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

Еще раз: StartServiceCtrlDispatcher и должен завершится с ошибкой ERROR_FAILED_SERVICE_CONTROLLER_CONNECT если процесс запущен как обычное приложение. По крайней мере других причин я не знаю.
PS. Код показать стесняемся ?
... << RSDN@Home 1.1.4 stable SR1 rev. 568>>
Re[8]: Сервис
От: Levin_610  
Дата: 21.07.06 11:41
Оценка:
Здравствуйте, 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.
Re[9]: Сервис
От: Danchik Украина  
Дата: 21.07.06 11:48
Оценка:
Здравствуйте, Levin_610, Вы писали:

[Skip]

А в теги форматирования pascal слобо обернуть? ЧЕРТОВСКИ мерзко читается
Re[10]: Сервис
От: Levin_610  
Дата: 21.07.06 11:55
Оценка:
Здравствуйте, Danchik, Вы писали:

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


D>[Skip]


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


что сделать?)
Re[11]: Сервис
От: Danchik Украина  
Дата: 21.07.06 12:00
Оценка:
Здравствуйте, Levin_610, Вы писали:

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


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


Почитайте, очень полезно
Оформляем сообщения красиво
Re[13]: Сервис
От: Danchik Украина  
Дата: 21.07.06 12:26
Оценка:
Здравствуйте, 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.
Re[13]: Сервис
От: Danchik Украина  
Дата: 21.07.06 12:33
Оценка:
Здравствуйте, Levin_610, Вы писали:

[Skip]

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

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

Регистрируется (все работает сразу) service_sample.exe /install
Анинсталится service_sample.exe /uninstall
Re[14]: Сервис
От: Levin_610  
Дата: 21.07.06 12:39
Оценка:
Здравствуйте, 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


Мне нужно создать самоустанавливающийся сервис. С возможностями старта, паузы, продолжения, остановки.
Re[15]: Сервис
От: Danchik Украина  
Дата: 21.07.06 12:46
Оценка:
Здравствуйте, Levin_610, Вы писали:

[Skip]


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


По порядку:
Что еще надо?
Re[16]: Сервис
От: Levin_610  
Дата: 21.07.06 12:52
Оценка:
Здравствуйте, Danchik, Вы писали:

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


D>[Skip]



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


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

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

Дело в том, что я не знаю, как так сделать, есть какой-нить пример или где-нить прочитать про это?
Re[17]: Сервис
От: Levin_610  
Дата: 21.07.06 13:12
Оценка:
пожалуйста
Re[17]: Сервис
От: Danchik Украина  
Дата: 21.07.06 13:14
Оценка:
Здравствуйте, Levin_610, Вы писали:

[Skip]

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


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


Включаем мозги, а то я уже начал скучать...
Re[18]: Сервис
От: Levin_610  
Дата: 21.07.06 13:17
Оценка:
Здравствуйте, Danchik, Вы писали:

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


D>[Skip]


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


D>Да какой пример!!!!

D>Елы палы.

D>

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


Делов том, что это ни есть автоматическая установка. Мне нужно сделать так, чтоб я запускал экзешник и сервис регистрировался.
Re[19]: Сервис
От: Danchik Украина  
Дата: 21.07.06 13:45
Оценка:
Здравствуйте, Levin_610, Вы писали:

[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.
Re[20]: Сервис
От: Levin_610  
Дата: 21.07.06 13:49
Оценка:
Здравствуйте, 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>


спасибо большое
Re[20]: Сервис
От: Levin_610  
Дата: 21.07.06 13:51
Оценка:
Здравствуйте, 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>


только теперь другая проблема устанавливаться, то устанавливается, но теперь, как и у меня раньше не запускается
Re[21]: Сервис
От: Danchik Украина  
Дата: 21.07.06 14:09
Оценка:
Здравствуйте, Levin_610, Вы писали:

[Skip]

L_>спасибо большое


Это самое, спасибо тут говорят так: Правила начисления оценок
Автор: IT
Дата: 16.04.03
.
Тоесть помогло, интересно. Нажали цифорку
Re[21]: Сервис
От: Danchik Украина  
Дата: 21.07.06 14:10
Оценка:
Здравствуйте, Levin_610, Вы писали:

[Skip]

Замечание. Не занимайтесь оверквотингом. Мне и никому из здесь присутствующих нафиг не интересно смотреть на код запостаный до того. Просто вырезайте лишнее и пишите [Skip]. Нету модератора, а то бы он вам это замечание сделал.

L_>только теперь другая проблема устанавливаться, то устанавливается, но теперь, как и у меня раньше не запускается


Как вы его запускаете?
Re[22]: Сервис
От: Levin_610  
Дата: 24.07.06 05:17
Оценка:
Здравствуйте, Danchik, Вы писали:

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


D>[Skip]


D>Замечание. Не занимайтесь оверквотингом. Мне и никому из здесь присутствующих нафиг не интересно смотреть на код запостаный до того. Просто вырезайте лишнее и пишите [Skip]. Нету модератора, а то бы он вам это замечание сделал.


L_>>только теперь другая проблема устанавливаться, то устанавливается, но теперь, как и у меня раньше не запускается


D>Как вы его запускаете?


Администрирование -> службы -> запуск службы
Re[9]: Сервис
От: xentry  
Дата: 24.07.06 07:04
Оценка:
Здравствуйте, Levin_610, Вы писали:

Мда .... Невнимательно Вы видимо читали "это всё". Я местами Ваш код честно говоря "не осилил", поэтому вот вам работающий пример, (по мотивам вашего кода), который даже компилится, и запускается. Обработка ошибок, и проч. не относящиеся к делу вещи — выброшены:


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.
... << RSDN@Home 1.1.4 stable SR1 rev. 568>>
Re[10]: Сервис
От: Levin_610  
Дата: 24.07.06 07:17
Оценка:
Здравствуйте, xentry, Вы писали:

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


X>Мда .... Невнимательно Вы видимо читали "это всё". Я местами Ваш код честно говоря "не осилил", поэтому вот вам работающий пример, (по мотивам вашего кода), который даже компилится, и запускается. Обработка ошибок, и проч. не относящиеся к делу вещи — выброшены:



X>
X>program service_sample;

X>uses
X>  Windows,
X>  WinSvc,
X>  Messages,
X>  SysUtils,
X>  Classes;

X>const
X>  SServiceName = 'project1';
X>  SName = 'muSuperEvent';

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

X>procedure ServiceCtrlHandler(Opcode: Cardinal); stdcall;
X>var
X>  lEvent: THandle;
X>begin
X>  case Opcode of
X>    SERVICE_CONTROL_STOP:
X>      begin
X>        lEvent := CreateEvent(nil, false, true, SName);
X>        SetEvent(lEvent);
X>        CloseHandle(lEvent);
X>      end;
X>  end;
X>end;

X>procedure ServiceMain(argc: DWORD; var argv: array of PChar); stdcall;
X>var
X>  lEvent: THandle;
X>begin
X>  ServiceStatusHandle :=
X>    RegisterServiceCtrlHandler(SName, @ServiceCtrlHandler);

X>  ZeroMemory(@ServiceStatus, SizeOf(ServiceStatus));
X>  ServiceStatus.dwServiceType := SERVICE_WIN32_OWN_PROCESS;
X>  ServiceStatus.dwCurrentState := SERVICE_START_PENDING;
X>  SetServiceStatus(ServiceStatusHandle, ServiceStatus);

X>  { .... }

X>  ServiceStatus.dwCurrentState := SERVICE_RUNNING;
X>  ServiceStatus.dwControlsAccepted := SERVICE_ACCEPT_STOP;
X>  SetServiceStatus(ServiceStatusHandle, ServiceStatus);

X>  lEvent := CreateEvent(nil, false, false, SName);
X>  WaitForSingleObject(lEvent, INFINITE);
X>  CloseHandle(lEvent);

X>  ServiceStatus.dwCurrentState := SERVICE_STOPPED;
X>  SetServiceStatus(ServiceStatusHandle, ServiceStatus);
X>end;

X>function CreateNTService(ExecutablePath, ServiceName: string): boolean;
X>var
X>  hSCMgr: SC_HANDLE;
X>begin
X>  hSCMgr := OpenSCManager(nil, nil, SC_MANAGER_CREATE_SERVICE);
X>  Result := hSCMgr <> 0;
X>  if Result then
X>  begin
X>    CreateService(hSCMgr, PChar(ServiceName), PChar(ServiceName),
X>      SC_MANAGER_CREATE_SERVICE, SERVICE_WIN32_OWN_PROCESS,
X>      SERVICE_AUTO_START, SERVICE_ERROR_NORMAL,
X>      PChar(ExecutablePath), nil, nil, nil, nil, nil);
X>    CloseServiceHandle(hSCMgr);
X>  end;
X>end;

X>procedure DeleteNTService(ServiceName: string);
X>var
X>  hServiceToDelete, hSCMgr: SC_HANDLE;
X>begin
X>  hSCMgr := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
X>  if (hSCMgr <> 0) then
X>  begin
X>    hServiceToDelete := OpenService(hSCMgr, PChar(ServiceName),
X>      SERVICE_ALL_ACCESS);
X>    DeleteService(hServiceToDelete);
X>    CloseServiceHandle(hSCMgr);
X>  end;
X>end;

X>begin
X>  if FindCmdLineSwitch('install', true) then
X>    CreateNTService(ParamStr(0), SServiceName)
X>  else
X>    if FindCmdLineSwitch('remove', true) then
X>      DeleteNTService(SServiceName)
X>    else
X>    begin
X>      DispatchTable[0].lpServiceName := SName;
X>      DispatchTable[0].lpServiceProc := @ServiceMain;
X>      DispatchTable[1].lpServiceName := nil;
X>      DispatchTable[1].lpServiceProc := nil;
X>      StartServiceCtrlDispatcher(DispatchTable[0]);
X>    end;
X>end.
X>



Спасибо за код, но:
Я по идее могу сделать: CreateNTService('c:\temp\caracurta', SServiceName), т.е. самому автоматически задать параметры? и по идее должно всё запускаться, так?
Re[23]: Сервис
От: Danchik Украина  
Дата: 24.07.06 09:50
Оценка:
Здравствуйте, Levin_610, Вы писали:

[Skip]

L_>>>только теперь другая проблема устанавливаться, то устанавливается, но теперь, как и у меня раньше не запускается


D>>Как вы его запускаете?


L_>Администрирование -> службы -> запуск службы


И что говорит?
В OnStart попадает?
Re[24]: Сервис
От: Levin_610  
Дата: 24.07.06 10:23
Оценка:
Здравствуйте, Danchik, Вы писали:

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


D>[Skip]


L_>>>>только теперь другая проблема устанавливаться, то устанавливается, но теперь, как и у меня раньше не запускается


D>>>Как вы его запускаете?


L_>>Администрирование -> службы -> запуск службы


D>И что говорит?

D>В OnStart попадает?

говорит следующее: "Не удалось запустить службу на локальный компьютер — ошибка 1053 — служба не ответила на вопрос своевременно"
Re[25]: Сервис
От: Danchik Украина  
Дата: 24.07.06 10:27
Оценка:
Здравствуйте, Levin_610, Вы писали:

[Skip]

L_>>>Администрирование -> службы -> запуск службы


D>>И что говорит?

D>>В OnStart попадает?

L_>говорит следующее: "Не удалось запустить службу на локальный компьютер — ошибка 1053 — служба не ответила на вопрос своевременно"


Начинаем от противного
Коментим лишнее и смотрим что мешает работать. Не буду же я вас учить как искать ошибки...
Re[26]: Сервис
От: Levin_610  
Дата: 24.07.06 10:32
Оценка:
Здравствуйте, Danchik, Вы писали:

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


D>[Skip]


L_>>>>Администрирование -> службы -> запуск службы


D>>>И что говорит?

D>>>В OnStart попадает?

L_>>говорит следующее: "Не удалось запустить службу на локальный компьютер — ошибка 1053 — служба не ответила на вопрос своевременно"


D>Начинаем от противного

D>Коментим лишнее и смотрим что мешает работать. Не буду же я вас учить как искать ошибки...


я делал так, если запускать программу командная строка ... -> /install — то всё ок.
а если автоматически, то уже не запускается.
Re[26]: Сервис
От: Levin_610  
Дата: 24.07.06 10:42
Оценка:
Здравствуйте, Danchik, Вы писали:

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


D>[Skip]


L_>>>>Администрирование -> службы -> запуск службы


D>>>И что говорит?

D>>>В OnStart попадает?

L_>>говорит следующее: "Не удалось запустить службу на локальный компьютер — ошибка 1053 — служба не ответила на вопрос своевременно"


D>Начинаем от противного

D>Коментим лишнее и смотрим что мешает работать. Не буду же я вас учить как искать ошибки...


Application.Run; — у меня не проходит вот это.
Re[27]: Сервис
От: Levin_610  
Дата: 24.07.06 11:13
Оценка:
Здравствуйте, Levin_610, Вы писали:

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


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


D>>[Skip]


L_>>>>>Администрирование -> службы -> запуск службы


D>>>>И что говорит?

D>>>>В OnStart попадает?

L_>>>говорит следующее: "Не удалось запустить службу на локальный компьютер — ошибка 1053 — служба не ответила на вопрос своевременно"


D>>Начинаем от противного

D>>Коментим лишнее и смотрим что мешает работать. Не буду же я вас учить как искать ошибки...


L_>Application.Run; — у меня не проходит вот это.


Насчёт этого вопрос снят, т.е. при /install всё работает при регистрации из проги нет.
Re[28]: Сервис
От: Levin_610  
Дата: 24.07.06 11:24
Оценка:
Здравствуйте, 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>




Всё работает — спасибо огромное!
Re[29]: Сервис
От: Danchik Украина  
Дата: 24.07.06 11:58
Оценка:
Здравствуйте, Levin_610, Вы писали:

[Skip]

L_>Всё работает — спасибо огромное!


Я смотрю вы не хотите учится — вытереть кусок сообщения надо! Прекращайте оверквотить.
Спасибо здесь говорят через оценки.
Re[30]: Сервис
От: Levin_610  
Дата: 24.07.06 12:08
Оценка:
Здравствуйте, Danchik, Вы писали:

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


D>[Skip]


L_>>Всё работает — спасибо огромное!


D>Я смотрю вы не хотите учится — вытереть кусок сообщения надо! Прекращайте оверквотить.

D>Спасибо здесь говорят через оценки.

да сэр, так точно сэр!
 
Подождите ...
Wait...
Пока на собственное сообщение не было ответов, его можно удалить.