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服务演示程序\改为\"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,并且把这个窗口设置为手工创建.完成后的代码如下:
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.
主窗口单元如下:
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; {窗口最前}
SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW); {不在任务栏显示} 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服务演示程序'; 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; // 执行默认动作 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.
补充:
(1)关于更多服务程序的演示程序,请访问以下Url:http://www.torry.net/pages.php?id=226,上面包含了多个演示如何控制和管理系统服务的代码.
(2)请切记:Windows实际上存在多个桌面.例如屏幕传输会出现白屏,可能有两个原因:一是系统处于锁定或未登陆桌面,二是处于屏幕保护桌面.这时候要将当前桌面切换到该桌面才能抓屏.
(3)关于服务程序与桌面交互,还有种动态切换方法.大概单元如下: 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 Result 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.
更详细的演示代码请参看: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实现的话,单元如下:
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_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}
SC_ACTION_REBOOT,
_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('服务名称','显示名称','描述信息','服务文件'); 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 StrPCopy(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);//连接服务数据库
if hSCM=0 then Exit;//MessageBox(hHandle,Pchar(SysErrorMessage(GetLastError)),'服务程序管理器',MB_ICONERROR+MB_TOPMOST);
hSCS:=CreateService( //创建服务函数 hSCM, // 服务控制管理句柄
Pchar(strServiceName), // 服务名称
Pchar(strDisplayName), // 显示的服务名称 SERVICE_ALL_ACCESS, // 存取权利 SERVICE_WIN32_OWN_PROCESS or SERVICE_INTERACTIVE_PROCESS,// 服务类型 SERVICE_WIN32_SHARE_PROCESS SERVICE_AUTO_START, // 启动类型
SERVICE_ERROR_IGNORE, // 错误控制类型 Pchar(strFilename), // 服务程序 nil, // 组服务名称 nil, // 组标识
nil, // 依赖的服务 nil, // 启动服务帐号 nil); // 启动服务口令 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 //启动服务 Exit;
//MessageBox(hHandle,Pchar(SysErrorMessage(GetLastError)),Pchar(Application.Title),MB_ICONERROR+MB_TOPMOST);
CloseServiceHandle(hSCS); //关闭句柄 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)如何暴力关闭一个服务程序,实现我们以前那个\"NT工具箱\"的功能?首先,根据进程名称来杀死进程是用以下函数: uses Tlhelp32;
function KillTask(ExeFileName: string): Integer; const
PROCESS_TERMINATE = $0001; var
ContinueLoop: BOOL;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32; begin
Result := 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;
但是对于服务程序,它会提示\"拒绝访问\".其实只要程序拥有Debug权限即可: 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;
使用方法:
EnableDebugPrivilege;//提升权限
KillTask('xxxx.exe');//关闭该服务程序.
因篇幅问题不能全部显示，请点此查看更多更全内容