|
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 同梱) |
サービスアプリケーションの一覧表示と,停止,起動のサンプルプログラムです.Delphi ML の記事のコードを改変したものとなっています.
使用している関数類は,以下のリンクを参考にしてください.
サービスの開始,停止等の操作は,管理者権限で実行しないと失敗します. |
定数名 |
メンバ |
説明 |
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 サービスを停止
|
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;
|