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.