Delphi托盘问题

Posted 2023-04-12

我用AppTrayIcon已经写好托盘了问题是 鼠标指向托盘处的图标怎么提示消息都没有如何让它显示一个标题呢 犹如腾讯QQ 显示QQ名称和号码一样

兄弟一句一句解释还不如我分3部介绍3部分内容你就明白了!1个记录类型变量,2个API函数.
1,Tnotifyicondata 记录原体:
type
_NOTIFYICONDATAA = record
cbSize: DWORD; cbSize就是你定义的NotifyIcon变量的大小，用SizeOf(TNotifyIconData)可以取得，
Wnd: HWND; Wnd是一个句柄，你希望托盘程序产生的消息有哪个窗体来处理就让Wnd指向那个窗体.
uID: UINT; uID:如果你要创建多个托盘小程序，那么怎么区分它们呢？就是靠这个ID号来区分。
uFlags: UINT; uFlags是一个标志位，它表示当前所创建的托盘程序具有哪些性质.
NIF_ICON 表示当前所设置的图标（即hIcon的值）是有效的
NIF_MESSAGE 表示当前所设置的系统消息（即uCallBackMessage的值）是有效的
NIF_TIP 表示当前所设置的提示条（即szTip的值）是有效的
uCallbackMessage: UINT;uCallBackMessage这是7个部分里面最重要的一个。这里指定一个回调消息，也就是说这里定义一个消 息名，当你单击或者右击托盘图标的时候就会向你在Wnd所指向的窗体发送一个在uCallBackMessage 中定义的消息名，然后你在程序中定义一个消息出来函数来处理这个消息。这样就把Windows关于消 息的整套流程都处理好了。
hIcon: HICON; hIcon为托盘图标的句柄，根据这个句柄你就可以增加、修改、删除图标。
szTip: array [0..63] of AnsiChar; szTip就是当你的鼠标放到任务栏托盘的小图标上的时候弹出来的提示信息。
end;

2,ShowWindow
是一个API函数.函数功能：该函数设置指定窗口的显示状态。
参数:
nCmdShow：指定窗口如何显示。如果发送应用程序的程序提供了STARTUPINFO结构，则应用程序第一次调用ShowWindow时该参数被忽略。否则，在第一次调用ShowWindow函数时，该值应为在函数WinMain中nCmdShow参数。在随后的调用中，该参数可以为下列值之一：
SW_FORCEMINIMIZE：在WindowNT5.0中最小化窗口，即使拥有窗口的线程被挂起也会最小化。在从其他线程最小化窗口时才使用这个参数。
SW_HIDE：隐藏窗口并激活其他窗口。
SW_MAXIMIZE：最大化指定的窗口。
SW_MINIMIZE：最小化指定的窗口并且激活在Z序中的下一个顶层窗口。
SW_RESTORE：激活并显示窗口。如果窗口最小化或最大化，则系统将窗口恢复到原来的尺寸和位置。在恢复最小化窗口时，应用程序应该指定这个标志。
SW_SHOW：在窗口原来的位置以原来的尺寸激活和显示窗口。
SW_SHOWDEFAULT：依据在STARTUPINFO结构中指定的SW_FLAG标志设定显示状态，STARTUPINFO 结构是由启动应用程序的程序传递给CreateProcess函数的。
SW_SHOWMAXIMIZED：激活窗口并将其最大化。
SW_SHOWMINIMIZED：激活窗口并将其最小化。
SW_SHOWMINNOACTIVATE：窗口最小化，激活窗口仍然维持激活状态。
SW_SHOWNA：以窗口原来的状态显示窗口。激活窗口仍然维持激活状态。
SW_SHOWNOACTIVATE：以窗口最近一次的大小和状态显示窗口。激活窗口仍然维持激活状态。
SW_SHOWNOMAL：激活并显示一个窗口。如果窗口被最小化或最大化，系统将其恢复到原来的尺寸和大小。应用程序在第一次显示窗口的时候应该指定此标志
返回值:如果窗口以前可见，则返回值为非零。如果窗口以前被隐藏，则返回值为零。

3,Shell_NotifyIcon 系统托盘API函数
Shell_NotifyIcon(dwMessage: DWORD; lpData: PNotifyIconData);
dwMessage：[输入参数] 说明要执行的动作。动作的可选值如下:
NIM_ADD 增加一个图标到托盘区
NIM_DELETE 从托盘区删除一个图标
NIM_MODIFY 修改图标
NIM_SETFOCUS 将焦点（Focus）返回托盘区。这个消息通常在托盘区图标完成了用户界面下的操作后发出。比如一 个托盘图标显示了一个快捷菜单，然后用户按下ESC键了操作，这时使用NIM_SETFOCUS将焦点继续保 留在托盘区。该项仅在系统外壳与常用控制DLL（ Shlwapi.dll与Comctl32.dll）5.0以上版本才可用
NIM_SETVERSION 指定使用特定版本的系统外壳与常用控制DLL。缺省值为0，表示使用Win95方式。该项在系统外壳 与常用控制DLL 5.0以上版本才可用。
lpdata：[输入参数] 一个指向NOTIFYICONDATA结构的指针
返回值:成功时函数返回TRUE，否则FALSE。
回调消息上面记录体解释已经解释了.
句柄:HANDLE这是一个中文翻译很古怪的字，我刚开始时一直不知道它是什么东东。刚开始学时总想知道一个HANDLE代表一个什么对象，现在我不去理解它是某对象，而就是理解为访问某一个对象的入口，事实上HANDLE大多数时候是一个整数索引（标志该对象在操作系统的某表中的位置,就好像一个数组的下标一样），Windows系统核心中主要是几张大表，这样一个整数索引就是标记目标在这个表中的位置，供操作系统访问时查询用。偶而它的确是指向某对象的指针，有时它还携带一些额外辅助信息。
参考技术A 这个需要和popupMenu菜单段关联，你可能是照本拷贝代码的，如果你是delphi2010以前的版本建议使用Tray Icon控件，如果是2010以后的在additional页有个TTray Icon,然后在popupmenu属性里选择合适的右键菜单即可 参考技术B 保证两点：第一，托盘图标TNotifyIconData的属性szTip有需要提示的信息；第二，另一个属性uFlags包含NIF_TIP。这样应该就可以在鼠标放上去的时候显示值了。uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;最近自己也写了个托盘控件，可以交流交流。

服务程序增加系统托盘

服务程序增加系统托盘 用Delphi创建服务程序作者：未知 文章来源：岁月联盟 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,并且把这个窗口设置为手工创建.完成后的代码如下:unit Unit_Main;interfaceusesWindows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, Unit_FrmMain;typeTDelphiService = 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 }publicfunction GetServiceController: TServiceController; override;{ Public declarations }end;varDelphiService: TDelphiService;FrmMain: TFrmMain;implementation{$R *.DFM}procedure ServiceController(CtrlCode: DWord); stdcall;beginDelphiService.Controller(CtrlCode);end;function TDelphiService.GetServiceController: TServiceController;beginResult := ServiceController;end;procedure TDelphiService.ServiceContinue(Sender: TService;var Continued: Boolean);beginwhile not Terminated dobeginSleep(10);ServiceThread.ProcessRequests(False);end;end;procedure TDelphiService.ServiceExecute(Sender: TService);beginwhile not Terminated dobeginSleep(10);ServiceThread.ProcessRequests(False);end;end;procedure TDelphiService.ServicePause(Sender: TService;var Paused: Boolean);beginPaused := True;end;procedure TDelphiService.ServiceShutdown(Sender: TService);begingbCanClose := true;FrmMain.Free;Status := csStopped;ReportStatus();end;procedure TDelphiService.ServiceStart(Sender: TService;var Started: Boolean);beginStarted := True;Svcmgr.Application.CreateForm(TFrmMain, FrmMain);gbCanClose := False;FrmMain.Hide;end;procedure TDelphiService.ServiceStop(Sender: TService;var Stopped: Boolean);beginStopped := True;gbCanClose := True;FrmMain.Free;end;end.主窗口单元如下:unit Unit_FrmMain;interfaceusesWindows, Messages, SysUtils, Variants, Classes, ShellApi, Graphics, Controls, Forms,Dialogs, ExtCtrls, StdCtrls;constWM_TrayIcon = WM_USER + 1234;typeTFrmMain = 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;varFrmMain: TFrmMain;gbCanClose: Boolean;implementation{$R *.dfm}procedure TFrmMain.FormCreate(Sender: TObject);beginFormStyle := 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);beginCanClose := gbCanClose;if not CanClose thenbeginHide;end;end;procedure TFrmMain.FormDestroy(Sender: TObject);beginTimer1.Enabled := False;DelIconFromTray;end;procedure TFrmMain.AddIconToTray;beginZeroMemory(@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;beginShell_NotifyIcon(NIM_DELETE, @IconData);end;procedure TFrmMain.SysButtonMsg(var Msg: TMessage);beginif (Msg.wParam = SC_CLOSE) or(Msg.wParam = SC_MINIMIZE) then Hideelse inherited; // 执行默认动作end;procedure TFrmMain.TrayIconMessage(var Msg: TMessage);beginif (Msg.LParam = WM_LBUTTONDBLCLK) then Show();end;procedure TFrmMain.Timer1Timer(Sender: TObject);beginAddIconToTray;end;procedure SendHokKey;stdcall;varHDesk_WL: HDESK;beginHDesk_WL := OpenDesktop (Winlogon, 0, False, DESKTOP_JOURNALPLAYBACK);if (HDesk_WL <> 0) thenif (SetThreadDesktop (HDesk_WL) = True) thenPostMessage(HWND_BROADCAST, WM_HOTKEY, 0, MAKELONG (MOD_ALT or MOD_CONTROL, VK_DELETE));end;procedure TFrmMain.Button1Click(Sender: TObject);vardwThreadID : DWORD;beginCreateThread(nil, 0, @SendHokKey, nil, 0, dwThreadID);end;end.补充:(1)关于更多服务程序的演示程序,请访问以下Url:http://www.torry.net/pages.php?id=226,上面包含了多个演示如何控制和管理系统服务的代码.(2)请切记:Windows实际上存在多个桌面.例如屏幕传输会出现白屏,可能有两个原因:一是系统处于锁定或未登陆桌面,二是处于屏幕保护桌面.这时候要将当前桌面切换到该桌面才能抓屏.(3)关于服务程序与桌面交互,还有种动态切换方法.大概单元如下:unit ServiceDesktop;interfacefunction InitServiceDesktop: boolean;procedure DoneServiceDeskTop;implementationuses Windows, SysUtils;constDefaultWindowStation = WinSta0;DefaultDesktop = Default;varhwinstaSave: HWINSTA;hdeskSave: HDESK;hwinstaUser: HWINSTA;hdeskUser: HDESK;function InitServiceDesktop: boolean;vardwThreadId: DWORD;begindwThreadId := GetCurrentThreadID;// Ensure connection to service window station and desktop, and// save their handles.hwinstaSave := GetProcessWindowStation;hdeskSave := GetThreadDesktop(dwThreadId);hwinstaUser := OpenWindowStation(DefaultWindowStation, FALSE, MAXIMUM_ALLOWED);if hwinstaUser = 0 thenbeginOutputDebugString(PChar(OpenWindowStation failed + SysErrorMessage(GetLastError)));Result := false;exit;end;if not SetProcessWindowStation(hwinstaUser) thenbeginOutputDebugString(SetProcessWindowStation failed);Result := false;exit;end;hdeskUser := OpenDesktop(DefaultDesktop, 0, FALSE, MAXIMUM_ALLOWED);if hdeskUser = 0 thenbeginOutputDebugString(OpenDesktop failed);SetProcessWindowStation(hwinstaSave);CloseWindowStation(hwinstaUser);Result := false;exit;end;Result := SetThreadDesktop(hdeskUser);if not Result thenOutputDebugString(PChar(SetThreadDesktop + SysErrorMessage(GetLastError)));end;procedure DoneServiceDeskTop;begin// Restore window station and desktop.SetThreadDesktop(hdeskSave);SetProcessWindowStation(hwinstaSave);if hwinstaUser <> 0 thenCloseWindowStation(hwinstaUser);if hdeskUser <> 0 thenCloseDesktop(hdeskUser);end;initializationInitServiceDesktop;finalizationDoneServiceDesktop;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实现的话,单元如下:unit WinSvcEx;interfaceuses Windows, WinSvc;const//// Service config info levels//SERVICE_CONFIG_DESCRIPTION = 1;SERVICE_CONFIG_FAILURE_ACTIONS = 2;//// DLL name of imported functions//AdvApiDLL = advapi32.dll;type//// Service description string//PServiceDescriptionA = ^TServiceDescriptionA;PServiceDescriptionW = ^TServiceDescriptionW;PServiceDescription = PServiceDescriptionA;{$EXTERNALSYM _SERVICE_DESCRIPTIONA}_SERVICE_DESCRIPTIONA = recordlpDescription : PAnsiChar;end;{$EXTERNALSYM _SERVICE_DESCRIPTIONW}_SERVICE_DESCRIPTIONW = recordlpDescription : PWideChar;end;{$EXTERNALSYM _SERVICE_DESCRIPTION}_SERVICE_DESCRIPTION = _SERVICE_DESCRIPTIONA;{$EXTERNALSYM SERVICE_DESCRIPTIONA}SERVICE_DESCRIPTIONA = _SERVICE_DESCRIPTIONA;{$EXTERNALSYM SERVICE_DESCRIPTIONW}SERVICE_DESCRIPTIONW = _SERVICE_DESCRIPTIONW;{$EXTERNALSYM SERVICE_DESCRIPTION}SERVICE_DESCRIPTION = _SERVICE_DESCRIPTIONA;TServiceDescriptionA = _SERVICE_DESCRIPTIONA;TServiceDescriptionW = _SERVICE_DESCRIPTIONW;TServiceDescription = TServiceDescriptionA;//// Actions to take on service failure//{$EXTERNALSYM _SC_ACTION_TYPE}_SC_ACTION_TYPE = (SC_ACTION_NONE, SC_ACTION_RESTART, SC_ACTION_REBOOT, SC_ACTION_RUN_COMMAND);{$EXTERNALSYM SC_ACTION_TYPE}SC_ACTION_TYPE = _SC_ACTION_TYPE;PServiceAction = ^TServiceAction;{$EXTERNALSYM _SC_ACTION}_SC_ACTION = recordaType : SC_ACTION_TYPE;Delay : DWORD;end;{$EXTERNALSYM SC_ACTION}SC_ACTION = _SC_ACTION;TServiceAction = _SC_ACTION;PServiceFailureActionsA = ^TServiceFailureActionsA;PServiceFailureActionsW = ^TServiceFailureActionsW;PServiceFailureActions = PServiceFailureActionsA;{$EXTERNALSYM _SERVICE_FAILURE_ACTIONSA}_SERVICE_FAILURE_ACTIONSA = recorddwResetPeriod : DWORD;lpRebootMsg : LPSTR;lpCommand : LPSTR;cActions : DWORD;lpsaActions : ^SC_ACTION;end;{$EXTERNALSYM _SERVICE_FAILURE_ACTIONSW}_SERVICE_FAILURE_ACTIONSW = recorddwResetPeriod : DWORD;lpRebootMsg : LPWSTR;lpCommand : LPWSTR;cActions : DWORD;lpsaActions : ^SC_ACTION;end;{$EXTERNALSYM _SERVICE_FAILURE_ACTIONS}_SERVICE_FAILURE_ACTIONS = _SERVICE_FAILURE_ACTIONSA;{$EXTERNALSYM SERVICE_FAILURE_ACTIONSA}SERVICE_FAILURE_ACTIONSA = _SERVICE_FAILURE_ACTIONSA;{$EXTERNALSYM SERVICE_FAILURE_ACTIONSW}SERVICE_FAILURE_ACTIONSW = _SERVICE_FAILURE_ACTIONSW;{$EXTERNALSYM SERVICE_FAILURE_ACTIONS}SERVICE_FAILURE_ACTIONS = _SERVICE_FAILURE_ACTIONSA;TServiceFailureActionsA = _SERVICE_FAILURE_ACTIONSA;TServiceFailureActionsW = _SERVICE_FAILURE_ACTIONSW;TServiceFailureActions = TServiceFailureActionsA;///////////////////////////////////////////////////////////////////////////// API Function Prototypes///////////////////////////////////////////////////////////////////////////TQueryServiceConfig2 = function (hService : SC_HANDLE; dwInfoLevel : DWORD; lpBuffer : pointer;cbBufSize : DWORD; var pcbBytesNeeded) : BOOL; stdcall;TChangeServiceConfig2 = function (hService : SC_HANDLE; dwInfoLevel : DWORD; lpInfo : pointer) : BOOL; stdcall;varhDLL : THandle ;LibLoaded : boolean ;varOSVersionInfo : TOSVersionInfo;{$EXTERNALSYM QueryServiceConfig2A}QueryServiceConfig2A : TQueryServiceConfig2;{$EXTERNALSYM QueryServiceConfig2W}QueryServiceConfig2W : TQueryServiceConfig2;{$EXTERNALSYM QueryServiceConfig2}QueryServiceConfig2 : TQueryServiceConfig2;{$EXTERNALSYM ChangeServiceConfig2A}ChangeServiceConfig2A : TChangeServiceConfig2;{$EXTERNALSYM ChangeServiceConfig2W}ChangeServiceConfig2W : TChangeServiceConfig2;{$EXTERNALSYM ChangeServiceConfig2}ChangeServiceConfig2 : TChangeServiceConfig2;implementationinitializationOSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);GetVersionEx(OSVersionInfo);if (OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT) and (OSVersionInfo.dwMajorVersion >= 5) thenbeginif hDLL = 0 thenbeginhDLL:=GetModuleHandle(AdvApiDLL);LibLoaded := False;if hDLL = 0 thenbeginhDLL := LoadLibrary(AdvApiDLL);LibLoaded := True;end;end;if hDLL <> 0 [email protected] := GetProcAddress(hDLL, QueryServiceConfig2A);@QueryServiceConfig2W := GetProcAddress(hDLL, QueryServiceConfig2W);@QueryServiceConfig2 := @QueryServiceConfig2A;@ChangeServiceConfig2A := GetProcAddress(hDLL, ChangeServiceConfig2A);@ChangeServiceConfig2W := GetProcAddress(hDLL, ChangeServiceConfig2W);@ChangeServiceConfig2 := @ChangeServiceConfig2A;end;[email protected] := nil;@QueryServiceConfig2W := nil;@QueryServiceConfig2 := nil;@ChangeServiceConfig2A := nil;@ChangeServiceConfig2W := nil;@ChangeServiceConfig2 := nil;end;finalizationif (hDLL <> 0) and LibLoaded thenFreeLibrary(hDLL);end.unit winntService;interfaceusesWindows,WinSvc,WinSvcEx;function InstallService(const strServiceName,strDisplayName,strDescription,strFilename: string):Boolean;//eg:InstallService(服务名称,显示名称,描述信息,服务文件);procedure UninstallService(strServiceName:string);implementationfunction StrLCopy(Dest: PChar; const Source: PChar; MaxLen: Cardinal): PChar; assembler;asmPUSH EDIPUSH ESIPUSH EBXMOV ESI,EAXMOV EDI,EDXMOV EBX,ECXXOR AL,ALTEST ECX,ECXJZ @@1REPNE SCASBJNE @@1INC [email protected]@1: SUB EBX,ECXMOV EDI,ESIMOV ESI,EDXMOV EDX,EDIMOV ECX,EBXSHR ECX,2REP MOVSDMOV ECX,EBXAND ECX,3REP MOVSBSTOSBMOV EAX,EDXPOP EBXPOP ESIPOP EDIend;function StrPCopy(Dest: PChar; const Source: string): PChar;beginResult := StrLCopy(Dest, PChar(Source), Length(Source));end;function InstallService(const strServiceName,strDisplayName,strDescription,strFilename: string):Boolean;var//ss : TServiceStatus;//psTemp : PChar;hSCM,hSCS:THandle;srvdesc : PServiceDescription;desc : string;//SrvType : DWord;lpServiceArgVectors:pchar;beginResult:=False;//psTemp := nil;//SrvType := SERVICE_WIN32_OWN_PROCESS and SERVICE_INTERACTIVE_PROCESS;hSCM:=OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);//连接服务数据库if hSCM=0 then Exit;//MessageBox(hHandle,Pchar(SysErrorMessage(GetLastError)),服务程序管理器,MB_ICONERROR+MB_TOPMOST);hSCS:=CreateService( //创建服务函数hSCM, // 服务控制管理句柄Pchar(strServiceName), // 服务名称Pchar(strDisplayName), // 显示的服务名称SERVICE_ALL_ACCESS, // 存取权利SERVICE_WIN32_OWN_PROCESS or SERVICE_INTERACTIVE_PROCESS,// 服务类型 SERVICE_WIN32_SHARE_PROCESSSERVICE_AUTO_START, // 启动类型SERVICE_ERROR_IGNORE, // 错误控制类型Pchar(strFilename), // 服务程序nil, // 组服务名称nil, // 组标识nil, // 依赖的服务nil, // 启动服务帐号nil); // 启动服务口令if hSCS=0 then Exit;//MessageBox(hHandle,Pchar(SysErrorMessage(GetLastError)),Pchar(Application.Title),MB_ICONERROR+MB_TOPMOST);if Assigned(ChangeServiceConfig2) thenbegindesc := Copy(strDescription,1,1024);GetMem(srvdesc,SizeOf(TServiceDescription));GetMem(srvdesc^.lpDescription,Length(desc) + 1);tryStrPCopy(srvdesc^.lpDescription, desc);ChangeServiceConfig2(hSCS,SERVICE_CONFIG_DESCRIPTION,srvdesc);finallyFreeMem(srvdesc^.lpDescription);FreeMem(srvdesc);end;end;lpServiceArgVectors := nil;if not StartService(hSCS, 0, lpServiceArgVectors) then //启动服务Exit; //MessageBox(hHandle,Pchar(SysErrorMessage(GetLastError)),Pchar(Application.Title),MB_ICONERROR+MB_TOPMOST);CloseServiceHandle(hSCS); //关闭句柄Result:=True;end;procedure UninstallService(strServiceName:string);varSCManager: SC_HANDLE;Service: SC_HANDLE;Status: TServiceStatus;beginSCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);if SCManager = 0 then Exit;tryService := OpenService(SCManager, Pchar(strServiceName), SERVICE_ALL_ACCESS);ControlService(Service, SERVICE_CONTROL_STOP, Status);DeleteService(Service);CloseServiceHandle(Service);finallyCloseServiceHandle(SCManager);end;end;end.(5)如何暴力关闭一个服务程序,实现我们以前那个"NT工具箱"的功能?首先,根据进程名称来杀死进程是用以下函数:uses Tlhelp32;function KillTask(ExeFileName: string): Integer;constPROCESS_TERMINATE = 01;varContinueLoop: BOOL;FSnapshotHandle: THandle;FProcessEntry32: TProcessEntry32;beginResult := 0;FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);FProcessEntry32.dwSize := SizeOf(FProcessEntry32);ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);while Integer(ContinueLoop) <> 0 dobeginif ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =UpperCase(ExeFileName))) thenResult := Integer(TerminateProcess(OpenProcess(PROCESS_TERMINATE,BOOL(0),FProcessEntry32.th32ProcessID),0));ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);end;CloseHandle(FSnapshotHandle);end;但是对于服务程序,它会提示"拒绝访问".其实只要程序拥有Debug权限即可:function EnableDebugPrivilege: Boolean;function EnablePrivilege(hToken: Cardinal; PrivName: string; bEnable: Boolean): Boolean;varTP: TOKEN_PRIVILEGES;Dummy: Cardinal;beginTP.PrivilegeCount := 1;LookupPrivilegeValue(nil, pchar(PrivName), TP.Privileges[0].Luid);if bEnable thenTP.Privileges[0].Attributes := SE_PRIVILEGE_ENABLEDelse TP.Privileges[0].Attributes := 0;AdjustTokenPrivileges(hToken, False, TP, SizeOf(TP), nil, Dummy);Result := GetLastError = ERROR_SUCCESS;end;varhToken: Cardinal;beginOpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, hToken);result:=EnablePrivilege(hToken, SeDebugPrivilege, True);CloseHandle(hToken);end;使用方法:EnableDebugPrivilege;//提升权限KillTask(xxxx.exe);//关闭该服务程序.

http://blog.csdn.net/diligentcatrich/article/details/7079039