![]() |
Modern Servis Uygulama İskeleti - Baskı Önizleme +- Delphi Can (https://www.delphican.com) +-- Forum: Delphi (https://www.delphican.com/forumdisplay.php?fid=3) +--- Forum: Genel Programlama (https://www.delphican.com/forumdisplay.php?fid=6) +--- Konu Başlığı: Modern Servis Uygulama İskeleti (/showthread.php?tid=3293) |
Modern Servis Uygulama İskeleti - Tuğrul HELVACI - 11-02-2019 Delphi'nin Servis uygulamaları bildiğiniz gibi Windows 2000 ve öncesinin mimarisine dayanıyor. Windows 2000 sonrasında işletim sistemlerine katılan özellikleri bu servis mimarisinde kullanmaya çalışmak gerçekten de deveye hendek atlatmak gibi. Bu bağlamda; yaptığım bir proje için servis uygulaması içinde tarih/saatin değiştiği anı yakalamam gerekiyordu. Delphi'nin şu anda bizlere sunduğu mimaride, maalesef bunu yapabilmek için bir pencere oluşturmak ve o pencereye gelen WM_TIMECHANGE mesajlarını işlemek zorundasınız. Ancak yeni nesil servis mimarisinde inanılmaz derecede esneksiniz. Bu esnekliği elde edebilmek için standart RegisterServiceCtrlHandler API'si yerine RegisterServiceCtrlHandlerEx API'sini kullanmak icap ediyor. Yeni mimari ile neler yapabileceğinizin sınırlarını merak ediyorsanız, bu metni de okumalısınız. Mümkün mertebe tüm olayları kapsayan, thread destekli bir servis iskeleti oluşturmaya çalıştım: Aşağıda sizlerin beğenisine ve kullanımına sunuyorum. Hata ya da istek bildirimlerinizi buradan paylaşabilirsiniz. Fikir ve görüşlerinize açığım. (* 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. Modern Servis Uygulama İskeleti - Tuğrul HELVACI - 11-02-2019 Bu yapının bir diğer güzel tarafı da Release derlemede EXE boyutunun 56 KB olması :-) Modern Servis Uygulama İskeleti - SimaWB - 11-02-2019 Paylaşım için teşekkürler. Emeğinize sağlık. Modern Servis Uygulama İskeleti - mcuyan - 11-02-2019 Müthiş bir çalışma.. Elinize sağlık @Tuğrul HELVACI Hocam.. Modern Servis Uygulama İskeleti - narkotik - 11-02-2019 Üstad eline sağlık çok değerli bir paylaşım oldu Modern Servis Uygulama İskeleti - Tuğrul HELVACI - 11-02-2019 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. Modern Servis Uygulama İskeleti - sddk - 11-02-2019 Emeğinize sağlık, Allah razı olsun. Modern Servis Uygulama İskeleti - frmman - 12-02-2019 Teşekkürler @Tuğrul HELVACI hocam Cvp: Modern Servis Uygulama İskeleti - TescilsizUzman - 12-02-2019 Değerli katkılarınızdan dolayı teşekkür ederim, @Tuğrul HELVACI hocam. Ellerinize, emeklerinize sağlık. Modern Servis Uygulama İskeleti - 3ddark - 12-02-2019 Emeğinize sağlık. |