小技巧：用Delphi創建服務程序

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;
　　

From:http://tw.wingwit.com/Article/program/Delphi/201311/8444.html