在winXP下可安装,运行的系统服务程序,在Win7下出错!

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.CreateForm(TFrmMain, FrmMain);
  Application.Run;
end.

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, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, ShellApi;

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