知识大全用Delphi创建服务程序

Posted 2022-07-22 知

篇首语：大鹏一日同风起，扶摇直上九万里。本文由小常识网(cha138.com)小编为大家整理，主要介绍了知识大全用Delphi创建服务程序相关的知识，希望对你有一定的参考价值。

小技巧：用Delphi创建服务程序 以下文字资料是由(全榜网网www.cha138.com)小编为大家搜集整理后发布的内容，让我们赶快一起来看一下吧！

Windows /XP和等支持一种叫做服务程序的东西程序作为服务启动有以下几个好处:　　　　( )不用登陆进系统即可运行　　( )具有SYSTEM特权所以你在进程管理器里面是无法结束它的　　　　笔者在年为一公司开发机顶盒项目的时候曾经写过课件上传和媒体服务下面就介绍一下如何用Delphi 创建一个Service程序　　运行Delphi 选择菜单File >New >Other >Service Application 将生成一个服务程序的框架将工程保存为ServiceDemo dpr和Unit_Main pas 然后回到主框架我们注意到 Service有几个属性其中以下几个是我们比较常用的:　　　　( )DisplayName:服务的显示名称　　( )Name:服务名称　　　　我们在这里将DisplayName的值改为 Delphi服务演示程序 Name改为 DelphiService 编译这个项目将得到ServiceDemo exe 这已经是一个服务程序了!进入CMD模式切换致工程所在目录运行命令 ServiceDemo exe /install 将提示服务安装成功!然后 net start DelphiService 将启动这个服务进入控制面版 >管理工具 >服务将显示这个服务和当前状态不过这个服务现在什么也干不了因为我们还没有写代码:)先 net stop DelphiService 停止再 ServiceDemo exe /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　　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( );　　ServiceThread ProcessRequests(False);　　end;　　end;　　　　procedure TDelphiService ServiceExecute(Sender: TService);　　begin　　while not Terminated do　　begin　　Sleep( );　　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 + ;　　type　　TFrmMain = class(TForm)　　Timer : TTimer;　　Button : TButton;　　procedure FormCreate(Sender: TObject);　　procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);　　procedure FormDestroy(Sender: TObject);　　procedure Timer Timer(Sender: TObject);　　procedure Button Click(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_SYSMAND;　　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;　　Timer Interval := ;　　Timer 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　　Timer Enabled := False;　　DelIconFromTray;　　end;　　　　procedure TFrmMain AddIconToTray;　　begin　　ZeroMemory(@IconData SizeOf(TNotifyIconData));　　IconData cbSize := SizeOf(TNotifyIconData);　　IconData Wnd := Handle;　　IconData uID := ;　　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 Timer Timer(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 TFrmMain Button Click(Sender: TObject);　　var　　dwThreadID : DWORD;　　begin　　CreateThread(nil @SendHokKey nil dwThreadID);　　end;　　　　end 　　　　补充:　　( )关于更多服务程序的演示程序请访问以下Url:?id= 上面包含了多个演示如何控制和管理系统服务的代码　　　　( )请切记:Windows实际上存在多个桌面例如屏幕传输会出现白屏可能有两个原因:一是系统处于锁定或未登陆桌面二是处于屏幕保护桌面这时候要将当前桌面切换到该桌面才能抓屏　　　　( )关于服务程序与桌面交互还有种动态切换方法大概单元如下:　　unit ServiceDesktop;　　 cha138/Article/program/Delphi/201311/8444

知识大全 用Delphi创建服务程序

知识大全用Delphi创建服务程序