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,并且把這個視窗設定為手工建立.完成後的代碼如下:
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);
function TDelphiService.GetServiceController: TServiceController;
Result := ServiceController;
procedure TDelphiService.ServiceContinue(Sender: TService;
var Continued: Boolean);
while not Terminated do
Sleep(10);
ServiceThread.ProcessRequests(False);
procedure TDelphiService.ServiceExecute(Sender: TService);
procedure TDelphiService.ServicePause(Sender: TService;
var Paused: Boolean);
Paused := True;
procedure TDelphiService.ServiceShutdown(Sender: TService);
gbCanClose := true;
FrmMain.Free;
Status := csStopped;
ReportStatus();
procedure TDelphiService.ServiceStart(Sender: TService;
var Started: Boolean);
Started := True;
Svcmgr.Application.CreateForm(TFrmMain, FrmMain);
gbCanClose := False;
FrmMain.Hide;
procedure TDelphiService.ServiceStop(Sender: TService;
var Stopped: Boolean);
Stopped := True;
gbCanClose := True;
end.
主視窗單元如下:
unit Unit_FrmMain;
Windows, Messages, SysUtils, Variants, Classes, ShellApi, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;
const
WM_TrayIcon = WM_USER + 1234;
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);
IconData: TNotifyIconData;
procedure AddIconToTray;
procedure DelIconFromTray;
procedure TrayIconMessage(var Msg: TMessage); message WM_TrayIcon;
procedure SysButtonMsg(var Msg: TMessage); message WM_SYSCOMMAND;
gbCanClose: Boolean;
{$R *.dfm}
procedure TFrmMain.FormCreate(Sender: TObject);
FormStyle := fsStayOnTop;
SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
Timer1.Interval := 1000;
Timer1.Enabled := True;
procedure TFrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
CanClose := gbCanClose;
if not CanClose then
Hide;
procedure TFrmMain.FormDestroy(Sender: TObject);
Timer1.Enabled := False;
DelIconFromTray;
procedure TFrmMain.AddIconToTray;
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);
procedure TFrmMain.DelIconFromTray;
Shell_NotifyIcon(NIM_DELETE, @IconData);
procedure TFrmMain.SysButtonMsg(var Msg: TMessage);
if (Msg.wParam = SC_CLOSE) or
(Msg.wParam = SC_MINIMIZE) then Hide
else inherited; // 執行預設動作
procedure TFrmMain.TrayIconMessage(var Msg: TMessage);
if (Msg.LParam = WM_LBUTTONDBLCLK) then Show();
procedure TFrmMain.Timer1Timer(Sender: TObject);
AddIconToTray;
procedure SendHokKey;stdcall;
HDesk_WL: HDESK;
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));
procedure TFrmMain.Button1Click(Sender: TObject);
dwThreadID : DWORD;
CreateThread(nil, 0, @SendHokKey, nil, 0, dwThreadID);
補充:
(1)關于更多服務程式的示範程式,請通路以下Url:http://www.torry.net/pages.php?id=226,上面包含了多個示範如何控制和管理系統服務的代碼.
(2)請切記:Windows實際上存在多個桌面.例如螢幕傳輸會出現白屏,可能有兩個原因:一是系統處于鎖定或未登陸桌面,二是處于螢幕保護桌面.這時候要将目前桌面切換到該桌面才能抓屏.
(3)關于服務程式與桌面互動,還有種動态切換方法.大概單元如下:
unit ServiceDesktop;
function InitServiceDesktop: boolean;
procedure DoneServiceDeskTop;
uses Windows, SysUtils;
DefaultWindowStation = WinSta0;
DefaultDesktop = Default;
hwinstaSave: HWINSTA;
hdeskSave: HDESK;
hwinstaUser: HWINSTA;
hdeskUser: HDESK;
dwThreadId: DWORD;
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
OutputDebugString(PChar(OpenWindowStation failed + SysErrorMessage(GetLastError)));
Result := false;
exit;
if not SetProcessWindowStation(hwinstaUser) then
OutputDebugString(SetProcessWindowStation failed);
hdeskUser := OpenDesktop(DefaultDesktop, 0, FALSE, MAXIMUM_ALLOWED);
if hdeskUser = 0 then
OutputDebugString(OpenDesktop failed);
SetProcessWindowStation(hwinstaSave);
CloseWindowStation(hwinstaUser);
Result := SetThreadDesktop(hdeskUser);
if not Result then
OutputDebugString(PChar(SetThreadDesktop + SysErrorMessage(GetLastError)));
// Restore window station and desktop.
SetThreadDesktop(hdeskSave);
if hwinstaUser <> 0 then
if hdeskUser <> 0 then
CloseDesktop(hdeskUser);
initialization
InitServiceDesktop;
finalization
DoneServiceDesktop;
更詳細的示範代碼請參看: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;
uses Windows, WinSvc;
//
// Service config info levels
SERVICE_CONFIG_DESCRIPTION = 1;
SERVICE_CONFIG_FAILURE_ACTIONS = 2;
// DLL name of imported functions
AdvApiDLL = advapi32.dll;
// Service description string
PServiceDescriptionA = ^TServiceDescriptionA;
PServiceDescriptionW = ^TServiceDescriptionW;
PServiceDescription = PServiceDescriptionA;
{$EXTERNALSYM _SERVICE_DESCRIPTIONA}
_SERVICE_DESCRIPTIONA = record
lpDescription : PAnsiChar;
{$EXTERNALSYM _SERVICE_DESCRIPTIONW}
_SERVICE_DESCRIPTIONW = record
lpDescription : PWideChar;
{$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;
{$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;
{$EXTERNALSYM _SERVICE_FAILURE_ACTIONSW}
_SERVICE_FAILURE_ACTIONSW = record
lpRebootMsg : LPWSTR;
lpCommand : LPWSTR;
{$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;
hDLL : THandle ;
LibLoaded : boolean ;
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;
OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);
GetVersionEx(OSVersionInfo);
if (OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT) and (OSVersionInfo.dwMajorVersion >= 5) then
if hDLL = 0 then
hDLL:=GetModuleHandle(AdvApiDLL);
LibLoaded := False;
hDLL := LoadLibrary(AdvApiDLL);
LibLoaded := True;
if hDLL <> 0 then
@QueryServiceConfig2A := GetProcAddress(hDLL, QueryServiceConfig2A);
@QueryServiceConfig2W := GetProcAddress(hDLL, QueryServiceConfig2W);
@QueryServiceConfig2 := @QueryServiceConfig2A;
@ChangeServiceConfig2A := GetProcAddress(hDLL, ChangeServiceConfig2A);
@ChangeServiceConfig2W := GetProcAddress(hDLL, ChangeServiceConfig2W);
@ChangeServiceConfig2 := @ChangeServiceConfig2A;
end
else
@QueryServiceConfig2A := nil;
@QueryServiceConfig2W := nil;
@QueryServiceConfig2 := nil;
@ChangeServiceConfig2A := nil;
@ChangeServiceConfig2W := nil;
@ChangeServiceConfig2 := nil;
if (hDLL <> 0) and LibLoaded then
FreeLibrary(hDLL);
unit winntService;
Windows,WinSvc,WinSvcEx;
function InstallService(const strServiceName,strDisplayName,strDescription,strFilename: string):Boolean;
//eg:InstallService(服務名稱,顯示名稱,描述資訊,服務檔案);
procedure UninstallService(strServiceName:string);
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
AND ECX,3
REP MOVSB
STOSB
MOV EAX,EDX
POP EBX
POP ESI
POP EDI
function StrPCopy(Dest: PChar; const Source: string): PChar;
Result := StrLCopy(Dest, PChar(Source), Length(Source));
//ss : TServiceStatus;
//psTemp : PChar;
hSCM,hSCS:THandle;
srvdesc : PServiceDescription;
desc : string;
//SrvType : DWord;
lpServiceArgVectors:pchar;
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
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);
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;
SCManager: SC_HANDLE;
Service: SC_HANDLE;
Status: TServiceStatus;
SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
if SCManager = 0 then Exit;
Service := OpenService(SCManager, Pchar(strServiceName), SERVICE_ALL_ACCESS);
ControlService(Service, SERVICE_CONTROL_STOP, Status);
DeleteService(Service);
CloseServiceHandle(Service);
CloseServiceHandle(SCManager);
(5)如何暴力關閉一個服務程式,實作我們以前那個"NT工具箱"的功能?首先,根據程序名稱來殺死程序是用以下函數:
uses Tlhelp32;
function KillTask(ExeFileName: string): Integer;
PROCESS_TERMINATE = 01;
ContinueLoop: BOOL;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
Result := 0;
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
while Integer(ContinueLoop) <> 0 do
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);
CloseHandle(FSnapshotHandle);
但是對于服務程式,它會提示"拒絕通路".其實隻要程式擁有Debug權限即可:
function EnableDebugPrivilege: Boolean;
function EnablePrivilege(hToken: Cardinal; PrivName: string; bEnable: Boolean): Boolean;
TP: TOKEN_PRIVILEGES;
Dummy: Cardinal;
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;
hToken: Cardinal;
OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, hToken);
result:=EnablePrivilege(hToken, SeDebugPrivilege, True);
CloseHandle(hToken);
使用方法:
EnableDebugPrivilege;//提升權限
KillTask(xxxx.exe);//關閉該服務程式.