uchecksmbppservice.pas

用delphi实现的短信后台平台监测的源码

unit uCheckSmbppService;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
  ExtCtrls,Registry,Tlhelp32;

type
  TCheckSmbppService = class(TService)
    CheckSmbppTimer: TTimer;
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure ServicePause(Sender: TService; var Paused: Boolean);
    procedure ServiceContinue(Sender: TService; var Continued: Boolean);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
    procedure CheckSmbppTimerTimer(Sender: TObject);
  private
    { Private declarations }
  public
    function GetFileName:string;
    function QuerryProcessStatus(TheFileName:string):Boolean;//检测程序在进程中的运行状况
    procedure ReadRegeditInfo;  //读取注册表形式调用外部程序
    function GetServiceController: TServiceController; override;
    { Public declarations }
  end;

var
  CheckSmbppService: TCheckSmbppService;

implementation

{$R *.DFM}
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  CheckSmbppService.Controller(CtrlCode);
end;

function TCheckSmbppService.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;
//检测程序是否在进程中运行
function TCheckSmbppService.QuerryProcessStatus(TheFileName:string):Boolean;
var  ProcessList:THandle;
     pe:TPROCESSENTRY32;
     str:string;
begin
     CheckSmbppService.ServiceStartName:=TheFileName;
     str:=CheckSmbppService.ServiceStartName;
     //取得进程列表
     ProcessList:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
     //设置进程对象的大小
     pe.dwSize:=sizeof(TPROCESSENTRY32);
  try
     if process32first(processlist,pe) then
     begin
        if  str = pe.szExeFile   then //CheckSmbppService.ServiceStartName
        begin
            result:=true;
        end
        else
         while process32next(processlist,pe) do
           begin
              if  str = pe.szExeFile  then //CheckSmbppService.ServiceStartName
              begin
                 result:=true;
                 break;
              end
              else
              begin
                 result:=false;
              end;
          end;
     end;
  finally
     closeHandle(processlist);
  end;
end;

//通过注册表来启动程序
procedure TCheckSmbppService.ReadRegeditInfo;
var  reg:TRegistry;
     key:string;     //
     FileName:string;//绝对文件名
     i:integer;
begin
     key:='\SOFTWARE\ChinaSchool\Production\CoachNet';
     reg:=TRegistry.Create;
     reg.RootKey:=HKEY_LOCAL_MACHINE;
   try
     if reg.OpenKey(key,false) then
    begin
         fileName:= reg.ReadString('SMSProLocation');
         i:= winexec(pchar(FileName),SW_SHOWNORMAL);
         if i<=31 then
            case i of
              0: ShowMessage('系统内存或资源不足');
              ERROR_BAD_FORMAT: ShowMessage('该*.EXE文件无效');
              ERROR_FILE_NOT_FOUND: ShowMessage('没找到指定的文件');
              ERROR_PATH_NOT_FOUND: ShowMessage('没找到指定路径');
            else
              ShowMessage('设置不正确请重新设置注册表');
           end
     end;
   finally
     reg.Free;
   end;
end;

//获取注册表中的文件名
function TCheckSmbppService.GetFileName:string;
var  reg:TRegistry;
     key:string;     //
     FilePath:string;//绝对文件名
     NowFileName:string;//当前文件名
     str:string;
begin
     key:='\SOFTWARE\ChinaSchool\Production\CoachNet';
     reg:=TRegistry.Create;
     reg.RootKey:=HKEY_LOCAL_MACHINE;
   try
     if reg.OpenKey(key,false) then
     begin
        FilePath:=reg.ReadString('SMSProLocation');
        NowFileName:=ExtractFileName(FilePath);
        str:=ExtractFileExt(FilePath);
        //解析绝对文件名取得文件名并判断是否有扩展名则去掉扩展名
        if str='' then
           Result:=NowFileName
        else if str='.exe' then
             Result:=Copy(NowFileName,1,Pos('.exe',NowFileName)-1)
             else if str='.txt' then
                  Result:=Copy(NowFileName,1,Pos('.txt',NowFileName)-1)
                  else
                  Result:=NowFileName;
     end;
   finally
     reg.CloseKey;
     reg.Free;
   end;
end;

//开启服务
procedure TCheckSmbppService.ServiceStart(Sender: TService;
  var Started: Boolean);
begin
   CheckSmbppTimer.Enabled:=true;
   Started:=true;
end;
//暂停服务
procedure TCheckSmbppService.ServicePause(Sender: TService;
  var Paused: Boolean);
begin
   CheckSmbppTimer.Enabled:=false;
   Paused:=true;
end;
//继续服务
procedure TCheckSmbppService.ServiceContinue(Sender: TService;
  var Continued: Boolean);
begin
   CheckSmbppTimer.Enabled:=true;
   Continued:=true;
end;
//停止服务
procedure TCheckSmbppService.ServiceStop(Sender: TService;
  var Stopped: Boolean);
begin
   CheckSmbppTimer.Enabled:=false;
   Stopped:=true;
end;

procedure TCheckSmbppService.CheckSmbppTimerTimer(Sender: TObject);
var
  v_result: Boolean;
  str:string;
begin
  //取得文件名
  str:=GetFileName;
  try
    v_result := True;
    while v_result  do
    begin
       if QuerryProcessStatus(str) then
          v_result := False
       else
       begin
          ReadRegeditInfo;
          Sleep(10000);
       end;
    end;

    v_result := True;
    while v_result  do
    begin
       if QuerryProcessStatus(str) then
          v_result := False
       else
       begin
          ReadRegeditInfo;
          Sleep(10000);
       end;
    end;
  except
    ;
  end;
end;

end.