zoukankan      html  css  js  c++  java

  • 创建具有托盘的服务程序的实例分析[转]

     Windows 2000/XP和2003等支持一种叫做"服务程序"的东西.程序作为服务启动有以下几个好处: 


          (1)不用登陆进系统即可运行.
          (2)具有SYSTEM特权.所以你在进程管理器里面是无法结束它的.

          笔者在2003年为一公司开发机顶盒项目的时候,曾经写过课件上传和媒体服务,下面就介绍一下如何用Delphi7创建一个Service程序. 
          运行Delphi7,选择菜单File-->New-->Other--->Service Application.将生成一个服务程序的框架.将工程保存为ServiceDemo.dpr和Unit_Main.pas,然后回到主框架.我们注意到,Service有几个属性.其中以下几个是我们比较常用的:

          (1)DisplayName:服务的显示名称
          (2)Name:服务名称.

          我们在这里将DisplayName的值改为"Delphi服务演示程序",Name改为"DelphiService".编译这个项目,将得到ServiceDemo.exe.这已经是一个服务程序了!进入CMD模式,切换致工程所在目录,运行命令"ServiceDemo.exe /install",将提示服务安装成功!然后"net start DelphiService"将启动这个服务.进入控制面版-->管理工具-->服务,将显示这个服务和当前状态.不过这个服务现在什么也干不了,因为我们还没有写代码:)先"net stop DelphiService"停止再"ServiceDemo.exe /uninstall"删除这个服务.回到Delphi7的IDE.

          我们的计划是为这个服务添加一个主窗口,运行后任务栏显示程序的图标,双击图标将显示主窗口,上面有一个按钮,点击该按钮将实现Ctrl+Alt+Del功能.

          实际上,服务程序莫认是工作于Winlogon桌面的,可以打开控制面板,查看我们刚才那个服务的属性-->登陆,其中"允许服务与桌面交互"是不打钩的.怎么办?呵呵,回到IDE,注意那个布尔属性:Interactive,当这个属性为True的时候,该服务程序就可以与桌面交互了.

          File-->New-->Form为服务添加窗口FrmMain,单元保存为Unit_FrmMain,并且把这个窗口设置为手工创建.完成后的代码如下:

    view plainprint?
    1. unit Unit_Main;  
    2.   
    3. interface  
    4.   
    5. uses  
    6. Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, Unit_FrmMain;  
    7.   
    8. type  
    9. TDelphiService = class(TService)  
    10. procedure ServiceContinue(Sender: TService; var Continued: Boolean);  
    11. procedure ServiceExecute(Sender: TService);  
    12. procedure ServicePause(Sender: TService; var Paused: Boolean);  
    13. procedure ServiceShutdown(Sender: TService);  
    14. procedure ServiceStart(Sender: TService; var Started: Boolean);  
    15. procedure ServiceStop(Sender: TService; var Stopped: Boolean);  
    16. private  
    17. { Private declarations }  
    18. public  
    19. function GetServiceController: TServiceController; override;  
    20. { Public declarations }  
    21. end;  
    22.   
    23. var  
    24. DelphiService: TDelphiService;  
    25. FrmMain: TFrmMain;  
    26. implementation  
    27.   
    28. {$R *.DFM}  
    29.   
    30. procedure ServiceController(CtrlCode: DWord); stdcall;  
    31. begin  
    32.      DelphiService.Controller(CtrlCode);  
    33. end;  
    34.   
    35. function TDelphiService.GetServiceController: TServiceController;  
    36. begin  
    37.      Result := ServiceController;  
    38. end;  
    39.   
    40. procedure TDelphiService.ServiceContinue(Sender: TService;  
    41. var Continued: Boolean);  
    42. begin  
    43.     while not Terminated do  
    44.     begin  
    45.        Sleep(10);  
    46.        ServiceThread.ProcessRequests(False);  
    47.     end;  
    48. end;  
    49.   
    50. procedure TDelphiService.ServiceExecute(Sender: TService);  
    51. begin  
    52.     while not Terminated do  
    53.     begin  
    54.        Sleep(10);  
    55.        ServiceThread.ProcessRequests(False);  
    56.     end;  
    57. end;  
    58.   
    59. procedure TDelphiService.ServicePause(Sender: TService;  
    60. var Paused: Boolean);  
    61. begin  
    62.      Paused := True;  
    63. end;  
    64.   
    65. procedure TDelphiService.ServiceShutdown(Sender: TService);  
    66. begin  
    67.      gbCanClose := true;  
    68.      FrmMain.Free;  
    69.      Status := csStopped;  
    70.      ReportStatus();  
    71. end;  
    72.   
    73. procedure TDelphiService.ServiceStart(Sender: TService;  
    74. var Started: Boolean);  
    75. begin  
    76.      Started := True;  
    77.      Svcmgr.Application.CreateForm(TFrmMain, FrmMain);  
    78.      gbCanClose := False;  
    79.      FrmMain.Hide;  
    80. end;  
    81.   
    82. procedure TDelphiService.ServiceStop(Sender: TService;  
    83. var Stopped: Boolean);  
    84. begin  
    85.      Stopped := True;  
    86.      gbCanClose := True;  
    87.      FrmMain.Free;  
    88. end;  
    89.   
    90. end.  

    主窗口单元如下:

    view plainprint?
    1. unit Unit_FrmMain;  
    2.   
    3. interface  
    4.   
    5. uses  
    6. Windows, Messages, SysUtils, Variants, Classes, ShellApi, Graphics, Controls, Forms,  
    7. Dialogs, ExtCtrls, StdCtrls;  
    8.   
    9. const  
    10. WM_TrayIcon = WM_USER + 1234;  
    11. type  
    12. TFrmMain = class(TForm)  
    13. Timer1: TTimer;  
    14. Button1: TButton;  
    15. procedure FormCreate(Sender: TObject);  
    16. procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);  
    17. procedure FormDestroy(Sender: TObject);  
    18. procedure Timer1Timer(Sender: TObject);  
    19. procedure Button1Click(Sender: TObject);  
    20. private  
    21. { Private declarations }  
    22. IconData: TNotifyIconData;  
    23. procedure AddIconToTray;  
    24. procedure DelIconFromTray;  
    25. procedure TrayIconMessage(var Msg: TMessage); message WM_TrayIcon;  
    26. procedure SysButtonMsg(var Msg: TMessage); message WM_SYSCOMMAND;  
    27. public  
    28. { Public declarations }  
    29. end;  
    30.   
    31. var  
    32. FrmMain: TFrmMain;  
    33. gbCanClose: Boolean;  
    34. implementation  
    35.   
    36. {$R *.dfm}  
    37.   
    38. procedure TFrmMain.FormCreate(Sender: TObject);  
    39. begin  
    40.      FormStyle := fsStayOnTop; {窗口最前}  
    41.      SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW); {不在任务栏显示}  
    42.      gbCanClose := False;  
    43.      Timer1.Interval := 1000;  
    44.      Timer1.Enabled := True;  
    45. end;  
    46.   
    47. procedure TFrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);  
    48. begin  
    49.      CanClose := gbCanClose;  
    50.     if not CanClose then  
    51.     begin  
    52.        Hide;  
    53.     end;  
    54. end;  
    55.   
    56. procedure TFrmMain.FormDestroy(Sender: TObject);  
    57. begin  
    58.      Timer1.Enabled := False;  
    59.      DelIconFromTray;  
    60. end;  
    61.   
    62. procedure TFrmMain.AddIconToTray;  
    63. begin  
    64.      ZeroMemory(@IconData, SizeOf(TNotifyIconData));  
    65.      IconData.cbSize := SizeOf(TNotifyIconData);  
    66.      IconData.Wnd := Handle;  
    67.      IconData.uID := 1;  
    68.      IconData.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;  
    69.      IconData.uCallbackMessage := WM_TrayIcon;  
    70.      IconData.hIcon := Application.Icon.Handle;  
    71.      IconData.szTip := 'Delphi服务演示程序';  
    72.      Shell_NotifyIcon(NIM_ADD, @IconData);  
    73. end;  
    74.   
    75. procedure TFrmMain.DelIconFromTray;  
    76. begin  
    77.      Shell_NotifyIcon(NIM_DELETE, @IconData);  
    78. end;  
    79.   
    80. procedure TFrmMain.SysButtonMsg(var Msg: TMessage);  
    81. begin  
    82.     if (Msg.wParam = SC_CLOSE) or  
    83.      (Msg.wParam = SC_MINIMIZE) then Hide  
    84.     else inherited; // 执行默认动作  
    85. end;  
    86.   
    87. procedure TFrmMain.TrayIconMessage(var Msg: TMessage);  
    88. begin  
    89.     if (Msg.LParam = WM_LBUTTONDBLCLK) then Show();  
    90. end;  
    91.   
    92. procedure TFrmMain.Timer1Timer(Sender: TObject);  
    93. begin  
    94.      AddIconToTray;  
    95. end;  
    96.   
    97. procedure SendHokKey;stdcall;  
    98. var  
    99. HDesk_WL: HDESK;  
    100. begin  
    101.      HDesk_WL := OpenDesktop ('Winlogon', 0, False, DESKTOP_JOURNALPLAYBACK);  
    102.     if (HDesk_WL <> 0) then  
    103.     if (SetThreadDesktop (HDesk_WL) = True) then  
    104.      PostMessage(HWND_BROADCAST, WM_HOTKEY, 0, MAKELONG (MOD_ALT or MOD_CONTROL, VK_DELETE));  
    105. end;  
    106.   
    107. procedure TFrmMain.Button1Click(Sender: TObject);  
    108. var  
    109. dwThreadID : DWORD;  
    110. begin  
    111.      CreateThread(nil, 0, @SendHokKey, nil, 0, dwThreadID);  
    112. end;  
    113.   
    114. end.  

    应用程序：ServiceDemo
    view plainprint?
    1. program ServiceDemo;  
    2.   
    3. uses  
    4. SvcMgr,  
    5. Unit_Main in 'Unit_Main.pas' {DelphiService: TService},  
    6. Unit_frmMain in 'Unit_frmMain.pas' {frmMain};  
    7.   
    8. {$R *.RES}  
    9.   
    10. begin  
    11.      Application.Initialize;  
    12.      Application.CreateForm(TDelphiService, DelphiService);  
    13.      Application.Run;  
    14. end.  

    窗体代码如下:
    view plainprint?
    1. object DelphiService: TDelphiService  
    2. OldCreateOrder = False  
    3. DisplayName = 'Delphi服务演示程序'  
    4. Interactive = True  
    5. OnContinue = ServiceContinue  
    6. OnExecute = ServiceExecute  
    7. OnPause = ServicePause  
    8. OnShutdown = ServiceShutdown  
    9. OnStart = ServiceStart  
    10. OnStop = ServiceStop  
    11. Left = 261  
    12. Top = 177  
    13. Height = 150  
    14. Width = 215  
    15. end  
    16.   
    17. object frmMain: TfrmMain  
    18. Left = 192  
    19. Top = 107  
    20. Width = 696  
    21. Height = 480  
    22. Caption = '我的服务测试程序'  
    23. Color = clBtnFace  
    24. Font.Charset = DEFAULT_CHARSET  
    25. Font.Color = clWindowText  
    26. Font.Height = -11  
    27. Font.Name = 'MS Sans Serif'  
    28. Font.Style = []  
    29. OldCreateOrder = False  
    30. OnCloseQuery = FormCloseQuery  
    31. OnCreate = FormCreate  
    32. OnDestroy = FormDestroy  
    33. PixelsPerInch = 96  
    34. TextHeight = 13  
    35. object Button1: TButton  
    36. Left = 296  
    37. Top = 264  
    38. Width = 75  
    39. Height = 25  
    40. Caption = 'Button1'  
    41. TabOrder = 0  
    42. OnClick = Button1Click  
    43. end  
    44. object Timer1: TTimer  
    45. OnTimer = Timer1Timer  
    46. Left = 120  
    47. Top = 192  
    48. end  
    49. end   

    补充:
    (1)关于更多服务程序的演示程序,请访问以下Url:http://www.torry.net/pages.php?id=226,上面包含了多个演示如何控制和管理系统服务的代码.

    (2)请切记:Windows实际上存在多个桌面.例如屏幕传输会出现白屏,可能有两个原因:一是系统处于锁定或未登陆桌面,二是处于屏幕保护桌面.这时候要将当前桌面切换到该桌面才能抓屏.

    (3)关于服务程序与桌面交互,还有种动态切换方法.大概单元如下:

    view plainprint?
    1. unit ServiceDesktop;  
    2.   
    3. interface  
    4.   
    5. function InitServiceDesktop: boolean;  
    6. procedure DoneServiceDeskTop;  
    7.   
    8. implementation  
    9.   
    10. uses Windows, SysUtils;  
    11.   
    12. const  
    13. DefaultWindowStation = WinSta0;  
    14. DefaultDesktop = Default;  
    15. var  
    16. hwinstaSave: HWINSTA;  
    17. hdeskSave: HDESK;  
    18. hwinstaUser: HWINSTA;  
    19. hdeskUser: HDESK;  
    20. function InitServiceDesktop: boolean;  
    21. var  
    22. dwThreadId: DWORD;  
    23. begin  
    24. dwThreadId := GetCurrentThreadID;  
    25. // Ensure connection to service window station and desktop, and  
    26. // save their handles.  
    27. hwinstaSave := GetProcessWindowStation;  
    28. hdeskSave := GetThreadDesktop(dwThreadId);  
    29.   
    30.   
    31. hwinstaUser := OpenWindowStation(DefaultWindowStation, FALSE, MAXIMUM_ALLOWED);  
    32. if hwinstaUser = 0 then  
    33. begin  
    34. OutputDebugString(PChar(OpenWindowStation failed + SysErrorMessage(GetLastError)));  
    35. Result := false;  
    36. exit;  
    37. end;  
    38.   
    39. if not SetProcessWindowStation(hwinstaUser) then  
    40. begin  
    41. OutputDebugString(SetProcessWindowStation failed);  
    42. Result := false;  
    43. exit;  
    44. end;  
    45.   
    46. hdeskUser := OpenDesktop(DefaultDesktop, 0, FALSE, MAXIMUM_ALLOWED);  
    47. if hdeskUser = 0 then  
    48. begin  
    49. OutputDebugString(OpenDesktop failed);  
    50. SetProcessWindowStation(hwinstaSave);  
    51. CloseWindowStation(hwinstaUser);  
    52. Result := false;  
    53. exit;  
    54. end;  
    55. Result := SetThreadDesktop(hdeskUser);  
    56. if not Result then  
    57. OutputDebugString(PChar(SetThreadDesktop + SysErrorMessage(GetLastError)));  
    58. end;  
    59.   
    60. procedure DoneServiceDeskTop;  
    61. begin  
    62. // Restore window station and desktop.  
    63. SetThreadDesktop(hdeskSave);  
    64. SetProcessWindowStation(hwinstaSave);  
    65. if hwinstaUser <> 0 then  
    66. CloseWindowStation(hwinstaUser);  
    67. if hdeskUser <> 0 then  
    68. CloseDesktop(hdeskUser);  
    69. end;  
    70.   
    71. initialization  
    72. InitServiceDesktop;  
    73. finalization  
    74. DoneServiceDesktop;  
    75. end.  


    更详细的演示代码请参看:http://www.torry.net/samples/samples/os/isarticle.zip

    (4)关于安装服务如何添加服务描述.有两种方法:一是修改注册表.服务的详细信息都位于HKEY_LOCAL_MACHINE/SYSTEM/ ControlSet001/Services/下面,例如我们刚才那个服务就位于HKEY_LOCAL_MACHINE/SYSTEM/ ControlSet001/Services/DelphiService下.第二种方法就是先用QueryServiceConfig2函数获取服务信息,然后ChangeServiceConfig2来改变描述.用Delphi实现的话,单元如下:

    view plainprint?
    1. unit WinSvcEx;  
    2.   
    3. interface  
    4.   
    5. uses Windows, WinSvc;  
    6.   
    7. const  
    8. //  
    9. // Service config info levels  
    10. //  
    11. SERVICE_CONFIG_DESCRIPTION = 1;  
    12. SERVICE_CONFIG_FAILURE_ACTIONS = 2;  
    13. //  
    14. // DLL name of imported functions  
    15. //  
    16. AdvApiDLL = advapi32.dll;  
    17. type  
    18. //  
    19. // Service description string  
    20. //  
    21. PServiceDescriptionA = ^TServiceDescriptionA;  
    22. PServiceDescriptionW = ^TServiceDescriptionW;  
    23. PServiceDescription = PServiceDescriptionA;  
    24. {$EXTERNALSYM _SERVICE_DESCRIPTIONA}  
    25. _SERVICE_DESCRIPTIONA = record  
    26. lpDescription : PAnsiChar;  
    27. end;  
    28. {$EXTERNALSYM _SERVICE_DESCRIPTIONW}  
    29. _SERVICE_DESCRIPTIONW = record  
    30. lpDescription : PWideChar;  
    31. end;  
    32. {$EXTERNALSYM _SERVICE_DESCRIPTION}  
    33. _SERVICE_DESCRIPTION = _SERVICE_DESCRIPTIONA;  
    34. {$EXTERNALSYM SERVICE_DESCRIPTIONA}  
    35. SERVICE_DESCRIPTIONA = _SERVICE_DESCRIPTIONA;  
    36. {$EXTERNALSYM SERVICE_DESCRIPTIONW}  
    37. SERVICE_DESCRIPTIONW = _SERVICE_DESCRIPTIONW;  
    38. {$EXTERNALSYM SERVICE_DESCRIPTION}  
    39. SERVICE_DESCRIPTION = _SERVICE_DESCRIPTIONA;  
    40. TServiceDescriptionA = _SERVICE_DESCRIPTIONA;  
    41. TServiceDescriptionW = _SERVICE_DESCRIPTIONW;  
    42. TServiceDescription = TServiceDescriptionA;  
    43.   
    44. //  
    45. // Actions to take on service failure  
    46. //  
    47. {$EXTERNALSYM _SC_ACTION_TYPE}  
    48. _SC_ACTION_TYPE = (SC_ACTION_NONE, SC_ACTION_RESTART, SC_ACTION_REBOOT, SC_ACTION_RUN_COMMAND);  
    49. {$EXTERNALSYM SC_ACTION_TYPE}  
    50. SC_ACTION_TYPE = _SC_ACTION_TYPE;  
    51.   
    52. PServiceAction = ^TServiceAction;  
    53. {$EXTERNALSYM _SC_ACTION}  
    54. _SC_ACTION = record  
    55. aType : SC_ACTION_TYPE;  
    56. Delay : DWORD;  
    57. end;  
    58. {$EXTERNALSYM SC_ACTION}  
    59. SC_ACTION = _SC_ACTION;  
    60. TServiceAction = _SC_ACTION;  
    61.   
    62. PServiceFailureActionsA = ^TServiceFailureActionsA;  
    63. PServiceFailureActionsW = ^TServiceFailureActionsW;  
    64. PServiceFailureActions = PServiceFailureActionsA;  
    65. {$EXTERNALSYM _SERVICE_FAILURE_ACTIONSA}  
    66. _SERVICE_FAILURE_ACTIONSA = record  
    67. dwResetPeriod : DWORD;  
    68. lpRebootMsg : LPSTR;  
    69. lpCommand : LPSTR;  
    70. cActions : DWORD;  
    71. lpsaActions : ^SC_ACTION;  
    72. end;  
    73. {$EXTERNALSYM _SERVICE_FAILURE_ACTIONSW}  
    74. _SERVICE_FAILURE_ACTIONSW = record  
    75. dwResetPeriod : DWORD;  
    76. lpRebootMsg : LPWSTR;  
    77. lpCommand : LPWSTR;  
    78. cActions : DWORD;  
    79. lpsaActions : ^SC_ACTION;  
    80. end;  
    81. {$EXTERNALSYM _SERVICE_FAILURE_ACTIONS}  
    82. _SERVICE_FAILURE_ACTIONS = _SERVICE_FAILURE_ACTIONSA;  
    83. {$EXTERNALSYM SERVICE_FAILURE_ACTIONSA}  
    84. SERVICE_FAILURE_ACTIONSA = _SERVICE_FAILURE_ACTIONSA;  
    85. {$EXTERNALSYM SERVICE_FAILURE_ACTIONSW}  
    86. SERVICE_FAILURE_ACTIONSW = _SERVICE_FAILURE_ACTIONSW;  
    87. {$EXTERNALSYM SERVICE_FAILURE_ACTIONS}  
    88. SERVICE_FAILURE_ACTIONS = _SERVICE_FAILURE_ACTIONSA;  
    89. TServiceFailureActionsA = _SERVICE_FAILURE_ACTIONSA;  
    90. TServiceFailureActionsW = _SERVICE_FAILURE_ACTIONSW;  
    91. TServiceFailureActions = TServiceFailureActionsA;  
    92.   
    93. ///////////////////////////////////////////////////////////////////////////  
    94. // API Function Prototypes  
    95. ///////////////////////////////////////////////////////////////////////////  
    96. TQueryServiceConfig2 = function (hService : SC_HANDLE; dwInfoLevel : DWORD; lpBuffer : pointer;  
    97. cbBufSize : DWORD; var pcbBytesNeeded) : BOOL; stdcall;  
    98. TChangeServiceConfig2 = function (hService : SC_HANDLE; dwInfoLevel : DWORD; lpInfo : pointer) : BOOL; stdcall;  
    99.   
    100. var  
    101. hDLL : THandle ;  
    102. LibLoaded : boolean ;  
    103.   
    104. var  
    105. OSVersionInfo : TOSVersionInfo;  
    106.   
    107. {$EXTERNALSYM QueryServiceConfig2A}  
    108. QueryServiceConfig2A : TQueryServiceConfig2;  
    109. {$EXTERNALSYM QueryServiceConfig2W}  
    110. QueryServiceConfig2W : TQueryServiceConfig2;  
    111. {$EXTERNALSYM QueryServiceConfig2}  
    112. QueryServiceConfig2 : TQueryServiceConfig2;  
    113.   
    114. {$EXTERNALSYM ChangeServiceConfig2A}  
    115. ChangeServiceConfig2A : TChangeServiceConfig2;  
    116. {$EXTERNALSYM ChangeServiceConfig2W}  
    117. ChangeServiceConfig2W : TChangeServiceConfig2;  
    118. {$EXTERNALSYM ChangeServiceConfig2}  
    119. ChangeServiceConfig2 : TChangeServiceConfig2;  
    120.   
    121. implementation  
    122.   
    123. initialization  
    124. OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);  
    125. GetVersionEx(OSVersionInfo);  
    126. if (OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT) and (OSVersionInfo.dwMajorVersion >= 5) then  
    127. begin  
    128. if hDLL = 0 then  
    129. begin  
    130. hDLL:=GetModuleHandle(AdvApiDLL);  
    131. LibLoaded := False;  
    132. if hDLL = 0 then  
    133. begin  
    134. hDLL := LoadLibrary(AdvApiDLL);  
    135. LibLoaded := True;  
    136. end;  
    137. end;  
    138.   
    139. if hDLL <> 0 then  
    140. begin  
    141. @QueryServiceConfig2A := GetProcAddress(hDLL, QueryServiceConfig2A);  
    142. @QueryServiceConfig2W := GetProcAddress(hDLL, QueryServiceConfig2W);  
    143. @QueryServiceConfig2 := @QueryServiceConfig2A;  
    144. @ChangeServiceConfig2A := GetProcAddress(hDLL, ChangeServiceConfig2A);  
    145. @ChangeServiceConfig2W := GetProcAddress(hDLL, ChangeServiceConfig2W);  
    146. @ChangeServiceConfig2 := @ChangeServiceConfig2A;  
    147. end;  
    148. end  
    149. else  
    150. begin  
    151. @QueryServiceConfig2A := nil;  
    152. @QueryServiceConfig2W := nil;  
    153. @QueryServiceConfig2 := nil;  
    154. @ChangeServiceConfig2A := nil;  
    155. @ChangeServiceConfig2W := nil;  
    156. @ChangeServiceConfig2 := nil;  
    157. end;  
    158.   
    159. finalization  
    160. if (hDLL <> 0) and LibLoaded then  
    161. FreeLibrary(hDLL);  
    162.   
    163. end.  

    view plainprint?
    1. unit winntService;  
    2.   
    3. interface  
    4.   
    5. uses  
    6. Windows,WinSvc,WinSvcEx;  
    7.   
    8. function InstallService(const strServiceName,strDisplayName,strDescription,strFilename: string):Boolean;  
    9. //eg:InstallService(服务名称,显示名称,描述信息,服务文件);  
    10. procedure UninstallService(strServiceName:string);  
    11. implementation  
    12.   
    13. function StrLCopy(Dest: PChar; const Source: PChar; MaxLen: Cardinal): PChar; assembler;  
    14. asm  
    15. PUSH EDI  
    16. PUSH ESI  
    17. PUSH EBX  
    18. MOV ESI,EAX  
    19. MOV EDI,EDX  
    20. MOV EBX,ECX  
    21. XOR AL,AL  
    22. TEST ECX,ECX  
    23. JZ @@1  
    24. REPNE SCASB  
    25. JNE @@1  
    26. INC ECX  
    27. @@1: SUB EBX,ECX  
    28. MOV EDI,ESI  
    29. MOV ESI,EDX  
    30. MOV EDX,EDI  
    31. MOV ECX,EBX  
    32. SHR ECX,2  
    33. REP MOVSD  
    34. MOV ECX,EBX  
    35. AND ECX,3  
    36. REP MOVSB  
    37. STOSB  
    38. MOV EAX,EDX  
    39. POP EBX  
    40. POP ESI  
    41. POP EDI  
    42. end;  
    43.   
    44. function StrPCopy(Dest: PChar; const Source: string): PChar;  
    45. begin  
    46. Result := StrLCopy(Dest, PChar(Source), Length(Source));  
    47. end;  
    48.   
    49. function InstallService(const strServiceName,strDisplayName,strDescription,strFilename: string):Boolean;  
    50. var  
    51. //ss : TServiceStatus;  
    52. //psTemp : PChar;  
    53. hSCM,hSCS:THandle;  
    54.   
    55. srvdesc : PServiceDescription;  
    56. desc : string;  
    57. //SrvType : DWord;  
    58.   
    59. lpServiceArgVectors:pchar;  
    60. begin  
    61. Result:=False;  
    62. //psTemp := nil;  
    63. //SrvType := SERVICE_WIN32_OWN_PROCESS and SERVICE_INTERACTIVE_PROCESS;  
    64. hSCM:=OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);//连接服务数据库  
    65. if hSCM=0 then Exit;//MessageBox(hHandle,Pchar(SysErrorMessage(GetLastError)),服务程序管理器,MB_ICONERROR+MB_TOPMOST);  
    66.   
    67.   
    68. hSCS:=CreateService( //创建服务函数  
    69. hSCM, // 服务控制管理句柄  
    70. Pchar(strServiceName), // 服务名称  
    71. Pchar(strDisplayName), // 显示的服务名称  
    72. SERVICE_ALL_ACCESS, // 存取权利  
    73. SERVICE_WIN32_OWN_PROCESS or SERVICE_INTERACTIVE_PROCESS,// 服务类型 SERVICE_WIN32_SHARE_PROCESS  
    74. SERVICE_AUTO_START, // 启动类型  
    75. SERVICE_ERROR_IGNORE, // 错误控制类型  
    76. Pchar(strFilename), // 服务程序  
    77. nil, // 组服务名称  
    78. nil, // 组标识  
    79. nil, // 依赖的服务  
    80. nil, // 启动服务帐号  
    81. nil); // 启动服务口令  
    82. if hSCS=0 then Exit;//MessageBox(hHandle,Pchar(SysErrorMessage(GetLastError)),Pchar(Application.Title),MB_ICONERROR+MB_TOPMOST);  
    83.   
    84. if Assigned(ChangeServiceConfig2) then  
    85. begin  
    86. desc := Copy(strDescription,1,1024);  
    87. GetMem(srvdesc,SizeOf(TServiceDescription));  
    88. GetMem(srvdesc^.lpDescription,Length(desc) + 1);  
    89. try  
    90. StrPCopy(srvdesc^.lpDescription, desc);  
    91. ChangeServiceConfig2(hSCS,SERVICE_CONFIG_DESCRIPTION,srvdesc);  
    92. finally  
    93. FreeMem(srvdesc^.lpDescription);  
    94. FreeMem(srvdesc);  
    95. end;  
    96. end;  
    97. lpServiceArgVectors := nil;  
    98. if not StartService(hSCS, 0, lpServiceArgVectors) then //启动服务  
    99. Exit; //MessageBox(hHandle,Pchar(SysErrorMessage(GetLastError)),Pchar(Application.Title),MB_ICONERROR+MB_TOPMOST);  
    100. CloseServiceHandle(hSCS); //关闭句柄  
    101. Result:=True;  
    102. end;  
    103.   
    104. procedure UninstallService(strServiceName:string);  
    105. var  
    106. SCManager: SC_HANDLE;  
    107. Service: SC_HANDLE;  
    108. Status: TServiceStatus;  
    109. begin  
    110. SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);  
    111. if SCManager = 0 then Exit;  
    112. try  
    113. Service := OpenService(SCManager, Pchar(strServiceName), SERVICE_ALL_ACCESS);  
    114. ControlService(Service, SERVICE_CONTROL_STOP, Status);  
    115. DeleteService(Service);  
    116. CloseServiceHandle(Service);  
    117. finally  
    118. CloseServiceHandle(SCManager);  
    119. end;  
    120. end;  
    121.   
    122. end.  

    (5)如何暴力关闭一个服务程序,实现我们以前那个"NT工具箱"的功能?首先,根据进程名称来杀死进程是用以下函数:

    view plainprint?
    1. uses Tlhelp32;  
    2.   
    3. function KillTask(ExeFileName: string): Integer;  
    4. const  
    5. PROCESS_TERMINATE = 01;  
    6. var  
    7. ContinueLoop: BOOL;  
    8. FSnapshotHandle: THandle;  
    9. FProcessEntry32: TProcessEntry32;  
    10. begin  
    11. Result := 0;  
    12. FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);  
    13. FProcessEntry32.dwSize := SizeOf(FProcessEntry32);  
    14. ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);  
    15.   
    16. while Integer(ContinueLoop) <> 0 do  
    17. begin  
    18. if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =  
    19. UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =  
    20. UpperCase(ExeFileName))) then  
    21. Result := Integer(TerminateProcess(  
    22. OpenProcess(PROCESS_TERMINATE,  
    23. BOOL(0),  
    24. FProcessEntry32.th32ProcessID),  
    25. 0));  
    26. ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);  
    27. end;  
    28. CloseHandle(FSnapshotHandle);  
    29. end;  
    30.   
    31. 但是对于服务程序,它会提示"拒绝访问".其实只要程序拥有Debug权限即可:  
    32. function EnableDebugPrivilege: Boolean;  
    33. function EnablePrivilege(hToken: Cardinal; PrivName: string; bEnable: Boolean): Boolean;  
    34. var  
    35. TP: TOKEN_PRIVILEGES;  
    36. Dummy: Cardinal;  
    37. begin  
    38. TP.PrivilegeCount := 1;  
    39. LookupPrivilegeValue(nil, pchar(PrivName), TP.Privileges[0].Luid);  
    40. if bEnable then  
    41. TP.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED  
    42. else TP.Privileges[0].Attributes := 0;  
    43. AdjustTokenPrivileges(hToken, False, TP, SizeOf(TP), nil, Dummy);  
    44. Result := GetLastError = ERROR_SUCCESS;  
    45. end;  
    46.   
    47. var  
    48. hToken: Cardinal;  
    49. begin  
    50. OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, hToken);  
    51. result:=EnablePrivilege(hToken, SeDebugPrivilege, True);  
    52. CloseHandle(hToken);  
    53. end;  

    使用方法:
    EnableDebugPrivilege;//提升权限
    KillTask(xxxx.exe);//关闭该服务程序.  
    谢祥选【小宇飞刀(xieyunc)】
  • 相关阅读:
    jenkins构建时报错
    linux查看系统信息
    去掉jenkins的首页警告
    zabbix_server 报警
    OSI七层模型
    linux时间格式总结
    linux系统 lsof命令详解
    SharePoint 2010 用户权限和权限级别
    Error occurred in deployment step 'Activate Features': Unable to locate the workflow's association data.
    使用 Response.Write 向页面body中输出指定html
  • 原文地址：https://www.cnblogs.com/xieyunc/p/9126688.html
Copyright © 2011-2022 走看看