服务程序增加系统托盘 用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,并且把这个窗口设置为手工创建.完成后的代码如下:unit Unit_Main;interfaceusesWindows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, Unit_FrmMain;typeTDelphiService = 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 }publicfunction GetServiceController: TServiceController; override;{ Public declarations }end;varDelphiService: TDelphiService;FrmMain: TFrmMain;implementation{$R *.DFM}procedure ServiceController(CtrlCode: DWord); stdcall;beginDelphiService.Controller(CtrlCode);end;function TDelphiService.GetServiceController: TServiceController;beginResult := ServiceController;end;procedure TDelphiService.ServiceContinue(Sender: TService;var Continued: Boolean);beginwhile not Terminated dobeginSleep(10);ServiceThread.ProcessRequests(False);end;end;procedure TDelphiService.ServiceExecute(Sender: TService);beginwhile not Terminated dobeginSleep(10);ServiceThread.ProcessRequests(False);end;end;procedure TDelphiService.ServicePause(Sender: TService;var Paused: Boolean);beginPaused := True;end;procedure TDelphiService.ServiceShutdown(Sender: TService);begingbCanClose := true;FrmMain.Free;Status := csStopped;ReportStatus();end;procedure TDelphiService.ServiceStart(Sender: TService;var Started: Boolean);beginStarted := True;Svcmgr.Application.CreateForm(TFrmMain, FrmMain);gbCanClose := False;FrmMain.Hide;end;procedure TDelphiService.ServiceStop(Sender: TService;var Stopped: Boolean);beginStopped := True;gbCanClose := True;FrmMain.Free;end;end.主窗口单元如下:unit Unit_FrmMain;interfaceusesWindows, Messages, SysUtils, Variants, Classes, ShellApi, Graphics, Controls, Forms,Dialogs, ExtCtrls, StdCtrls;constWM_TrayIcon = WM_USER + 1234;typeTFrmMain = 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;varFrmMain: TFrmMain;gbCanClose: Boolean;implementation{$R *.dfm}procedure TFrmMain.FormCreate(Sender: TObject);beginFormStyle := 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);beginCanClose := gbCanClose;if not CanClose thenbeginHide;end;end;procedure TFrmMain.FormDestroy(Sender: TObject);beginTimer1.Enabled := False;DelIconFromTray;end;procedure TFrmMain.AddIconToTray;beginZeroMemory(@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;beginShell_NotifyIcon(NIM_DELETE, @IconData);end;procedure TFrmMain.SysButtonMsg(var Msg: TMessage);beginif (Msg.wParam = SC_CLOSE) or(Msg.wParam = SC_MINIMIZE) then Hideelse inherited; // 执行默认动作end;procedure TFrmMain.TrayIconMessage(var Msg: TMessage);beginif (Msg.LParam = WM_LBUTTONDBLCLK) then Show();end;procedure TFrmMain.Timer1Timer(Sender: TObject);beginAddIconToTray;end;procedure SendHokKey;stdcall;varHDesk_WL: HDESK;beginHDesk_WL := OpenDesktop (Winlogon, 0, False, DESKTOP_JOURNALPLAYBACK);if (HDesk_WL <> 0) thenif (SetThreadDesktop (HDesk_WL) = True) thenPostMessage(HWND_BROADCAST, WM_HOTKEY, 0, MAKELONG (MOD_ALT or MOD_CONTROL, VK_DELETE));end;procedure TFrmMain.Button1Click(Sender: TObject);vardwThreadID : DWORD;beginCreateThread(nil, 0, @SendHokKey, nil, 0, dwThreadID);end;end.补充:(1)关于更多服务程序的演示程序,请访问以下Url:http://www.torry.net/pages.php?id=226,上面包含了多个演示如何控制和管理系统服务的代码.(2)请切记:Windows实际上存在多个桌面.例如屏幕传输会出现白屏,可能有两个原因:一是系统处于锁定或未登陆桌面,二是处于屏幕保护桌面.这时候要将当前桌面切换到该桌面才能抓屏.(3)关于服务程序与桌面交互,还有种动态切换方法.大概单元如下:unit ServiceDesktop;interfacefunction InitServiceDesktop: boolean;procedure DoneServiceDeskTop;implementationuses Windows, SysUtils;constDefaultWindowStation = WinSta0;DefaultDesktop = Default;varhwinstaSave: HWINSTA;hdeskSave: HDESK;hwinstaUser: HWINSTA;hdeskUser: HDESK;function InitServiceDesktop: boolean;vardwThreadId: DWORD;begindwThreadId := 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 thenbeginOutputDebugString(PChar(OpenWindowStation failed + SysErrorMessage(GetLastError)));Result := false;exit;end;if not SetProcessWindowStation(hwinstaUser) thenbeginOutputDebugString(SetProcessWindowStation failed);Result := false;exit;end;hdeskUser := OpenDesktop(DefaultDesktop, 0, FALSE, MAXIMUM_ALLOWED);if hdeskUser = 0 thenbeginOutputDebugString(OpenDesktop failed);SetProcessWindowStation(hwinstaSave);CloseWindowStation(hwinstaUser);Result := false;exit;end;Result := SetThreadDesktop(hdeskUser);if not Result thenOutputDebugString(PChar(SetThreadDesktop + SysErrorMessage(GetLastError)));end;procedure DoneServiceDeskTop;begin// Restore window station and desktop.SetThreadDesktop(hdeskSave);SetProcessWindowStation(hwinstaSave);if hwinstaUser <> 0 thenCloseWindowStation(hwinstaUser);if hdeskUser <> 0 thenCloseDesktop(hdeskUser);end;initializationInitServiceDesktop;finalizationDoneServiceDesktop;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;interfaceuses 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 = recordlpDescription : PAnsiChar;end;{$EXTERNALSYM _SERVICE_DESCRIPTIONW}_SERVICE_DESCRIPTIONW = recordlpDescription : 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 = recordaType : 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 = recorddwResetPeriod : DWORD;lpRebootMsg : LPSTR;lpCommand : LPSTR;cActions : DWORD;lpsaActions : ^SC_ACTION;end;{$EXTERNALSYM _SERVICE_FAILURE_ACTIONSW}_SERVICE_FAILURE_ACTIONSW = recorddwResetPeriod : 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;varhDLL : THandle ;LibLoaded : boolean ;varOSVersionInfo : 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;implementationinitializationOSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);GetVersionEx(OSVersionInfo);if (OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT) and (OSVersionInfo.dwMajorVersion >= 5) thenbeginif hDLL = 0 thenbeginhDLL:=GetModuleHandle(AdvApiDLL);LibLoaded := False;if hDLL = 0 thenbeginhDLL := LoadLibrary(AdvApiDLL);LibLoaded := True;end;end;if hDLL <> 0 [email protected] := GetProcAddress(hDLL, QueryServiceConfig2A);@QueryServiceConfig2W := GetProcAddress(hDLL, QueryServiceConfig2W);@QueryServiceConfig2 := @QueryServiceConfig2A;@ChangeServiceConfig2A := GetProcAddress(hDLL, ChangeServiceConfig2A);@ChangeServiceConfig2W := GetProcAddress(hDLL, ChangeServiceConfig2W);@ChangeServiceConfig2 := @ChangeServiceConfig2A;end;[email protected] := nil;@QueryServiceConfig2W := nil;@QueryServiceConfig2 := nil;@ChangeServiceConfig2A := nil;@ChangeServiceConfig2W := nil;@ChangeServiceConfig2 := nil;end;finalizationif (hDLL <> 0) and LibLoaded thenFreeLibrary(hDLL);end.unit winntService;interfaceusesWindows,WinSvc,WinSvcEx;function InstallService(const strServiceName,strDisplayName,strDescription,strFilename: string):Boolean;//eg:InstallService(服务名称,显示名称,描述信息,服务文件);procedure UninstallService(strServiceName:string);implementationfunction StrLCopy(Dest: PChar; const Source: PChar; MaxLen: Cardinal): PChar; assembler;asmPUSH EDIPUSH ESIPUSH EBXMOV ESI,EAXMOV EDI,EDXMOV EBX,ECXXOR AL,ALTEST ECX,ECXJZ @@1REPNE SCASBJNE @@1INC [email protected]@1: SUB EBX,ECXMOV EDI,ESIMOV ESI,EDXMOV EDX,EDIMOV ECX,EBXSHR ECX,2REP MOVSDMOV ECX,EBXAND ECX,3REP MOVSBSTOSBMOV EAX,EDXPOP EBXPOP ESIPOP EDIend;function StrPCopy(Dest: PChar; const Source: string): PChar;beginResult := 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;beginResult:=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_PROCESSSERVICE_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) thenbegindesc := Copy(strDescription,1,1024);GetMem(srvdesc,SizeOf(TServiceDescription));GetMem(srvdesc^.lpDescription,Length(desc) + 1);tryStrPCopy(srvdesc^.lpDescription, desc);ChangeServiceConfig2(hSCS,SERVICE_CONFIG_DESCRIPTION,srvdesc);finallyFreeMem(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);varSCManager: SC_HANDLE;Service: SC_HANDLE;Status: TServiceStatus;beginSCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);if SCManager = 0 then Exit;tryService := OpenService(SCManager, Pchar(strServiceName), SERVICE_ALL_ACCESS);ControlService(Service, SERVICE_CONTROL_STOP, Status);DeleteService(Service);CloseServiceHandle(Service);finallyCloseServiceHandle(SCManager);end;end;end.(5)如何暴力关闭一个服务程序,实现我们以前那个"NT工具箱"的功能?首先,根据进程名称来杀死进程是用以下函数:uses Tlhelp32;function KillTask(ExeFileName: string): Integer;constPROCESS_TERMINATE = 01;varContinueLoop: BOOL;FSnapshotHandle: THandle;FProcessEntry32: TProcessEntry32;beginResult := 0;FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);FProcessEntry32.dwSize := SizeOf(FProcessEntry32);ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);while Integer(ContinueLoop) <> 0 dobeginif ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =UpperCase(ExeFileName))) thenResult := 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;varTP: TOKEN_PRIVILEGES;Dummy: Cardinal;beginTP.PrivilegeCount := 1;LookupPrivilegeValue(nil, pchar(PrivName), TP.Privileges[0].Luid);if bEnable thenTP.Privileges[0].Attributes := SE_PRIVILEGE_ENABLEDelse TP.Privileges[0].Attributes := 0;AdjustTokenPrivileges(hToken, False, TP, SizeOf(TP), nil, Dummy);Result := GetLastError = ERROR_SUCCESS;end;varhToken: Cardinal;beginOpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, hToken);result:=EnablePrivilege(hToken, SeDebugPrivilege, True);CloseHandle(hToken);end;使用方法:EnableDebugPrivilege;//提升权限KillTask(xxxx.exe);//关闭该服务程序.
http://blog.csdn.net/diligentcatrich/article/details/7079039