Konuyu Oyla:
  • Derecelendirme: 5/5 - 2 oy
  • 1
  • 2
  • 3
  • 4
  • 5
Modern Servis Uygulama İskeleti
#11
(11-02-2019, Saat: 21:24)Tuğrul HELVACI Adlı Kullanıcıdan Alıntı: Yarın da Allah nasip ederse dependencies (bağımlılıklar) üzerine küçük bir eklenti yapacağım.

İskeleti kullanıp fikirlerinizi yazarsanız eksiklerimizi görür, düzeltme imkanı buluruz. Özellikle gövdesini boş bıraktığım olayları da doldurursak çok sağlam bir iskelet çıkar ortaya. Bilhassa vakit bulabilenlerin ETW ile ilgili linki takip edip servis triggerları vasıtası ile işletim sisteminde gerçekleşen 1001 olayın bir kaçını paylaşması çok yerinde ve faydalı olur.

Bende Delphi XE var. O yüzden kullanmak için bazı değişiklikler yapmak zorunda kaldım:
SERVICE_ACCEPT_ ve  SERVICE_CONTROL_ ile başlayan sabitler tanımlı değildi, tanımladım.
PSERVICE_TIMECHANGE_INFO ve RegisterServiceCtrlHandlerEx tanımlı değildi. PSERVICE_TIMECHANGE_INFO şimdilik kullanılmadığı için onu kaldırdım.
RegisterServiceCtrlHandlerEx'yi ise şu şekilde tanımladım:

function RegisterServiceCtrlHandlerExW(lpServiceName: PWideChar; lpHandlerProc: Pointer): SERVICE_STATUS_HANDLE; stdcall; external advapi32 name 'RegisterServiceCtrlHandlerExW';
ve kodumun içinde de RegisterServiceCtrlHandlerExW methodunu kullandım.

Nur topu gibi bir servisim oldu. Hem de 32.5 KB!!!

Vakit bulup detaylı kullanım yaptıkça bilgilendireceğim inşallah.
There's no place like 127.0.0.1
WWW
Cevapla
#12
Çok teşekkür ederim elinize sağlık çok güzel bir çalışma olmuş, çok hakim olduğum bir konu değil ama çok öğrenmek istediğim bir konu buda bana güzel bir kaynak olacak kanısındayım.
Tekrar çok teşekkür ederim.
Cevapla
#13
@Tuğrul HELVACI Hocam ellerine sağlık
Bu dünyada kendine sakladığın bilgi ahirette işine yaramaz. 
Cevapla
#14
Servis iskeleti üzerinde bir kaç değişiklik ve eklenti yaptım:
  • Bağımlılık desteği eklendi.
  • Komut satırı üzerinden servisi başka bir isim, açıklama ile kurabilirsiniz.
  • Komut satırından bağımlılıkları ekleyebilirsiniz.
  • Komut satırı üzerinden herhangi bir servisi uninstall edebilme yeteneği eklendi.
  • Bazı uyarılar konuldu ve küçük iyileştirmeler yapıldı.
(*
 Created by Tuğrul HELVACI
 08 Şubat 2019
 AllahRazıOlsunWare (Gönül rahatlığı ile kullanıp, istediğiniz gibi dağıtabilirsiniz)
 %100 Beleş :-)

 Not : Bazı metodları Delphi RTL'den alıp içeriklerini değiştirip kullandım.
 Bunun nedeni, ilgili unit'leri projeye dahil edip, EXE boyutunu yükseltmek istemememdir.

 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...vicechange
 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...tification
 *)

 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      = 'Abuzer abi bence bizi görür';
 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
 AServiceName    : String = 'AbuzerdeBiziGorecekmi';

 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.)
                                            ];

 //DependentServices : array[0..2] of AnsiString = ('dummy_servis1', 'dummy_servis2', 'dummy_servis3');

 (*
   Bu dizi, statik olarak tanımlanmamıştır.
   Çünkü komut satırından da beslenebilmektedir.
   Dizinin içeriğini komut satırı üzerinden almak yerine,
   kendi sabit değerlerinizi kullanmak istiyor iseniz;

   Örneğin servisiniz 2 harici servise bağımlı olacak ise:

   SetLength(DependentServices, 2);
   DependentServices[0] := 'HariciServisAdi1';
   DependentServices[1] := 'HariciServisAdi2';

   biçiminde tanım yapmanız yeterli olur.
 *)
 DependentServices : array of AnsiString = nil;
 iDummy : Integer = 0;
{$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;

// Default Log function
procedure Log(const AMessage : String);
begin
 LogI(AMessage);
end;
{$ENDREGION}

{$REGION 'Utility Functions'}
function ToStr(const AValue : Integer) : String;
var
 AStr : ShortString;
begin
 Str(AValue, AStr);

 Result := String(AStr);
end;

function StrLenEx(const Str: PAnsiChar): Cardinal;
begin
 Result := Length(Str);
end;

function StrECopyEx(Dest: PAnsiChar; const Source: PAnsiChar): PAnsiChar;
var
 Len: Integer;
begin
 Len := StrLenEx(Source);
 Move(Source^, Dest^, (Len + 1) * SizeOf(AnsiChar));
 Result := Dest + Len;
end;

// TService.GetNTDependencies modifiye edilmiştir...
function GetNTDependencies : AnsiString;
var
 iCounter,
 Len : Integer;
 P   : PAnsiChar;
begin
 Result := '';
 Len := 0;

 for iCounter := Low(DependentServices) to High(DependentServices) do
   Inc(Len, Length(DependentServices[iCounter]) + 1); // For null-terminator

 if Len <> 0 then
 begin
   Inc(Len); // For final null-terminator;
   SetLength(Result, Len);
   P := @Result[1];

   for iCounter := Low(DependentServices) to High(DependentServices) do
   begin
     P := StrECopyEx(P, PAnsiChar(DependentServices[iCounter]));

     Inc(P);
   end;

   P^ := #0;
 end;
end;

function ParamExists(const AValue : String; var AIndex : Integer) : Boolean;
var
 AParam  : String;
 iCounter: Integer;
begin
 Result := false;

 AIndex := -1;

 if ParamCount <= 0 then
   Exit(false);

 for iCounter := 1 to ParamCount do
 begin
   AParam := ParamStr(iCounter);

   if System.Pos(AValue, AParam) > 0 then
   begin
     AIndex := iCounter;

     Exit(true);
   end;
 end;
end;

type
 TArrayOfStringEx = array of String;

function SplitStringEx(const ASource : String; const ASplitChar : Char = ','): TArrayOfStringEx;
var
 StartIdx    : Integer;
 FoundIdx    : Integer;
 SplitPoints : Integer;
 CurrentSplit: Integer;
 iCounter    : Integer;
begin
 Result := nil;

 if ASource <> '' then
 begin
   SplitPoints := 0;

   for iCounter := 1 to Length(ASource) do
     if ASource[iCounter] = ASplitChar then
       Inc(SplitPoints);

   SetLength(Result, SplitPoints + 1);

   StartIdx      := 1;
   CurrentSplit  := 0;

   repeat
     FoundIdx := System.Pos(ASplitChar, ASource, StartIdx);

     if FoundIdx <> 0 then
     begin
       Result[CurrentSplit] := Copy(ASource, StartIdx, FoundIdx - StartIdx);
       Inc(CurrentSplit);
       StartIdx := FoundIdx + 1;
     end;
   until CurrentSplit = SplitPoints;

   Result[SplitPoints] := Copy(ASource, StartIdx, Length(ASource) - StartIdx + 1);
 end;
end;
{$ENDREGION}

{$REGION 'Notlar & Uyarılar'}
(*
 1. Servisin Adı ve Açıklaması "Tanımlar" altındadır.
 2. Servisinizi pause edilebilir olarak ayarlasanız da; servis duraklatıldığında thread'iniz çalışmaya devam eder.
 Bu davranışı istemiyor iseniz, servisin duraklatıldığı yerde, thread'inizin de duraklamasını sağlayacak bir mekanizmayı siz
 hayata geçirmelisiniz.
*)
{$ENDREGION}

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

 Inc(iDummy);
 Sleep(1000);
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;

{$HINTS OFF}
// 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...unction_ex
                                               https://docs.microsoft.com/en-us/windows...ion-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;
{$HINTS ON}
{$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 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 AInternalServiceName : String = ''; const AInternalDisplayName : String = '');
const
 cError      = 'Servis yöneticisi açılamadı.';
 cInstalled  = 'Servis başarı ile yüklendi.';

var
 ServiceManager,
 ServiceHandle : NativeUInt;
 AFileName     : String;

 ADependency,
 _ServiceName,
 _DisplayName  : String;
begin
 ADependency := String(GetNTDependencies);

 // Bknz: https://docs.microsoft.com/en-us/windows...teservicea
 if AInternalServiceName = ''
 then
   AFileName := '"' + ParamStr(0) + '"'
 else
   AFileName := '"' + ParamStr(0) + '"' + ' -name=' + AInternalServiceName;

 _ServiceName := AInternalServiceName;
 _DisplayName := AInternalDisplayName;

 if AInternalServiceName = '' then
   _ServiceName := AServiceName;

 if AInternalDisplayName = '' then
   _DisplayName := ADisplayName;

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

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

 BeforeInstall;

 ServiceHandle := CreateService(
                                  ServiceManager,
                                  PWideChar(_ServiceName),
                                  PWideChar(_DisplayName),
                                  SERVICE_ALL_ACCESS,
                                  SERVICE_WIN32_OWN_PROCESS,
                                  SERVICE_DEMAND_START,
                                  SERVICE_ERROR_NORMAL,
                                  PWideChar(AFileName),
                                  nil,
                                  nil,
                                  PWideChar(ADependency),
                                  nil,
                                  nil
                               );
 try
   if ServiceHandle <> 0 then
     if not ASilent then
       MessageBox(0, cInstalled, PWideChar(_ServiceName), 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 AInternalServiceName : String = '');
const
 cRemoved = 'Servis başarı ile kaldırıldı.';

var
 ServiceManager,
 ServiceHandle : NativeUInt;

 _ServiceName  : String;
begin
 ServiceManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);

 if ServiceManager <> 0 then
 begin
   BeforeUnInstall;

   _ServiceName := AInternalServiceName;

   if AInternalServiceName = '' then
     _ServiceName := AServiceName;

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

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

       if not ASilent then
         MessageBox(0, cRemoved, PWideChar(_ServiceName), 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(PWideChar(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));

       Exit;
     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;

procedure ShowUsage;
var
 AHelpText : String;
begin
 AHelpText := 'Anlaşılmayan parametre.' + sLineBreak +
              'Geçerli parametreler: /i , /install, /u, /uninstall, /ip, /up' + sLineBreak +
              'ip = Install with parameters (3 parametre geçebilirsiniz). Param1 = servis adı, Param2 = servis görünen adı, Param3 = virgülle ayrılmış bağımlılıklar listesi' + sLineBreak +
              'up = Uninstall with parameters Param1 = servis adı' + sLineBreak + sLineBreak +
              'Örnek Install' + sLineBreak +
              'pServisAppIskeleti.exe /ip ServisAdiArtikBuOlacak "Servisin Görünen Adı Bu Olacak" "AppIDSvc,Appinfo,tzautoupdate"' + sLineBreak + sLineBreak +
              'Örnek UnInstall' + sLineBreak +
              'pServisAppIskeleti.exe /up ServisAdiArtikBuOlacak';

 MessageBox(0, PWideChar(AHelpText), PWideChar(AServiceName), MB_ICONINFORMATION or MB_OK or MB_TASKMODAL or MB_TOPMOST);
end;

var
 AItem,
 AParam,
 AParam2, // Service Name
 AParam3, // Display Name
 AParam4 : String; // Dependent Service Names

 Index   : Integer;
 AnArray : TArrayOfStringEx;
begin
 {$IFDEF LOGSUPPORT}
 CodeSite.ConnectUsingTcp;
 {$ENDIF}

 Index := -1;

 if (ParamCount = 0) or ParamExists('-name=', Index) then
 begin
   if Index > 0 then
   begin
     AParam := ParamStr(Index);

     System.Delete(AParam, 1, Length('-name='));

     AServiceName := AParam;
   end;

   AServiceTable[0].lpServiceName := PWideChar(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);
   AParam2 := ParamStr(2);
   AParam3 := ParamStr(3);
   AParam4 := ParamStr(4);

   if AParam4 <> '' then
   begin
     AnArray := SplitStringEx(AParam4);

     if Assigned(AnArray) then
       if Length(AnArray) > 0 then
       begin
         Index := 0;
         SetLength(DependentServices, Length(AnArray));

         for AItem in AnArray do
         begin
           DependentServices[Index] := AnsiString(AItem);
           Inc(Index);
         end; // for AItem in AnArray do
       end; // if Length(AnArray) > 0 then
   end // if AParam4 <> '' then
   else
   begin
     // Sabit bağımlılıklarınız için hafıza rezervasyonunu ve atamalarınızı burada yapabilirsiniz.
   end;

   if (AParam = '/i') or (AParam = '/install') then
     InstallService(false)
   else
   if (AParam = '/ip') then // ip = Install With Parameters (Servis adını dışarıdan parametre olarak al)
     InstallService(false, AParam2, AParam3)
   else
   if (AParam = '/u') or (AParam = '/uninstall') then
     UnInstallService(false)
   else
   if (AParam = '/up') then // up = Uninstall With Parameters (Servis adını dışarıdan parametre olarak al)
     UnInstallService(false, AParam2)
   else
     ShowUsage;

   if Assigned(DependentServices) then
     DependentServices := nil;
 end;

{$ENDREGION}
end.


Ek Dosyalar
.txt   pServisAppIskeleti.dpr.txt (Dosya Boyutu: 27,97 KB / İndirme Sayısı: 6)
Mal sahibi, mülk sahibi
Hani bunun ilk sahibi ?
Mal da yalan mülk de yalan
Var biraz da sen oyalan...
WWW
Cevapla
#15
Tuğrul üstadımız yine döktürmüşün eline sağlık.

Ek olarak string tipindeki metinlerin ve parametre adlarının en üstte CONST ile tanımlanması faydalı olabilir.
Cevapla
#16
(12-02-2019, Saat: 13:11)ssahinoglu Adlı Kullanıcıdan Alıntı: Tuğrul üstadımız yine döktürmüşün eline sağlık.

Ek olarak string tipindeki metinlerin ve parametre adlarının en üstte CONST ile tanımlanması faydalı olabilir.

Teşekkür ederim. Mesela const olarak neyi tanımlayabilirim ?
Mal sahibi, mülk sahibi
Hani bunun ilk sahibi ?
Mal da yalan mülk de yalan
Var biraz da sen oyalan...
WWW
Cevapla
#17
Aslında hata metinlerini kastetmiştim.
Hepsi bir arada olması belki iyi olur diye ama tercih meselesi tabi.
Cevapla
#18
(12-02-2019, Saat: 11:01)SimaWB Adlı Kullanıcıdan Alıntı:
(11-02-2019, Saat: 21:24)Tuğrul HELVACI Adlı Kullanıcıdan Alıntı: Yarın da Allah nasip ederse dependencies (bağımlılıklar) üzerine küçük bir eklenti yapacağım.

İskeleti kullanıp fikirlerinizi yazarsanız eksiklerimizi görür, düzeltme imkanı buluruz. Özellikle gövdesini boş bıraktığım olayları da doldurursak çok sağlam bir iskelet çıkar ortaya. Bilhassa vakit bulabilenlerin ETW ile ilgili linki takip edip servis triggerları vasıtası ile işletim sisteminde gerçekleşen 1001 olayın bir kaçını paylaşması çok yerinde ve faydalı olur.

Bende Delphi XE var. O yüzden kullanmak için bazı değişiklikler yapmak zorunda kaldım:
SERVICE_ACCEPT_ ve  SERVICE_CONTROL_ ile başlayan sabitler tanımlı değildi, tanımladım.
PSERVICE_TIMECHANGE_INFO ve RegisterServiceCtrlHandlerEx tanımlı değildi. PSERVICE_TIMECHANGE_INFO şimdilik kullanılmadığı için onu kaldırdım.
RegisterServiceCtrlHandlerEx'yi ise şu şekilde tanımladım:

function RegisterServiceCtrlHandlerExW(lpServiceName: PWideChar; lpHandlerProc: Pointer): SERVICE_STATUS_HANDLE; stdcall; external advapi32 name 'RegisterServiceCtrlHandlerExW';
ve kodumun içinde de RegisterServiceCtrlHandlerExW methodunu kullandım.

Nur topu gibi bir servisim oldu. Hem de 32.5 KB!!!

Vakit bulup detaylı kullanım yaptıkça bilgilendireceğim inşallah.

Ellerinize sağlık üstad. Delphi'nin eski versiyonlarında boyut 'da düşüyor haliyle. Aslında benim hedefim birinci öncelik olarak boyut değildi. Ama yapmışken fazla kastırmadan boyutu da düşürmek iyi olur diye düşündüm. Bu arada boyutu çok daha fazla düşürebiliriz ama ciddi emek ister. O nedenle bence gerek yok. Bilgilendirmelerinizi bekliyor olacağım Smile
Mal sahibi, mülk sahibi
Hani bunun ilk sahibi ?
Mal da yalan mülk de yalan
Var biraz da sen oyalan...
WWW
Cevapla
#19
(12-02-2019, Saat: 13:41)ssahinoglu Adlı Kullanıcıdan Alıntı: Aslında hata metinlerini kastetmiştim.
Hepsi bir arada olması belki iyi olur diye ama tercih meselesi tabi.

Elbette. Haklısınız, güzelde olur. Teşekkür ederim, yapayım.
Mal sahibi, mülk sahibi
Hani bunun ilk sahibi ?
Mal da yalan mülk de yalan
Var biraz da sen oyalan...
WWW
Cevapla
#20
Elinize Sağlık, Detaylı bir çalışma olmuş,
Cevapla


Konu ile Alakalı Benzer Konular
Konular Yazar Yorumlar Okunma Son Yorum
  delphi ile web servis yazmak. Kamuran Alpkaya 7 1.700 12-02-2019, Saat: 13:19
Son Yorum: enes6635
  Hal Kayıt Sistemi Web Servis eyln 45 4.672 06-11-2018, Saat: 13:29
Son Yorum: Abdullah ILGAZ
  Web Servis Access Violation ahmet_sinav 6 454 25-09-2018, Saat: 15:48
Son Yorum: ahmet_sinav
  Rest Web Servis Cookie Sıkıntısı Hk. satiuqea 7 527 31-08-2018, Saat: 17:36
Son Yorum: SimaWB
  Uygulama derlenirken exe açık uyarısı hk yhackup 6 1.950 24-05-2018, Saat: 17:41
Son Yorum: narkotik



Konuyu Okuyanlar: 1 Ziyaretçi