使用XE之后的开发工具,编写Service Application服务。
分别有如下窗口代码:1. 服务定义
unit uFileServer;interfaceuses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.SvcMgr, Vcl.Dialogs, Main;type
  TZJGAFileServer = 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
  ZJGAFileServer: TZJGAFileServer;
  FrmMain: TFrmMain;implementation{$R *.dfm}procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  ZJGAFileServer.Controller(CtrlCode);
end;function TZJGAFileServer.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;procedure TZJGAFileServer.ServiceContinue(Sender: TService;
  var Continued: Boolean);
begin
  while not Terminated do
  begin
    Sleep(10);
    ServiceThread.ProcessRequests(False);
  end;
end;procedure TZJGAFileServer.ServiceExecute(Sender: TService);
begin
  while not Terminated do
  begin
    Sleep(10);
    ServiceThread.ProcessRequests(False);
  end;
end;procedure TZJGAFileServer.ServicePause(Sender: TService; var Paused: Boolean);
begin
  Paused := True;
  WriteLog(FormatDateTime('YYYY-MM-DD HH:MM:SS', Now)+' ServicePause End.');
end;procedure TZJGAFileServer.ServiceShutdown(Sender: TService);
begin
  g_gbCanClose := True;
  FrmMain.Free;
  Status := csStopped;
  ReportStatus();
end;procedure TZJGAFileServer.ServiceStart(Sender: TService; var Started: Boolean);
begin
  WriteLog(FormatDateTime('YYYY-MM-DD HH:MM:SS', Now)+' ServiceStart End.');
  Started := True;
  Vcl.Svcmgr.Application.CreateForm(TFrmMain, FrmMain);
  g_gbCanClose := False;
  FrmMain.Hide;
end;procedure TZJGAFileServer.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
  WriteLog(FormatDateTime('YYYY-MM-DD HH:MM:SS', Now)+' ServiceStop End.');
  Stopped := True;
  g_gbCanClose := True;
  FrmMain.Free;
end;end.2. 服务弹窗
unit Main;interfaceuses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, ShellApi, Vcl.StdCtrls;const
  WM_TrayIcon = WM_USER + 1234;
type
  TFrmMain = class(TForm)
    Timer1: TTimer;
    Button1: TButton;
    TrayIcon1: TTrayIcon;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormDestroy(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure TrayIcon1DblClick(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;
  g_gbCanClose: Boolean;
  g_FileNum: Integer;  //撰写临时日志
  procedure WriteLog(Log: String);implementation{$R *.dfm}//撰写临时日志
procedure WriteLog(Log: String);
var WriteFile: TextFile; SQLFileFullName: String;
begin
  //生成文件
  SQLFileFullName := 'D:\UpFile\Log\test'+FormatFloat('0000',g_FileNum)+'.log';
  AssignFile(WriteFile, SQLFileFullName);
  ReWrite(WriteFile);
  try
    WriteLn(WriteFile, Log);
  finally
    CloseFile(WriteFile);
  end;
  Inc(g_FileNum);
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.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 := '资产文件通道服务';
  Shell_NotifyIcon(NIM_ADD, @IconData);
end;procedure TFrmMain.Button1Click(Sender: TObject);
var
  dwThreadID : DWORD;
begin
  CreateThread(nil, 0, @SendHokKey, nil, 0, dwThreadID);
end;procedure TFrmMain.DelIconFromTray;
begin
  Shell_NotifyIcon(NIM_DELETE, @IconData);
end;procedure TFrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := g_gbCanClose;
  if not CanClose then
  begin
    Hide;
  end;
end;procedure TFrmMain.FormCreate(Sender: TObject);
begin
  WriteLog(FormatDateTime('YYYY-MM-DD HH:MM:SS', Now)+' Main FormCreate Begin.');
  TrayIcon1.Hint := Application.Title;
  FormStyle := fsStayOnTop; {窗口最前}
  SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW); {不在任务栏显示}
  g_gbCanClose := False;
  Timer1.Interval := 1000;
  Timer1.Enabled := True;
  WriteLog(FormatDateTime('YYYY-MM-DD HH:MM:SS', Now)+' Main FormCreate End.');
end;procedure TFrmMain.FormDestroy(Sender: TObject);
begin
  Timer1.Enabled := False;
  DelIconFromTray;
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.Timer1Timer(Sender: TObject);
begin
  //Timer1.Enabled := False;
  //AddIconToTray;
  TrayIcon1.Visible := True;
end;procedure TFrmMain.TrayIcon1DblClick(Sender: TObject);
begin
  Show();
end;procedure TFrmMain.TrayIconMessage(var Msg: TMessage);
begin
  if (Msg.LParam = WM_LBUTTONDBLCLK) then
    Show();
end;end.3. 工程代码
program TestLog;uses
  Vcl.SvcMgr, //Vcl.Forms, System.SysUtils,
  uFileServer in 'uFileServer.pas' {ZJGAFileServer: TService},
  Main in 'Main.pas' {FrmMain};{$R *.RES}begin
  g_FileNum := 1;
  Application.Initialize;
  Application.CreateForm(TZJGAFileServer, ZJGAFileServer);
  Application.Run;
end.服务是可以正常启动、停止、暂停。但是服务启动之后,没有添加右下角任务图标,并且写了WriteLog日志也没有执行!
请教各位,这个是何情况?

解决方案 »

  1.   

    定义:
    constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); override;如下:
    constructor TZJGAFileServer.CreateNew(AOwner: TComponent; Dummy: Integer);
    begin
      inherited;
      inherited CreateNew(AOwner, Dummy);
      AllowPause := False;
      Interactive := True;
      OnStart := ServiceStart;
      OnStop := ServiceStop;
      OnPause := ServicePause;
    end;没触发原因导致.
      

  2.   

    但是 图标为何暂时无法做解答,可能是该模式下图标加载失败。如果是直接exe,TrayIcon1.Visible := True;就能显示。
      

  3.   

    加个Timer。定时启动托盘,隐藏界面。
      

  4.   

    谢谢,托盘的我加了timer和隐藏页面,但是一直无用的。代码前面已有,我再拷贝出来,如下:procedure TZJGAFileServer.ServiceStart(Sender: TService; var Started: Boolean);
    begin
      WriteLog(FormatDateTime('YYYY-MM-DD HH:MM:SS', Now)+' ServiceStart End.');
      Started := True;
      Application.CreateForm(TFrmMain, FrmMain);
      g_gbCanClose := False;
      FrmMain.Hide;
    end;procedure TFrmMain.Timer1Timer(Sender: TObject);
    begin
      WriteLog(FormatDateTime('YYYY-MM-DD HH:MM:SS', Now)+' TrayIcon Visible.');
      Timer1.Enabled := False;
      TrayIcon1.Visible := True;
    end;
      

  5.   

    有个奇怪的,想咨询下,是否跟这个有关:ServiceStart 下,我添加如下代码:
      WriteLog(FormatDateTime('YYYY-MM-DD HH:MM:SS', Now)+' ServiceStart End.');
      Started := True;
      Application.CreateForm(TFrmMain, FrmMain);
      FrmMain.Show;
      g_gbCanClose := False;窗口不会显示?
      

  6.   

    是否是如下情况:在Vista和Windows7以上服务是运行在不同的会话中,不能在用户的会话显示界面,完全隔离了.
    只能是在用户会话运行带界面的程序,和服务程序进行进程通讯来控制.
      

  7.   

    有这种可能,但不会一点反应都没有。我是写日志监测是否执行完毕的,代码是执行了,就是不弹窗。
    FrmMain也创建了,创建的时候,自动加载右下角TrayIcon图标,也没有显示出来,代码也是执行了。
    所以很奇怪