服務程序增加系統托盤 用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 thenbegin@QueryServiceConfig2A := GetProcAddress(hDLL, QueryServiceConfig2A);@QueryServiceConfig2W := GetProcAddress(hDLL, QueryServiceConfig2W);@QueryServiceConfig2 := @QueryServiceConfig2A;@ChangeServiceConfig2A := GetProcAddress(hDLL, ChangeServiceConfig2A);@ChangeServiceConfig2W := GetProcAddress(hDLL, ChangeServiceConfig2W);@ChangeServiceConfig2 := @ChangeServiceConfig2A;end;endelsebegin@QueryServiceConfig2A := 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 ECX@@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);//關閉該服務程序.

總結

以上是生活随笔為你收集整理的服务程序增加系统托盘的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。