Dephi10.1 编写Service Application服务,无法弹窗显示
使用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日志也没有执行!
请教各位,这个是何情况?