服務(wù)程序增加系統(tǒng)托盤

1、服務(wù)程序增加系統(tǒng)托盤用Delphi創(chuàng)建服務(wù)程序作者：未知文章來源：歲月聯(lián)盟Windows 2000/XP和2003等支持一種叫做”服務(wù)程序”的東西.程序作為服務(wù)啟動有以下幾個好處：不用登陸進(jìn)系統(tǒng)即可運行.具有SYSTEM特權(quán),所以你在進(jìn)程管理器里面是無法結(jié)束它的.筆者在2003年為一公司開發(fā)機頂盒項目的時候，曾經(jīng)寫過課件上傳和媒體服務(wù)，下面就介紹一下如何用Delphi?創(chuàng)建一個Service程序.運行Delphi?,選擇菜單File-New-OtherService Application.將生成一個服務(wù)程序的框架,將工程保存為ServiceDemo.dpr和 Unit_Main.pas,然后

2、回到主框架.我們注意到,Service有幾個屬性.其中以下幾個是我們比較常用的：DisplayName:服務(wù)的顯示名稱Name:服務(wù)名稱,我們在這里將DisplayName的值改為Delphi服務(wù)演示程序,Name改為DelphiService”,編譯這個項目,將得到ServiceDemo.exe.這已經(jīng)是 一個服務(wù)程序了 ！進(jìn)入CMD模式，切換致工程所在目錄，運行命令ServiceDemo.exe /install,將提示服務(wù)安裝成功！然后net start DelphiService將啟動這個服務(wù).進(jìn)入控制面版-管理工具-服務(wù),將顯示這個服務(wù)和當(dāng)前狀態(tài).不過這個服務(wù)現(xiàn)在什么也干不了，因為我

3、們還沒 有寫代碼：)先net stop DelphiService停止再ServiceDemo.exe /uninstall刪除這個服務(wù).回到 Delphi?的 IDE.我們的計劃是為這個服務(wù)添加一個主窗口，運行后任務(wù)欄顯示程序的圖標(biāo) ，雙擊圖標(biāo)將顯示主窗口 ，上面有一個按鈕，點擊該按鈕將實現(xiàn)Ctrl+Alt+Del 功能實際上，服務(wù)程序莫認(rèn)是工作于Winlogon桌面的，可以打開控制面板，查看我們剛才那個服務(wù)的屬性-登陸，其中”允許服務(wù)與桌面交互”是不打鉤 的.怎么辦？呵呵，回到IDE,注意那個布爾屬性:Interactive,當(dāng)這個屬性為True的時候，該服務(wù)程序就可以與桌面交互了.Fil

4、e-New-Form為服務(wù)添加窗口 FrmMain,單元保存為Unit_FrmMain,并且把這個窗口設(shè)置為手工創(chuàng)建.完成后的代碼如下： unit Unit_Main;interfaceusesWindows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, Unit_FrmMain;typeTDelphiService = class(TService)procedure ServiceContinue(Sender: TService; var Continued: Boolean);procedure S

5、erviceExecute(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 publicfu

6、nction GetServiceController: TServiceController; override; Public declarations end;varDelphiService: TDelphiService;FrmMain: TFrmMain;implementationprocedure ServiceController(CtrlCode: DWord); stdcall;beginDelphiService.Controller(CtrlCode);end;function TDelphiService.GetServiceController: TService

7、Controller;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 Terminate

8、d 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;p

9、rocedure 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;F

10、rmMain.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: TObjec

11、t);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

12、 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 *.dfmprocedure TFrmMain.FormCreate(Sender: TObject);beginFormStyle := fsStayOnTop;SetWin

13、dowLong(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.FormDestro

14、y(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.uC

15、allbackMessage := WM_TrayIcon;IconData.hIcon := Application.Icon.Handle;IconData.szTip := Delphi 服務(wù)演示程序；Shell_NotifyIcon(NIM_ADD, IconData);end;procedure TFrmMain.DelIconFromTray;beginShell_NotifyIcon(NIM_DELETE, IconData);end;procedure TFrmMain.SysButtonMsg(var Msg: TMessage);beginif (Msg.wParam =

16、SC_CLOSE) or(Msg.wParam = SC_MINIMIZE) then Hideelse inherited; /執(zhí)行默認(rèn)動作 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: H

17、DESK;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 :

18、 DWORD;beginCreateThread(nil, 0, SendHokKey, nil, 0, dwThreadID);end;end.補充：關(guān)于更多服務(wù)程序的演示程序，請訪問以下Url: HYPERLINK /pages.php?id=226,%e4%b8%8a%e9%9d%a2%e5%8c%85%e5%90%ab%e4%ba%86%e5%a4%9a%e4%b8%aa%e6%bc%94%e7%a4%ba%e5%a6%82%e4%bd%95%e6%8e%a7%e5%88%b6%e5%92%8c%e7%ae%a1%e7%90%86%e7%b3%bb%e7%bb%9f%e6%9c%8d%

19、e5%8a%a1%e7%9a%84 /pages.php?id=226,上面包含了多個演示如何控制和管理系統(tǒng)服務(wù)的 代碼請切記:Windows實際上存在多個桌面.例如屏幕傳輸會出現(xiàn)白屏，可能有兩個原因:一是系統(tǒng)處于鎖定或未登陸桌面,二是處于屏幕保護桌面.這 時候要將當(dāng)前桌面切換到該桌面才能抓屏,關(guān)于服務(wù)程序與桌面交互,還有種動態(tài)切換方法.大概單元如下：unit ServiceDesktop;interfacefunction InitServiceDesktop: boolean;procedure DoneServiceDeskTop;implementationuses Windows,

20、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 deskt

21、op, and/ save their handles.hwinstaSave := GetProcessWindowStation;hdeskSave := GetThreadDesktop(dwThreadId);hwinstaUser := OpenWindowStation(DefaultWindowStation, FALSE, MAXIMUM_ALLOWED);if hwinstaUser = 0 thenbeginOutputDebugString(PChar(OpenWindowStation failed + SysErrorMessage(GetLastError);Res

22、ult := false;exit;end;if not SetProcessWindowStation(hwinstaUser) then beginOutputDebugString(SetProcessWindowStation failed);Result := false;exit;end;hdeskUser := OpenDesktop(DefaultDesktop, 0, FALSE, MAXIMUM_ALLOWED);if hdeskUser = 0 thenbeginOutputDebugString(OpenDesktop failed);SetProcessWindowS

23、tation(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(hd

24、eskSave);SetProcessWindowStation(hwinstaSave);if hwinstaUser 0 thenCloseWindowStation(hwinstaUser);if hdeskUser 0 thenCloseDesktop(hdeskUser);end;initializationInitServiceDesktop;finalizationDoneServiceDesktop;end.更詳細(xì)的演示代碼請參看： HYPERLINK /samples/samples/os/isarticle.zip /samples/samples/os/isarticle

25、.zip(4)關(guān)于安裝服務(wù)如何添加服務(wù)描述.有兩種方法：一是修改注冊表.服務(wù)的詳細(xì)信息都位于HKEY_LOCAL_MACHINESYSTEM ControlSet001Services 下面，例如我們岡 U 才那個服務(wù)就位于 HKEY_LOCAL_MACHINESYSTEM ControlSet001ServicesDelphiService 下.第二種方法就是先用 QueryServiceConfig2 函數(shù)獲取服務(wù)信息，然后 ChangeServiceConfig2 來 改變描述.用Delphi實現(xiàn)的話，單元如下：unit WinSvcEx;interfaceuses Windows, W

26、inSvc;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;PServiceDescrip

27、tion = PServiceDescriptionA;$EXTERNALSYM _SERVICE_DESCRIPTIONA_SERVICE_DESCRIPTIONA = recordlpDescription : PAnsiChar;end;$EXTERNALSYM _SERVICE_DESCRIPTIONW_SERVICE_DESCRIPTIONW = recordlpDescription : PWideChar;end;$EXTERNALSYM _SERVICE_DESCRIPTION_SERVICE_DESCRIPTION = _SERVICE_DESCRIPTIONA;$EXTER

28、NALSYM SERVICE_DESCRIPTIONASERVICE_DESCRIPTIONA = _SERVICE_DESCRIPTIONA;$EXTERNALSYM SERVICE_DESCRIPTIONWSERVICE_DESCRIPTIONW = _SERVICE_DESCRIPTIONW;$EXTERNALSYM SERVICE_DESCRIPTIONSERVICE_DESCRIPTION = _SERVICE_DESCRIPTIONA;TServiceDescriptionA = _SERVICE_DESCRIPTIONA;TServiceDescriptionW = _SERVI

29、CE_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_TYPESC_ACTION_TYPE = _SC_ACTION_TYPE;PServiceAction =人TSer

30、viceAction;$EXTERNALSYM _SC_ACTION_SC_ACTION = recordaType : SC_ACTION_TYPE;Delay : DWORD;end;$EXTERNALSYM SC_ACTIONSC_ACTION = _SC_ACTION;TServiceAction = _SC_ACTION;PServiceFailureActionsA =人TServiceFailureActionsA;PServiceFailureActionsW =人TServiceFailureActionsW;PServiceFailureActions = PService

31、FailureActionsA;$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;IpRebootMsg :

32、 LPWSTR;IpCommand : LPWSTR;cActions : DWORD;IpsaActions :人SC_ACTION;end;$EXTERNALSYM _SERVICE_FAILURE_ACTIONS_SERVICE_FAILURE_ACTIONS = _SERVICE_FAILURE_ACTIONSA;$EXTERNALSYM SERVICE_FAILURE_ACTIONSASERVICE_FAILURE_ACTIONSA = _SERVICE_FAILURE_ACTIONSA;$EXTERNALSYM SERVICE_FAILURE_ACTIONSWSERVICE_FAI

33、LURE_ACTIONSW = _SERVICE_FAILURE_ACTIONSW;$EXTERNALSYM SERVICE_FAILURE_ACTIONSSERVICE_FAILURE_ACTIONS = _SERVICE_FAILURE_ACTIONSA;TServiceFailureActionsA = _SERVICE_FAILURE_ACTIONSA;TServiceFailureActionsW = _SERVICE_FAILURE_ACTIONSW;TServiceFailureActions = TServiceFailureActionsA;/ API Function Pr

34、ototypes/TQueryServiceConfig2 = function (hService : SC_HANDLE; dwInfoLevel : DWORD; IpBuffer : pointer;cbBufSize : DWORD; var pcbBytesNeeded) : BOOL; stdcall;TChangeServiceConfig2 = function (hService : SC_HANDLE; dwInfoLevel : DWORD; lpInfo : pointer) : BOOL; stdcall; varhDLL : THandle ;LibLoaded

35、: boolean ;varOSVersionInfo : TOSVersionInfo;$EXTERNALSYM QueryServiceConfig2AQueryServiceConfig2A : TQueryServiceConfig2;$EXTERNALSYM QueryServiceConfig2WQueryServiceConfig2W : TQueryServiceConfig2;$EXTERNALSYM QueryServiceConfig2QueryServiceConfig2 : TQueryServiceConfig2;$EXTERNALSYM ChangeService

36、Config2AChangeServiceConfig2A : TChangeServiceConfig2;$EXTERNALSYM ChangeServiceConfig2WChangeServiceConfig2W : TChangeServiceConfig2;$EXTERNALSYM ChangeServiceConfig2ChangeServiceConfig2 : TChangeServiceConfig2;implementationinitializationOSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);G

37、etVersionEx(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 thenbegi

38、nQueryServiceConfig2A := GetProcAddress(hDLL, QueryServiceConfig2A);QueryServiceConfig2W := GetProcAddress(hDLL, QueryServiceConfig2W);QueryServiceConfig2 := QueryServiceConfig2A;ChangeServiceConfig2A := GetProcAddress(hDLL, ChangeServiceConfig2A);ChangeServiceConfig2W := GetProcAddress(hDLL, Change

39、ServiceConfig2W);ChangeServiceConfig2 := ChangeServiceConfig2A;end;endelsebeginQueryServiceConfig2A := nil;QueryServiceConfig2W := nil;QueryServiceConfig2 := nil;ChangeServiceConfig2A := nil;ChangeServiceConfig2W := nil;ChangeServiceConfig2 := nil;end;finalizationif (hDLL 0) and LibLoaded thenFreeLi

40、brary(hDLL);end.unit winntService;interfaceusesWindows,WinSvc,WinSvcEx;function InstallService(const strServiceName,strDisplayName,strDescription,strFilename: string):Boolean;/eg:InstallService (服務(wù)名稱，顯示名稱，描述信息,服務(wù)文件)； procedure UninstallService(strServiceName:string);implementationfunction StrLCopy(D

41、est: 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 ECX1: SUB EBX,ECXMOV EDI,ESIMOV ESI,EDXMOV EDX,EDIMOV ECX,EBXSHR ECX,2REP MOVSDMOV ECX,EBXAND ECX,3REP MOVSBSTOSBMOV EAX,EDXPO

42、P 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

43、: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);/ 連接服務(wù)數(shù)據(jù)庫ifhSCM = 0then Exit;/MessageBox(hHandl

44、e,Pchar(SysErrorMessage(GetLastError), 服 務(wù) 程 序 管 理器,MB_ICONERROR+MB_TOPMOST);hSCS:=CreateService( 創(chuàng)建服務(wù)函數(shù)hSCM, /服務(wù)控制管理句柄Pchar(strServiceName), / 服務(wù)名稱Pchar(strDisplayName), / 顯示的服務(wù)名稱SERVICE_ALL_ACCESS, / 存取權(quán)利SERVICE_WIN32_OWN_PROCESS or SERVICE_INTERACTIVE_PROCESS,/ 服務(wù)類型 SERVICE_WIN32_SHARE_PROCESSSER

45、VICE_AUTO_START, / 啟動類型SERVICE_ERROR_IGNORE, / 錯誤控制類型Pchar(strFilename), / 服務(wù)程序nil, /組服務(wù)名稱nil, /組標(biāo)識nil, /依賴的服務(wù)nil, /啟動服務(wù)帳號nil); /啟動服務(wù)口令ifhSCS=0thenExit;/MessageBox(hHandle,Pchar(SysErrorMessage(GetLastError),Pchar(Application.Title),MB_ICONERROR+MB_TOPMOST); if Assigned(ChangeServiceConfig2) thenbeg

46、indesc := Copy(strDescription,1,1024);GetMem(srvdesc,SizeOf(TServiceDescription);GetMem(srvdesc人.lpDescription,Length(desc) + 1);tryStrPCopy(srvdesc人.IpDescription, desc);ChangeServiceConfig2(hSCS,SERVICE_CONFIG_DESCRIPTION,srvdesc);finallyFreeMem(srvdesc人.IpDescription);FreeMem(srvdesc);end;end;IpS

47、erviceArgVectors := nil;if not StartService(hSCS, 0, IpServiceArgVectors) then / 啟動服務(wù)Exit; /MessageBox(hHandIe,Pchar(SysErrorMessage(GetLastError),Pchar(AppIication.TitIe),MB_ICONERROR+MB_TOPMOST);CloseServiceHandle(hSCS); / 關(guān)閉句柄ResuIt:=True;end;procedure UninstaIIService(strServiceName:string);varS

48、CManager: SC_HANDLE;Service: SC_HANDLE;Status: TServiceStatus;beginSCManager := OpenSCManager(niI, nil, SC_MANAGER_ALL_ACCESS);if SCManager = 0 then Exit;tryService := OpenService(SCManager, Pchar(strServiceName), SERVICE_ALL_ACCESS);ControIService(Service, SERVICE_CONTROL_STOP, Status);DeIeteService(Service);CIoseServiceHandIe(Service);fi