1、关于TServiceManager控件

WIKI上的内容很少，只有判断服务是否存在的代码（不能进行遍历所有服务，调用Services.Items是空的）：
program ServiceTest;
// Check if a certain process is running.
{KaTeX parse error: Expected 'EOF', got '}' at position 12: mode objfpc}̲{H+}
uses
Classes,
SysUtils,
ServiceManager,
JwaWinSvc {for services declarations};

const
ServiceToTest = ‘SamSs’;

//Security Accounts Manager, should be running, at least on Vista
begin
WriteLn(‘Starting test for ’ + ServiceToTest + ’ service.’);
if IsServiceRunning(ServiceToTest) then
WriteLn(‘The ’ + ServiceToTest + ’ service is running’)
else
WriteLn(‘The ’ + ServiceToTest + ’ service is not running’);
end.

在https://forum.lazarus.freepascal.org/index.php/topic,59497.msg443560.html#msg443560上找到代码：首先是Access属性的值要设定，然后RefreshOnConnect应该置为TURE:
procedure TForm1.Button1Click(Sender: TObject);
var
Num_of_Services: longint;
i: Integer;
entry: TServiceEntry;
begin

servicemanager1.Access := SC_MANAGER_ALL_ACCESS;
ServiceManager1.RefreshOnConnect := True;
ServiceManager1.Connect();

Num_of_Services := serviceManager1.Services.Count;

for i := 0 to Num_of_Services -1 do
begin
entry := serviceManager1.Services[i];
memo1.Lines.Add (entry.DisplayName
+ ’ : ’
+ ServiceStateName(entry.CurrentState));
end;
end;

2、进程管理

2.1、Delphi下的例子

网上找到的例子和我在Delphi下测试都没问题（通过TCP握手信号进行状态保持）：
unit WatchDog_ut;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, Vcl.ExtCtrls, Vcl.StdCtrls, Winapi.ShellApi,
Web.Win.Sockets, Vcl.Grids, Vcl.ValEdit, System.IniFiles;

type
TProcessObject=class
private
FWaitCount: integer;
FUseWatch: boolean;
procedure SetWaitCount(const Value: integer);
procedure SetUseWatch(const Value: boolean);
public
LogList:TListBox; //测试输出
ProcessName:string; //进程名称，运行程序文件名
ProcessTitle:string; //程序标题
ProcessHandle:Cardinal; //进程句柄
ProcessState:integer; //状态：-1 未启动； 0：启动进程； 1：正常运行（接收到握手）
ProcessWaitTime:integer; //等待时间，如果此时间到，程序仍无握手信号来，则认为程序当掉，要杀掉进程，重启程序
property UseWatch:boolean read FUseWatch write SetUseWatch; //是否进行看护
property WaitCount:integer read FWaitCount write SetWaitCount; //延时计数器

procedure CloseProcess;        //强杀进程
procedure StartProcess;        //启动程序
function FindProcess:boolean;   //查找进程 ，如果一直没有程序连接过来，则主动查找进程，并Kill之，无论有无都启动程序

end;

TWatchDogForm = class(TForm)
TrayIcon1: TTrayIcon;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
Button1: TButton;
Button2: TButton;
TcpServer1: TTcpServer;
ValueListEditor1: TValueListEditor;
Timer1: TTimer;
Timer2: TTimer;
ListBox1: TListBox;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Timer1Timer(Sender: TObject);
procedure TcpServer1Accept(Sender: TObject; ClientSocket: TCustomIpClient);
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure TrayIcon1DblClick(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
WatchDogForm: TWatchDogForm;
AppPath:string;
ProcessList:TList;
ProcessNumber:integer;
TcpPort:string;

implementation
uses TLHelp32;
{$R *.dfm}

{ TProcessObject }

procedure TProcessObject.CloseProcess;
var s:string;
begin
if ProcessHandle=0 then FindProcess;

if ProcessHandle<>0 then
begin
if ProcessState=-2 then Exit;

if TerminateProcess(ProcessHandle,0) then
beginCloseHandle(ProcessHandle);ProcessHandle:=0;ProcessState:=-1;
end
else
beginProcessHandle:=0;ProcessState:=2;
end;

end;
//测试输出
s:=ProcessName + ‘关闭：’ + DateTimeToStr(now) ;
if LogList<>nil then LogList.Items.Append(s);
end;

function TProcessObject.FindProcess: boolean;
var
hSnapshot: THandle; //用于获得进程列表
lppe: TProcessEntry32; //用于查找进程
Found: Boolean; //用于判断进程遍历是否完成
KillHandle: THandle; //用于杀死进程
begin
result:=false;
if ProcessName<>‘’ then
begin
hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); //获得系统进程列表
lppe.dwSize := SizeOf(TProcessEntry32); //在调用Process32First API之前，需要初始化lppe记录的大小
Found := Process32First(hSnapshot, lppe); //将进程列表的第一个进程信息读入ppe记录中
while Found do
begin
if ((UpperCase(ExtractFileName(lppe.szExeFile)) = UpperCase(ProcessName)) or (UpperCase(lppe.szExeFile) = UpperCase(ProcessName)))
then
begin
//ProcessHandle:= lppe.th32ProcessID;
ProcessHandle:= OpenProcess(PROCESS_TERMINATE, False, lppe.th32ProcessID);
if ProcessHandle<>0 then
begin
ProcessState:=0;
Result := True;
end;
Exit;
end;
Found := Process32Next(hSnapshot, lppe); //将进程列表的下一个进程信息读入lppe记录中
end;
end;
end;

procedure TProcessObject.SetUseWatch(const Value: boolean);
begin
FUseWatch := Value;
if not Value then ProcessState:=-2;
end;

procedure TProcessObject.SetWaitCount(const Value: integer);
begin
FWaitCount := Value;
if Value > ProcessWaitTime then
begin
FWaitCount:=0;
if ProcessHandle = 0 then StartProcess
else CloseProcess;
end;
end;

procedure TProcessObject.StartProcess;
var i:integer;
s:string;
begin
//if ProcessState=2 then Exit;
if ProcessState=-2 then Exit;

if ProcessName<>‘’ then
begin
if FileExists(ProcessName) then
begin
i:=ShellExecute(0,‘open’,PWideChar(ProcessName),‘’,‘’,SW_SHOWMINIMIZED);
if i<>0 then
begin
ProcessState:=0;
FindProcess;
end else ProcessState:=4;
end
else ProcessState:=3;
end;
//测试输出
s:=ProcessName + ‘启动：’ + DateTimeToStr(now) ;
if LogList<>nil then LogList.Items.Append(s);
end;

{WatchDogForm}

procedure TWatchDogForm.Button1Click(Sender: TObject);
begin
Timer1.Enabled:=false;
Button1.Enabled:=false;
Button2.Enabled:=true;
N2.Enabled:=false;
N1.Enabled:=true;
ValueListEditor1.Values[‘守护程序[WatchDog.exe]’]:=‘停止守护’;
end;

procedure TWatchDogForm.Button2Click(Sender: TObject);
begin
Timer1.Enabled:=true;
Button2.Enabled:=false;
Button1.Enabled:=true;
N1.Enabled:=false;
N2.Enabled:=true;
ValueListEditor1.Values[‘守护程序[WatchDog.exe]’]:=‘启动守护’;
end;

procedure TWatchDogForm.FormClose(Sender: TObject; var Action: TCloseAction);
var po:TProcessObject;
i:integer;
begin
if Application.MessageBox(‘你确定要退出[传感器转发软件守护程序]吗？’,‘确认’,MB_YESNO) = IDYES then
begin
Timer1.Enabled:=false;
if TcpServer1.Active then TcpServer1.Close;

if ProcessNumber>0 then
beginif ProcessList<>nil thenbeginfor i := 0 to ProcessNumber-1 dobeginpo:=TProcessObject(ProcessList.Items[i]);if po<>nil then po.Free;end;ProcessList.Free;end;
end;
Action:=caFree;

end else Action:=caNone;
end;

procedure TWatchDogForm.FormCreate(Sender: TObject);
var f:TInifile;
i:integer;
s:string;
po:TProcessObject;
begin
AppPath:= ExtractFilePath(Paramstr(0));
f:=TInifile.Create(AppPath + ‘WatchDog.ini’);
try
ProcessNumber:=f.ReadInteger(‘System’,‘ProcessNumber’,0);
TcpPort:=f.ReadString(‘System’,‘TcpPort’,‘7780’);
if ProcessNumber>0 then
begin
TcpServer1.LocalHost:=‘localhost’;
TcpServer1.LocalPort:=TcpPort;
TcpServer1.Open;
ProcessList:=TList.Create;
for i := 1 to ProcessNumber do
begin
po:=TProcessObject.Create;
po.LogList:=ListBox1;
s:=‘Process’ + IntToStr(i);
po.ProcessName:=f.ReadString(s,‘ProcessName’,‘’);
po.ProcessTitle:=f.ReadString(s,‘ProcessTitle’,‘’);
po.ProcessHandle:=0;
po.ProcessState:=-1;
po.ProcessWaitTime:=f.ReadInteger(s,‘ProcessWaitTime’,60);
po.UseWatch:=f.ReadBool(s,‘UseWatch’,false);
po.FindProcess;
ProcessList.Add(po);
end;
end;
finally
f.Free;
end;
Button2.Click;
end;

procedure TWatchDogForm.FormResize(Sender: TObject);
begin
if Application.MainForm.WindowState = wsMinimized then
begin
Application.MainForm.Hide;
end;
end;

procedure TWatchDogForm.N4Click(Sender: TObject);
begin
Close;
end;

procedure TWatchDogForm.TcpServer1Accept(Sender: TObject;
ClientSocket: TCustomIpClient);
var s:string;
i,h:integer;
po:TProcessObject;
s1,s2:string;
m,n:integer;
begin
s:=ClientSocket.Receiveln;
while s<>‘’ do
begin
if ProcessNumber >0 then
begin
if ProcessList<>nil then
begin
m:=Length(s);
n:=Pos(‘#’,s);
if n>0 then
begin
s1:=copy(s,1,n-1);
s2:=copy(s,n+1,m-n);
for i := 0 to ProcessNumber-1 do
begin
po:=TProcessObject(ProcessList.Items[i]);
if po<>nil then
begin
if po.ProcessName = s1 then
begin
if s2<>‘1’ then po.ProcessState:=-2
else po.ProcessState:=1;
po.WaitCount:=0;
end;
end;
end;
end;
end;
end;
s:=ClientSocket.Receiveln;
end;
end;

procedure TWatchDogForm.Timer1Timer(Sender: TObject);
var i:integer;
po:TProcessObject;
s:string;
begin
if TcpServer1.Active = false then Exit;

if ProcessNumber>0 then
begin
if ProcessList<>nil then
begin
for i := 0 to ProcessNumber-1 do
begin
po:=TProcessObject(ProcessList.Items[i]);
if po<>nil then
begin
if po.UseWatch then po.WaitCount:=po.WaitCount+1;

      case po.ProcessState  of-2:s:='程序自主运行';-1:s:='程序未启动';0:s:='程序已启动';1:s:='程序运行中...';2:s:='程序异常，无法关闭';3:s:='程序文件未找到';4:s:='程序启动异常';end;ValueListEditor1.Values[po.ProcessTitle + '['+po.ProcessName +']']:=s;//+'['+DateTimeToStr(now) + ']';end;end;
end;

end;
end;

procedure TWatchDogForm.Timer2Timer(Sender: TObject);
begin
Application.MainForm.WindowState:=wsMinimized;
Timer2.Enabled:=false;
end;

procedure TWatchDogForm.TrayIcon1DblClick(Sender: TObject);
begin
Application.MainForm.Show;
Application.MainForm.WindowState := wsNormal;
end;

end.

2.2、Lazarus下应用（Lazarus 2.0.10 + Windows10)

首先在非wince下是没有TLHelp32这个单元的，而且在wince下shellApi和TLHelp32均是简化的，好多函数是没有的，强行增加这个单元也会出现编译错误，还得在英文论坛上找（英文不好，实在不想看外文网站）：https://forum.lazarus.freepascal.org/index.php?action=search2，在这个页面上搜索TLHelp32出现

由这个可以看出，在Lazarus下用JwaTlHelp32, jwawinbase, jwawinnt…代替TlHelp32单元，在工程中增加这些单元，果然函数和定义均可用。

随记 2022.6.24 于合肥

Lazarus进行Windows下服务和进程的管理相关推荐

WINDOWS XP服务和进程优化详解
WINDOWS XP服务和进程优化详解 1.Alerter Alerter(警示器)服务的进程名是Services.exe(即启动这个服务后在后台运行的进程的名称,可以通过任务管理器看到).Alert ...
windows下解决PHP-CGI 进程崩溃502
PHP是世界上最好的语言,但需要PHP解析器:Apache+php,需要通过mod_php.so和php相连:nginx+php 需要转发给 cgi程序关于FastCGI: 全称 FastCGI P ...
windows下创建守护进程A和B 互相监视挂掉拉起
在windows下创建守护进程A和B ,在其中一个挂掉以后,另一个会把挂掉的拉起来. 下面展示一些内联代码片. 这里只列出了A的代码,B和A类似. #include<iostream> ...
Linux实验3 服务与进程的管理实验报告（部分英文）
实验题目实验3 服务与进程的管理一.实验目的 (1) 掌握进程的启动和停止方法,掌握进程开机启动的方法: (2) 掌握 crontab 的使用. (3) 掌握进程变成服务的方法.Ps top ...
windows下查看当前进程，杀掉进程等
虽然我们平时学习最多的是linux命令,但是平时开发,更多的却是在windows下,而cmd命令也是我们经常需要用到的.cmd命令和linux命令有相同也有不同之处.这里记录一下windows下,如何 ...
tasklist 结束进程_Windows: windows下的终止进程的命令(tasklist/tskill)
在Unix/Linux下可以使用ps/kill命令查找/终止一个正在运行的进程, Windows平台下也有一组类似的命令: tasklist/tskill C:\>tskill /? 结束进程. ...
windows下守护sqlserver进程并将bat注入服务
最近windows服务上的SqlServer2008进程老是莫名其妙的自动崩了,原因一时半会查不出来,所以准备监控一下SqlServer进程,崩了自动重启一.守护进程编写下面是bat文件 @ech ...
windows下批量杀死进程
有时候由于病毒或其他原因,启动了一系列的进程,并且有时杀了这个,又多了那个.使用命令taskkill可将这些进程一下子全部杀光: C:\Users\NR>taskkill /F /im fron ...
windows下服务或SYSTEM权限读取当前用户注册表HKEY_CURRENT_USER
最近一直在给一个程序增加一个功能,需要修改注册表 HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\MountP ...

Lazarus进行Windows下服务和进程的管理

1、关于TServiceManager控件

2、进程管理

2.1、Delphi下的例子

2.2、Lazarus下应用（Lazarus 2.0.10 + Windows10)

Lazarus进行Windows下服务和进程的管理相关推荐

最新文章

热门文章