ce; 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.
主窗口单元如下:
3 / 17
unit Unit_FrmMain; interface uses Windows, Messages, SysUtils, Variants, Classes, ShellApi, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls; 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 { 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;
4 / 17
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);
5 / 17
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.
补充: (1) 关 于 更 多 服 务 程 序 的 演 示 程 序 , 请 访 问 以 下 Url:torry.net/pages.php?id=226,上面包含了多个演示如何控制和
管理系统服 务的代码. (2)请切记:Windows 实际上存在多个桌面.例如屏幕传输会出现白屏,可能有两个原因:一是
系统处于锁定或未登陆桌面,二是处于屏幕保护桌面.这时候要将当前桌面切换到该桌面才能 抓屏. (3)关于服务程