服务端守护程序

      写程序有时候总是会碰到很多莫名其妙的问题，前两天LIS中间件 加载血气分析仪dll后总是无故自动关闭了，找了一天的av错误，项目现场催着验收，没办法就找了这个折中的法子。 （思路）写一个服务端守护程序，当守护程序检测不到服务端程序的时候 就自动开启服务端程序。

全部源码 我已经上传到 ：

http://download.csdn.net/detail/u013051638/9789543

Q群 Delphi Home 235236282，QQ:359985051/183902633 

诚邀delphi 爱好者加入，一起学习，研究、探讨。

1、在线程中添加一个FindProcess方法  AFileName是服务端程序的路径

function TautoStart.FindProcess(AFileName: string): boolean;//查找Pserver程序是否开启var  hSnapshot: THandle; //用于获得进程列表  lppe: TProcessEntry32; //用于查找进程  Found: Boolean; //用于判断进程遍历是否完成begin  Result := False;  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(AFileName)) or (UpperCase(lppe.szExeFile) = UpperCase(AFileName))) then    begin      GHandle := hSnapshot;      Result := True;      Break;    end;    Found := Process32Next(hSnapshot, lppe); //将进程列表的下一个进程信息读入lppe记录中  end;end;

2、在线程的Execute事件中 不停的循环检测服务端程序是否运行 没有运行则开启外部服务端程序。

procedure TautoStart.Execute;var  filename: string;begin  inherited;  filename := 'Pserver.exe'; //服务端程序的路径 我把守护程序和Pserver放一起了  while not Terminated do  begin    if not FindProcess(filename) then    begin      ShellExecute(Application.Handle, 'open', PChar(filename), nil, nil, SW_SHOWNORMAL);      Sleep(1000);    end;    Sleep(1000);  end;end;

整个守护程序中还有一个最小化托盘和关闭外部程序的代码，详情请看下面的单元文件：

unit umain;interfaceuses  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, RzPanel;const  NIF_INFO = $00000010;          //气泡显示标志  NIIF_NONE = $00000000;          //无图标  NIIF_INFO = $00000001;          //信息图标  NIIF_WARNING = $00000002;          //警告图标  NIIF_ERROR = $00000003;          //错误图标  NIIF_USER = $00000004;          //XP使用hIcon图标type  TNotifyIconDataEx = record    cbSize: DWORD;    Wnd: HWND;    uID: UINT;    uFlags: UINT;    uCallbackMessage: UINT;    hIcon: HICON;    szTip: array[0..127] of AnsiChar;    dwState: DWORD;    dwStateMask: DWORD;    szInfo: array[0..255] of AnsiChar;    case Integer of      0:        (uTimeout: UINT);      1:        (uVersion: UINT;        szInfoTitle: array[0..63] of AnsiChar;        dwInfoFlags: DWORD);  end;const  WM_TRAYMSG = WM_USER + 1001;                   //自定义托盘消息type  TautoStart = class(TThread)  private    function FindProcess(AFileName: string): boolean;  protected    procedure Execute; override;  end;type  TForm1 = class(TForm)    RzPanel1: TRzPanel;    procedure FormCreate(Sender: TObject);    procedure FormDestroy(Sender: TObject);    procedure FormShow(Sender: TObject);    procedure FormClose(Sender: TObject; var Action: TCloseAction);  private    { Private declarations }    procedure WMTrayMsg(var Msg: TMessage); message WM_TRAYMSG;    //声明托盘消息    procedure WMSysCommand(var Msg: TMessage); message WM_SYSCOMMAND;    function KillAppExe(const aPathExe: string): Boolean;  public    { Public declarations }    autoStart: TautoStart;  end;var  Form1: TForm1;  NotifyIcon: TNotifyIconDataEx;                    //定义托盘图标结构体implementation{$R *.dfm}uses  ShellAPI, TLHelp32; { TautoStart }procedure TautoStart.Execute;var  filename: string;begin  inherited;  filename := 'Pserver.exe'; //服务端程序的路径 我把守护程序和Pserver放一起了  while not Terminated do  begin    if not FindProcess(filename) then    begin      ShellExecute(Application.Handle, 'open', PChar(filename), nil, nil, SW_SHOWNORMAL);      Sleep(1000);    end;    Sleep(1000);  end;end;function TautoStart.FindProcess(AFileName: string): boolean;//查找Pserver程序是否开启var  hSnapshot: THandle; //用于获得进程列表  lppe: TProcessEntry32; //用于查找进程  Found: Boolean; //用于判断进程遍历是否完成begin  Result := False;  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(AFileName)) or (UpperCase(lppe.szExeFile) = UpperCase(AFileName))) then    begin         Result := True;      Break;    end;    Found := Process32Next(hSnapshot, lppe); //将进程列表的下一个进程信息读入lppe记录中  end;end;procedure TForm1.FormCreate(Sender: TObject);begin  with NotifyIcon do  begin    cbSize := SizeOf(TNotifyIconDataEx);    Wnd := Self.Handle;    uID := 1;    uFlags := NIF_ICON + NIF_MESSAGE + NIF_TIP + NIF_INFO;   //图标、消息、提示信息    uCallbackMessage := WM_TRAYMSG;    hIcon := Application.Icon.Handle;    szTip := 'PserverS守护程序';    szInfo := '守护程序';    szInfoTitle := 'Pserver守护';    dwInfoFlags := NIIF_USER;  end;  Shell_NotifyIcon(NIM_ADD, @NotifyIcon);  autoStart := TautoStart.Create(True);end;procedure TForm1.FormDestroy(Sender: TObject);begin  Shell_NotifyIcon(NIM_DELETE, @NotifyIcon);  autoStart.Terminate;  autoStart.WaitFor;  autoStart.Free;end;procedure TForm1.FormShow(Sender: TObject);begin  autoStart.Resume;end;procedure TForm1.WMSysCommand(var Msg: TMessage);begin  if Msg.WParam = SC_ICON then    Self.Visible := False  else    DefWindowProc(Self.Handle, Msg.Msg, Msg.WParam, Msg.LParam);end;{------------------------------------------------------------------------------- Description: 自定义的托盘消息 -------------------------------------------------------------------------------}procedure TForm1.WMTrayMsg(var Msg: TMessage);var  p: TPoint;begin  case Msg.LParam of    WM_LBUTTONDOWN:      Self.Visible := True;   //显示窗体    WM_RBUTTONDOWN:      begin        SetForegroundWindow(Self.Handle);   //把窗口提前        GetCursorPos(p);       end;  end;end;procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);var  lsbool: Boolean;begin  lsbool := KillAppExe('Pserver.exe');//关闭程序  while not lsbool do  begin    lsbool := KillAppExe('Pserver.exe');  end;end;function TForm1.KillAppExe(const aPathExe: string): Boolean;//关闭外部Pserver服务端程序const  PROCESS_TERMINATE = $0001;var  _vHandle: THandle;  _vProEntry: TProcessEntry32;  _vIsFound: Boolean;  _vTempStr: string;begin  Result := False;  _vHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);  try    _vProEntry.dwSize := SizeOf(_vProEntry);    _vIsFound := Process32First(_vHandle, _vProEntry);    while _vIsFound do    begin      _vTempStr := _vProEntry.szExeFile;      if (UpperCase(_vTempStr) = UpperCase(ExtractFileName(aPathExe))) or (UpperCase(_vTempStr) = UpperCase(aPathExe)) then      begin        Result := TerminateProcess(OpenProcess(PROCESS_TERMINATE, Boolean(0), _vProEntry.th32ProcessID), 0);      end;      _vIsFound := Process32Next(_vHandle, _vProEntry);    end;  finally    CloseHandle(_vHandle);  end;end;end.

窗体文件

object Form1: TForm1  Left = 192  Top = 133  BorderIcons = [biSystemMenu, biMinimize]  BorderStyle = bsSingle  Caption = '服务端守护程序'  ClientHeight = 65  ClientWidth = 306  Color = clBtnFace  Font.Charset = DEFAULT_CHARSET  Font.Color = clWindowText  Font.Height = -11  Font.Name = 'MS Sans Serif'  Font.Style = []  OldCreateOrder = False  OnClose = FormClose  OnCreate = FormCreate  OnDestroy = FormDestroy  OnShow = FormShow  PixelsPerInch = 96  TextHeight = 13  object RzPanel1: TRzPanel    Left = 0    Top = 0    Width = 306    Height = 65    Align = alClient    BorderOuter = fsNone    Caption = '服务端守护程序'    Font.Charset = DEFAULT_CHARSET    Font.Color = clBlue    Font.Height = -24    Font.Name = 'MS Sans Serif'    Font.Style = [fsBold]    GradientColorStyle = gcsCustom    GradientColorStop = clSkyBlue    ParentFont = False    TabOrder = 0    VisualStyle = vsGradient  endend