首页  编辑  

在服务中显示系统托盘

Tags: /超级猛料/Core.驱动，VxD，服务/   Date Created:
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);
end;

function TDelphiService.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;

procedure TDelphiService.ServiceContinue(Sender: TService;
  var Continued: Boolean);
begin
  while not Terminated do
  begin
    Sleep(10);
    ServiceThread.ProcessRequests(False);
  end;
end;

procedure TDelphiService.ServiceExecute(Sender: TService);
begin
  while not Terminated do
  begin
    Sleep(10);
    ServiceThread.ProcessRequests(False);
  end;
end;

procedure TDelphiService.ServicePause(Sender: TService; var Paused: Boolean);
begin
  Paused := True;
end;

procedure TDelphiService.ServiceShutdown(Sender: TService);
begin
  gbCanClose := True;
  FrmMain.Free;
  Status := csStopped;
  ReportStatus();
end;

procedure TDelphiService.ServiceStart(Sender: TService; var Started: Boolean);
begin
  Started := True;
  SvcMgr.Application.CreateForm(TFrmMain, FrmMain);
  gbCanClose := False;
  FrmMain.Hide;
end;

procedure TDelphiService.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
  Stopped := True;
  gbCanClose := True;
  FrmMain.Free;
end;

end.
主窗口单元如下:
unit Unit_FrmMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, ShellApi, Graphics, Controls,
  Forms,
  Dialogs, ExtCtrls, StdCtrls;

const
  WM_TrayIcon = WM_USER + 1234;

type
  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);
  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;

var
  FrmMain: TFrmMain;
  gbCanClose: Boolean;

implementation

{$R *.dfm}

procedure TFrmMain.FormCreate(Sender: TObject);
begin
  FormStyle := 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);
begin
  CanClose := gbCanClose;
  if not CanClose then
  begin
    Hide;
  end;
end;

procedure TFrmMain.FormDestroy(Sender: TObject);
begin
  Timer1.Enabled := False;
  DelIconFromTray;
end;

procedure TFrmMain.AddIconToTray;
begin
  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);
end;

procedure TFrmMain.DelIconFromTray;
begin
  Shell_NotifyIcon(NIM_DELETE, @IconData);
end;

procedure TFrmMain.SysButtonMsg(var Msg: TMessage);
begin
  if (Msg.wParam = SC_CLOSE) or (Msg.wParam = SC_MINIMIZE) then
    Hide
  else
    inherited; // 执行默认动作
end;

procedure TFrmMain.TrayIconMessage(var Msg: TMessage);
begin
  if (Msg.LParam = WM_LBUTTONDBLCLK) then
    Show();
end;

procedure TFrmMain.Timer1Timer(Sender: TObject);
begin
  AddIconToTray;
end;

procedure SendHokKey; stdcall;
var
  HDesk_WL: HDESK;
begin
  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));
end;

procedure TFrmMain.Button1Click(Sender: TObject);
var
  dwThreadID: DWORD;
begin
  CreateThread(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 = 215
end

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
  end
end