熱點推薦:
您现在的位置: 電腦知識網 >> 編程 >> Delphi編程 >> 正文

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

2013-11-11 21:04:56  來源: 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
    推薦文章
    Copyright © 2005-2013 電腦知識網 Computer Knowledge   All rights reserved.