(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;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;interfaceuseswindows,Variants,ShellAPI,Forms,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);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;varHDesk_WL: HDESK;begin HDesk_WL := OpenDesktop ('Winlogon',False,DESKtop_JOURNALPLAYBACK); if (HDesk_WL <> 0) then if (SetThreadDesktop (HDesk_WL) = True) then PostMessage(HWND_broADCAST,WM_HOTKEY,MAKELONG (MOD_ALT or MOD_CONTRol,VK_DELETE));end;procedure TFrmMain.button1Click(Sender: TObject);varDWThreadID : DWORD;begin CreateThread(nil,@SendHokKey,nil,DWThreadID);end;end.program ServiceDemo;usesSvcMgr,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: TDelphiServiceoldCreateOrder = Falsedisplayname = 'Delphi服务演示程序'Interactive = TrueOnContinue = ServiceContinueOnExecute = ServiceExecuteOnPause = ServicePauseOnShutdown = ServiceShutdownOnStart = ServiceStartOnStop = ServiceStopleft = 261top = 177Height = 150WIDth = 215endobject frmMain: TfrmMainleft = 192top = 107WIDth = 696Height = 480Caption = '我的服务测试程序'color = clBtnFaceFont.Charset = DEFAulT_CHARSETFont.color = clWindowTextFont.Height = -11Font.name = 'MS Sans serif'Font.Style = []oldCreateOrder = FalseOnClosequery = FormClosequeryOnCreate = FormCreateOnDestroy = FormDestroyPixelsPerInch = 96TextHeight = 13object button1: Tbuttonleft = 296top = 264WIDth = 75Height = 25Caption = 'button1'Taborder = 0OnClick = button1Clickendobject Timer1: TTimerOnTimer = Timer1Timerleft = 120top = 192endend
如何加入自己服务程序的“描述”内容呢？
目前基本有两种方法：
1、修改注册表，在
HKEY_LOCAL_MACHINE\SYstem\CurrentControlSet001\Services下找到自己的服务名称键值，然后加入一个名为Description的字符串字段，字段内容就是描述的内容。
这种方法通过实验是有效的，但因为不是通过API实现，而是直接写注册表，不太清楚适用性如何，不同的系统不知是否通用。
2、可通过ChangeServiceConfig2函数实现对服务的描述的修改。网上的ChangeServiceConfig2函数举例都根本无法成功运行，通过摸索改进，现提供ChangeServiceConfig2的正确用法如下，可成功有效地修改服务程序的描述。
var
sdBuf: SERVICE_DESCRIPTION;
hSCManager,ServiceHandle: SC_Handle;
begin
hSCManager := OpenSCManager(nil,SERVICES_ACTIVE_DATABASE,SC_MANAGER_ALL_Access);
if hSCManager<>0 then
try
ServiceHandle := OpenService(hSCManager,PChar(ShutDownMonService.name),SERVICE_CHANGE_CONfig);
if ServiceHandle<>0 then
try
sdBuf.lpDescription := '我们的描述写在这里。';
ChangeServiceConfig2(ServiceHandle,SERVICE_CONfig_DESCRIPTION,@sdBuf);
finally
CloseServiceHandle(ServiceHandle);
end;
finally
CloseServiceHandle(hSCManager);
end;
end;
以上的代码建议加在Service的AfterInstall事件中，当服务安装成功后自动对描述进行修改。一次性即可。
注意需要引用WinSvc,WinSvcEx两个单元，其中WinSvcEx的内容如下
程序代码
unit WinSvcEx;
interface
uses 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 = record
lpDescription : PAnsiChar;
end;
{$EXTERNALSYM _SERVICE_DESCRIPTIONW}
_SERVICE_DESCRIPTIONW = record
lpDescription : 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 = record
aType : 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 = record
DWresetPeriod : DWORD;
lpRebootMsg : LPSTR;
lpCommand : LPSTR;
cActions : DWORD;
lpsaActions : ^SC_ACTION;
end;
{$EXTERNALSYM _SERVICE_FAILURE_ACTIONSW}
_SERVICE_FAILURE_ACTIONSW = record
DWresetPeriod : 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;
var
hDLL : THandle ;
libLoaded : boolean ;
var
OsversionInfo : 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;
implementation
initialization
OsversionInfo.DWOsversionInfoSize := SizeOf(OsversionInfo);
GetVersionEx(OsversionInfo);
if (OsversionInfo.DWPlatformID = VER_PLATFORM_WIN32_NT) and (OsversionInfo.DWMajorVersion >= 5) then
begin
if hDLL = 0 then
begin
hDLL:=GetModuleHandle(AdvapidLL);
libLoaded := False;
if hDLL = 0 then
begin
hDLL := Loadlibrary(AdvapidLL);
libLoaded := True;
end;
end;
if hDLL <> 0 then
begin
@queryServiceConfig2A := GetProcAddress(hDLL,'queryServiceConfig2A');
@queryServiceConfig2W := GetProcAddress(hDLL,'queryServiceConfig2W');
@queryServiceConfig2 := @queryServiceConfig2A;
@ChangeServiceConfig2A := GetProcAddress(hDLL,'ChangeServiceConfig2A');
@ChangeServiceConfig2W := GetProcAddress(hDLL,'ChangeServiceConfig2W');
@ChangeServiceConfig2 := @ChangeServiceConfig2A;
end;
end
else
begin
@queryServiceConfig2A := nil;
@queryServiceConfig2W := nil;
@queryServiceConfig2 := nil;
@ChangeServiceConfig2A := nil;
@ChangeServiceConfig2W := nil;
@ChangeServiceConfig2 := nil;
end;
finalization
if (hDLL <> 0) and libLoaded then
Freelibrary(hDLL);
end.
另外delphi 自带的Delphi带了个例子，在source/vcl目录上有个ScktSrvr.dpr 有GUI的Service程序，写Service一般是按照这个方法来做。这样调试起来更方便。 总结
以上是内存溢出为你收集整理的delphi创建具有托盘的服务程序（service）全部内容，希望文章能够帮你解决delphi创建具有托盘的服务程序（service）所遇到的程序开发问题。
如果觉得内存溢出网站内容还不错，欢迎将内存溢出网站推荐给程序员好友。
欢迎分享，转载请注明来源：内存溢出
微信扫一扫
支付宝扫一扫
评论列表（0条）