ist

创建具有托盘的服务程序 关键字: 托盘 服务 分类　: 个人专区 密级　: 公开
(评分:★★★ , 回复: 4, 阅读: 298) »»

作者：未知 文章来源：中国X黑客小组
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
usesWindows, 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;
interface
usesWindows, 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.
program ServiceDemo;
uses SvcMgr, Unit_Main in 'Unit_Main.pas' {DelphiService: TService}, Unit_frmMain in 'Unit_frmMain.pas' {frmMain};
{$R *.RES}
begin Application.Initialize; Application.CreateForm(TDelphiService, DelphiService); Application.Run;end.

object DelphiService: TDelphiService OldCreateOrder = False DisplayName = 'Delphi服务演示程序' Interactive = True OnContinue = ServiceContinue OnExecute = ServiceExecute OnPause = ServicePause OnShutdown = ServiceShutdown OnStart = ServiceStart OnStop = ServiceStop Left = 261 Top = 177 Height = 150 Width = 215end
object frmMain: TfrmMain Left = 192 Top = 107 Width = 696 Height = 480 Caption = '我的服务测试程序' Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] OldCreateOrder = False OnCloseQuery = FormCloseQuery OnCreate = FormCreate OnDestroy = FormDestroy PixelsPerInch = 96 TextHeight = 13 object Button1: TButton Left = 296 Top = 264 Width = 75 Height = 25 Caption = 'Button1' TabOrder = 0 OnClick = Button1Click end object Timer1: TTimer OnTimer = Timer1Timer Left = 120 Top = 192 endend