Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2011年04月30日] [更新 2014年01月29日]　Delphi サンプルプログラム集
   
556_サービスアプリケーションの一覧と停止起動
動作確認等 Windows 7 U64(SP1) + Delphi XE Pro
556_ServiceStopStart.zip　[1,814 KB]　2014年01月29日版 (EXE 同梱)






01_サービスの一覧と停止起動


サービスアプリケーションの一覧表示と，停止，起動のサンプルプログラムです．Delphi ML の記事のコードを改変したものとなっています．
使用している関数類は，以下のリンクを参考にしてください．
サービスの開始，停止等の操作は，管理者権限で実行しないと失敗します．



表1
サービスの状態を示す定数値

定数名 メンバ 説明
SERVICE_STOPPED Stoped 停止中
SERVICE_START_PENDING Start Pending 開始作業中
SERVICE_STOP_PENDING Stop Pending 停止作業中
SERVICE_RUNNING Running 起動中
SERVICE_CONTINUE_PENDING Continue Pending 再開作業中
SERVICE_PAUSE_PENDING Pause Pending 一時停止作業中
SERVICE_PAUSED Paused' 一時停止中


図1
設計時画面
図2
実行画面
図3
UxSms サービスを停止
  • Edit1 にはサービスのフルパスを表示

リスト1
サービスの一覧と停止・起動 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, WinSVC;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    ListBox1: TListBox;
    LabeledEdit1: TLabeledEdit;
    LabeledEdit2: TLabeledEdit;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    function GetStartup(hService :SC_HANDLE):Cardinal;
    function ChangeStartup(hService: SC_HANDLE; dwStartType: DWord): Boolean;
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  引数のサービスハンドルのサービスの状態(停止等)を調査する関数
//  ここではスタートアップの状態を調べるために利用
//
//  筆者は，この動作については動作未確認
//  usesにWinSvcが必要
//=============================================================================
function TForm1.GetStartup(hService: THandle): Cardinal;
var
  PSvcConfig   : PQueryServiceConfig;
  nBytesNeeded : DWORD;
begin
  nBytesNeeded := 0;
  PSvcConfig   := nil;

  try
    //バッファサイズを取得してメモリ確保
    QueryServiceConfig(hService, nil, 0, nBytesNeeded);
    GetMem(PSvcConfig, nBytesNeeded);

    //PSvcConfigに情報を取得してサービスのステータス取得
    QueryServiceConfig(hService, PSvcConfig, nBytesNeeded, nBytesNeeded);
    Result := PSvcConfig.dwStartType;
  except;
    Result := $FFFFFFFF;
  end;

  FreeMem(PSvcConfig);
end;

//=============================================================================
//  hServiceで指定するサービスハンドルのサービスの状態を設定
//  このサンプルでは，スタートアップ時に無効にするために使用
//
//  usesにWinSvcが必要
//=============================================================================
function TForm1.ChangeStartup(hService: THandle; dwStartType: DWord): Boolean;
begin
  Result := ChangeServiceConfig(hService,
                                SERVICE_NO_CHANGE,
                                dwStartType,
                                SERVICE_NO_CHANGE,
                                nil,
                                nil,
                                nil,
                                nil,
                                nil,
                                nil,
                                nil);
end;

//=============================================================================
//  サービスの一覧を取得してListboxにその名前を表示
//
//  THandleはSC_HANDLE(WinSvc.pasで定義)でも可
//  usesにWinSvcが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  SvcMgrHandle  : THandle;
  nBytesNeeded  : DWORD;
  nServices     : DWORD;
  nResumeHandle : DWORD;
  SvcArray      : array of TEnumServiceStatus;
  i             : Integer;
begin
  //サービスマネージャーハンドル取得
  SvcMgrHandle := OpenSCManager(nil, nil, SC_MANAGER_ENUMERATE_SERVICE);

  if SvcMgrHandle <> 0 then begin
    try
      //EnumServicesStatus関数を最初に呼び出す時は，nResumeHandle等を0にして
      //nBytesNeeded,nServices等を取得する
      //他のサービス関係の関数も同様
      SvcArray　　  := nil;
      nBytesNeeded  := 0;
      nServices     := 0;
      nResumeHandle := 0;

      EnumServicesStatus(SvcMgrHandle,
                         SERVICE_WIN32,
                         SERVICE_STATE_ALL,
                         SvcArray[0],
                         nBytesNeeded,
                         nBytesNeeded,
                         nServices,
                         nResumeHandle);

      //情報取得に必要な分を確保(実際にはバイト数)
      SetLength(SvcArray, nBytesNeeded);

      EnumServicesStatus(SvcMgrHandle,
                         SERVICE_WIN32,
                         SERVICE_STATE_ALL,
                         SvcArray[0],
                         nBytesNeeded,
                         nBytesNeeded,
                         nServices,
                         nResumeHandle);

      for i := 0 to nServices - 1 do begin
        //SvcArray[i].lpDisplayNameにすると，例えば
        //ALGは，Application Layer Geteway Serviceと表示される
        ListBox1.Items.Add(StrPas(SvcArray[i].lpServiceName));
      end;
    finally
      CloseServiceHandle(SvcMgrHandle);
    end;
  end;
end;

//=============================================================================
//  サービスの停止
//  LabeledEdit1.Text(Listbox1で選択中のサービス名と同じ)からサービス名を取得
//
//  THandleはSC_HANDLE(WinSvc.pasで定義)でも可
//  usesにWinSvcが必要
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  SvcMgrHandle   : THandle;
  SvcHanle       : THandle;
  SvcName        : String;
  PSvcStatus     : _SERVICE_STATUS;
  DW             : DWORD;
  SvcStatus      : TServiceStatus;
begin
  //サービスマネージャーハンドル取得
  SvcMgrHandle := OpenSCManager(nil,
                                nil,
                                STANDARD_RIGHTS_EXECUTE or SC_MANAGER_CONNECT);
  if SvcMgrHandle = 0 then exit;

  SvcName := LabeledEdit1.Text;
  try
    //サービスハンドル取得
    //サービス名のサービスのハンドルを取得する
    SvcHanle := OpenService(SvcMgrHandle,
                            PChar(SvcName),
                            GENERIC_READ or GENERIC_EXECUTE);
    if SvcHanle <> 0 then begin
      try
        QueryServiceStatus (SvcHanle, SvcStatus);
        DW := SvcStatus.dwCurrentState;
        if DW = SERVICE_STOPPED then begin
          //サービスは既に停止している
        end else begin
          if (DW = SERVICE_RUNNING) or (DW = SERVICE_PAUSED) then begin
            if ControlService(SvcHanle, SERVICE_CONTROL_STOP, PSvcStatus) then begin
              //サービスを停止させた
            end else begin
              //サービスの停止に失敗した
            end;
          end;
        end;
      finally
        CloseServiceHandle(SvcHanle);
      end;
    end;
  finally
    CloseServiceHandle(SvcMgrHandle);
  end;

  //現在の状態を表示
  ListBox1Click(nil);
end;

//=============================================================================
//  サービスの開始・起動
//  LabeledEdit1.Text(Listbox1で選択中のサービス名と同じ)からサービス名を取得
//
//  THandleはSC_HANDLE(WinSvc.pasで定義)でも可
//  usesにWinSvcが必要
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  SvcMgrHandle   : THandle;
  SvcHandle      : THandle;
  SvcName        : String;
  SvcStatus      : TServiceStatus;
  DW             : DWord;
  CD             : Cardinal;
  P              : PChar;
  Startup        : Boolean;
begin
  Startup := False;
  CD      := $FFFFFFFF;

  //サービスマネージャーハンドル取得
  SvcMgrHandle := OpenSCManager(nil,
                                nil,
                                STANDARD_RIGHTS_EXECUTE or SC_MANAGER_CONNECT);
  if SvcMgrHandle = 0 then exit;

  SvcName := LabeledEdit1.Text;
  try
    //スタートアップのハンドルを取得
    //サービス名のサービスのハンドルを取得する
    SvcHandle := OpenService(SvcMgrHandle,
                             PChar(SvcName),
                             GENERIC_READ or SERVICE_CHANGE_CONFIG);

    try
      if SvcHandle <> 0 then begin
        //スタートアップが無効の場合手動にする
        CD := GetStartup(SvcHandle);
        if CD =  SERVICE_DISABLED then begin
            Startup := True;
            ChangeStartup(SvcHandle, SERVICE_DEMAND_START);
        end;
        CD := GetStartup(SvcHandle);
      end;
    finally
      CloseServiceHandle(SvcHandle);
    end;

    //サービスハンドル取得
    //サービス名のサービスのハンドルを取得する
    SvcHandle := OpenService(SvcMgrHandle,
                             PChar(SvcName),
                             GENERIC_READ or GENERIC_EXECUTE);
    try
      if SvcHandle <> 0 then begin
        QueryServiceStatus (SvcHandle, SvcStatus);
        DW := SvcStatus.dwCurrentState;

        case DW of
        SERVICE_RUNNING:
          begin
            //サービスは既に実行中
          end;
        SERVICE_PAUSED,SERVICE_STOPPED:
          begin
            P := nil;
            if StartService(SvcHandle, 0, P) then begin
              //サービスを実行させた
              if Startup = True then begin
                //スタートアップを手動にしてサービスを起動させた
              end;
            end else begin
              //サービスの実行に失敗した
              if (Startup = True) and (CD =  SERVICE_DISABLED) then begin
                //スタートアップを手動に変更したがサービスの実行に失敗した
              end;
            end;
          end;
        end;
      end;
    finally
      CloseServiceHandle(SvcHandle);
    end;

    //スタートアップを変更した場合元(無効)に戻す
    if Startup = True then begin
      //スタートアップの状態を取得
      SvcHandle := OpenService(SvcMgrHandle,
                               PChar(SvcName),
                               GENERIC_READ or SERVICE_CHANGE_CONFIG);
      try
        if SvcHandle <> 0 then ChangeStartup(SvcHandle, SERVICE_DISABLED);
      finally
        CloseServiceHandle(SvcHandle);
      end;
    end;
  finally
    CloseServiceHandle(SvcMgrHandle);
  end;

  //現在の状態を表示
  ListBox1Click(nil);
end;

//=============================================================================
//  Listboxに表示されている項目をクリックしたら，そのサービス名の情報を表示
//
//  LabeledEdit1にサービス名
//  LabeledEdit2に停止・起動中の状態
//  Edit1にサービスのコマンドライン文字列(サービスアプリのフルパス)
//
//  THandleはSC_HANDLE(WinSvc.pasで定義)でも可
//  usesにWinSvcが必要
//=============================================================================
procedure TForm1.ListBox1Click(Sender: TObject);
var
  SrvStatus    : TServiceStatus;
  SvcName      : String;
  SvcMgrHandle : THandle;
  SvcHandle    : THandle;

  PSvcConfig   : PQueryServiceConfig;
  nBytesNeeded : DWORD;
begin
  if ListBox1.ItemIndex < 0 then exit;

  //LabeledEdit1.Textはサービス名
  LabeledEdit1.Text := ListBox1.Items[ListBox1.ItemIndex];
  LabeledEdit2.Text := '';
  SvcName := LabeledEdit1.Text;

  //サービスマネージャーハンドル取得
  SvcMgrHandle := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  if SvcMgrHandle = 0 then exit;

  //サービスハンドル取得
  SvcHandle := OpenService(SvcMgrHandle,
                           PChar(SvcName),
                           SERVICE_ALL_ACCESS);

  //コードのネストを浅くするためにはこんなやり方も...
  if SvcHandle = 0 then begin
    CloseServiceHandle( SvcMgrHandle );
    exit;
  end;

  //取得したサービスハンドルから，そのサービスの実行状態を取得
  if QueryServiceStatus(SvcHandle, SrvStatus) then begin
    case SrvStatus.dwCurrentState of
      SERVICE_STOPPED:          LabeledEdit2.Text := 'Stoped';
      SERVICE_START_PENDING:    LabeledEdit2.Text := 'Start Pending';
      SERVICE_STOP_PENDING:     LabeledEdit2.Text := 'Stop Pending';
      SERVICE_RUNNING:          LabeledEdit2.Text := 'Running';
      SERVICE_CONTINUE_PENDING: LabeledEdit2.Text := 'Continue Pending';
      SERVICE_PAUSE_PENDING:    LabeledEdit2.Text := 'Pause Pending';
      SERVICE_PAUSED:           LabeledEdit2.Text := 'Paused';
    end;
  end;
  CloseServiceHandle(SvcHandle);

  Edit1.Text := '';
  //QueryServiceConfig調査としてサービスハンドルを取得
  SvcHandle := OpenService(SvcMgrHandle,
                              PChar(SvcName),
                              SERVICE_QUERY_CONFIG);
  if SvcHandle <> 0 then begin
    PSvcConfig := nil;
    try
      //バッファサイズを取得してメモリ確保
      QueryServiceConfig(SvcHandle, nil, 0, nBytesNeeded);
      GetMem(PSvcConfig, nBytesNeeded);

      //PSvcConfigに情報を取得してサービスのフルパス取得
      if QueryServiceConfig(SvcHandle,
                            PSvcConfig,
                            nBytesNeeded,
                            nBytesNeeded) then begin
        Edit1.Text := PSvcConfig.lpBinaryPathName;
      end;
    finally
      CloseServiceHandle(SvcHandle);
      FreeMem(PSvcConfig);
    end;
  end;

  CloseServiceHandle(SvcMgrHandle);
end;

end.



02_サービスの一覧と停止起動  -  JEDI プロジェクト利用


JEDI プロジェクトにもサービス関係を操作するユニット類があります．これを使用した例です．
TJclSCManager クラスと TJclNTService クラスを使用しています．このサンプルは，[Delphi ッこ倶楽部東京出張所: サービスの起動と停止] のコードを改変したものです．
取得するサービス一覧は上のサンプルの場合と違います．

サービスの開始，停止等の操作は，管理者権限で実行しないと失敗します．


図4
設計時画面
図5
実行画面例

リスト2
サービスの一覧と停止・起動   JEDI プロジェクトのユニットを使用 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    ListBox1: TListBox;
    LabeledEdit1: TLabeledEdit;
    LabeledEdit2: TLabeledEdit;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses JclSvcCtrl, TypInfo;

{$R *.dfm}

//=============================================================================
//  サービスの一覧を取得してListboxにその名前を表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  SvcMgr : TJclSCManager;
  i      : Integer;
begin
  SvcMgr := TJclSCManager.Create();
  try
    SvcMgr.Refresh(true);
    ListBox1.Clear;
    for i := 0 to SvcMgr.ServiceCount - 1 do begin
      ListBox1.Items.Add(SvcMgr.Services[i]. ServiceName);
    end;
  finally
    SvcMgr.Free;
  end;
end;

//=============================================================================
//  サービスの停止
//  LabeledEdit1.Text(Listbox1で選択中のサービス名と同じ)からサービスSvcを取
//  得して停止
//
//  Svc.Stop;以外は，Button3Clickと全く同じ
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  SvcMgr : TJclSCManager;
  Svc    : TJclNTService;
begin
  SvcMgr := TJclSCManager.Create();

  try
    SvcMgr.Refresh(true);
    if (SvcMgr.FindService(LabeledEdit1.Text, Svc)) then begin
      Svc.Stop;
    end;
  finally
    SvcMgr.Free;
  end;

  //現在の状態を表示
  ListBox1Click(nil);
end;

//=============================================================================
//  サービスの開始・起動
//  LabeledEdit1.Text(Listbox1で選択中のサービス名と同じ)からサービスSvcを取
//  得して起動
//
//  Svc.Start;以外は，Button2Clickと全く同じ
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  SvcMgr : TJclSCManager;
  Svc    : TJclNTService;
begin
  SvcMgr := TJclSCManager.Create();

  try
    SvcMgr.Refresh(true);
    if (SvcMgr.FindService(LabeledEdit1.Text, Svc)) then begin
      Svc.Start;
    end;
  finally
    SvcMgr.Free;
  end;

  //現在の状態を表示
  ListBox1Click(nil);
end;

//=============================================================================
//  Listboxに表示されている項目をクリックしたら，そのサービスの情報を表示
//  LabeledEdit1に表示するのは，サービス名の文字列のコピー用
//  Memo1には説明のテキスト．これは[コントロールパネル]からの[サービス]で表示さ
//  れる説明と同じ
//
//  GetEnumName,TypeInfoの使用には，usesにTypInfoが必要
//=============================================================================
procedure TForm1.ListBox1Click(Sender: TObject);
var
  SvcMgr : TJclSCManager;
  Svc    : TJclNTService;
begin
  if ListBox1.ItemIndex < 0 then exit;

  LabeledEdit1.Text := ListBox1.Items.Strings[ListBox1.ItemIndex];
  SvcMgr := TJclSCManager.Create();

  try
    SvcMgr.Refresh(true);
    if (SvcMgr.FindService(LabeledEdit1.Text, Svc)) then begin
      LabeledEdit2.Text := GetEnumName(TypeInfo(TJclServiceState),
                                       Ord(Svc.ServiceState));
      //Svc.FileName;の場合は，サービスのフルパスとなる
      //(パス名にはダブルコーテーションが付き)
      //Svc.DisplayNameならば，例えばALGはApplication Layer Gateway Serviceとなる
      Memo1.Text := Svc.Description;
    end;
  finally
    SvcMgr.Free;
  end;
end;

end.



03_TShell を使用したサービスの起動と停止


[タイプライブラリの取り込み] の記事の説明で使用している TShell を使用してもサービスの起動停止ができます．
以下が結果の図とサンプルコードです．TShell ではサービスの一覧の取得はできません．
サンプルでは Edit1 に入力したサービス名に対して操作します．これも管理者権限で実行しないと操作に失敗します．


図6
設計時画面
図7
実行画面例

リスト3
TShell を使用したサービスの起動と停止		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses Shell32_TLB;

{$R *.DFM}

//=============================================================================
//  フォーム表示開始時の処理
//  サービス名をセット
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  Edit1.Text := 'lltdsvc';
end;

//=============================================================================
//  [チェック]
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  ServiceName : String;
  ObjShell    : Shell32_TLB.TShell;
begin
  ServiceName := Trim(Edit1.Text);

  //TShellオブジェクトを生成
  ObjShell := TShell.Create(Self);
  try
    if objShell.IsServiceRunning(ServiceName) then begin
      MessageBox(Handle, '開始しています', 'サービス', MB_ICONINFORMATION);
    end else begin
      MessageBox(Handle, '停止しています', 'サービス', MB_ICONINFORMATION);
    end;
  finally
    FreeAndNil(ObjShell);
  end;
end;

//=============================================================================
//  [開始]
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  ServiceName : String;
  ObjShell    : Shell32_TLB.TShell;
begin
  ServiceName := Trim(Edit1.Text);

  //TShellオブジェクトを生成
  ObjShell := TShell.Create(Self);
  try
    if not objShell.IsServiceRunning(ServiceName) then begin
      if ObjShell.ServiceStart(ServiceName, False) then begin
        MessageBox(Handle, 'サービスを開始しました', 'サービス', MB_OK);
      end else begin
        MessageBox(Handle, 'サービスの開始に失敗しました', 'サービス', MB_OK);
      end;
    end else begin
      MessageBox(Handle, 'サービスは開始しています', 'サービス', MB_OK);
    end;
  finally
    FreeAndNil(ObjShell);
  end;
end;

//=============================================================================
//  [停止]
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  ServiceName : String;
  ObjShell    : Shell32_TLB.TShell;
begin
  ServiceName := Trim(Edit1.Text);

  //TShellオブジェクトを生成
  ObjShell := TShell.Create(Self);
  try
    if objShell.IsServiceRunning(ServiceName) then begin
      if ObjShell.ServiceStop(ServiceName, False) then begin
        MessageBox(Handle, 'サービスを停止しました', 'サービス', MB_OK);
      end else begin
        MessageBox(Handle, 'サービスの停止に失敗しました', 'サービス', MB_OK);
      end;
    end else begin
      MessageBox(Handle, 'サービスは停止しています', 'サービス', MB_OK);
    end;
  finally
    FreeAndNil(ObjShell);
  end;
end;

end.


Shell オブジェクトを CreateOleObject で生成することもできます．
この時，引数の CLSID の値を Shell.Application にします．Shell32_TLB は必要ありませんが，uses に ComObj が必要です．		 


//=============================================================================
//  ShellオブジェクトをCreataeOleObjectで生成する
//  usesにComObjが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  ServiceName : String;
  ObjShell    : OleVariant;
begin
  ServiceName := Trim(Edit1.Text);

  //Shellオブジェクトを生成
  ObjShell := CreateOleObject('Shell.Application');
  //
end;