Windows 2000/XP and 2003 support something called "service programs". Programs have the following benefits as service startup:
(1) You can run without logging in to the system.
(2) Have SYSTEM privileges. So you cannot end it in the process manager.
When I was developing a set-top box project for a company in 2003, I wrote courseware uploads and media services. Here is a description of how to create a Service program with Delphi7.
Run Delphi7, select the menu File-->New-->Other--->Service application. A framework for the service program will be generated. Save the project as ServiceDemo.dPR and Unit_Main.pas, and then return to the main framework. We noticed , Service has several properties. The following are the ones we use more commonly:
(1)DisplayName: The display name of the service
(2)Name: Service name.
Here we change the value of DisplayName to "Delphi Service Demo" and the Name to "DelphiService". Compile this project and you will get ServiceDemo.exe. This is already a service program! Enter CMD mode and switch to the directory where the project is located. , run the command "ServiceDemo.exe /install", and the service installation will be prompted! Then "net start DelphiService" will start this service. Enter the Control Panel --> Administrative Tools --> Services, and the service and current status will be displayed. However, this service can't do anything now, because we haven't written the code yet:) First "net stop DelphiService" and then "ServiceDemo.exe /uninstall" to delete the service. Go back to Delphi7's IDE.
Our plan is to add a main window for this service. After running, the taskbar displays the program icon. Double-clicking the icon will display the main window, with a button on it. Clicking the button will implement the Ctrl+Alt+Del function.
In fact, don't think that the service program works on Winlogon desktop. You can open the control panel and view the properties of the service we just did --> Login, where "Allow the service to interact with the desktop" is not ticked. What should I do? Haha, reply When you go to the IDE, pay attention to the boolean attribute: Interactive. When this attribute is True, the service program can interact with the desktop.
File-->New-->Form adds a window FrmMain to the service, saves the unit as Unit_FrmMain, and sets this window to be created manually. The completed code is as follows:
unit Unit_Main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, Unit_FrmMain;
type
TDelphiService = class(TService)
procedure ServiceContinue(Sender: TService; var Continued: Boolean);
procedure ServiceExecute(Sender: TService);
procedure ServicePause(Sender: TService; var Paused: Boolean);
procedure ServiceShutdown(Sender: TService);
procedure ServiceStart(Sender: TService; var Started: Boolean);
procedure ServiceStop(Sender: TService; var Stopped: Boolean);
Private
{ Private declarations }
public
function GetServiceController: TServiceController; override;
{ Public declarations }
end;
var
DelphiService: TDelphiService;
FrmMain: TFrmMain;
Implementation
{$R *.DFM}
procedure ServiceController(CtrlCode: DWord); stdcall;
Begin
DelphiService.Controller(CtrlCode);
end;
function TDelphiService.GetServiceController: TServiceController;
Begin
Result := ServiceController;
end;
procedure TDelphiService.ServiceContinue(Sender: TService;
var Continued: Boolean);
Begin
While not Terminated do
Begin
Sleep(10);
ServiceThread.ProcessRequests(False);
end;
end;
procedure TDelphiService.ServiceExecute(Sender: TService);
Begin
While not Terminated do
Begin
Sleep(10);
ServiceThread.ProcessRequests(False);
end;
end;
procedure TDelphiService.ServicePause(Sender: TService;
var Paused: Boolean);
Begin
Paused := True;
end;
procedure TDelphiService.ServiceShutdown(Sender: TService);
Begin
gbCanClose := true;
FrmMain.Free;
Status := CSStopped;
ReportStatus();
end;
procedure TDelphiService.ServiceStart(Sender: TService;
var Started: Boolean);
Begin
Started := True;
Svcmgr.Application.CreateForm(TFrmMain, FrmMain);
gbCanClose := False;
FrmMain.Hide;
end;
procedure TDelphiService.ServiceStop(Sender: TService;
var Stopped: Boolean);
Begin
Stopped := True;
gbCanClose := True;
FrmMain.Free;
end;
end.
The main window unit is as follows:
unit Unit_FrmMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, ShellApi, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;
const
WM_TrayIcon = WM_USER + 1234;
type
TFrmMain = class(TForm)
Timer1: TTimer;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FormDestroy(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Button1Click(Sender: TObject);
Private
{ Private declarations }
IconData: TNotifyIconData;
procedure AddIconToTray;
procedure DelIconFromTray;
procedure TrayIconMessage(var Msg: TMessage); message WM_TrayIcon;
procedure SysButtonMsg(var Msg: TMessage); message WM_SYSCOMMAND;
public
{ Public declarations }
end;
var
FrmMain: TFrmMain;
gbCanClose: Boolean;
Implementation
{$R *.dfm}
procedure TFrmMain.FormCreate(Sender: TObject);
Begin
FormStyle := fsStayOnTop; {front of window}
SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW); {not displayed in the taskbar}
gbCanClose := False;
Timer1.Interval := 1000;
Timer1.Enabled := True;
end;
procedure TFrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
Begin
CanClose := gbCanClose;
If not CanClose then
Begin
Hide;
end;
end;
procedure TFrmMain.FormDestroy(Sender: TObject);
Begin
Timer1.Enabled := False;
DelIconFromTray;
end;
procedure TFrmMain.AddIconToTray;
Begin
ZeroMemory(@IconData, SizeOf(TNotifyIconData));
IconData.cbSize := SizeOf(TNotifyIconData);
IconData.Wnd := Handle;
IconData.uID := 1;
IconData.uFlags := NIF_MESSAGE or NIF_ICON or NIF_Tip;
IconData.uCallbackMessage := WM_TrayIcon;
IconData.hIcon := Application.Icon.Handle;
IconData.szTip := 'Delphi service demo program';
Shell_NotifyIcon(NIM_ADD, @IconData);
end;
procedure TFrmMain.DelIconFromTray;
Begin
Shell_NotifyIcon(NIM_DELETE, @IconData);
end;
procedure TFrmMain.SysButtonMsg(var Msg: TMessage);
Begin
if (Msg.wParam = SC_CLOSE) or
(Msg.wParam = SC_MINIMIZE) then Hide
else inherited; // Perform the default action
end;
procedure TFrmMain.TrayIconMessage(var Msg: TMessage);
Begin
if (Msg.LParam = WM_LBUTTONDBLCLK) then Show();
end;
procedure TFrmMain.Timer1Timer(Sender: TObject);
Begin
AddIconToTray;
end;
procedure SendHokKey;stdcall;
var
HDesk_WL: HDESK;
Begin
HDesk_WL := OpenDesktop ('Winlogon', 0, False, DESKTOP_JOURNALPLAYBACK);
if (HDesk_WL <> 0) then
if (SetThreadDesktop (HDesk_WL) = True) then
PostMessage(HWND_BROADCAST, WM_HOTKEY, 0, MAKELONG (MOD_ALT or MOD_CONTROL, VK_DELETE));
end;
procedure TFrmMain.Button1Click(Sender: TObject);
var
dwThreadID : DWORD;
Begin
CreateThread(nil, 0, @SendHokKey, nil, 0, dwThreadID);
end;
end.
Replenish:
(1) For more service program demonstration programs, please visit the following Url: http://www.torry.net/pages.php?id=226, which contains multiple codes that demonstrate how to control and manage system services.
(2) Please remember: Windows actually has multiple desktops. For example, there will be white screens when screen transmission occurs. There may be two reasons: one is that the system is locked or not logged into the desktop, and the other is that it is on the screen protector desktop. At this time, you must turn the current screen to the desktop. Switch to the desktop to capture the screen.
(3) There is also a dynamic switching method for interaction between the service program and the desktop. The rough unit is as follows:
unit ServiceDesktop;
interface
function InitServiceDesktop: boolean;
procedure DoneServiceDeskTop;
Implementation
uses Windows, SysUtils;
const
DefaultWindowStation = 'WinSta0';
DefaultDesktop = 'Default';
var
hwinstaSave: HWINSTA;
hdeskSave: HDESK;
hwinstaUser: HWINSTA;
hdeskUser: HDESK;
function InitServiceDesktop: boolean;
var
dwThreadId: DWORD;
Begin
dwThreadId := GetCurrentThreadID;
// Ensure connection to service window station and desktop, and
// save their handles.
hwinstaSave := GetProcessWindowStation;
hdeskSave := GetThreadDesktop(dwThreadId);
hwinstaUser := OpenWindowStation(DefaultWindowStation, FALSE, MAXIMUM_ALLOWED);
if hwinstaUser = 0 then
Begin
OutputDebugString(PChar('OpenWindowStation failed' + SysErrorMessage(GetLastError)));
Result := false;
exit;
end;
if not SetProcessWindowStation(hwinstaUser) then
Begin
OutputDebugString('SetProcessWindowStation failed');
Result := false;
exit;
end;
hdeskUser := OpenDesktop(DefaultDesktop, 0, FALSE, MAXIMUM_ALLOWED);
if hdeskUser = 0 then
Begin
OutputDebugString('OpenDesktop failed');
SetProcessWindowStation(hwinstaSave);
CloseWindowStation(hwinstaUser);
Result := false;
exit;
end;
Result := SetThreadDesktop(hdeskUser);
If not Results then
OutputDebugString(PChar('SetThreadDesktop' + SysErrorMessage(GetLastError)));
end;
procedure DoneServiceDeskTop;
Begin
// Restore window station and desktop.
SetThreadDesktop(hdeskSave);
SetProcessWindowStation(hwinstaSave);
if hwinstaUser <> 0 then
CloseWindowStation(hwinstaUser);
if hdeskUser <> 0 then
CloseDesktop(hdeskUser);
end;
Initialization
InitServiceDesktop;
Finalization
DoneServiceDesktop;
end.
For more detailed demonstration code, please refer to: http://www.torry.net/samples/samples/os/isarticle.zip
(4) How to add service descriptions on how to install a service. There are two methods: one is to modify the registry. The detailed information of the service is located under HKEY_LOCAL_MACHINE/SYSTEM/ControlSet001/Services/. For example, the service we just now is located in HKEY_LOCAL_MACHINE/SYSTEM/ControlSet001. Under /Services/DelphiService. The second method is to first use the QueryServiceConfig2 function to obtain service information, and then ChangeServiceConfig2 to change the description. If implemented with Delphi, the unit is as follows:
unit WinSvcEx;
interface
uses Windows, WinSvc;
const
//
// Service config info levels
//
SERVICE_CONFIG_DESCRIPTION = 1;
SERVICE_CONFIG_FAILURE_ACTIONS = 2;
//
// DLL name of imported functions
//
AdvApiDLL = 'advapi32.dll';
type
//
// Service description string
//
PServiceDescriptionA = ^TServiceDescriptionA;
PServiceDescriptionW = ^TServiceDescriptionW;
PServiceDescription = PServiceDescriptionA;
{$EXTERNALSYM _SERVICE_DESCRIPTIONA}
_SERVICE_DESCRIPTIONA = record
lpDescription : PAnsiChar;
end;
{$EXTERNALSYM _SERVICE_DESCRIPTIONW}
_SERVICE_DESCRIPTIONW = record
lpDescription : PWideChar;
end;
{$EXTERNALSYM _SERVICE_DESCRIPTION}
_SERVICE_DESCRIPTION = _SERVICE_DESCRIPTIONA;
{$EXTERNALSYM SERVICE_DESCRIPTIONA}
SERVICE_DESCRIPTIONA = _SERVICE_DESCRIPTIONA;
{$EXTERNALSYM SERVICE_DESCRIPTIONW}
SERVICE_DESCRIPTIONW = _SERVICE_DESCRIPTIONW;
{$EXTERNALSYM SERVICE_DESCRIPTION}
SERVICE_DESCRIPTION = _SERVICE_DESCRIPTIONA;
TServiceDescriptionA = _SERVICE_DESCRIPTIONA;
TServiceDescriptionW = _SERVICE_DESCRIPTIONW;
TServiceDescription = TServiceDescriptionA;
//
// Actions to take on service failure
//
{$EXTERNALSYM _SC_ACTION_TYPE}
_SC_ACTION_TYPE = (SC_ACTION_NONE, SC_ACTION_RESTART, SC_ACTION_REBOOT, SC_ACTION_RUN_COMMAND);
{$EXTERNALSYM SC_ACTION_TYPE}
SC_ACTION_TYPE = _SC_ACTION_TYPE;
PServiceAction = ^TServiceAction;
{$EXTERNALSYM _SC_ACTION}
_SC_ACTION = record
aType : SC_ACTION_TYPE;
Delay : DWORD;
end;
{$EXTERNALSYM SC_ACTION}
SC_ACTION = _SC_ACTION;
TServiceAction = _SC_ACTION;
PServiceFailureActionsA = ^TServiceFailureActionsA;
PServiceFailureActionsW = ^TServiceFailureActionsW;
PServiceFailureActions = PServiceFailureActionsA;
{$EXTERNALSYM _SERVICE_FAILURE_ACTIONSA}
_SERVICE_FAILURE_ACTIONSA = record
dwResetPeriod : DWORD;
lpRebootMsg: LPSTR;
lpCommand : LPSTR;
cActions : DWORD;
lpsaActions : ^SC_ACTION;
end;
{$EXTERNALSYM _SERVICE_FAILURE_ACTIONSW}
_SERVICE_FAILURE_ACTIONSW = record
dwResetPeriod : DWORD;
lpRebootMsg: LPWSTR;
lpCommand : LPWSTR;
cActions : DWORD;
lpsaActions : ^SC_ACTION;
end;
{$EXTERNALSYM _SERVICE_FAILURE_ACTIONS}
_SERVICE_FAILURE_ACTIONS = _SERVICE_FAILURE_ACTIONSA;
{$EXTERNALSYM SERVICE_FAILURE_ACTIONSA}
SERVICE_FAILURE_ACTIONSA = _SERVICE_FAILURE_ACTIONSA;
{$EXTERNALSYM SERVICE_FAILURE_ACTIONSW}
SERVICE_FAILURE_ACTIONSW = _SERVICE_FAILURE_ACTIONSW;
{$EXTERNALSYM SERVICE_FAILURE_ACTIONS}
SERVICE_FAILURE_ACTIONS = _SERVICE_FAILURE_ACTIONSA;
TServiceFailureActionsA = _SERVICE_FAILURE_ACTIONSA;
TServiceFailureActionsW = _SERVICE_FAILURE_ACTIONSW;
TServiceFailureActions = TServiceFailureActionsA;
////////////////////////////////////////////////// //////////////////////////////////////////////////////////
// API Function Prototypes
////////////////////////////////////////////////// //////////////////////////////////////////////////////////
TQueryServiceConfig2 = function (hService : SC_HANDLE; dwInfoLevel : DWORD; lpBuffer : pointer;
cbBufSize : DWORD; var pcbBytesNeeded) : BOOL; stdcall;
TChangeServiceConfig2 = function (hService : SC_HANDLE; dwInfoLevel : DWORD; lpInfo : pointer) : BOOL; stdcall;
var
hDLL : THandle ;
LibLoaded : boolean ;
var
OSVersionInfo: TOSVersionInfo;
{$EXTERNALSYM QueryServiceConfig2A}
QueryServiceConfig2A: TQueryServiceConfig2;
{$EXTERNALSYM QueryServiceConfig2W}
QueryServiceConfig2W: TQueryServiceConfig2;
{$EXTERNALSYM QueryServiceConfig2}
QueryServiceConfig2: TQueryServiceConfig2;
{$EXTERNALSYM ChangeServiceConfig2A}
ChangeServiceConfig2A: TChangeServiceConfig2;
{$EXTERNALSYM ChangeServiceConfig2W}
ChangeServiceConfig2W: TChangeServiceConfig2;
{$EXTERNALSYM ChangeServiceConfig2}
ChangeServiceConfig2: TChangeServiceConfig2;
Implementation
Initialization
OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);
GetVersionEx(OSVersionInfo);
if (OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT) and (OSVersionInfo.dwMajorVersion >= 5) then
Begin
if hDLL = 0 then
Begin
hDLL:=GetModuleHandle(AdvApiDLL);
LibLoaded := False;
if hDLL = 0 then
Begin
hDLL := LoadLibrary(AdvApiDLL);
LibLoaded := True;
end;
end;
if hDLL <> 0 then
Begin
@QueryServiceConfig2A := GetProcAddress(hDLL, 'QueryServiceConfig2A');
@QueryServiceConfig2W := GetProcAddress(hDLL, 'QueryServiceConfig2W');
@QueryServiceConfig2 := @QueryServiceConfig2A;
@ChangeServiceConfig2A := GetProcAddress(hDLL, 'ChangeServiceConfig2A');
@ChangeServiceConfig2W := GetProcAddress(hDLL, 'ChangeServiceConfig2W');
@ChangeServiceConfig2 := @ChangeServiceConfig2A;
end;
end
else
Begin
@QueryServiceConfig2A := nil;
@QueryServiceConfig2W := nil;
@QueryServiceConfig2 := nil;
@ChangeServiceConfig2A := nil;
@ChangeServiceConfig2W := nil;
@ChangeServiceConfig2 := nil;
end;
Finalization
if (hDLL <> 0) and LibLoaded then
FreeLibrary(hDLL);
end.
unit winntService;
interface
uses
Windows, WinSvc, WinSvcEx;
function InstallService(const strServiceName,strDisplayName,strDescription,strFilename: string):Boolean;
//eg:InstallService('Service Name','Display Name','Description Information','Service File');
procedure UninstallService(strServiceName:string);
Implementation
function StrLCopy(Dest: PChar; const Source: PChar; MaxLen: Cardinal): PChar; assembler;
asm
PUSH EDI
PUSH ESI
PUSH EBX
MOV ESI,EAX
MOV EDI,EDX
MOV EBX,ECX
XOR AL,AL
TEST ECX,ECX
JZ @@1
REPNE SCASB
JNE @@1
INC ECX
@@1: SUB EBX,ECX
MOV EDI,ESI
MOV ESI,EDX
MOV EDX,EDI
MOV ECX,EBX
SHR ECX,2
REP MOVSD
MOV ECX,EBX
AND ECX,3
REP MOVSB
STOSB
MOV EAX,EDX
POP EBX
POP ESI
POP EDI
end;
function StrPChar(Dest: PChar; const Source: string): PChar;
Begin
Result := StrLCopy(Dest, PChar(Source), Length(Source));
end;
function InstallService(const strServiceName,strDisplayName,strDescription,strFilename: string):Boolean;
var
//ss : TServiceStatus;
//psTemp: PChar;
hSCM,hSCS:THandle;
srvdesc : PServiceDescription;
desc : string;
//SrvType: DWord;
lpServiceArgVectors:pchar;
Begin
Result:=False;
//psTemp := nil;
//SrvType := SERVICE_WIN32_OWN_PROCESS and SERVICE_INTERACTIVE_PROCESS;
hSCM:=OpenSCManager(nil,nil,SC_MANAGER_ALL_access);//Connect the service database
if hSCM=0 then Exit;//MessageBox(hHandle,Pchar(SysErrorMessage(GetLastError)),'Service Program Manager',MB_ICONERROR+MB_TOPMOST);
hSCS:=CreateService( //Create service function
hSCM, // Service control management handle
Pchar(strServiceName), // Service name
Pchar(strDisplayName), // The service name displayed
SERVICE_ALL_ACCESS, // Access rights
SERVICE_WIN32_OWN_PROCESS or SERVICE_INTERACTIVE_PROCESS,// Service type SERVICE_WIN32_SHARE_PROCESS
SERVICE_AUTO_START, // Startup type
SERVICE_ERROR_IGNORE, // Error control type
Pchar(strFilename), // Service program
nil, // Group service name
nil, // Group ID
nil, // dependent services
nil, // Start the service account
nil); // Start the service password
if hSCS=0 then Exit;//MessageBox(hHandle,Pchar(SysErrorMessage(GetLastError)),Pchar(Application.Title),MB_ICONERROR+MB_TOPMOST);
if Assigned(ChangeServiceConfig2) then
Begin
desc := Copy(strDescription,1,1024);
GetMem(srvdesc,SizeOf(TServiceDescription));
GetMem(srvdesc^.lpDescription,Length(desc) + 1);
try
StrPCopy(srvdesc^.lpDescription, desc);
ChangeServiceConfig2(hSCS, SERVICE_CONFIG_DESCRIPTION,srvdesc);
Finally
FreeMem(srvdesc^.lpDescription);
FreeMem(srvdesc);
end;
end;
lpServiceArgVectors := nil;
if not StartService(hSCS, 0, lpServiceArgVectors) then //Start the service
Exit; //MessageBox(hHandle,Pchar(SysErrorMessage(GetLastError)),Pchar(Application.Title),MB_ICONERROR+MB_TOPMOST);
CloseServiceHandle(hSCS); //Close the handle
Result:=True;
end;
procedure UninstallService(strServiceName:string);
var
SCManager: SC_HANDLE;
Service: SC_HANDLE;
Status: TServiceStatus;
Begin
SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
if SCManager = 0 then Exit;
try
Service := OpenService(SCManager, Pchar(strServiceName), SERVICE_ALL_ACCESS);
ControlService(Service, SERVICE_CONTROL_STOP, Status);
DeleteService(Service);
CloseServiceHandle(Service);
Finally
CloseServiceHandle(SCManager);
end;
end;
end.
(5) How to brutally close a service program and realize the function of our previous "NT toolbox"? First, killing a process based on the process name is to use the following function:
uses Tlhelp32;
function KillTask(ExeFileName: string): Integer;
const
PROCESS_TERMINATE = $0001;
var
ContinueLoop: BOOL;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
Begin
Results := 0;
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
while Integer(ContinueLoop) <> 0 do
Begin
if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
UpperCase(ExeFileName)) then
Result := Integer(TerminateProcess(
OpenProcess(PROCESS_TERMINATE,
BOOL(0),
FProcessEntry32.th32ProcessID),
0));
ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
end;
CloseHandle(FSnapshotHandle);
end;
However, for the service program, it will prompt "access denied". In fact, as long as the program has Debug permissions:
function EnableDebugPrivilege: Boolean;
function EnablePrivilege(hToken: Cardinal; PrivName: string; bEnable: Boolean): Boolean;
var
TP: TOKEN_PRIVILEGES;
Dummy: Cardinal;
Begin
TP.PrivilegeCount := 1;
LookupPrivilegeValue(nil, pchar(PrivName), TP.Privileges[0].Luid);
If bEnable then
TP.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED
else TP.Privileges[0].Attributes := 0;
AdjustTokenPrivileges(hToken, False, TP, SizeOf(TP), nil, Dummy);
Result := GetLastError = ERROR_SUCCESS;
end;
var
hToken: Cardinal;
Begin
OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, hToken);
result:=EnablePrivilege(hToken, 'SeDebugPrivilege', True);
CloseHandle(hToken);
end;
How to use:
EnableDebugPrivilege;//Elevate permissions
KillTask('xxxx.exe');//Close the service program.
---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- ----------