![]() |
|
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) |
Cvp: Modern Servis Uygulama İskeleti - SimaWB - 12-02-2019 (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. 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. Modern Servis Uygulama İskeleti - Bay_Y - 12-02-2019 Ç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. Modern Servis Uygulama İskeleti - adelphiforumz - 12-02-2019 @Tuğrul HELVACI Hocam ellerine sağlık Cvp: Modern Servis Uygulama İskeleti - Tuğrul HELVACI - 12-02-2019 Servis iskeleti üzerinde bir kaç değişiklik ve eklenti yaptı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ş :-)
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/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 = '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/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;
{$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/desktop/api/winsvc/nf-winsvc-createservicea
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.
Modern Servis Uygulama İskeleti - ssahinoglu - 12-02-2019 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. Cvp: Modern Servis Uygulama İskeleti - Tuğrul HELVACI - 12-02-2019 (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. Teşekkür ederim. Mesela const olarak neyi tanımlayabilirim ? Modern Servis Uygulama İskeleti - ssahinoglu - 12-02-2019 Aslında hata metinlerini kastetmiştim. Hepsi bir arada olması belki iyi olur diye ama tercih meselesi tabi. Cvp: Modern Servis Uygulama İskeleti - Tuğrul HELVACI - 12-02-2019 (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. 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
Cvp: Modern Servis Uygulama İskeleti - Tuğrul HELVACI - 12-02-2019 (12-02-2019, Saat: 13:41)ssahinoglu Adlı Kullanıcıdan Alıntı: Aslında hata metinlerini kastetmiştim. Elbette. Haklısınız, güzelde olur. Teşekkür ederim, yapayım. Modern Servis Uygulama İskeleti - WhiteWarriorTR - 13-02-2019 Elinize Sağlık, Detaylı bir çalışma olmuş, |