Unit ads_XPServices;
{Copyright(c)2016 Advanced Delphi Systems
Richard Maley
Advanced Delphi Systems
12613 Maidens Bower Drive
Potomac, MD 20854 USA
phone 301-840-1554
dickmaley@advdelphisys.com
The code herein can be used or modified by anyone. Please retain references
to Richard Maley at Advanced Delphi Systems. If you make improvements to the
code please send your improvements to dickmaley@advdelphisys.com so that the
entire Delphi community can benefit. All comments are welcome.
}
(*UnitIndex Master Index Implementation Section Download UnitsDescription: ads_XPServices.pas This unit contains the following routines.
CopySecurity ServiceCreate ServiceGetDisplayName ServiceGetKeyName ServiceGetList ServiceGetStatus ServiceIsRunning ServiceIsStopped ServiceStart ServiceStop
*)
Interface
Uses
Classes, Windows, WinSvc;
Function ServiceIsRunning(sMachine,sService : String ) : Boolean;
Function ServiceIsStopped(sMachine,sService: String ) : Boolean;
Function ServiceGetStatus(sMachine,sService: STRING): DWord;
Function ServiceStop(sMachine,sService : String ) : Boolean;
Function ServiceStart(sMachine,sService: String ): Boolean;
Function ServiceGetKeyName(sMachine,sServiceDispName: String) : String;
Function ServiceGetDisplayName(sMachine,sServiceKeyName: String): String;
Function ServiceGetList(sMachine:String;dwServiceType,dwServiceState:DWord;slServicesList:TStrings):Boolean;
Function ServiceCreate(
ServiceName : String; //name of service to start
DisplayName : String; //display name
BinaryPathName : String; //Full path to application file
ServiceOwner : String; //Service owner userid
OwnerPassword : String //Service owner password
): SC_HANDLE;
implementation
Uses AccCtrl, AclApi, Dialogs, SysUtils;
Const
SERVICE_KERNEL_DRIVER = $00000001;
SERVICE_FILE_SYSTEM_DRIVER = $00000002;
SERVICE_ADAPTER = $00000004;
SERVICE_RECOGNIZER_DRIVER = $00000008;
SERVICE_DRIVER =
(SERVICE_KERNEL_DRIVER Or
SERVICE_FILE_SYSTEM_DRIVER Or
SERVICE_RECOGNIZER_DRIVER);
SERVICE_WIN32_OWN_PROCESS = $00000010;
SERVICE_WIN32_SHARE_PROCESS = $00000020;
SERVICE_WIN32 =
(SERVICE_WIN32_OWN_PROCESS Or
SERVICE_WIN32_SHARE_PROCESS);
SERVICE_INTERACTIVE_PROCESS = $00000100;
SERVICE_TYPE_ALL =
(SERVICE_WIN32 Or
SERVICE_ADAPTER Or
SERVICE_DRIVER Or
SERVICE_INTERACTIVE_PROCESS);
//Unit Description UnitIndex Master Index
Function ServiceGetStatus(sMachine,sService: STRING): DWord;
Var
dwStat : DWord; // current service status
schm : SC_Handle; // service control manager handle
schs : SC_Handle; // service handle
ss : TServiceStatus; // service status
Begin
dwStat := 0;
schm := OpenSCManager(PCHAR(sMachine),nil,SC_MANAGER_CONNECT);
If schm>0 Then
Begin
schs := OpenService(schm,PCHAR(sService),SERVICE_QUERY_STATUS);
If schs>0 Then
Begin
If QueryServiceStatus(schs,ss) Then
dwStat:=ss.dwCurrentState;
CloseServiceHandle(schs);
End;
CloseServiceHandle(schm);
End;
Result := dwStat;
End;
//Unit Description UnitIndex Master IndexFunction ServiceIsRunning(sMachine,sService : String ) : Boolean; Begin Result := (SERVICE_RUNNING=ServiceGetStatus(sMachine,sService)); End; //Unit Description UnitIndex Master Index
Function ServiceIsStopped(sMachine,sService: String ) : Boolean; Begin Result := (SERVICE_STOPPED=ServiceGetStatus(sMachine,sService)); End; //Unit Description UnitIndex Master Index
Function ServiceStart(sMachine,sService: String ): Boolean;
Var
dwChkP : DWord;
psTemp : PChar;
schm : SC_Handle;
schs : SC_Handle;
ss : TServiceStatus;
Begin
ss.dwCurrentState := 0;
schm := OpenSCManager(PChar(sMachine),nil,SC_MANAGER_CONNECT);
If(schm > 0)Then
Begin
schs := OpenService(schm,PChar(sService),SERVICE_START Or SERVICE_QUERY_STATUS);
If schs>0 Then
Begin
psTemp := nil;
If(StartService(schs,0,psTemp))Then
If(QueryServiceStatus(schs,ss))Then
While SERVICE_RUNNING<>ss.dwCurrentState Do
Begin
dwChkP := ss.dwCheckPoint;
Sleep(ss.dwWaitHint);
If Not QueryServiceStatus(schs,ss) Then
break;
If ss.dwCheckPointUnit Description UnitIndex Master Index
Function ServiceStop(sMachine,sService : String ): Boolean;
Var
dwChkP : DWord;
schm : SC_Handle;
schs : SC_Handle;
ss : TServiceStatus;
Begin
schm := OpenSCManager(PChar(sMachine),nil,SC_MANAGER_CONNECT);
If schm>0 Then
Begin
schs := OpenService(schm,PChar(sService),SERVICE_STOP Or SERVICE_QUERY_STATUS);
If schs>0 Then
Begin
If ControlService(schs,SERVICE_CONTROL_STOP,ss) Then
If QueryServiceStatus(schs,ss) Then
While SERVICE_STOPPED<>ss.dwCurrentState Do
Begin
dwChkP := ss.dwCheckPoint;
Sleep(ss.dwWaitHint);
If Not QueryServiceStatus(schs,ss) Then
break;
If ss.dwCheckPointUnit Description UnitIndex Master Index
Function ServiceGetKeyName(sMachine,sServiceDispName: String) : String;
Var
nMaxNameLen : DWord;
psServiceName : PChar;
schm : SC_Handle;
Begin
Result := '';
nMaxNameLen := 255;
schm := OpenSCManager(PChar(sMachine),nil,SC_MANAGER_CONNECT);
If schm>0 Then
Begin
psServiceName:=StrAlloc(nMaxNameLen+1);
If psServiceName<>nil Then
Begin
If GetServiceKeyName(
schm,
PChar(sServiceDispName),
psServiceName,
nMaxNameLen) Then
Begin
psServiceName[nMaxNameLen] := #0;
Result:=StrPas(psServiceName);
End;
StrDispose(psServiceName);
End;
CloseServiceHandle(schm);
End;
End;
//Unit Description UnitIndex Master Index
Function ServiceGetDisplayName(sMachine,sServiceKeyName: String): String;
Var
schm : SC_Handle;
nMaxNameLen : DWord;
psServiceName : PChar;
Begin
Result := '';
nMaxNameLen := 255;
schm := OpenSCManager(
PChar(sMachine),
nil,
SC_MANAGER_CONNECT);
If(schm > 0)Then
Begin
psServiceName:=StrAlloc(nMaxNameLen+1);
If(nil <> psServiceName)Then
Begin
If( GetServiceDisplayName(
schm,
PChar(sServiceKeyName),
psServiceName,
nMaxNameLen ) )Then
Begin
psServiceName[nMaxNameLen] := #0;
Result:=StrPas( psServiceName );
End;
StrDispose(psServiceName);
End;
CloseServiceHandle(schm);
End;
End;
//Unit Description UnitIndex Master Index
Function ServiceGetList(
sMachine : String;
dwServiceType,
dwServiceState : DWord;
slServicesList : TStrings ) : Boolean;
Const
cnMaxServices = 4096;
Type
TSvcA = Array[0..cnMaxServices] Of TEnumServiceStatus;
PSvcA = ^TSvcA;
Var
j : Integer;
schm : SC_Handle;
nBytesNeeded : DWord;
nServices : DWord;
nResumeHandle : DWord;
ssa : PSvcA;
Begin
Result := False;
schm := OpenSCManager(
PChar(sMachine),
nil,
SC_MANAGER_ALL_ACCESS);
If(schm > 0)Then
Begin
nResumeHandle := 0;
New(ssa);
EnumServicesStatus(
schm,
dwServiceType,
dwServiceState,
ssa^[0],
SizeOf(ssa^),
nBytesNeeded,
nServices,
nResumeHandle );
For j := 0 To nServices-1 Do
slServicesList.
Add( StrPas(
ssa^[j].lpDisplayName ) );
Result := True;
Dispose(ssa);
CloseServiceHandle(schm);
End;
End;
//Unit Description UnitIndex Master Index
Function ServiceCreate(
ServiceName : String; //name of service to start
DisplayName : String; //display name
BinaryPathName : String; //Full path to application file
ServiceOwner : String; //Service owner userid
OwnerPassword : String //Service owner password
): SC_HANDLE;
Var
hSCManager : SC_HANDLE; // handle to service control manager database
lpServiceName : LPCTSTR; // pointer to name of service to start
lpDisplayName : LPCTSTR; // pointer to display name
dwDesiredAccess : DWORD; // type of access to service
dwServiceType : DWORD; // type of service
dwStartType : DWORD; // when to start service
dwErrorControl : DWORD; // severity if service fails to start
lpBinaryPathName : LPCTSTR; // pointer to name of binary file
lpLoadOrderGroup : LPCTSTR; // pointer to name of load ordering group
lpdwTagId : LPDWORD; // pointer to variable to get tag identifier
lpDependencies : LPCTSTR; // pointer to array of dependency names
lpServiceStartName: LPCTSTR; // pointer to account name of service
lpPassword : LPCTSTR; // pointer to password for service account
Begin
hSCManager := OpenSCManager(PChar(''),nil,SC_MANAGER_ALL_ACCESS);
lpServiceName := PChar(ServiceName); // pointer to name of service to start
lpDisplayName := PChar(DisplayName); // pointer to display name
dwDesiredAccess := SERVICE_ALL_ACCESS; // type of access to service
dwServiceType := SERVICE_WIN32_OWN_PROCESS; // type of service
dwStartType := SERVICE_AUTO_START; // when to start service
dwErrorControl := SERVICE_ERROR_IGNORE; // severity if service fails to start
lpBinaryPathName := PChar(BinaryPathName); // pointer to name of binary file
lpLoadOrderGroup := nil; // pointer to name of load ordering group
lpdwTagId := nil; // pointer to variable to get tag identifier
lpDependencies := nil; // pointer to array of dependency names
lpServiceStartName:= PChar(ServiceOwner); // pointer to account name of service
lpPassword := PChar(OwnerPassword); // pointer to password for service account
Result:=
CreateService(
hSCManager , //hSCManager : SC_HANDLE; // handle to service control manager database
lpServiceName , //lpServiceName : LPCTSTR; // pointer to name of service to start
lpDisplayName , //lpDisplayName : LPCTSTR; // pointer to display name
dwDesiredAccess , //dwDesiredAccess : DWORD; // type of access to service
dwServiceType , //dwServiceType : DWORD; // type of service
dwStartType , //dwStartType : DWORD; // when to start service
dwErrorControl , //dwErrorControl : DWORD; // severity if service fails to start
lpBinaryPathName , //lpBinaryPathName : LPCTSTR; // pointer to name of binary file
lpLoadOrderGroup , //lpLoadOrderGroup : LPCTSTR; // pointer to name of load ordering group
lpdwTagId , //lpdwTagId : LPDWORD; // pointer to variable to get tag identifier
lpDependencies , //lpDependencies : LPCTSTR; // pointer to array of dependency names
lpServiceStartName, //lpServiceStartName: LPCTSTR; // pointer to account name of service
lpPassword //lpPassword : LPCTSTR // pointer to password for service account
);//): SC_HANDLE;
End;
//Unit Description UnitIndex Master Index
Function CopySecurity(Src, Des : String) : Boolean;
Var
Drv1, Drv2 : String;
Buf, FSBuf : PChar;
MaxFNLen, FileSysFlags : DWORD;
pSidOwner, pSidGroup : PSID;
pDacl, pSacl : PACL;
pSecDesc : PSECURITY_DESCRIPTOR;
LastError : DWORD;
Begin
Drv1 := ExtractFileDrive(Src);
Drv2 := ExtractFileDrive(Des);
Result := False;
If (Drv1 <> '') And (Drv2 <> '') Then
Begin
GetMem(Buf, 120);
GetMem(FSBuf, 120);
Result := GetVolumeInformation(PChar(Drv1), Buf, 120, nil, MaxFNLen,
FileSysFlags, FSBuf, 120);
If Result And (String(FSBuf) = 'NTFS') Then
Result := GetVolumeInformation(PChar(Drv2), Buf, 120, nil, MaxFNLen,
FileSysFlags, FSBuf, 120);
FreeMem(Buf);
FreeMem(FSBuf);
GetMem(pDacl, SizeOf(TACL));
GetMem(pSacl, SizeOf(TACL));
Result := Result And (String(FSBuf) = 'NTFS');
If Result Then
Begin
LastError := GetNamedSecurityInfo(
PChar(Src), SE_FILE_OBJECT, DACL_SECURITY_INFORMATION Or
GROUP_SECURITY_INFORMATION Or
OWNER_SECURITY_INFORMATION Or SACL_SECURITY_INFORMATION,
Addr(pSidOwner), Addr(pSidGroup), pDacl, pSacl, pSecDesc);
Result := LastError = ERROR_SUCCESS;
If Not Result Then
ShowMessage('Error in GetNamedSecurityInfo: ' +
IntToStr(LastError));
End;
If Result Then
Begin
LastError := SetNamedSecurityInfo(
PChar(Des), SE_FILE_OBJECT, DACL_SECURITY_INFORMATION Or
GROUP_SECURITY_INFORMATION Or
OWNER_SECURITY_INFORMATION Or SACL_SECURITY_INFORMATION,
Addr(pSidOwner), Addr(pSidGroup), pDacl, pSacl);
Result := LastError = ERROR_SUCCESS;
If Not Result Then
ShowMessage('Error in SetNamedSecurityInfo: ' +
IntToStr(LastError));
End;
FreeMem(pDacl);
FreeMem(pSacl);
End;
End;
End.
//