11-02-2019, Saat: 17:58
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.
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...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 = '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...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; {$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...teservicea 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.
Mal sahibi, mülk sahibi
Hani bunun ilk sahibi ?
Mal da yalan mülk de yalan
Var biraz da sen oyalan...
Hani bunun ilk sahibi ?
Mal da yalan mülk de yalan
Var biraz da sen oyalan...