国产探花免费观看_亚洲丰满少妇自慰呻吟_97日韩有码在线_资源在线日韩欧美_一区二区精品毛片,辰东完美世界有声小说,欢乐颂第一季,yy玄幻小说排行榜完本

首頁 > 學院 > 開發設計 > 正文

創建具有托盤的服務程序

2019-11-18 17:57:51
字體:
來源:轉載
供稿:網友

我的主頁: http://www.tommstudio.com/

Windows 2000/XP和2003等支持一種叫做"服務程序"的東西.程序作為服務啟動有以下幾個好處:

    (1)不用登陸進系統即可運行.
    (2)具有SYSTEM特權.所以你在進程管理器里面是無法結束它的.

    筆者在2003年為一公司開發機頂盒項目的時候,曾經寫過課件上傳和媒體服務,下面就介紹一下如何用Delphi7創建一個Service程序.
    運行Delphi7,選擇菜單File-->New-->Other--->Service application.將生成一個服務程序的框架.將工程保存為ServiceDemo.d
    我們的計劃是為這個服務添加一個主窗口,運行后任務欄顯示程序的圖標,雙擊圖標將顯示主窗口,上面有一個按鈕,點擊該按鈕將實現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
  DelphiService.Controller(CtrlCode);
end;

function TDelphiService.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;

procedure TDelphiService.ServiceContinue(Sender: TService;
var Continued: Boolean);
begin
  while not Terminated do
  begin
    Sleep(10);
    ServiceThread.ProcessRequests(False);
  end;
end;

procedure TDelphiService.ServiceExecute(Sender: TService);
begin
  while not Terminated do
  begin
    Sleep(10);
    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.Hide;
end;

procedure TDelphiService.ServiceStop(Sender: TService;
var Stopped: Boolean);
begin
  Stopped := True;
  gbCanClose := True;
  FrmMain.Free;
end;

end.



主窗口單元如下:


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;
  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);
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.

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.Run;
end.




窗體代碼如下:


object DelphiService: TDelphiService
OldCreateOrder = False
DisplayName = 'Delphi服務演示程序'
Interactive = True
OnContinue = ServiceContinue
OnExecute = ServiceExecute
OnPause = ServicePause
OnShutdown = ServiceShutdown
OnStart = ServiceStart
OnStop = ServiceStop
Left = 261
Top = 177
Height = 150
Width = 215
end

object frmMain: TfrmMain
Left = 192
Top = 107
Width = 696
Height = 480
Caption = '我的服務測試程序'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCloseQuery = FormCloseQuery
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object Button1: TButton
Left = 296
Top = 264
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 0
OnClick = Button1Click
end
object Timer1: TTimer
OnTimer = Timer1Timer
Left = 120
Top = 192
end
end





上一篇:創建一個簡單的&quot;專家&quot;

下一篇:實現VirtualTree的Editor的功能定制之setBounds

發表評論 共有條評論
用戶名: 密碼:
驗證碼: 匿名發表
學習交流
熱門圖片

新聞熱點

疑難解答

圖片精選

網友關注

主站蜘蛛池模板: 邵阳市| 贺兰县| 迁西县| 永德县| 喀喇沁旗| 凤冈县| 西宁市| 青冈县| 唐山市| 玉树县| 合江县| 交口县| 康定县| 黑山县| 云和县| 罗山县| 始兴县| 和平县| 岐山县| 策勒县| 资兴市| 潢川县| 普兰县| 靖西县| 当阳市| 奉贤区| 台南县| 南乐县| 鞍山市| 汶川县| 普格县| 措勤县| 香河县| 旺苍县| 祁东县| 阿城市| 思茅市| 河津市| 犍为县| 伊吾县| 东城区|