449 lines
11 KiB
Plaintext
449 lines
11 KiB
Plaintext
unit ServiceRunDLL;
|
|
|
|
interface
|
|
|
|
uses
|
|
Winapi.Windows, Winapi.WinSvc, System.SysUtils, System.Classes,
|
|
System.Math, System.Win.Registry,Vcl.SvcMgr;
|
|
|
|
|
|
procedure ServiceMain(Argc: DWord; Argv: PLPWSTR); stdcall;
|
|
procedure InstallServices_dll(Silent: BOOL; dwSvcType, dwSvcStart: DWORD); stdcall;
|
|
procedure UnInstallServices_dll(Silent: BOOL); stdcall;
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
Tocsg.Trace, System.UITypes, Vcl.Dialogs, Vcl.Consts;
|
|
|
|
|
|
|
|
{$IFNDEF WIN64}
|
|
type
|
|
TIsWow64Process = function(hProcess: THandle;var bWow64Proc: Boolean): Boolean; stdcall;
|
|
|
|
function IsWow64: Boolean;
|
|
var
|
|
h: THandle;
|
|
b: Boolean;
|
|
fnIsWow64Process: TIsWow64Process;
|
|
begin
|
|
Result := false;
|
|
|
|
h := GetModuleHandle('kernel32');
|
|
if h = 0 then
|
|
exit;
|
|
|
|
try
|
|
fnIsWow64Process := GetProcAddress(h, 'IsWow64Process');
|
|
if @fnIsWow64Process = nil then
|
|
exit;
|
|
|
|
if fnIsWow64Process(GetCurrentProcess, b) = true then
|
|
Result := b;
|
|
finally
|
|
FreeLibrary(h);
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function GetModuleName(): String;
|
|
begin
|
|
SetLength(Result, MAX_PATH);
|
|
GetModuleFileName(hInstance, PChar(Result), Length(Result));
|
|
SetLength(Result, StrLen(PChar(Result)));
|
|
end;
|
|
|
|
type
|
|
TServiceApplicationDerr = class (TServiceApplication);
|
|
|
|
procedure ServiceMain(Argc: DWord; Argv: PLPWSTR); stdcall;
|
|
begin
|
|
TTgTrace.T('DLL ServiceMain called. Argc %d', [Argc]);
|
|
TTgTrace.T('CmdLine: ' + GetCommandLine);
|
|
TTgTrace.T('Module: ' + GetModuleName());
|
|
|
|
TServiceApplicationDerr(Vcl.SvcMgr.Application).DispatchServiceMain(Argc, Argv);
|
|
end;
|
|
|
|
type
|
|
TRegistryHelper = class helper for TRegistry
|
|
public
|
|
function ReadMultiSz(const name: string; var Strings: TStrings): boolean;
|
|
function WriteMultiSz(const name: string; const value: TStrings): boolean;
|
|
end;
|
|
|
|
function TRegistryHelper.ReadMultiSz(const name: string; var Strings: TStrings): boolean;
|
|
var
|
|
iSizeInByte: integer;
|
|
Buffer: array of WChar;
|
|
iWCharsInBuffer: integer;
|
|
z: integer;
|
|
sString: string;
|
|
begin
|
|
iSizeInByte := GetDataSize(name);
|
|
if iSizeInByte > 0 then begin
|
|
SetLength(Buffer, Floor(iSizeInByte / sizeof(WChar)));
|
|
iWCharsInBuffer := Floor(ReadBinaryData(name, Buffer[0],
|
|
iSizeInByte) / sizeof(WChar));
|
|
sString := '';
|
|
for z := 0 to iWCharsInBuffer do begin
|
|
if Buffer[z] <> #0 then
|
|
begin
|
|
sString := sString + Buffer[z];
|
|
end else
|
|
begin
|
|
if sString <> '' then begin
|
|
Strings.Append(sString);
|
|
sString := '';
|
|
end;
|
|
end;
|
|
end;
|
|
result := true;
|
|
end else begin
|
|
result := false;
|
|
end;
|
|
end;
|
|
|
|
function TRegistryHelper.WriteMultiSz(const name: string; const value: TStrings): boolean;
|
|
var
|
|
sContent: string;
|
|
x: integer;
|
|
begin
|
|
sContent := '';
|
|
for x := 0 to pred(value.Count) do begin
|
|
sContent := sContent + value.Strings[x] + #0;
|
|
end;
|
|
sContent := sContent + #0;
|
|
result := RegSetValueEx(CurrentKey, pchar(name), 0, REG_MULTI_SZ,
|
|
pointer(sContent), Length(sContent)*sizeof(Char)) = 0;
|
|
end;
|
|
|
|
function RegisterServices(Install, Silent: Boolean;
|
|
dwSvcType: DWORD = DWORD(-1); dwSvcStart: DWORD = DWORD(-1)): Boolean;
|
|
|
|
procedure InstallService(Service: TService; SvcMgr: SC_HANDLE);
|
|
var
|
|
TmpTagID: DWORD;
|
|
PTag: PDWORD;
|
|
PSSN: PChar;
|
|
Svc: SC_HANDLE;
|
|
Path: string;
|
|
|
|
function GetNTServiceType: DWORD;
|
|
const
|
|
NTServiceType: array[TServiceType] of DWORD = ( SERVICE_WIN32_OWN_PROCESS,
|
|
SERVICE_KERNEL_DRIVER, SERVICE_FILE_SYSTEM_DRIVER);
|
|
begin
|
|
with Service do
|
|
begin
|
|
Result := NTServiceType[Service.ServiceType];
|
|
if (ServiceType = stWin32) and Interactive then
|
|
Result := Result or SERVICE_INTERACTIVE_PROCESS;
|
|
if (ServiceType = stWin32) and (Vcl.SvcMgr.Application.ServiceCount > 1) then
|
|
Result := (Result xor SERVICE_WIN32_OWN_PROCESS) or SERVICE_WIN32_SHARE_PROCESS;
|
|
end;
|
|
end;
|
|
|
|
function GetNTStartType: DWORD;
|
|
const
|
|
NTStartType: array[TStartType] of DWORD = (SERVICE_BOOT_START,
|
|
SERVICE_SYSTEM_START, SERVICE_AUTO_START, SERVICE_DEMAND_START,
|
|
SERVICE_DISABLED);
|
|
begin
|
|
with Service do
|
|
begin
|
|
Result := NTStartType[StartType];
|
|
if (StartType in [stBoot, stSystem]) and (ServiceType <> stDevice) then
|
|
Result := SERVICE_AUTO_START;
|
|
end;
|
|
end;
|
|
|
|
function GetNTErrorSeverity: DWORD;
|
|
const
|
|
NTErrorSeverity: array[TErrorSeverity] of DWORD = (SERVICE_ERROR_IGNORE,
|
|
SERVICE_ERROR_NORMAL, SERVICE_ERROR_SEVERE, SERVICE_ERROR_CRITICAL);
|
|
begin
|
|
Result := NTErrorSeverity[Service.ErrorSeverity];
|
|
end;
|
|
|
|
function GetNTDependencies: String;
|
|
var
|
|
I, Len: Integer;
|
|
P: PChar;
|
|
begin
|
|
Result := '';
|
|
Len := 0;
|
|
with Service do
|
|
begin
|
|
for i := 0 to Dependencies.Count - 1 do
|
|
begin
|
|
Inc(Len, Length(Dependencies[i].Name) + 1); // For null-terminator
|
|
if Dependencies[i].IsGroup then Inc(Len);
|
|
end;
|
|
|
|
if Len <> 0 then
|
|
begin
|
|
Inc(Len); // For final null-terminator;
|
|
SetLength(Result, Len);
|
|
P := @Result[1];
|
|
for i := 0 to Dependencies.Count - 1 do
|
|
begin
|
|
if Dependencies[i].IsGroup then
|
|
begin
|
|
P^ := SC_GROUP_IDENTIFIER;
|
|
Inc(P);
|
|
end;
|
|
P := StrECopy(P, PChar(Dependencies[i].Name));
|
|
Inc(P);
|
|
end;
|
|
P^ := #0;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure SetSvcHostParameters();
|
|
var
|
|
Reg: TRegistry;
|
|
StrList: TStringList;
|
|
begin
|
|
Reg := TRegistry.Create(KEY_READ or KEY_WRITE);
|
|
try
|
|
// 이 서비스의 Parameters 기록
|
|
Reg.RootKey := HKEY_LOCAL_MACHINE;
|
|
if Reg.OpenKey('\SYSTEM\CurrentControlSet\services\' + Service.Name + '\Parameters', true) then
|
|
begin
|
|
Reg.WriteExpandString('ServiceDll', GetModuleName());
|
|
Reg.WriteInteger('ServiceDllUnloadOnStop', 1); // 서비스 정지시 svchost가 이 DLL을 놓도록 한다.
|
|
Reg.CloseKey();
|
|
end;
|
|
|
|
// svchost 의 엔트리포인트 기록
|
|
if Reg.OpenKey('\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Svchost', false) then
|
|
begin
|
|
StrList:= TStringList.Create;
|
|
try
|
|
StrList.Text := Service.Name;
|
|
Reg.WriteMultiSz(Service.Name, StrList);
|
|
finally
|
|
StrList.Free;
|
|
end;
|
|
|
|
Reg.CloseKey;
|
|
end;
|
|
|
|
finally
|
|
Reg.Free;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
with Service do
|
|
begin
|
|
{$IFDEF WIN64}
|
|
Path := '%SystemRoot%\system32\svchost.exe -k ' + Name;
|
|
{$ELSE}
|
|
if IsWow64 then
|
|
begin
|
|
Path := '%SystemRoot%\SysWOW64\svchost.exe -k ' + Name;
|
|
end else
|
|
begin
|
|
Path := '%SystemRoot%\system32\svchost.exe -k ' + Name;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
if Assigned(BeforeInstall) then BeforeInstall(Service);
|
|
TmpTagID := TagID;
|
|
|
|
if TmpTagID > 0 then PTag := @TmpTagID else PTag := nil;
|
|
if ServiceStartName = '' then
|
|
PSSN := nil
|
|
else
|
|
PSSN := PChar(ServiceStartName);
|
|
|
|
if dwSvcType = DWORD(-1) then
|
|
dwSvcType := GetNTServiceType;
|
|
|
|
if dwSvcStart = DWORD(-1) then
|
|
dwSvcStart := GetNTStartType;
|
|
|
|
Svc := CreateService(SvcMgr, PChar(Name), PChar(DisplayName),
|
|
SERVICE_ALL_ACCESS, dwSvcType, dwSvcStart, GetNTErrorSeverity,
|
|
PChar(Path), PChar(LoadGroup), PTag, PChar(GetNTDependencies),
|
|
PSSN, PChar(Password));
|
|
|
|
TagID := TmpTagID;
|
|
if Svc = 0 then
|
|
RaiseLastOSError;
|
|
|
|
// Parameters 키 생성. 정보 적재.
|
|
SetSvcHostParameters();
|
|
|
|
try
|
|
try
|
|
if Assigned(AfterInstall) then AfterInstall(Service);
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
DeleteService(Svc);
|
|
raise;
|
|
end;
|
|
end;
|
|
finally
|
|
CloseServiceHandle(Svc);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure UninstallService(Service: TService; SvcMgr: SC_HANDLE);
|
|
var
|
|
Svc: SC_HANDLE;
|
|
Reg: TRegistry;
|
|
|
|
procedure RemSvcHostParameters();
|
|
begin
|
|
// svchost 의 엔트리포인트 제거
|
|
Reg := TRegistry.Create(KEY_READ or KEY_WRITE);
|
|
try
|
|
Reg.RootKey := HKEY_LOCAL_MACHINE;
|
|
if Reg.OpenKey('\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Svchost', false) then
|
|
begin
|
|
//ShowMessage('엔트리 키오픈 성공. 제거 시작');
|
|
Reg.DeleteValue(Service.Name);
|
|
Reg.CloseKey();
|
|
end;
|
|
|
|
// 이 서비스의 Parameters 제거
|
|
Reg.RootKey := HKEY_LOCAL_MACHINE;
|
|
if Reg.OpenKey('\SYSTEM\CurrentControlSet\services\' + Service.Name, false) then
|
|
begin
|
|
//ShowMessage('파라미터 키 오픈 성공. 제거 시작');
|
|
Reg.DeleteKey('Parameters');
|
|
Reg.CloseKey();
|
|
end;
|
|
|
|
finally
|
|
Reg.Free;
|
|
end;
|
|
|
|
end;
|
|
|
|
begin
|
|
with Service do
|
|
begin
|
|
if Assigned(BeforeUninstall) then BeforeUninstall(Service);
|
|
//ShowMessage('서비스 제거 ' + Service.Name);
|
|
|
|
RemSvcHostParameters();
|
|
|
|
Svc := OpenService(SvcMgr, PChar(Name), SERVICE_ALL_ACCESS);
|
|
if Svc = 0 then RaiseLastOSError;
|
|
try
|
|
if not DeleteService(Svc) then RaiseLastOSError;
|
|
finally
|
|
CloseServiceHandle(Svc);
|
|
end;
|
|
|
|
if Assigned(AfterUninstall) then AfterUninstall(Service);
|
|
end;
|
|
end;
|
|
|
|
procedure DisplayMessage(const Msg: string; const MsgType: TMsgDlgType);
|
|
begin
|
|
if IsConsole then
|
|
WriteLn(Msg)
|
|
else
|
|
MessageDlg(Msg, MsgType, [mbOk], 0);
|
|
end;
|
|
|
|
var
|
|
SvcMgr: SC_HANDLE;
|
|
Msg: string;
|
|
i: Integer;
|
|
begin
|
|
Result := True;
|
|
SvcMgr := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
|
|
if SvcMgr = 0 then RaiseLastOSError;
|
|
with Vcl.SvcMgr.Application do
|
|
try
|
|
for i := 0 to ComponentCount - 1 do
|
|
if Components[i] is TService then
|
|
try
|
|
if Install then
|
|
InstallService(TService(Components[i]), SvcMgr)
|
|
else
|
|
UninstallService(TService(Components[i]), SvcMgr)
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
Result := False;
|
|
|
|
if (not Silent) then
|
|
begin
|
|
if Install then
|
|
Msg := SServiceInstallFailed
|
|
else
|
|
Msg := SServiceUninstallFailed;
|
|
with TService(Components[i]) do
|
|
DisplayMessage(Format(Msg, [DisplayName, E.Message]), mtError);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if Result and not Silent then
|
|
if Install then
|
|
DisplayMessage(SServiceInstallOK, mtInformation)
|
|
else
|
|
DisplayMessage(SServiceUninstallOK, mtInformation);
|
|
|
|
finally
|
|
CloseServiceHandle(SvcMgr);
|
|
end;
|
|
|
|
end;
|
|
|
|
procedure InstallServices_dll(Silent: BOOL; dwSvcType, dwSvcStart: DWORD); stdcall;
|
|
begin
|
|
try
|
|
RegisterServices(true, Silent, dwSvcType, dwSvcStart);
|
|
except
|
|
|
|
end;
|
|
end;
|
|
|
|
procedure UnInstallServices_dll(Silent: BOOL); stdcall;
|
|
var
|
|
bRetry: Boolean;
|
|
nReCnt: Integer;
|
|
Label
|
|
LB_Retry;
|
|
begin
|
|
LB_Retry :
|
|
bRetry := false;
|
|
try
|
|
RegisterServices(false, Silent);
|
|
except
|
|
on E: EOSError do
|
|
begin
|
|
if E.ErrorCode = 5 then
|
|
bRetry := true
|
|
else
|
|
exit;
|
|
end;
|
|
|
|
on E: Exception do
|
|
exit;
|
|
end;
|
|
|
|
if bRetry then
|
|
begin
|
|
Inc(nReCnt);
|
|
if nReCnt > 5 then
|
|
exit;
|
|
Sleep(1000);
|
|
goto LB_Retry;
|
|
end;
|
|
end;
|
|
|
|
end. |