Windows
/XP和
等支持一种叫做
服务程序
的东西
程序作为服务启动有以下几个好处:
()不用登陆进系统即可运行
()具有SYSTEM特权所以你在进程管理器里面是无法结束它的
笔者在年为一公司开发机顶盒项目的时候曾经写过课件上传和媒体服务下面就介绍一下如何用Delphi创建一个Service程序
运行Delphi选择菜单File>New>Other>Service Application将生成一个服务程序的框架将工程保存为ServiceDemodpr和Unit_Mainpas然后回到主框架我们注意到Service有几个属性其中以下几个是我们比较常用的:
()DisplayName:服务的显示名称
()Name:服务名称
我们在这里将DisplayName的值改为Delphi服务演示程序Name改为DelphiService编译这个项目将得到ServiceDemoexe这已经是一个服务程序了!进入CMD模式切换致工程所在目录运行命令ServiceDemoexe /install将提示服务安装成功!然后net start DelphiService将启动这个服务进入控制面版>管理工具>服务将显示这个服务和当前状态不过这个服务现在什么也干不了因为我们还没有写代码:)先net stop DelphiService停止再ServiceDemoexe /uninstall删除这个服务回到Delphi的IDE
我们的计划是为这个服务添加一个主窗口运行后任务栏显示程序的图标双击图标将显示主窗口上面有一个按钮点击该按钮将实现Ctrl+Alt+Del功能
实际上服务程序莫认是工作于Winlogon桌面的可以打开控制面板查看我们刚才那个服务的属性>登陆其中允许服务与桌面交互是不打钩的怎么办?呵呵回到IDE注意那个布尔属性:Interactive当这个属性为True的时候该服务程序就可以与桌面交互了
File>New>Form为服务添加窗口FrmMain单元保存为Unit_FrmMain并且把这个窗口设置为手工创建完成后的代码如下:
unit Unit_Main;
interface
uses
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
{$R *DFM}
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
DelphiServiceController(CtrlCode);
end;
function TDelphiServiceGetServiceController: TServiceController;
begin
Result := ServiceController;
end;
procedure TDelphiServiceServiceContinue(Sender: TService;
var Continued: Boolean);
begin
while not Terminated do
begin
Sleep();
ServiceThreadProcessRequests(False);
end;
end;
procedure TDelphiServiceServiceExecute(Sender: TService);
begin
while not Terminated do
begin
Sleep();
ServiceThreadProcessRequests(False);
end;
end;
procedure TDelphiServiceServicePause(Sender: TService;
var Paused: Boolean);
begin
Paused := True;
end;
procedure TDelphiServiceServiceShutdown(Sender: TService);
begin
gbCanClose := true;
FrmMainFree;
Status := csStopped;
ReportStatus();
end;
procedure TDelphiServiceServiceStart(Sender: TService;
var Started: Boolean);
begin
Started := True;
SvcmgrApplicationCreateForm(TFrmMain FrmMain);
gbCanClose := False;
FrmMainHide;
end;
procedure TDelphiServiceServiceStop(Sender: TService;
var Stopped: Boolean);
begin
Stopped := True;
gbCanClose := True;
FrmMainFree;
end;
end
主窗口单元如下:
unit Unit_FrmMain;
interface
uses
Windows Messages SysUtils Variants Classes ShellApi Graphics Controls Forms
Dialogs ExtCtrls StdCtrls;
const
WM_TrayIcon = WM_USER + ;
type
TFrmMain = class(TForm)
Timer: TTimer;
Button: TButton;
procedure FormCreate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FormDestroy(Sender: TObject);
procedure TimerTimer(Sender: TObject);
procedure ButtonClick(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 TFrmMainFormCreate(Sender: TObject);
begin
FormStyle := fsStayOnTop; {窗口最前}
SetWindowLong(ApplicationHandle GWL_EXSTYLE WS_EX_TOOLWINDOW); {不在任务栏显示}
gbCanClose := False;
TimerInterval := ;
TimerEnabled := True;
end;
procedure TFrmMainFormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := gbCanClose;
if not CanClose then
begin
Hide;
end;
end;
procedure TFrmMainFormDestroy(Sender: TObject);
begin
TimerEnabled := False;
DelIconFromTray;
end;
procedure TFrmMainAddIconToTray;
begin
ZeroMemory(@IconData SizeOf(TNotifyIconData));
IconDatacbSize := SizeOf(TNotifyIconData);
IconDataWnd := Handle;
IconDatauID := ;
IconDatauFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
IconDatauCallbackMessage := WM_TrayIcon;
IconDatahIcon := ApplicationIconHandle;
IconDataszTip := Delphi服务演示程序;
Shell_NotifyIcon(NIM_ADD @IconData);
end;
procedure TFrmMainDelIconFromTray;
begin
Shell_NotifyIcon(NIM_DELETE @IconData);
end;
procedure TFrmMainSysButtonMsg(var Msg: TMessage);
begin
if (MsgwParam = SC_CLOSE) or
(MsgwParam = SC_MINIMIZE) then Hide
else inherited; // 执行默认动作
end;
procedure TFrmMainTrayIconMessage(var Msg: TMessage);
begin
if (MsgLParam = WM_LBUTTONDBLCLK) then Show();
end;
procedure TFrmMainTimerTimer(Sender: TObject);
begin
AddIconToTray;
end;
procedure SendHokKey;stdcall;
var
HDesk_WL: HDESK;
begin
HDesk_WL := OpenDesktop (Winlogon False DESKTOP_JOURNALPLAYBACK);
if (HDesk_WL <> ) then
if (SetThreadDesktop (HDesk_WL) = True) then
PostMessage(HWND_BROADCAST WM_HOTKEY MAKELONG (MOD_ALT or MOD_CONTROL VK_DELETE));
end;
procedure TFrmMainButtonClick(Sender: TObject);
var
dwThreadID : DWORD;
begin
CreateThread(nil @SendHokKey nil dwThreadID);
end;
end
补充:
()关于更多服务程序的演示程序请访问以下Url:?id=上面包含了多个演示如何控制和管理系统服务的代码
()请切记:Windows实际上存在多个桌面例如屏幕传输会出现白屏可能有两个原因:一是系统处于锁定或未登陆桌面二是处于屏幕保护桌面这时候要将当前桌面切换到该桌面才能抓屏
()关于服务程序与桌面交互还有种动态切换方法大概单元如下:
unit ServiceDesktop;
