Dephi10.1 编写Service Application服务，无法弹窗显示

[fullhappy]

使用XE之后的开发工具，编写Service Application服务。
分别有如下窗口代码：

1. 服务定义
unit uFileServer;

interface

uses
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;

interface

uses
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日志也没有执行！
请教各位，这个是何情况？

[qfitsoft]

定义： 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; 没触发原因导致.

[qfitsoft]

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

[lyhoo163]

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

[fullhappy]

谢谢，托盘的我加了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;

[fullhappy]

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

[fullhappy]

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

[lyhoo163]

引用 6 楼 fullhappy 的回复:

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

有这种可能，但不会一点反应都没有。

[fullhappy]

引用 7 楼 lyhoo163 的回复:

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

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