Delphi 写服务程序
如何用 Delphi 创建系统服务程序?
Windows 2000/XP和2003等支持一种叫做"服务程序"的东西.程序作为服务启动有以下几个好处:
(1)不用登陆进系统即可运行.
(2)具有SYSTEM特权.所以你在进程管理器里面是无法结束它的.
笔者在2003年为一公司开发机顶盒项目的时候,曾经写过课件上传和媒体服务,下面就介绍一下如何用Delphi7创建一个Service程序.
运行Delphi7,选择菜单File-->New-->Other--->Service Application.将生成一个服务程序的框架.将工程保存为ServiceDemo.dpr和Unit_Main.pas,然后回到主框架.我们注意到,Service有几个属性.其中以下几个是我们比较常用的:
(1)DisplayName:服务的显示名称
(2)Name:服务名称.
我们在这里将DisplayName的值改为"Delphi服务演示程序",Name改为"DelphiService".编译这个项目,将得到 ServiceDemo.exe.这已经是一个服务程序了!进入CMD模式,切换致工程所在目录,运行命令"ServiceDemo.exe /install",将提示服务安装成功!然后"net start DelphiService"将启动这个服务.进入控制面版-->管理工具-->服务,将显示这个服务和当前状态.不过这个服务现在什么也干不了,因为我们还没有写代码:)先"net stop DelphiService"停止再"ServiceDemo.exe /uninstall"删除这个服务.回到Delphi7的IDE.
我们的计划是为这个服务添加一个主窗口,运行后任务栏显示程序的图标,双击图标将显示主窗口,上面有一个按钮,点击该按钮将实现Ctrl+Alt+Del功能.
实际上,服务程序莫认是工作于Winlogon桌面的,可以打开控制面板,查看我们刚才那个服务的属性-->登陆,其中"允许服务与桌面交互 "是不打钩的.怎么办?呵呵,回到IDE,注意那个布尔属性:Interactive,当这个属性为True的时候,该服务程序就可以与桌面交互了.
File-->New-->Form为服务添加窗口FrmMain,单元保存为Unit_FrmMain,并且把这个窗口设置为手工创建.完成后的代码如下:
01
|
unit Unit_Main;
|
02
|
|
03
|
interface
|
04
|
|
05
|
uses
|
06
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, Unit_FrmMain;
|
07
|
|
08
|
type
|
09
|
TDelphiService = class (TService)
|
10
|
procedure ServiceContinue(Sender: TService; var Continued: Boolean );
|
11
|
procedure ServiceExecute(Sender: TService);
|
12
|
procedure ServicePause(Sender: TService; var Paused: Boolean );
|
13
|
procedure ServiceShutdown(Sender: TService);
|
14
|
procedure ServiceStart(Sender: TService; var Started: Boolean );
|
15
|
procedure ServiceStop(Sender: TService; var Stopped: Boolean );
|
16
|
private
|
17
|
{ Private declarations }
|
18
|
public
|
19
|
function GetServiceController: TServiceController; override;
|
20
|
{ Public declarations }
|
21
|
end ;
|
22
|
|
23
|
var
|
24
|
DelphiService: TDelphiService;
|
25
|
FrmMain: TFrmMain;
|
26
|
implementation
|
27
|
|
28
|
{$R *.DFM}
|
29
|
|
30
|
procedure ServiceController(CtrlCode: DWord); stdcall;
|
31
|
begin
|
32
|
DelphiService . Controller(CtrlCode);
|
33
|
end ;
|
34
|
|
35
|
function TDelphiService . GetServiceController: TServiceController;
|
36
|
begin
|
37
|
Result := ServiceController;
|
38
|
end ;
|
39
|
|
40
|
procedure TDelphiService . ServiceContinue(Sender: TService;
|
41
|
var Continued: Boolean );
|
42
|
begin
|
43
|
while not Terminated do
|
44
|
begin
|
45
|
Sleep( 10 );
|
46
|
ServiceThread . ProcessRequests( False );
|
47
|
end ;
|
48
|
end ;
|
49
|
|
50
|
procedure TDelphiService . ServiceExecute(Sender: TService);
|
51
|
begin
|
52
|
while not Terminated do
|
53
|
begin
|
54
|
Sleep( 10 );
|
55
|
ServiceThread . ProcessRequests( False );
|
56
|
end ;
|
57
|
end ;
|
58
|
|
59
|
procedure TDelphiService . ServicePause(Sender: TService;
|
60
|
var Paused: Boolean );
|
61
|
begin
|
62
|
Paused := True ;
|
63
|
end ;
|
64
|
|
65
|
procedure TDelphiService . ServiceShutdown(Sender: TService);
|
66
|
begin
|
67
|
gbCanClose := true ;
|
68
|
FrmMain . Free;
|
69
|
Status := csStopped;
|
70
|
ReportStatus();
|
71
|
end ;
|
72
|
|
73
|
procedure TDelphiService . ServiceStart(Sender: TService;
|
74
|
var Started: Boolean );
|
75
|
begin
|
76
|
Started := True ;
|
77
|
Svcmgr . Application . CreateForm(TFrmMain, FrmMain);
|
78
|
gbCanClose := False ;
|
79
|
FrmMain . Hide;
|
80
|
end ;
|
81
|
|
82
|
procedure TDelphiService . ServiceStop(Sender: TService;
|
83
|
var Stopped: Boolean );
|
84
|
begin
|
85
|
Stopped := True ;
|
86
|
gbCanClose := True ;
|
87
|
FrmMain . Free;
|
88
|
end ;
|
89
|
|
90
|
end .
|
主窗口单元如下:
001
|
unit Unit_FrmMain;
|
002
|
|
003
|
interface
|
004
|
|
005
|
uses
|
006
|
Windows, Messages, SysUtils, Variants, Classes, ShellApi, Graphics, Controls, Forms,
|
007
|
Dialogs, ExtCtrls, StdCtrls;
|
008
|
|
009
|
const
|
010
|
WM_TrayIcon = WM_USER + 1234 ;
|
011
|
type
|
012
|
TFrmMain = class (TForm)
|
013
|
Timer1: TTimer;
|
014
|
Button1: TButton;
|
015
|
procedure FormCreate(Sender: TObject);
|
016
|
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean );
|
017
|
procedure FormDestroy(Sender: TObject);
|
018
|
procedure Timer1Timer(Sender: TObject);
|
019
|
procedure Button1Click(Sender: TObject);
|
020
|
private
|
021
|
{ Private declarations }
|
022
|
IconData: TNotifyIconData;
|
023
|
procedure AddIconToTray;
|
024
|
procedure DelIconFromTray;
|
025
|
procedure TrayIconMessage( var Msg: TMessage); message WM_TrayIcon;
|
026
|
procedure SysButtonMsg( var Msg: TMessage); message WM_SYSCOMMAND;
|
027
|
public
|
028
|
{ Public declarations }
|
029
|
end ;
|
030
|
|
031
|
var
|
032
|
FrmMain: TFrmMain;
|
033
|
gbCanClose: Boolean ;
|
034
|
implementation
|
035
|
|
036
|
{$R *.dfm}
|
037
|
|
038
|
procedure TFrmMain . FormCreate(Sender: TObject);
|
039
|
begin
|
040
|
FormStyle := fsStayOnTop;
|
041
|
SetWindowLong(Application . Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
|
042
|
gbCanClose := False ;
|
043
|
Timer1 . Interval := 1000 ;
|
044
|
Timer1 . Enabled := True ;
|
045
|
end ;
|
046
|
|
047
|
procedure TFrmMain . FormCloseQuery(Sender: TObject; var CanClose: Boolean );
|
048
|
begin
|
049
|
CanClose := gbCanClose;
|
050
|
if not CanClose then
|
051
|
begin
|
052
|
Hide;
|
053
|
end ;
|
054
|
end ;
|
055
|
|
056
|
procedure TFrmMain . FormDestroy(Sender: TObject);
|
057
|
begin
|
058
|
Timer1 . Enabled := False ;
|
059
|
DelIconFromTray;
|
060
|
end ;
|
061
|
|
062
|
procedure TFrmMain . AddIconToTray;
|
063
|
begin
|
064
|
ZeroMemory(@IconData, SizeOf(TNotifyIconData));
|
065
|
IconData . cbSize := SizeOf(TNotifyIconData);
|
066
|
IconData . Wnd := Handle;
|
067
|
IconData . uID := 1 ;
|
068
|
IconData . uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
|
069
|
IconData . uCallbackMessage := WM_TrayIcon;
|
070
|
IconData . hIcon := Application . Icon . Handle;
|
071
|
IconData . szTip := Delphi服务演示程序;
|
072
|
Shell_NotifyIcon(NIM_ADD, @IconData);
|
073
|
end ;
|
074
|
|
075
|
procedure TFrmMain . DelIconFromTray;
|
076
|
begin
|
077
|
Shell_NotifyIcon(NIM_DELETE, @IconData);
|
078
|
end ;
|
079
|
|
080
|
procedure TFrmMain . SysButtonMsg( var Msg: TMessage);
|
081
|
begin
|
082
|
if (Msg . wParam = SC_CLOSE) or
|
083
|
(Msg . wParam = SC_MINIMIZE) then Hide
|
084
|
else inherited ; // 执行默认动作
|
085
|
end ;
|
086
|
|
087
|
procedure TFrmMain . TrayIconMessage( var Msg: TMessage);
|
088
|
begin
|
089
|
if (Msg . LParam = WM_LBUTTONDBLCLK) then Show();
|
090
|
end ;
|
091
|
|
092
|
procedure TFrmMain . Timer1Timer(Sender: TObject);
|
093
|
begin
|
094
|
AddIconToTray;
|
095
|
end ;
|
096
|
|
097
|
procedure SendHokKey;stdcall;
|
098
|
var
|
099
|
HDesk_WL: HDESK;
|
100
|
begin
|
101
|
HDesk_WL := OpenDesktop (Winlogon, 0 , False , DESKTOP_JOURNALPLAYBACK);
|
102
|
if (HDesk_WL <> 0 ) then
|
103
|
if (SetThreadDesktop (HDesk_WL) = True ) then
|
104
|
PostMessage(HWND_BROADCAST, WM_HOTKEY, 0 , MAKELONG (MOD_ALT or MOD_CONTROL, VK_DELETE));
|
105
|
end ;
|
106
|
|
107
|
procedure TFrmMain . Button1Click(Sender: TObject);
|
108
|
var
|
109
|
dwThreadID : DWORD;
|
110
|
begin
|
111
|
CreateThread( nil , 0 , @SendHokKey, nil , 0 , dwThreadID);
|
112
|
end ;
|
113
|
|
114
|
end .
|
补充:
(1)关于更多服务程序的演示程序,请访问以下 http://www.torry.net/pages.php?id=226 ,上面包含了多个演示如何控制和管理系统服务的代码.
(2)请切记:Windows实际上存在多个桌面.例如屏幕传输会出现白屏,可能有两个原因:一是系统处于锁定或未登陆桌面,二是处于屏幕保护桌面.这时候要将当前桌面切换到该桌面才能抓屏.
(3)关于服务程序与桌面交互,还有种动态切换方法.大概单元如下:
01
|
unit ServiceDesktop;
|
02
|
|
03
|
interface
|
04
|
|
05
|
function InitServiceDesktop: boolean ;
|
06
|
procedure DoneServiceDeskTop;
|
07
|
|
08
|
implementation
|
09
|
|
10
|
uses Windows, SysUtils;
|
11
|
|
12
|
const
|
13
|
DefaultWindowStation = WinSta0;
|
14
|
DefaultDesktop = Default;
|
15
|
var
|
16
|
hwinstaSave: HWINSTA;
|
17
|
hdeskSave: HDESK;
|
18
|
hwinstaUser: HWINSTA;
|
19
|
hdeskUser: HDESK;
|
20
|
function InitServiceDesktop: boolean ;
|
21
|
var
|
22
|
dwThreadId: DWORD;
|
23
|
begin
|
24
|
dwThreadId := GetCurrentThreadID;
|
25
|
// Ensure connection to service window station and desktop, and
|
26
|
// save their handles.
|
27
|
hwinstaSave := GetProcessWindowStation;
|
28
|
hdeskSave := GetThreadDesktop(dwThreadId);
|
29
|
|
30
|
|
31
|
hwinstaUser := OpenWindowStation(DefaultWindowStation, FALSE , MAXIMUM_ALLOWED);
|
32
|
if hwinstaUser = 0 then
|
33
|
begin
|
34
|
OutputDebugString( PChar (OpenWindowStation failed + SysErrorMessage(GetLastError)));
|
35
|
Result := false ;
|
36
|
exit;
|
37
|
end ;
|
38
|
|
39
|
if not SetProcessWindowStation(hwinstaUser) then
|
40
|
begin
|
41
|
OutputDebugString(SetProcessWindowStation failed);
|
42
|
Result := false ;
|
43
|
exit;
|
44
|
end ;
|
45
|
|
46
|
hdeskUser := OpenDesktop(DefaultDesktop, 0 , FALSE , MAXIMUM_ALLOWED);
|
47
|
if hdeskUser = 0 then
|
48
|
begin
|
49
|
OutputDebugString(OpenDesktop failed);
|
50
|
SetProcessWindowStation(hwinstaSave);
|
51
|
CloseWindowStation(hwinstaUser);
|
52
|
Result := false ;
|
53
|
exit;
|
54
|
end ;
|
55
|
Result := SetThreadDesktop(hdeskUser);
|
56
|
if not Result then
|
57
|
OutputDebugString( PChar (SetThreadDesktop + SysErrorMessage(GetLastError)));
|
58
|
end ;
|
59
|
|
60
|
procedure DoneServiceDeskTop;
|
61
|
begin
|
62
|
// Restore window station and desktop.
|
63
|
SetThreadDesktop(hdeskSave);
|
64
|
SetProcessWindowStation(hwinstaSave);
|
65
|
if hwinstaUser <> 0 then
|
66
|
CloseWindowStation(hwinstaUser);
|
67
|
if hdeskUser <> 0 then
|
68
|
CloseDesktop(hdeskUser);
|
69
|
end ;
|
70
|
|
71
|
initialization
|
72
|
InitServiceDesktop;
|
73
|
finalization
|
74
|
DoneServiceDesktop;
|
75
|
end .
|
更详细的演示代码请参看: http://www.torry.net/samples/samples/os/isarticle.zip
(4)关于安装服务如何添加服务描述.有两种方法:一是修改注册表.服务的详细信息都位于HKEY_LOCAL_MACHINE\SYSTEM\ ControlSet001\Services\下面,例如我们刚才那个服务就位于HKEY_LOCAL_MACHINE\SYSTEM\ ControlSet001\Services\DelphiService下.第二种方法就是先用QueryServiceConfig2函数获取服务信息,然后ChangeServiceConfig2来改变描述.用Delphi实现的话,单元如下:
001
|
unit WinSvcEx;
|
002
|
|
003
|
interface
|
004
|
|
005
|
uses Windows, WinSvc;
|
006
|
|
007
|
const
|
008
|
//
|
009
|
// Service config info levels
|
010
|
//
|
011
|
SERVICE_CONFIG_DESCRIPTION = 1 ;
|
012
|
SERVICE_CONFIG_FAILURE_ACTIONS = 2 ;
|
013
|
//
|
014
|
// DLL name of imported functions
|
015
|
//
|
016
|
AdvApiDLL = advapi32 . dll;
|
017
|
type
|
018
|
//
|
019
|
// Service description string
|
020
|
//
|
021
|
PServiceDescriptionA = ^TServiceDescriptionA;
|
022
|
PServiceDescriptionW = ^TServiceDescriptionW;
|
023
|
PServiceDescription = PServiceDescriptionA;
|
024
|
{$EXTERNALSYM _SERVICE_DESCRIPTIONA}
|
025
|
_SERVICE_DESCRIPTIONA = record
|
026
|
lpDescription : PAnsiChar ;
|
027
|
end ;
|
028
|
{$EXTERNALSYM _SERVICE_DESCRIPTIONW}
|
029
|
_SERVICE_DESCRIPTIONW = record
|
030
|
lpDescription : PWideChar ;
|
031
|
end ;
|
032
|
{$EXTERNALSYM _SERVICE_DESCRIPTION}
|
033
|
_SERVICE_DESCRIPTION = _SERVICE_DESCRIPTIONA;
|
034
|
{$EXTERNALSYM SERVICE_DESCRIPTIONA}
|
035
|
SERVICE_DESCRIPTIONA = _SERVICE_DESCRIPTIONA;
|
036
|
{$EXTERNALSYM SERVICE_DESCRIPTIONW}
|
037
|
SERVICE_DESCRIPTIONW = _SERVICE_DESCRIPTIONW;
|
038
|
{$EXTERNALSYM SERVICE_DESCRIPTION}
|
039
|
SERVICE_DESCRIPTION = _SERVICE_DESCRIPTIONA;
|
040
|
TServiceDescriptionA = _SERVICE_DESCRIPTIONA;
|
041
|
TServiceDescriptionW = _SERVICE_DESCRIPTIONW;
|
042
|
TServiceDescription = TServiceDescriptionA;
|
043
|
|
044
|
//
|
045
|
// Actions to take on service failure
|
046
|
//
|
047
|
{$EXTERNALSYM _SC_ACTION_TYPE}
|
048
|
_SC_ACTION_TYPE = (SC_ACTION_NONE, SC_ACTION_RESTART, SC_ACTION_REBOOT, SC_ACTION_RUN_COMMAND);
|
049
|
{$EXTERNALSYM SC_ACTION_TYPE}
|
050
|
SC_ACTION_TYPE = _SC_ACTION_TYPE;
|
051
|
|
052
|
PServiceAction = ^TServiceAction;
|
053
|
{$EXTERNALSYM _SC_ACTION}
|
054
|
_SC_ACTION = record
|
055
|
aType : SC_ACTION_TYPE;
|
056
|
Delay : DWORD;
|
057
|
end ;
|
058
|
{$EXTERNALSYM SC_ACTION}
|
059
|
SC_ACTION = _SC_ACTION;
|
060
|
TServiceAction = _SC_ACTION;
|
061
|
|
062
|
PServiceFailureActionsA = ^TServiceFailureActionsA;
|
063
|
PServiceFailureActionsW = ^TServiceFailureActionsW;
|
064
|
PServiceFailureActions = PServiceFailureActionsA;
|
065
|
{$EXTERNALSYM _SERVICE_FAILURE_ACTIONSA}
|
066
|
_SERVICE_FAILURE_ACTIONSA = record
|
067
|
dwResetPeriod : DWORD;
|
068
|
lpRebootMsg : LPSTR;
|
069
|
lpCommand : LPSTR;
|
070
|
cActions : DWORD;
|
071
|
lpsaActions : ^SC_ACTION;
|
072
|
end ;
|
073
|
{$EXTERNALSYM _SERVICE_FAILURE_ACTIONSW}
|
074
|
_SERVICE_FAILURE_ACTIONSW = record
|
075
|
dwResetPeriod : DWORD;
|
076
|
lpRebootMsg : LPWSTR;
|
077
|
lpCommand : LPWSTR;
|
078
|
cActions : DWORD;
|
079
|
lpsaActions : ^SC_ACTION;
|
080
|
end ;
|
081
|
{$EXTERNALSYM _SERVICE_FAILURE_ACTIONS}
|
082
|
_SERVICE_FAILURE_ACTIONS = _SERVICE_FAILURE_ACTIONSA;
|
083
|
{$EXTERNALSYM SERVICE_FAILURE_ACTIONSA}
|
084
|
SERVICE_FAILURE_ACTIONSA = _SERVICE_FAILURE_ACTIONSA;
|
085
|
{$EXTERNALSYM SERVICE_FAILURE_ACTIONSW}
|
086
|
SERVICE_FAILURE_ACTIONSW = _SERVICE_FAILURE_ACTIONSW;
|
087
|
{$EXTERNALSYM SERVICE_FAILURE_ACTIONS}
|
088
|
SERVICE_FAILURE_ACTIONS = _SERVICE_FAILURE_ACTIONSA;
|
089
|
TServiceFailureActionsA = _SERVICE_FAILURE_ACTIONSA;
|
090
|
TServiceFailureActionsW = _SERVICE_FAILURE_ACTIONSW;
|
091
|
TServiceFailureActions = TServiceFailureActionsA;
|
092
|
|
093
|
///
|
094
|
// API Function Prototypes
|
095
|
///
|
096
|
TQueryServiceConfig2 = function (hService : SC_HANDLE; dwInfoLevel : DWORD; lpBuffer : pointer ;
|
097
|
cbBufSize : DWORD; var pcbBytesNeeded) : BOOL; stdcall;
|
098
|
TChangeServiceConfig2 = function (hService : SC_HANDLE; dwInfoLevel : DWORD; lpInfo : pointer ) : BOOL; stdcall;
|
099
|
|
100
|
var
|
101
|
hDLL : THandle ;
|
102
|
LibLoaded : boolean ;
|
103
|
|
104
|
var
|
105
|
OSVersionInfo : TOSVersionInfo;
|
106
|
|
107
|
{$EXTERNALSYM QueryServiceConfig2A}
|
108
|
QueryServiceConfig2A : TQueryServiceConfig2;
|
109
|
{$EXTERNALSYM QueryServiceConfig2W}
|
110
|
QueryServiceConfig2W : TQueryServiceConfig2;
|
111
|
{$EXTERNALSYM QueryServiceConfig2}
|
112
|
QueryServiceConfig2 : TQueryServiceConfig2;
|
113
|
|
114
|
{$EXTERNALSYM ChangeServiceConfig2A}
|
115
|
ChangeServiceConfig2A : TChangeServiceConfig2;
|
116
|
{$EXTERNALSYM ChangeServiceConfig2W}
|
117
|
ChangeServiceConfig2W : TChangeServiceConfig2;
|
118
|
{$EXTERNALSYM ChangeServiceConfig2}
|
119
|
ChangeServiceConfig2 : TChangeServiceConfig2;
|
120
|
|
121
|
implementation
|
122
|
|
123
|
initialization
|
124
|
OSVersionInfo . dwOSVersionInfoSize := SizeOf(OSVersionInfo);
|
125
|
GetVersionEx(OSVersionInfo);
|
126
|
if (OSVersionInfo . dwPlatformId = VER_PLATFORM_WIN32_NT) and (OSVersionInfo . dwMajorVersion >= 5 ) then
|
127
|
begin
|
128
|
if hDLL = 0 then
|
129
|
begin
|
130
|
hDLL:=GetModuleHandle(AdvApiDLL);
|
131
|
LibLoaded := False ;
|
132
|
if hDLL = 0 then
|
133
|
begin
|
134
|
hDLL := LoadLibrary(AdvApiDLL);
|
135
|
LibLoaded := True ;
|
136
|
end ;
|
137
|
end ;
|
138
|
|
139
|
if hDLL <> 0 then
|
140
|
begin
|
141
|
@QueryServiceConfig2A := GetProcAddress(hDLL, QueryServiceConfig2A);
|
142
|
@QueryServiceConfig2W := GetProcAddress(hDLL, QueryServiceConfig2W);
|
143
|
@QueryServiceConfig2 := @QueryServiceConfig2A;
|
144
|
@ChangeServiceConfig2A := GetProcAddress(hDLL, ChangeServiceConfig2A);
|
145
|
@ChangeServiceConfig2W := GetProcAddress(hDLL, ChangeServiceConfig2W);
|
146
|
@ChangeServiceConfig2 := @ChangeServiceConfig2A;
|
147
|
end ;
|
148
|
end
|
149
|
else
|
150
|
begin
|
151
|
@QueryServiceConfig2A := nil ;
|
152
|
@QueryServiceConfig2W := nil ;
|
153
|
@QueryServiceConfig2 := nil ;
|
154
|
@ChangeServiceConfig2A := nil ;
|
155
|
@ChangeServiceConfig2W := nil ;
|
156
|
@ChangeServiceConfig2 := nil ;
|
157
|
end ;
|
158
|
|
159
|
finalization
|
160
|
if (hDLL <> 0 ) and LibLoaded then
|
161
|
FreeLibrary(hDLL);
|
162
|
|
163
|
end .
|
164
|
|
165
|
unit winntService;
|
166
|
|
167
|
interface
|
168
|
|
169
|
uses
|
170
|
Windows,WinSvc,WinSvcEx;
|
171
|
|
172
|
function InstallService( const strServiceName,strDisplayName,strDescription,strFilename: string ): Boolean ;
|
173
|
//eg:InstallService(服务名称,显示名称,描述信息,服务文件);
|
174
|
procedure UninstallService(strServiceName: string );
|
175
|
implementation
|
176
|
|
177
|
function StrLCopy(Dest: PChar ; const Source: PChar ; MaxLen: Cardinal ): PChar ; assembler;
|
178
|
asm
|
179
|
PUSH EDI
|
180
|
PUSH ESI
|
181
|
PUSH EBX
|
182
|
MOV ESI,EAX
|
183
|
MOV EDI,EDX
|
184
|
MOV EBX,ECX
|
185
|
XOR AL,AL
|
186
|
TEST ECX,ECX
|
187
|
JZ @@ 1
|
188
|
REPNE SCASB
|
189
|
JNE @@ 1
|
190
|
INC ECX
|
191
|
@@ 1 : SUB EBX,ECX
|
192
|
MOV EDI,ESI
|
193
|
MOV ESI,EDX
|
194
|
MOV EDX,EDI
|
195
|
MOV ECX,EBX
|
196
|
SHR ECX, 2
|
197
|
REP MOVSD
|
198
|
MOV ECX,EBX
|
199
|
AND ECX, 3
|
200
|
REP MOVSB
|
201
|
STOSB
|
202
|
MOV EAX,EDX
|
203
|
POP EBX
|
204
|
POP ESI
|
205
|
POP EDI
|
206
|
end ;
|
207
|
|
208
|
function StrPCopy(Dest: PChar ; const Source: string ): PChar ;
|
209
|
begin
|
210
|
Result := StrLCopy(Dest, PChar (Source), Length(Source));
|
211
|
end ;
|
212
|
|
213
|
function InstallService( const strServiceName,strDisplayName,strDescription,strFilename: string ): Boolean ;
|
214
|
var
|
215
|
//ss : TServiceStatus;
|
216
|
//psTemp : PChar;
|
217
|
hSCM,hSCS:THandle;
|
218
|
|
219
|
srvdesc : PServiceDescription;
|
220
|
desc : string ;
|
221
|
//SrvType : DWord;
|
222
|
|
223
|
lpServiceArgVectors: pchar ;
|
224
|
begin
|
225
|
Result:= False ;
|
226
|
//psTemp := nil;
|
227
|
//SrvType := SERVICE_WIN32_OWN_PROCESS and SERVICE_INTERACTIVE_PROCESS;
|
228
|
hSCM:=OpenSCManager( nil , nil ,SC_MANAGER_ALL_ACCESS); //连接服务数据库
|
229
|
if hSCM= 0 then Exit; //MessageBox(hHandle,Pchar(SysErrorMessage(GetLastError)),服务程序管理器,MB_ICONERROR+MB_TOPMOST);
|
230
|
|
231
|
|
232
|
hSCS:=CreateService( //创建服务函数
|
233
|
hSCM, // 服务控制管理句柄
|
234
|
Pchar (strServiceName), // 服务名称
|
235
|
Pchar (strDisplayName), // 显示的服务名称
|
236
|
SERVICE_ALL_ACCESS, // 存取权利
|
237
|
SERVICE_WIN32_OWN_PROCESS or SERVICE_INTERACTIVE_PROCESS, // 服务类型 SERVICE_WIN32_SHARE_PROCESS
|
238
|
SERVICE_AUTO_START, // 启动类型
|
239
|
SERVICE_ERROR_IGNORE, // 错误控制类型
|
240
|
Pchar (strFilename), // 服务程序
|
241
|
nil , // 组服务名称
|
242
|
nil , // 组标识
|
243
|
nil , // 依赖的服务
|
244
|
nil , // 启动服务帐号
|
245
|
nil ); // 启动服务口令
|
246
|
if hSCS= 0 then Exit; //MessageBox(hHandle,Pchar(SysErrorMessage(GetLastError)),Pchar(Application.Title),MB_ICONERROR+MB_TOPMOST);
|
247
|
|
248
|
if Assigned(ChangeServiceConfig2) then
|
249
|
begin
|
250
|
desc := Copy(strDescription, 1 , 1024 );
|
251
|
GetMem(srvdesc,SizeOf(TServiceDescription));
|
252
|
GetMem(srvdesc^.lpDescription,Length(desc) + 1 );
|
253
|
try
|
254
|
StrPCopy(srvdesc^.lpDescription, desc);
|
255
|
ChangeServiceConfig2(hSCS,SERVICE_CONFIG_DESCRIPTION,srvdesc);
|
256
|
finally
|
257
|
FreeMem(srvdesc^.lpDescription);
|
258
|
FreeMem(srvdesc);
|
259
|
end ;
|
260
|
end ;
|
261
|
lpServiceArgVectors := nil ;
|
262
|
if not StartService(hSCS, 0 , lpServiceArgVectors) then //启动服务
|
263
|
Exit; //MessageBox(hHandle,Pchar(SysErrorMessage(GetLastError)),Pchar(Application.Title),MB_ICONERROR+MB_TOPMOST);
|
264
|
CloseServiceHandle(hSCS); //关闭句柄
|
265
|
Result:= True ;
|
266
|
end ;
|
267
|
|
268
|
procedure UninstallService(strServiceName: string );
|
269
|
var
|
270
|
SCManager: SC_HANDLE;
|
271
|
Service: SC_HANDLE;
|
272
|
Status: TServiceStatus;
|
273
|
begin
|
274
|
SCManager := OpenSCManager( nil , nil , SC_MANAGER_ALL_ACCESS);
|
275
|
if SCManager = 0 then Exit;
|
276
|
try
|
277
|
Service := OpenService(SCManager, Pchar (strServiceName), SERVICE_ALL_ACCESS);
|
278
|
ControlService(Service, SERVICE_CONTROL_STOP, Status);
|
279
|
DeleteService(Service);
|
280
|
CloseServiceHandle(Service);
|
281
|
finally
|
282
|
CloseServiceHandle(SCManager);
|
283
|
end ;
|
284
|
end ;
|
285
|
|
286
|
end .
|
(5)如何暴力关闭一个服务程序,实现我们以前那个"NT工具箱"的功能?首先,根据进程名称来杀死进程是用以下函数:
01
|
uses Tlhelp32;
|
02
|
|
03
|
function KillTask(ExeFileName: string ): Integer ;
|
04
|
const
|
05
|
PROCESS_TERMINATE = 01 ;
|
06
|
var
|
07
|
ContinueLoop: BOOL;
|
08
|
FSnapshotHandle: THandle;
|
09
|
FProcessEntry32: TProcessEntry32;
|
10
|
begin
|
11
|
Result := 0 ;
|
12
|
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0 );
|
13
|
FProcessEntry32 . dwSize := SizeOf(FProcessEntry32);
|
14
|
ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
|
15
|
|
16
|
while Integer (ContinueLoop) <> 0 do
|
17
|
begin
|
18
|
if ((UpperCase(ExtractFileName(FProcessEntry32 . szExeFile)) =
|
19
|
UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32 . szExeFile) =
|
20
|
UpperCase(ExeFileName))) then
|
21
|
Result := Integer (TerminateProcess(
|
22
|
OpenProcess(PROCESS_TERMINATE,
|
23
|
BOOL( 0 ),
|
24
|
FProcessEntry32 . th32ProcessID),
|
25
|
0 ));
|
26
|
ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
|
27
|
end ;
|
28
|
CloseHandle(FSnapshotHandle);
|
29
|
end ;
|
但是对于服务程序,它会提示"拒绝访问".其实只要程序拥有Debug权限即可:
01
|
function EnableDebugPrivilege: Boolean ;
|
02
|
function EnablePrivilege(hToken: Cardinal ; PrivName: string ; bEnable: Boolean ): Boolean ;
|
03
|
var
|
04
|
TP: TOKEN_PRIVILEGES;
|
05
|
Dummy: Cardinal ;
|
06
|
begin
|
07
|
TP . PrivilegeCount := 1 ;
|
08
|
LookupPrivilegeValue( nil , pchar (PrivName), TP . Privileges[ 0 ].Luid);
|
09
|
if bEnable then
|
10
|
TP . Privileges[ 0 ].Attributes := SE_PRIVILEGE_ENABLED
|
11
|
else TP . Privileges[ 0 ].Attributes := 0 ;
|
12
|
AdjustTokenPrivileges(hToken, False , TP, SizeOf(TP), nil , Dummy);
|
13
|
Result := GetLastError = ERROR_SUCCESS;
|
14
|
end ;
|
15
|
|
16
|
var
|
17
|
hToken: Cardinal ;
|
18
|
begin
|
19
|
OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, hToken);
|
20
|
result:=EnablePrivilege(hToken, SeDebugPrivilege, True );
|
21
|
CloseHandle(hToken);
|
22
|
end ;
|
使用方法:
1
|
EnableDebugPrivilege; //提升权限
|
2
|
|
3
|
KillTask(xxxx . exe); //关闭该服务程序.
|
转载于:https://www.cnblogs.com/ywangzi/archive/2011/10/24/2222850.html
Delphi 写服务程序相关推荐
- 一个Delphi写的DES算法, 翻译成C#
其实.NET Framework已经提供实现DES算法的类: System.Security.Cryptography.DESCryptoServiceProvider.之所以要把一个Delphi写的 ...
- IOCP 写服务程序时的关键问题研究[转]
网络数据传输速度已经不仅仅依赖于带宽的增加,对软件系统提出了更高的要求.随着Windows 对新技术的支持,在现有带宽前提下,开发出更高系统资源利用率.更高数据吞吐量的网络服务程序成为可能.在开发TC ...
- WPS office 2005发布了,是Delphi写的哟!
刚出差回来就听说WPS office 2005发布了,而且可以免费下载使用,经研究,发现是Delphi写的,刚开始听人说还不大相信,用SPY++一看类名才知果然,试了试竟能反编译,没什么保护措施.大概 ...
- 用Delphi写的一个完整OpenGL框架
用Delphi写的一个完整OpenGL框架 program OpenGLFramework; { OpenGL DelphiXE 出处:根据NeHe代码翻译而来(http://nehe.gamedev ...
- 用Delphi创建服务程序
Windows 2000/XP和2003等支持一种叫做"服务程序"的东西.程序作为服务启动有以下几个好处: (1)不用登陆进系统即可运行. (2)具有SYSTEM特权.所以你在进程 ...
- Delphi写游戏外挂
在几年前我看到别人玩网络游戏用上了外挂,做为程序员的我心里实在是不爽,想搞清楚这到底是怎么回事.就拿了一些来研究,小有心得,拿出来与大家共享,外挂无非就是分几种罢了(依制作难度): 1.动作式,所谓动 ...
- 开发一个delphi写的桌面图标管理代码
参加工作了就很少有时间去玩delphi了,这个适合初学者看看,大神勿喷 工具 delhpi7.0 access数据库 原则win下有安装office就可用 当初不太熟悉sqlite所有没用 ...
- node.js调用Delphi写的Dll
一.调用代码 Delphi版本Delphi 10 Seattle Delphi代码 unit Unit1;interfacefunction testint(i: Integer): Integer; ...
- 如何解决Delphi写的APP发布到APP Store需要1024x1024图标的问题
由于苹果修改了发布规则,原先在iTunes Connect里上传的1024x1024图标,修改为要加入到发布的ipa包里.导致delphi生成的app无法在苹果商店发布.查阅很多资料,以下办法可以通过 ...
最新文章
- python文件读写1
- 独家 | 谷歌医学AI在生活中的精确度(附链接)
- python 字符编码
- VS 条件断点学习总结2
- JVM 的内存模型及jstat命令的使用
- stl swap函数_vector :: swap()函数以及C ++ STL中的示例
- 链表面试笔试题目总结
- 《Java8实战》笔记(15):面向对象和函数式编程的混合-Java 8和Scala的比较
- Activiti - 新一代的开源BPM引擎
- PAT乙级 1005继续3n+1猜想
- [Codeforces1132G]Greedy Subsequences——线段树+单调栈
- [转]nonlocal和global
- Unity Physics.Raycast踩坑
- 基于java的班级管理系统
- vivado使用入门
- 2016最新淘宝客申请高佣金以及分析抓包详情
- iOS 开源项目(一)
- 搭建智能语音交互系统重要点那些
- unity支持的模型数据格式,unity3d模型制作规范
- 电脑wps可以语音录入吗_怎样用word进行语音录入文字