Сервисы или службы в delphi. Инсталл, деинсталл, запуск, остановка

{***********************************************************
Инсталл сервиса
************************************************************}
function ServiceInstall:boolean;
var
  Service,SCManager: SC_HANDLE;
begin
 
   SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
   Service := CreateService(SCManager, ProgServiceName, ServiceName,
                              SERVICE_ALL_ACCESS, SERVICE_WIN32_OWN_PROCESS,
                              SERVICE_DEMAND_START, SERVICE_ERROR_NORMAL,
                              PathServiceExeFile,
                              nil, nil, '', nil, nil);
   case Service of
     0:   Result:=false;
     else Result:=true;
   end;
   CloseServiceHandle(SCManager);
end;
 
 
{***********************************************************
Старт сервиса
************************************************************}
function ServiceStart: Boolean;
var
  SCManager, Service: SC_HANDLE;
  P:PChar;
begin
  Result := False;
  SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  if SCManager <> 0 then
  try
    Service := OpenService(SCManager, ProgServiceName, SERVICE_ALL_ACCESS);
    if Service <> 0 then
    try
      P:=nil;
      Result := StartService(Service, 0, P);
    finally
      CloseServiceHandle(Service);
    end;
  finally
    CloseServiceHandle(SCManager);
  end;
end;
 
 
{***********************************************************
Остановка сервиса
************************************************************}
function ServiceStop:boolean;
var Service,SCManager: SC_HANDLE;
    ss: SERVICE_STATUS;
begin
  SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  Service := OpenService(SCManager, ProgServiceName, SERVICE_ALL_ACCESS);
  Result:=ControlService(Service, SERVICE_CONTROL_STOP, ss);
  CloseServiceHandle(SCManager);
end;
 
 
{***********************************************************
Деинсталяция сервиса
************************************************************}
Function ServiceUninstall:boolean;
var Service,SCManager: SC_HANDLE;
    ss: SERVICE_STATUS;
begin
  SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  Service := OpenService(SCManager, ProgServiceName, SERVICE_ALL_ACCESS);
  ControlService(Service, SERVICE_CONTROL_STOP, ss);
  Result:=DeleteService(Service);
  CloseServiceHandle(SCManager);
end;

program proxi;
 
uses
  Windows, WinSvc,sysutils, classes, messages,
  IdBaseComponent, IdComponent, IdTCPServer, IdMappedPortTCP;
 
  
 type
  HUDP = class
    IdMappedPortTCP1: TIdMappedPortTCP;
 
 public
    constructor Create;
    destructor Destroy; override;
    procedure WMQueryEndSession(var Message: TWMQueryEndSession); message WM_QUERYENDSESSION;
 end;
 
const
  SERVICE_NAME = 'Proxi service';
  SERVICE_DISPLAY_NAME = 'Proxi';
  SERVICE_DISPLAY_TOTAL = 'http://raxp.radioliga.com';
 
var
  hSCM: SC_HANDLE;
  hService: SC_HANDLE;
  hServStatus: SERVICE_STATUS_HANDLE;
  status: SERVICE_STATUS;
  ServicesListFileName: string;
  hThread: HWND;
  ThID: Cardinal;
  //
  IdMappedPortTCP1: TIdMappedPortTCP;
  HUDP1: HUDP;
 
 
// ПРОКСИ ---------------------------------------------------------------------
procedure HUDP.WMQueryEndSession(var Message: TWMQueryEndSession);
begin
 inherited
end;
 
constructor HUDP.Create;
Begin
 inherited Create;
 
 IdMappedPortTCP1:= TIdMappedPortTCP.Create(nil);
 IdMappedPortTCP1.DefaultPort      := 808;
 IdMappedPortTCP1.MappedHost       := '192.168.0.56';
 IdMappedPortTCP1.MappedPort       := 8080;
 IdMappedPortTCP1.TerminateWaitTime:= 5000;
 IdMappedPortTCP1.Active:= true
end;
 
destructor HUDP.Destroy;
Begin
 IdMappedPortTCP1.Free;
 inherited Destroy
End;
// END ПРОКСИ -----------------------------------------------------------------
 
 
 
// CЕРВИС ---------------------------------------------------------------------
function UpperCase(st: string): string;  stdcall;
var i: integer;
begin
  result:= st;
  for i:= 1 to length(result) do
    if result[i] in ['a'..'z'] then result[i]:= Chr(Ord(result[i])-32)
    else result[i]:= result[i];
end;
 
 
function GetErrosString: string; stdcall;
var
  Len: Integer;
  Buffer: array[0..255] of Char;
begin
  Len:= FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_ARGUMENT_ARRAY, nil,
                      GetLastError, 0, Buffer, SizeOf(Buffer), nil);
  while (Len > 0) and (Buffer[Len - 1] in [#0..#32]) do Dec(Len);
  SetString(Result, Buffer, Len);
end;
 
function IsInstalled: boolean; stdcall;
begin
 result:= false;
 try
 hSCM:= OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  if hSCM <> 0 then begin
     hService:= OpenService(hSCM, SERVICE_NAME, SERVICE_QUERY_CONFIG);
     if hService <> 0 then begin
       CloseServiceHandle(hService);
       result:= true;
     end else ;
 
     CloseServiceHandle(hSCM);
  end;
 except end
end;
 
function Install: boolean; stdcall;
begin
  result:= true;
  if IsInstalled then exit;
 
  hSCM:= OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  if hSCM = 0 then begin
    result:= false;
    exit;
  end;
 
  hService:= CreateService(
    hSCM, SERVICE_NAME, SERVICE_DISPLAY_NAME, SERVICE_ALL_ACCESS,
    SERVICE_WIN32_OWN_PROCESS or SERVICE_INTERACTIVE_PROCESS, SERVICE_AUTO_START,
    SERVICE_ERROR_NORMAL, PChar(ParamStr(0)), SERVICE_DISPLAY_TOTAL, nil, nil, nil, nil);
 
  if (hService = 0) then begin
    CloseServiceHandle(hSCM);
    result:= false;
    exit;
  end;
 
 //
 //
 
 CloseServiceHandle(hService);
 CloseServiceHandle(hSCM)
end;
 
function UnInstall: boolean; stdcall;
var status: SERVICE_STATUS;
begin
 if not IsInstalled then begin
  result:= true;
  exit
 end;
 
 result:= false;
 try
 
 hSCM:= OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
 if hSCM = 0 then begin
  exit
 end;
 
 hService:= OpenService(hSCM, SERVICE_NAME, SERVICE_ALL_ACCESS);
 if hService = 0 then begin
  CloseServiceHandle(hSCM);
  exit
 end;
 
 ControlService(hService, SERVICE_CONTROL_STOP, status);
 if DeleteService(hService) then result:= true;
 //
 CloseServiceHandle(hService);
 CloseServiceHandle(hSCM);
 
 except end
end;
 
function GetData: boolean; stdcall;
type
  TArrayEnumServicesStatus = array of TEnumServiceStatus;
const
  StatusText : array [SERVICE_STOPPED..SERVICE_PAUSED] of string =
  ('Stopped', 'Starting', 'Stopping', 'Started', 'Restarting', 'Pausing', 'Paused');
var
  EnumServiceStatus: Pointer;
  BytesAllocated, BytesNeeded, ServicesReturned, ResumeHandle : DWORD;
  i: Integer;
  bBol: boolean;
 
  fLog: THandle;
  BitesWriten: DWORD;
  Msg: string;
begin
  result:= false;
  ResumeHandle:= 0;
 
  hSCM:= OpenSCManager(nil, nil, GENERIC_READ or GENERIC_EXECUTE);
  if hSCM = 0 then begin
    exit;
  end;
 
  BytesAllocated:= 1024; //маловато будет нужен повтор
  GetMem(EnumServiceStatus, BytesAllocated);
  try
    bBol:= EnumServicesStatus(hSCM, SERVICE_TYPE_ALL, SERVICE_STATE_ALL, TEnumServiceStatus(EnumServiceStatus^),
                              BytesAllocated, BytesNeeded, ServicesReturned, ResumeHandle);
    if GetLastError = ERROR_MORE_DATA then begin
      BytesAllocated:= BytesNeeded;
      ReallocMem(EnumServiceStatus, BytesNeeded);
      bBol:= EnumServicesStatus(hSCM, SERVICE_TYPE_ALL, SERVICE_STATE_ALL, TEnumServiceStatus(EnumServiceStatus^),
                                BytesAllocated, BytesNeeded, ServicesReturned, ResumeHandle);
    end;
 
    if bBol then begin
      fLog:= CreateFile(PChar(ServicesListFileName), GENERIC_WRITE, FILE_SHARE_WRITE, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
 
      for i:= 0 to ServicesReturned - 1 do
      with TArrayEnumServicesStatus((@EnumServiceStatus)^)[i] do begin
        Msg:= lpServiceName + ' - ' + lpDisplayName +', '+ Statustext[ServiceStatus.dwCurrentState] + #13#10;
        WriteFile(fLog, Msg[1], Length(Msg), BitesWriten, nil);
      end;
 
      CloseHandle(fLog);
      result:= true;
    end;
    CloseServiceHandle(hSCM);
  finally
    FreeMem (EnumServiceStatus, BytesAllocated);
  end;
end;
 
function ReportStatusToSCMgr(dwCurrentState, dwWin32ExitCode, dwWaitHint: DWORD): boolean; stdcall;
begin
  if dwCurrentState = SERVICE_START_PENDING then status.dwControlsAccepted:= SERVICE_ACCEPT_SHUTDOWN
  else status.dwControlsAccepted:= SERVICE_ACCEPT_STOP or SERVICE_ACCEPT_SHUTDOWN or SERVICE_ACCEPT_PAUSE_CONTINUE;
 
  status.dwCurrentState:= dwCurrentState;
  status.dwWin32ExitCode:= dwWin32ExitCode;
  status.dwWaitHint:= dwWaitHint;
 
  if (dwCurrentState = SERVICE_RUNNING) or (dwCurrentState = SERVICE_STOPPED) then status.dwCheckPoint:= 0
  else inc(status.dwCheckPoint);
 
  result:= SetServiceStatus(hServStatus, status);
end;
 
procedure ServiceCtrlHandler(Opcode: Cardinal); stdcall;
begin
  case Opcode of
    SERVICE_CONTROL_STOP: begin
      if not ReportStatusToSCMgr(SERVICE_STOP_PENDING, NO_ERROR, 0) then
      while (Status.dwCurrentState = SERVICE_STOP_PENDING) do sleep(100);
    end;
    SERVICE_CONTROL_PAUSE: begin
      ReportStatusToSCMgr(SERVICE_PAUSE_PENDING, NO_ERROR, 0);
      SuspendThread(hThread);
      ReportStatusToSCMgr(SERVICE_PAUSED, NO_ERROR, 0);
    end;
 
    SERVICE_CONTROL_CONTINUE: begin
      ReportStatusToSCMgr(SERVICE_START_PENDING, NO_ERROR, 0);
      ResumeThread(hThread);
      ReportStatusToSCMgr(SERVICE_RUNNING, NO_ERROR, 0);
    end;
 
    SERVICE_CONTROL_INTERROGATE: begin
      SetServiceStatus(hServStatus, status);
    end;
 
    SERVICE_CONTROL_SHUTDOWN: begin
      ReportStatusToSCMgr(SERVICE_STOP_PENDING, NO_ERROR, 0);
      while (Status.dwCurrentState = SERVICE_STOP_PENDING) do sleep(100);
    end;
  end;
end;
 
function ServiceThread(P: Pointer): DWORD; stdcall;
var h: thandle;
    s: string;
begin
 if not ReportStatusToSCMgr(SERVICE_RUNNING, NO_ERROR, 0) then begin
  result:= GetLastError;
  exit
 end;
 
 try
  while (Status.dwCurrentState <> SERVICE_STOP_PENDING) do begin
   sleep(700);
 
   
   //---
 
 
  end;
  result:= 0
 finally Status.dwCurrentState:= SERVICE_STOP end
end;
 
procedure ServiceProc(argc : DWORD;var argv : array of PChar) stdcall;
begin
  Status.dwServiceType:= SERVICE_WIN32;
  Status.dwServiceSpecificExitCode:= 0;
 
  hServStatus:= RegisterServiceCtrlHandler(SERVICE_NAME, @ServiceCtrlHandler);
  if hServStatus = 0 then begin
    ReportStatusToSCMgr(SERVICE_STOPPED, GetLastError, 0);
    exit;
  end;
 
  if not ReportStatusToSCMgr(SERVICE_START_PENDING, NO_ERROR, 0) then begin
    exit;
  end;
 
  hThread:= CreateThread(nil, 0, @ServiceThread, nil, 0, ThID);
  WaitForSingleObject(hThread, INFINITE);
  CloseHandle(hThread);
 
  ReportStatusToSCMgr(SERVICE_STOPPED, NO_ERROR, 0);
end;
 
function Start: boolean; stdcall;
var
  ServTable: array [0..1] of SERVICE_TABLE_ENTRYA;
begin
  ServTable[0].lpServiceName:= SERVICE_NAME;
  ServTable[0].lpServiceProc:= @ServiceProc;
  ServTable[1].lpServiceName:= nil;
  ServTable[1].lpServiceProc:= nil;
  if not StartServiceCtrlDispatcher(ServTable[0]) then begin
    result:= false;
  end else result:= true;
end;
 
function RunService: boolean; stdcall;
var pParameters: PChar;
begin
 result:= false;
 //
 hSCM:= OpenSCManager(nil, nil, GENERIC_READ or GENERIC_EXECUTE);
 if hSCM = 0 then begin
  exit
 end;
 hService:= OpenService(hSCM, SERVICE_NAME, SERVICE_ALL_ACCESS);
 
 if hService = 0 then begin
  CloseServiceHandle(hSCM);
  exit
 end;
 
 StartService(hService, 0, pParameters);
 //
 CloseServiceHandle(hService);
 CloseServiceHandle(hSCM);
 result:= true
end;
 
begin
 HUDP1:= HUDP.Create;
 //
 ErrorLogFileName:= ParamStr(0);
 ErrorLogFileName:= Copy(ErrorLogFileName, 1, length(ErrorLogFileName)-3) + 'Log';
 ServicesListFileName:= Copy(ErrorLogFileName, 1, length(ErrorLogFileName)-3) + 'Txt';
 
 if ParamCount > 0 then begin
    if UpperCase(ParamStr(1)) = 'I' then begin
      if Install then begin
        RunService
      end;
    end;
 
    if UpperCase(ParamStr(1)) = 'U' then begin
      HUDP1.Destroy;
      UnInstall;
    end;
 
    if UpperCase(ParamStr(1)) = 'G' then begin
     GetData;
    end;
    exit;
  end;
 
 Start
// END CЕРВИС -----------------------------------------------------------------
 
end.