(*
 Created by Tuğrul HELVACI
 08 Şubat 2019
 AllahRazıOlsunWare (Gönül rahatlığı ile kullanıp, istediğiniz gibi dağıtabilirsiniz)
 %100 Beleş :-)

 tugrul.helvaci@gmail.com
*)
program pServisAppIskeleti;

{.$DEFINE LOGSUPPORT}

uses
 {$IFDEF LOGSUPPORT}
 CodeSiteLogging,
 {$ENDIF }
 Winapi.Windows,
 Winapi.WinSvc;

{$REGION 'Tanımlar'}
const
 SERVICE_ACCEPT_USERMODEREBOOT = $00000800;
 SERVICE_CONTROL_USERMODEREBOOT= $00000040;

 // Service Control Session Change ile ilgili tanımlar
 WTS_SESSION_REMOTE_CONTROL    = $9;
 WTS_SESSION_CREATE            = $A;
 WTS_SESSION_TERMINATE         = $B;

 // Service Control Device Event ile ilgili tanımlar
 // https://docs.microsoft.com/en-us/windows/desktop/DevIO/wm-devicechange
 DBT_DEVICEARRIVAL             = $8000;
 DBT_DEVICEQUERYREMOVE         = $8001;
 DBT_DEVICEQUERYREMOVEFAILED   = $8002;
 DBT_DEVICEREMOVEPENDING       = $8003;
 DBT_DEVICEREMOVECOMPLETE      = $8004;
 DBT_CUSTOMEVENT               = $8006;

 // Service Control Hardware Profile Change ile ilgili tanımlar
 DBT_QUERYCHANGECONFIG         = $0017;
 DBT_CONFIGCHANGED             = $0018;
 DBT_CONFIGCHANGECANCELED      = $0019;

type
 (*
   Jedi'den alınmıştır.
   https://docs.microsoft.com/en-us/windows/desktop/api/winuser/ns-winuser-tagwtssession_notification
 *)

 tagWTSSESSION_NOTIFICATION = record
   cbSize: DWORD;
   dwSessionId: DWORD;
 end;

 WTSSESSION_NOTIFICATION = tagWTSSESSION_NOTIFICATION;
 PWTSSESSION_NOTIFICATION = ^WTSSESSION_NOTIFICATION;
 TWtsSessionNotification = WTSSESSION_NOTIFICATION;
 PWtsSessionNotification = PWTSSESSION_NOTIFICATION;
 // Jedi'den alınmıştır.

 _DEV_BROADCAST_HDR = record
   dbch_size: DWORD;
   dbch_devicetype: DWORD;
   dbch_reserved: DWORD;
 end;
 DEV_BROADCAST_HDR = _DEV_BROADCAST_HDR;
 PDEV_BROADCAST_HDR = ^DEV_BROADCAST_HDR;
 TDevBroadcastHdr = DEV_BROADCAST_HDR;
 PDevBroadcastHdr = PDEV_BROADCAST_HDR;

 TServiceAcceptMode = (
                         samStop,
                         samPauseContinue,
                         samShutDown,
                         samParamChange,
                         samNetBindChange,
                         samHardwareProfileChange,
                         samPowerEvent,
                         samSessionChange,
                         samPreShutDown,
                         samTimeChange,
                         samTriggerEvent,
                         samUserModeReboot
                      );

 TServiceAcceptModes = set of TServiceAcceptMode;

const
 AServiceName      = 'ServisAdınıBurayaYazın';
 ADisplayName      = 'Servis Açıklamanızı Buraya Yazın';
 ANumberOfServices = 2;
 ARealModes        : array[TServiceAcceptMode] of Cardinal =  (
                                                               SERVICE_ACCEPT_STOP,
                                                               SERVICE_ACCEPT_PAUSE_CONTINUE,
                                                               SERVICE_ACCEPT_SHUTDOWN,
                                                               SERVICE_ACCEPT_PARAMCHANGE,
                                                               SERVICE_ACCEPT_NETBINDCHANGE,
                                                               SERVICE_ACCEPT_HARDWAREPROFILECHANGE,
                                                               SERVICE_ACCEPT_POWEREVENT,
                                                               SERVICE_ACCEPT_SESSIONCHANGE,
                                                               SERVICE_ACCEPT_PRESHUTDOWN,
                                                               SERVICE_ACCEPT_TIMECHANGE,
                                                               SERVICE_ACCEPT_TRIGGEREVENT,
                                                               SERVICE_ACCEPT_USERMODEREBOOT
                                                              );

var
 AServiceStatus  : TServiceStatus;
 AStatusHandle   : SERVICE_STATUS_HANDLE;
 AServiceTable   : array [0..ANumberOfServices] of TServiceTableEntry;
 AStopEvent      : Cardinal  = 0;
 AEventLog       : THandle   = 0;

 // İlgilenmediğiniz modları aşağıdaki listeden çıkartınız. Varsayılan olarak herşey ile ilgileniyoruz.
 AcceptModes       : TServiceAcceptModes = [
                                              samStop,
                                              samPauseContinue,
                                              samShutDown,
                                              samParamChange,
                                              samNetBindChange,
                                              samHardwareProfileChange,
                                              samPowerEvent,
                                              samSessionChange,
                                              samPreShutDown,
                                              samTimeChange,
                                              samTriggerEvent
                                              //samUserModeReboot (Windows 10'da bu seçenekte bir BUG olduğu söyleniyor.)
                                            ];
{$ENDREGION}

{$REGION 'Log Metodları'}
procedure LogI(const AMessage : String);
{$IFNDEF LOGSUPPORT}
var
 PMessage : Pointer;
{$ENDIF}
begin
 if AEventLog = 0 then
   AEventLog := RegisterEventSource(nil, PWideChar(AServiceName));

 {$IFDEF LOGSUPPORT}
   CodeSite.Send(AMessage);
 {$ELSE}
   PMessage := PChar(AMessage);
   ReportEvent(AEventLog, EVENTLOG_INFORMATION_TYPE, 1453, 1299, nil, 1, 0, @PMessage, nil);
 {$ENDIF}
end;

procedure LogE(const AMessage : String);
{$IFNDEF LOGSUPPORT}
var
 PMessage : Pointer;
{$ENDIF}
begin
 if AEventLog = 0 then
   AEventLog := RegisterEventSource(nil, PWideChar(AServiceName));

 {$IFDEF LOGSUPPORT}
   CodeSite.SendError(AMessage);
 {$ELSE}
   PMessage := PChar(AMessage);
   ReportEvent(AEventLog, EVENTLOG_ERROR_TYPE, 1453, 1299, nil, 1, 0, @PMessage, nil);
 {$ENDIF}
end;

procedure LogW(const AMessage : String);
{$IFNDEF LOGSUPPORT}
var
 PMessage : Pointer;
{$ENDIF}
begin
 if AEventLog = 0 then
   AEventLog := RegisterEventSource(nil, PWideChar(AServiceName));

 {$IFDEF LOGSUPPORT}
   CodeSite.SendWarning(AMessage);
 {$ELSE}
   PMessage := PChar(AMessage);
   ReportEvent(AEventLog, EVENTLOG_WARNING_TYPE, 1453, 1299, nil, 1, 0, @PMessage, nil);
 {$ENDIF}
end;
{$ENDREGION}

// Servisin Adı ve Açıklaması "Tanımlar" altındadır.

{$REGION 'Programcının ilgileneceği metodlar burada'}
procedure UserThreadCode;
begin
 (* Thread Kodunuz buraya... *)
end;

procedure BeforeInstall;
begin
 // Servis sisteme yüklenmeden hemen önce...
end;

procedure AfterInstall;
begin
 // Servis sisteme yüklendikten hemen sonra...
end;

procedure BeforeUnInstall;
begin
 // Servis sistemden kaldırılmadan hemen önce...
end;

procedure AfterUnInstall;
begin
 // Servis sistemden kaldırıldıktan hemen sonra...
end;

// Sistem tanımlı olaylara yanıt vermek istiyorsanız aşağıdaki kod bloğunu kullanabilirsiniz...
procedure UserCode(const AControlMode : DWord; const AParam1, AParam2 : Pointer; const AEventType : DWord);
var
 SessionNotification : PWtsSessionNotification;
 DeviceHeader        : PDevBroadcastHdr;
 PowerSettings       : PPowerBroadcastSetting;
 TimeChangeInfo      : PSERVICE_TIMECHANGE_INFO;
begin
 case AControlMode of
   SERVICE_CONTROL_STOP                  : ;
   SERVICE_CONTROL_PAUSE                 : ;
   SERVICE_CONTROL_CONTINUE              : ;
   SERVICE_CONTROL_INTERROGATE           : ;
   SERVICE_CONTROL_SHUTDOWN              : ;
   SERVICE_CONTROL_PARAMCHANGE           : ;
   SERVICE_CONTROL_NETBINDADD            : ;
   SERVICE_CONTROL_NETBINDREMOVE         : ;
   SERVICE_CONTROL_NETBINDENABLE         : ;
   SERVICE_CONTROL_NETBINDDISABLE        : ;
   SERVICE_CONTROL_DEVICEEVENT           : begin
                                             DeviceHeader := PDevBroadcastHdr(AParam1);

                                             case AEventType of
                                               DBT_DEVICEARRIVAL           : ;
                                               DBT_DEVICEQUERYREMOVE       : ;
                                               DBT_DEVICEQUERYREMOVEFAILED : ;
                                               DBT_DEVICEREMOVEPENDING     : ;
                                               DBT_DEVICEREMOVECOMPLETE    : ;
                                               DBT_CUSTOMEVENT             : ;
                                             end;
                                           end;
   SERVICE_CONTROL_HARDWAREPROFILECHANGE : begin
                                             case AEventType of
                                               DBT_CONFIGCHANGED       : ;
                                               DBT_QUERYCHANGECONFIG   : ;
                                               DBT_CONFIGCHANGECANCELED: ;
                                             end;
                                           end;
   SERVICE_CONTROL_POWEREVENT            : begin
                                             case AEventType of
                                               PBT_APMPOWERSTATUSCHANGE  : ;
                                               PBT_APMRESUMEAUTOMATIC    : ;
                                               PBT_APMRESUMESUSPEND      : ;
                                               PBT_APMSUSPEND            : ;
                                               PBT_POWERSETTINGCHANGE    : begin
                                                                             PowerSettings := PPowerBroadcastSetting(AParam1);
                                                                           end;
                                             end;
                                           end;
   SERVICE_CONTROL_SESSIONCHANGE         : begin
                                             (*
                                               Detaylara aşağıdaki linkten ulaşabilirsiniz:
                                               https://docs.microsoft.com/en-us/windows/desktop/api/winsvc/nc-winsvc-lphandler_function_ex
                                               https://docs.microsoft.com/en-us/windows/desktop/TermServ/wm-wtssession-change
                                             *)
                                             SessionNotification := PWtsSessionNotification(AParam1);

                                             case AEventType of
                                               WTS_CONSOLE_CONNECT         : ;
                                               WTS_CONSOLE_DISCONNECT      : ;
                                               WTS_REMOTE_CONNECT          : ;
                                               WTS_REMOTE_DISCONNECT       : ;
                                               WTS_SESSION_REMOTE_CONTROL  : ;
                                               WTS_SESSION_CREATE          : ;
                                               WTS_SESSION_TERMINATE       : ;
                                               WTS_SESSION_LOGON           : ;
                                               WTS_SESSION_LOGOFF          : ;
                                               WTS_SESSION_LOCK            : ;
                                               WTS_SESSION_UNLOCK          : ;
                                             end;
                                           end;
   SERVICE_CONTROL_PRESHUTDOWN           : ;
   SERVICE_CONTROL_TIMECHANGE            : begin
                                             TimeChangeInfo := PSERVICE_TIMECHANGE_INFO(AParam1);
                                           end;
   SERVICE_CONTROL_TRIGGEREVENT          : ;
   SERVICE_CONTROL_USERMODEREBOOT        : ;
 end; // case AControlMode of
end;
{$ENDREGION}

{$REGION 'Servis iskeleti için gereken metodlar. Mümkün mertebe değiştirmemeniz önerilir. Değişiklik yaparsanız ya da hata bulursanız lütfen beni de mail yolu ile bilgilendirin.'}
function ToStr(const AValue : Integer) : String;
var
 AStr : ShortString;
begin
 Str(AValue, AStr);

 Result := String(AStr);
end;

function ThreadProc(lpParameter : LPVOID) : DWord; stdcall;
begin
 try
   while true do
   begin
     if WaitForSingleObject(AStopEvent, 0) = WAIT_OBJECT_0 then
       Exit;

     UserThreadCode;
   end; // while true do
 finally
   Result := NO_ERROR;
 end;
end;

function ServicesCtrlHandlerEx(dwControl: DWord; dwEventType: DWord; lpEventData: LPVOID; lpContext: LPVOID): DWord; stdcall;
begin
 case dwControl of
   SERVICE_CONTROL_STOP      : begin
                                 if AServiceStatus.dwCurrentState = SERVICE_RUNNING then
                                 begin
                                   AServiceStatus.dwControlsAccepted := 0;
                                   AServiceStatus.dwCurrentState := SERVICE_STOP_PENDING;
                                   AServiceStatus.dwCheckPoint := 1;
                                   AServiceStatus.dwWaitHint := 10000;
                                   AServiceStatus.dwWin32ExitCode := NO_ERROR;
                                 end;
                               end;
   SERVICE_CONTROL_PAUSE     : begin
                                 AServiceStatus.dwCurrentState := SERVICE_PAUSED; //SERVICE_PAUSE_PENDING;
                                 AServiceStatus.dwCheckPoint := 0;
                                 AServiceStatus.dwWaitHint := 0;
                                 AServiceStatus.dwWin32ExitCode := NO_ERROR;
                               end;
   SERVICE_CONTROL_CONTINUE  : begin
                                 AServiceStatus.dwCurrentState := SERVICE_RUNNING;
                                 AServiceStatus.dwCheckPoint := 0;
                                 AServiceStatus.dwWaitHint := 0;
                                 AServiceStatus.dwWin32ExitCode := NO_ERROR;
                               end;
 end; // case dwControl of

 SetServiceStatus(AStatusHandle, AServiceStatus);

 UserCode(dwControl, lpEventData, lpContext, dwEventType);

 if (dwControl = SERVICE_CONTROL_STOP) or (dwControl = SERVICE_CONTROL_SHUTDOWN) then
   SetEvent(AStopEvent);

 Result := NO_ERROR;
 //Result := ERROR_CALL_NOT_IMPLEMENTED;
end;

procedure InstallService(const ASilent : Boolean = true);
const
 cError      = 'Servis yöneticisi açılamadı.';
 cInstalled  = 'Servis başarı ile yüklendi.';

var
 ServiceManager,
 ServiceHandle : NativeUInt;
 AFileName     : String;
begin
 // Bknz: https://docs.microsoft.com/en-us/windows/desktop/api/winsvc/nf-winsvc-createservicea
 AFileName := '"' + ParamStr(0) + '"';

 ServiceManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);

 if ServiceManager = 0 then
 begin
   MessageBox(0, cError, AServiceName, MB_ICONERROR or MB_OK or MB_TASKMODAL or MB_TOPMOST);
   Exit;
 end;

 BeforeInstall;

 ServiceHandle := CreateService(
                                  ServiceManager,
                                  PWideChar(AServiceName),
                                  PWideChar(ADisplayName),
                                  SERVICE_ALL_ACCESS,
                                  SERVICE_WIN32_OWN_PROCESS,
                                  SERVICE_DEMAND_START,
                                  SERVICE_ERROR_NORMAL,
                                  PWideChar(AFileName),
                                  nil,
                                  nil,
                                  nil,
                                  nil,
                                  nil
                               );
 try
   if ServiceHandle <> 0 then
     if not ASilent then
       MessageBox(0, cInstalled, AServiceName, MB_ICONINFORMATION or MB_OK or MB_TASKMODAL or MB_TOPMOST);
 finally
   if ServiceHandle <> 0 then
     CloseServiceHandle(ServiceHandle);

   if ServiceManager <> 0 then
     CloseServiceHandle(ServiceManager);

   if ServiceHandle <> 0 then
     AfterInstall;
 end; // try..finally
end;

procedure UnInstallService(const ASilent : Boolean = true);
const
 cRemoved = 'Servis başarı ile kaldırıldı.';

var
 ServiceManager,
 ServiceHandle : NativeUInt;
begin
 ServiceManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);

 if ServiceManager <> 0 then
 begin
   BeforeUnInstall;

   ServiceHandle := OpenService(ServiceManager, PWideChar(AServiceName), SERVICE_ALL_ACCESS);

   try
     if ServiceHandle <> 0 then
     begin
       ControlService(ServiceHandle, SERVICE_CONTROL_STOP, AServiceStatus);
       DeleteService(ServiceHandle);

       if not ASilent then
         MessageBox(0, cRemoved, AServiceName, MB_ICONINFORMATION or MB_OK or MB_TASKMODAL or MB_TOPMOST);
     end;
   finally
     if ServiceHandle <> 0 then
     begin
       CloseServiceHandle(ServiceHandle);

       AfterUnInstall;
     end;

     CloseServiceHandle(ServiceManager);
   end; // try..finally
 end; // if ServiceManager <> 0 then
end;

procedure RegisterServiceEx(dwNumServicesArgs: DWORD; lpServiceArgVectors: PLPWSTR); stdcall;
var
 AThreadID,
 ALastError,
 AControlsAccepted : Cardinal;

 AThread           : NativeUInt;
 AcceptMode        : TServiceAcceptMode;
begin
 AStatusHandle := RegisterServiceCtrlHandlerEx(AServiceName, @ServicesCtrlHandlerEx, nil);

 if AStatusHandle <> 0 then
 begin
   FillChar(AServiceStatus, SizeOf(TServiceStatus), 0);

   AServiceStatus.dwServiceType := SERVICE_WIN32_OWN_PROCESS;
   AServiceStatus.dwControlsAccepted := 0;
   AServiceStatus.dwCurrentState := SERVICE_START_PENDING;
   AServiceStatus.dwWin32ExitCode := NO_ERROR;
   AServiceStatus.dwServiceSpecificExitCode := NO_ERROR;
   AServiceStatus.dwCheckPoint := 0;

   if not SetServiceStatus(AStatusHandle, AServiceStatus) then
     LogE('Servis başlatılıyor durumuna alınamadı.');

   AStopEvent := CreateEvent(nil, true, false, nil);

   if AStopEvent = 0 then
   begin
     AServiceStatus.dwControlsAccepted := 0;
     AServiceStatus.dwCurrentState := SERVICE_STOPPED;
     AServiceStatus.dwWin32ExitCode := GetLastError();
     AServiceStatus.dwCheckPoint := 0;
     AServiceStatus.dwWaitHint := 0;

     if not SetServiceStatus(AStatusHandle, AServiceStatus) then
       LogE('Servis durduruldu durumuna alınamadı.');

     Exit;
   end; // if AStopEvent = 0 then

   AThread := 0;
   AControlsAccepted := 0;

   try
     if AcceptModes = [] then
       AControlsAccepted := SERVICE_ACCEPT_STOP // Programcı hiç birşey seçmemiş ise, servisimiz en azından durdurulabilmeli :-)
     else
       for AcceptMode in AcceptModes do
         AControlsAccepted := AControlsAccepted or ARealModes[AcceptMode];

     AServiceStatus.dwControlsAccepted := AControlsAccepted;

     AServiceStatus.dwCurrentState := SERVICE_RUNNING;
     AServiceStatus.dwWin32ExitCode := 0;
     AServiceStatus.dwCheckPoint := 0;

     if not SetServiceStatus(AStatusHandle, AServiceStatus) then
     begin
       ALastError := GetLastError;

       LogE('Servis çalışıyor durumuna alınamadı. Hata:' + ToStr(ALastError));
     end;

     AThread := CreateThread(nil, 0, @ThreadProc, nil, 0, AThreadID);

     if AThread <> 0 then
       WaitForSingleObject(AThread, INFINITE);
   finally
     if AStopEvent <> 0 then
       CloseHandle(AStopEvent);

     if AThread <> 0 then
       CloseHandle(AThread);

     AServiceStatus.dwControlsAccepted := 0;
     AServiceStatus.dwCurrentState := SERVICE_STOPPED;
     AServiceStatus.dwWin32ExitCode := GetLastError();
     AServiceStatus.dwCheckPoint := 0;

     if not SetServiceStatus(AStatusHandle, AServiceStatus) then
       LogE('Servis durduruldu durumuna alınamadı.');
   end;
 end // if AStatusHandle <> 0 then
 else
 begin
   ALastError := GetLastError();

   LogE('Hata, RegisterServiceCtrlHandlerEx:' + ToStr(ALastError));

   ExitProcess(ALastError);
 end;
end;

var
 AParam : String;
begin
 {$IFDEF LOGSUPPORT}
 CodeSite.ConnectUsingTcp;
 {$ENDIF}

 if ParamCount = 0 then
 begin
   AServiceTable[0].lpServiceName := AServiceName;
   AServiceTable[0].lpServiceProc := @RegisterServiceEx;
   AServiceTable[1].lpServiceName := nil;
   AServiceTable[1].lpServiceProc := nil;

   try
     StartServiceCtrlDispatcher(AServiceTable[0]);
   finally
     if AEventLog <> 0 then
     begin
       DeregisterEventSource(AEventLog);

       AEventLog := 0;
     end;

     ExitProcess(0);
   end; // try..finally
 end // if ParamCount = 0 then
 else
 begin
   AParam := ParamStr(1);

   if (AParam = '/i') or (AParam = '/install') then
     InstallService(false)
   else
   if (AParam = '/u') or (AParam = '/uninstall') then
     UnInstallService(false)
   else
     MessageBox(0, PWideChar('Anlaşılmayan parametre. Geçerli parametreler: /i , /install, /u, /uninstall'), AServiceName, MB_ICONINFORMATION or MB_OK or MB_TASKMODAL or MB_TOPMOST);
 end;

{$ENDREGION}
end.