H
hnzpeng
Unregistered / Unconfirmed
GUEST, unregistred user!
网上找的这段代码(带托盘图标的服务程序) 服务安装运行后没有托盘图标? (刚才搜索了一下是 陈经韬先生写的‘用DELPHI创建服务程序’的原代码)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;interfaceuses 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//uses Unit_FrmMain;{$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 Terminateddo
begin
Sleep(10);ServiceThread.ProcessRequests(False);
end;
end;
procedure TDelphiService.ServiceExecute(Sender: TService);
begin
while not Terminateddo
begin
Sleep(10);MessageBeep(0);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.show;//Hide;改成show后,服务运行,桌面上有窗口弹出来。end;
procedure TDelphiService.ServiceStop(Sender: TService;var Stopped: Boolean);
begin
Stopped := True;gbCanClose := True;FrmMain.Free;
end;
end.
unit Unit_FrmMain;interfaceuses Windows, Messages, SysUtils, Variants, Classes, ShellApi, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls;constWM_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;
//FICON:TIcon;
public { Public declarations } end;
var FrmMain: TFrmMain;
gbCanClose: Boolean;implementationprocedure 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.FormCreate(Sender: TObject);
begin
FormStyle := fsStayOnTop;SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);gbCanClose := False;Timer1.Interval := 1000;Timer1.Enabled := True;// SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
end;
{$R *.dfm}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.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;varHDesk_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);vardwThreadID : DWORD;
begin
CreateThread(nil, 0, @SendHokKey, nil, 0, dwThreadID);
end;
end.
用原来问题的位置,原来的问题没有解决,是用Timer 做了一个自动关机程序,系统锁定后,关不了机有说要用线程,现在用线程这样做: procedure TcloseThread.Execute;
begin
while now() < Unit1.tido
//ti是关机时间 begin
sleep(10000);
if now() > Unit1.ti then
begin
if Operate='close' then
begin
Form1.closecomputer(EWX_POWEROFF);
end else
if Operate='logout' then
Form1.closecomputer(EWX_LOGOFF) else
if Operate='repeat' then
Form1.closecomputer(EWX_REBOOT);
//调用主线程关机过程 //调用主线程重起过程 //调用主线程注销过程 end;
end;
系统锁定后一样关不了机,不锁定可以关机那位神仙指点迷津
Application.Initialize;
Application.CreateForm(TDelphiService, DelphiService);
Application.CreateForm(TFrmMain, FrmMain);
Application.Run;
end.
unit Unit_Main;interfaceuses 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//uses Unit_FrmMain;{$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 Terminateddo
begin
Sleep(10);ServiceThread.ProcessRequests(False);
end;
end;
procedure TDelphiService.ServiceExecute(Sender: TService);
begin
while not Terminateddo
begin
Sleep(10);MessageBeep(0);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.show;//Hide;改成show后,服务运行,桌面上有窗口弹出来。end;
procedure TDelphiService.ServiceStop(Sender: TService;var Stopped: Boolean);
begin
Stopped := True;gbCanClose := True;FrmMain.Free;
end;
end.
unit Unit_FrmMain;interfaceuses Windows, Messages, SysUtils, Variants, Classes, ShellApi, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls;constWM_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;
//FICON:TIcon;
public { Public declarations } end;
var FrmMain: TFrmMain;
gbCanClose: Boolean;implementationprocedure 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.FormCreate(Sender: TObject);
begin
FormStyle := fsStayOnTop;SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);gbCanClose := False;Timer1.Interval := 1000;Timer1.Enabled := True;// SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
end;
{$R *.dfm}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.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;varHDesk_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);vardwThreadID : DWORD;
begin
CreateThread(nil, 0, @SendHokKey, nil, 0, dwThreadID);
end;
end.
用原来问题的位置,原来的问题没有解决,是用Timer 做了一个自动关机程序,系统锁定后,关不了机有说要用线程,现在用线程这样做: procedure TcloseThread.Execute;
begin
while now() < Unit1.tido
//ti是关机时间 begin
sleep(10000);
if now() > Unit1.ti then
begin
if Operate='close' then
begin
Form1.closecomputer(EWX_POWEROFF);
end else
if Operate='logout' then
Form1.closecomputer(EWX_LOGOFF) else
if Operate='repeat' then
Form1.closecomputer(EWX_REBOOT);
//调用主线程关机过程 //调用主线程重起过程 //调用主线程注销过程 end;
end;
系统锁定后一样关不了机,不锁定可以关机那位神仙指点迷津