Service - VBA(VB6) - Win32 API編

始める前に、ここを読んでください

VBA(VB6)でサービスを制御する場合は便利なクラスライブラリもないですから VB2005と比べて大変そうに思われます。これらの言語はCOMと親和性が高いですから、サービスを扱うコンポーネントがあれば楽に実装できるでしょう。なければ、最後の手段Win32 APIでゴリゴリコーディングになります。

実はそんなコンポーネントがあるのですが、まずは先に苦労をしておくとそのコンポーネントのありがたさがわかるでしょう。ということでWin32APIを使った方法を先に書いてみます。

実装環境はVBAを扱えるプラットフォームでしたらなんでもいいのですが、今回は Excel 2000 VBA - Window XPを前提にします。

早速、Excel 2000を起動して、Alt + F11でVBEを起動してください。
次にツールバーの挿入(I)→標準モジュール(M)で新しいモジュールを作成してください。ここにすべてのコードを記述していきます。

・Win32APIの宣言

VB6またはOffice 2000, 2002 Developerユーザは Win32Api.txt というWin32API(以後APIと呼びます)の宣言の一覧が書かれたファイルを使って宣言すると思います。それ以外のユーザでもVectorあたりに同じようなファイルがあったと思いますが、ないと宣言することがたいへんなのでここにおいておきます。

ところがこれがなかなか曲者で、偶にそのままコピペして使おうとすると最悪Officeが落ちてしまうこともあります。(私も何度も経験があります。)　
>もともとAPIはC言語で書かれていてDeclareステートメントでVB/VBAでも使えるようにしたものなので、最終的には MSDNで使用しようとするC言語でのAPIの宣言、特に引数・戻値の型を確認してその上で注意してVBA/VB6で宣言しなおさないといけないこともでてくるでしょう。

・サービスの状態の取得

まず、サービスの状態を取得するAPIを宣言してみます。使用するAPIは
OpenSCManager・・・・・・・・サービス制御マネージャとの接続・データベースOpen
OpenService・・・・・・・・・・・サービスハンドルのOpen
QueryServiceStatus・・・・サービスの状態の取得
CloseServiceHandle ・・・・・サービスハンドルのClose

です。 Win32Api.txt からコピーすると

'サービス制御マネージャ接続・データベースOpen
Private Declare Function OpenSCManager Lib "advapi32.dll" Alias "OpenSCManagerA" _
             (ByVal lpMachineName As String, _
              ByVal lpDatabaseName As String, _
              ByVal dwDesiredAccess As Long) As Long

'サービスOpen
Private Declare Function OpenService Lib "advapi32.dll" Alias "OpenServiceA" _
             (ByVal hSCManager As Long, _
              ByVal lpServiceName As String, _
              ByVal dwDesiredAccess As Long) As Long

'サービス状態取得
Private Declare Function QueryServiceStatus Lib "advapi32.dll" _
             (ByVal hService As Long, _
              lpServiceStatus As SERVICE_STATUS) As Long

'ハンドルClose
Private Declare Function CloseServiceHandle Lib "advapi32.dll" _
             (ByVal hSCObject As Long) As Long

Win32Api.txt がないと自身でMSDNのC言語での宣言を見て、引数の型、戻値の型を設定しないといけないので、C言語をある程度理解できてないとつらいかもしれません。

次に、 OpenSCManager の第三引数で指定する定数、 OpenService の第三引数で指定する定数、QueryServiceStatusでサービスの状態を受け取る SERVICE_STATUS 構造体、サービスの状態を示す定数（SERVICE_STATUSのdwCurrentStateメンバが保持する定数）も定義します。

定数はMSDNを見ると様々な値がありますが、各値の説明を読むと、 OpenSCManagerの第三引数はサービス制御マネージャとの接続を有効にするだけでいいので SC_MANAGER_CONNECTを定義します。 OpenServiceの第三引数は、状態の取得だけなのでSERVCE_QUERY_STATUSだけです。サービスの状態を示す定数はMSDNのSERVICE_STATUSのdwCurrentStateの説明で示されている値に加えてサービス状態の取得失敗のための定数を加えます。

Win32Api.txt から各値をコピーします。

'OpenSCManager第三引数定数
Private Const SC_MANAGER_CONNECT As Long = &H1
OpenService第三引数定数
Private Const SERVICE_QUERY_STATUS As Long = &H4
'サービスの状態を示す定数
Public Const SERVICE_STOPPED          As Long = &H1
Public Const SERVICE_START_PENDING    As Long = &H2
Public Const SERVICE_STOP_PENDING     As Long = &H3
Public Const SERVICE_RUNNING          As Long = &H4
Public Const SERVICE_CONTINUE_PENDING As Long = &H5
Public Const SERVICE_PAUSE_PENDING    As Long = &H6
Public Const SERVICE_PAUSED           As Long = &H7
Public Const SERVICE_NONE             As Long = &H0       '手作業で加える行

'QueryServiceStatusで使われる構造体
Private Type SERVICE_STATUS
    dwServiceType             As Long
    dwCurrentState            As Long
    dwControlsAccepted        As Long
    dwWin32ExitCode           As Long
    dwServiceSpecificExitCode As Long
    dwCheckPoint              As Long
    dwWaitHint                As Long
End Type

準備ができたので実装します。
サービスの状態を取得するFunctionプロシージャをGetServiceStatusとし、引数をサービス名、戻値を先に定義したSERVICE_XXXX定数のうちの１つとします。上記の宣言に続いて以下を記述してください。

'サービス状態の取得
'引数    argsName : 状態を取得しようとするサービス名
'戻値    サービスの状態を示す SERVICE_XXXX定数のうちの一つ

Public Function GetServiceStatus(ByVal argsName As String) As Long
    Dim vlRet         As Long
    Dim vlHSCManager  As Long            'サービス制御マネージャのデータベースのハンドル
    Dim vlHService    As Long            'サービスのハンドル
    Dim vtSvcStatus   As SERVICE_STATUS  'SERVICE_STATUS

    Do
        vlHSCManager = OpenSCManager("", "ServicesActive", SC_MANAGER_CONNECT)  '(A)
        If vlHSCManager = 0 Then
            vlRet = SERVICE_NONE: Exit Do
        End If

        vlHService = OpenService(vlHSCManager, argsName, SERVICE_QUERY_STATUS)  '(B)
        If vlHService = 0 Then
            vlRet = SERVICE_NONE: Exit Do
        End If

        If QueryServiceStatus(vlHService, vtSvcStatus) = 0 Then                 '(C)
            vlRet = SERVICE_NONE: Exit Do
        End If

        vlRet = vtSvcStatus.dwCurrentState

        Exit Do
    Loop

    If vlHService <> 0 Then CloseServiceHandle vlHService
    If vlHSCManager <> 0 Then CloseServiceHandle vlHSCManager

    GetServiceStatus = vlRet
End Function

(A)のOpenSCManagerの第一引数はコンピュータ名を指定しますが、ローカルコンピュータを指定する時は空文字列か NULL(0)を代入しますが、DeclareでString型を宣言していますので、 ""とします。もし、NULL(0)を設定するのでしたら第一引数を
ByVal lpMachineName As LongとDeclareステートメントを修正することになります。

Private Declare Function OpenSCManager Lib "advapi32.dll" Alias "OpenSCManagerA" _
        (ByVal lpMachineName As Long, _
         ByVal lpDatabaseName As String, _
         ByVal dwDesiredAccess As Long) As Long

vlHSCManager = OpenSCManager( 0&, "ServicesActive", SC_MANAGER_CONNECT)

第二引数はデータベース名の指定でMSDNにはSERVICES_ACTIVE_DATABASE、またはNULL(0)を設定するように書かれています。ここもDeclareでString型として宣言しているので、SERVICES_ACTIVE_DATABASEとしたいのですが、この実体はプラットフォームSDKのwinsvc.hヘッダファイルに

#define SERVICES_ACTIVE_DATABASE   SERVICES_ACTIVE_DATABASEW
#define SERVICES_ACTIVE_DATABASEW  L"ServicesActive"

と定義されています。C言語なのでわからないかもしれませんが、要はServicesActiveは SERVICES_ACTIVE_DATABASEとして定義されていますよということです。ということでこの文字列を指定します。ここにNULL(0)を設定したいのでしたら、第一引数の時と同様に Declareステートメントを修正することになります。

第三引数は先ほど定義したSC_MANAGER_CONNECTを設定します。
OpenSCManagerが失敗した場合、0を返すので、GetServiceStatusの戻値を0にしてDo～Loopを抜けます。

(B)の第一引数は(A)が成功した場合のハンドルを指定します。第二引数はOpenしようとするサービス名、第三引数はサービスの状態を取得するだけなので SERVICE_QUERY_STATUSだけを設定すればいいです。

サービスのハンドルが取得できたら(C)の第二引数の SERVICE_STATUS 構造体に結果が格納されます。サービスの状態を示すメンバはdwCurrentStateなのでこれをGetServiceStatus関数の戻値として返します。なお、他のメンバについては必要が出てきた時点で書きたいと思います。詳しくはMSDNをご覧ください。

・サービス状態の変更

サービス状態の取得はできたので今度は変更です。変更はさらにたいへんになります。前項で使用したAPIの他にサービスを制御する

StartService ・・・・・・サービスの開始
ControlService ・・・・サービスの他の制御

と、サービス状態が変更するまで待機する

Sleep

を使用します。では Win32Api.txt からGetServiceStatus関数の上にコピーします。

    
'サービス開始
Private Declare Function StartService Lib "advapi32.dll" Alias "StartServiceA" _
        (ByVal hService As Long, _
         ByVal dwNumServiceArgs As Long, _
         ByVal lpServiceArgVectors As Long) As Long

'サービス状態変更
Private Declare Function ControlService Lib "advapi32.dll" _
        (ByVal hService As Long, _
         ByVal dwControl As Long, _
         lpServiceStatus As SERVICE_STATUS) As Long

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

そして、OpenServiceの第三引数で前回はSERVICE_QUERY_STATUSだけを指定しましたが、今度は状態を変更するのでさらに
SERVICE_START
SERVICE_STOP
SERVICE_PAUSE_CONTINUE
を使います。

ControlServiceの第二引数で指定する制御コードの定数を定義します。Start以外の
SERVICE_CONTROL_STOP
SERVICE_CONTROL_PAUSE
SERVICE_CONTROL_CONTINUE
を定義します。

サービスの状態を SERVICE_STATUS構造体に受け取った後、そのメンバのdwControlsAcceptedで停止、再開、一時停止ができるかどうかを確認しなければならないので、ここに受け取ることができる定数を定義します。

Win32Api.txt からSleep関数のしたあたりにでもコピーしましょう。

'OpenService用定数
Private Const SERVICE_QUERY_STATUS = &H4     'ここは既に定義済み
Private Const SERVICE_START = &H10
Private Const SERVICE_STOP = &H20
Private Const SERVICE_PAUSE_CONTINUE = &H40

'ControlService用定数
Private Const SERVICE_CONTROL_STOP = &H1
Private Const SERVICE_CONTROL_PAUSE = &H2
Private Const SERVICE_CONTROL_CONTINUE = &H3

'SERVICE_STATUS構造体のメンバdwControlsAcceped用定数
Private Const SERVICE_ACCEPT_PAUSE_CONTINUE = &H2
Private Const SERVICE_ACCEPT_STOP = &H1

さらに、サービスを変更する動作を列挙定数として VB2005の事例の時と同様に次のように定義します。

Public Enum SERVICE_ACTION
    Svc_Start = 1
    Svc_Stop = 2
    Svc_Pause = 3
    Svc_Continue = 4
End Enum

それではサービスの状態を変更する関数を実装します。流れとしては QueryServiceStatus APIで現在のサービスの状態を取得し、その値によってStartService、またはControlServiceを実行します。
プロシージャ名はChangeServiceStatus、引数はString型のサービス名とSERVICE_ACTION列挙型のサービスの状態を変更する値。戻値は状態が変更された場合はTrue、失敗または状態が変更されなかったときはFalseのBoolean型とします。

'サービス状態変更
'引数 argsName  : 状態を変更しようとするサービス名
'     argeAction: 停止・開始・停止・一時停止を表す列挙定数
'戻値 サービス状態が変更したときTrue、エラーまたは状態が変更しないときFalse
Public Function ChangeServiceStatus(ByVal argsName As String, _
                                    ByVal argeAction As SERVICE_ACTION) As Boolean
    Dim vyRet        As Boolean         '戻値用
    Dim vlHSCManager As Long            'サービス制御マネージャのデータベースのハンドル
    Dim vlHService   As Long            'サービスのハンドル
    Dim vtSvcStatus  As SERVICE_STATUS  'SERVICE_STATUS構造体

    Do
        'サービス制御マネージャのデータベースハンドル取得
        vlHSCManager = OpenSCManager("", "ServicesActive", SC_MANAGER_CONNECT)  '(A)
        If vlHSCManager = 0 Then
            vyRet = False: Exit Do
        End If

        'サービスハンドル取得
        vlHService = OpenService(vlHSCManager, argsName, SERVICE_QUERY_STATUS _
                                            Or SERVICE_START _
                                            Or SERVICE_STOP _
                                            Or SERVICE_PAUSE_CONTINUE)          '(B)
        If vlHService = 0 Then
            vyRet = False: Exit Do
        End If

        'サービスの状態取得
        If QueryServiceStatus(vlHService, vtSvcStatus) = 0 Then                 '(C)
            vyRet = False: Exit Do
        End If

        Do             '(a)
            Select Case vtSvcStatus.dwCurrentState          '(D)
                Case SERVICE_STOPPED   '現在停止中          '(E)
                    If argeAction = Svc_start Then          '(F)
                        If StartService(vlHService, 0&, 0&) = 0 Then  'サービス開始 '(G)
                            vyRet = False: Exit Do
                        End If

                        '状態変更確認までループ
                        Do Until QueryServiceStatus(vlHService, vtSvcStatus) = 0    '(H)
                            If vtSvcStatus.dwCurrentState = SERVICE_RUNNING Then
                                Exit Do                     '(I)
                            End If

                            Sleep IIf(vtSvcStatus.dwWaitHint > 500, 500, _
                                                            vtSvcStatus.dwWaitHint) '(J)
                        Loop

                        vyRet = True
                    End If
                    Exit Do

                Case SERVICE_RUNNING    '現在実行中        '(K)
                    If (argeAction = Svc_stop) And _
                        ((vtSvcStatus.dwControlsAccepted And _
                                                     SERVICE_ACCEPT_STOP) > 0) Then '(L)

                        'サービス停止
                        If ControlService(vlHService, SERVICE_CONTROL_STOP, _
                                                              vtSvcStatus) = 0 Then '(M)
                            vyRet = False: Exit Do
                        End If

                        '状態変更確認までループ
                        Do Until QueryServiceStatus(vlHService, vtSvcStatus) = 0
                            If vtSvcStatus.dwCurrentState = SERVICE_STOPPED Then
                                Exit Do 
                            End If

                            Sleep IIf(vtSvcStatus.dwWaitHint > 500, 500, _
                                                            vtSvcStatus.dwWaitHint)
                        Loop

                        vyRet = True
                    ElseIf (argeAction = Svc_pause) And _
                            ((vtSvcStatus.dwControlsAccepted And _
                                           SERVICE_ACCEPT_PAUSE_CONTINUE) > 0) Then '(N)
                        'サービス一時停止
                        If ControlService(vlHService, SERVICE_CONTROL_PAUSE, _
                                                                   vtSvcStatus) = 0 Then
                            vyRet = False: Exit Do
                        End If

                        '状態変更確認までループ
                        Do Until QueryServiceStatus(vlHService, vtSvcStatus) = 0
                            If vtSvcStatus.dwCurrentState = SERVICE_PAUSED Then
                                Exit Do
                            End If

                            Sleep IIf(vtSvcStatus.dwWaitHint > 500, 500, _
                                                            vtSvcStatus.dwWaitHint)
                        Loop

                        vyRet = True
                    End If
                    Exit Do

                Case SERVICE_PAUSED     '現在一時停止      '(O)
                    If (argeAction = Svc_continue) And _
                        ((vtSvcStatus.dwControlsAccepted And _
                                            SERVICE_ACCEPT_PAUSE_CONTINUE) > 0) Then

                        'サービス再開
                        If ControlService(vlHService, SERVICE_CONTROL_CONTINUE, _
                                                                   vtSvcStatus) = 0 Then
                            vyRet = False: Exit Do
                        End If

                        '状態変更確認までループ
                        Do Until QueryServiceStatus(vlHService, vtSvcStatus) = 0
                            If vtSvcStatus.dwCurrentState = SERVICE_RUNNING Then
                                Exit Do
                            End If

                            Sleep IIf(vtSvcStatus.dwWaitHint > 500, 500, _
                                                            vtSvcStatus.dwWaitHint)
                        Loop

                        vyRet = True

                    ElseIf (argeAction = Svc_stop) And _
                            ((vtSvcStatus.dwControlsAccepted And _
                                                        SERVICE_ACCEPT_STOP) > 0) Then
                        'サービス停止
                        If (ControlService(vlHService, SERVICE_CONTROL_STOP, _
                                                                vtSvcStatus) = 0) Then
                            vyRet = False: Exit Do
                        End If

                        '状態変更確認までループ
                        Do Until QueryServiceStatus(vlHService, vtSvcStatus) = 0
                            If vtSvcStatus.dwCurrentState = SERVICE_STOPPED Then
                                Exit Do
                            End If

                            Sleep IIf(vtSvcStatus.dwWaitHint > 500, 500, _
                                                            vtSvcStatus.dwWaitHint)
                        Loop

                        vyRet = True

                    End If
                    Exit Do

                Case Else    'Pending状態の時        '(P)
                    Sleep IIf(vtSvcStatus.dwWaitHint > 500, 500, _
                                                            vtSvcStatus.dwWaitHint)

                    If QueryServiceStatus(vlHService, vtSvcStatus) = 0 Then
                        Exit Do
                    End If
            End Select
        Loop      '(a')

        Exit Do
    Loop

    '各ハンドルのclose
    If vlHService <> 0 Then CloseServiceHandle vlHService
    If vlHSCManager <> 0 Then CloseServiceHandle vlHSCManager
    
    '戻値の設定
    ChangeServiceStatus = vyRet
End Function

(A),(B),(C)はGetServiceStatus のときとほぼ同じですが、(B)のOpenServiceの第三引数はサービスの状態を変更するので、それを許可できるように定数を加えます。

(C)で SERVICE_STATUS 構造体のdwCurrentStateに現在のサービスの状態を受け取っているので (D)以下で場合分けをしています。

(E)のサービスが停止中の時は変更できる状態は実行中、つまりサービス開始アクション( Svc_Start)なのでそれ以外は何もしないようにします。(F)

(G)でサービスを開始しますが直ちに状態は変更しないので、 (H)で状態が変更するまでQueryServiceStatusを実行して無限ループに入ります。ループ内でQueryServiceStatusを実行することによって受け取ったdwCurrentStateがRunningになったらループを抜けます。(I)　　状態がまだRunningになっていない場合は、 (J)でSleepして制御を一時停止します。どれだけ停止するかを指定するかを第一引数で指定しますが、 SERVICE_STATUS 構造体のインスタンスvtSvcStatusのdwWaitHintは状態を変更するまでに必要とされる見積もり時間（ミリ秒単位)なので、これを指定します。

(K)の実行中の時は、変更できる状態は停止中と一時停止、つまり停止アクション(Svc_Stop) (L)と、一時停止アクション(Svc_Pause) (N)なので、それぞれ場合分けをします。(L)と(N)で場合分けすると同時に、そのサービスが SERVICE_STATUS 構造体のdwControlsAcceptedメンバで停止や一時停止ができるかも確認しています。

(M)でサービスを停止させ、サービス開始の時と同様の処理を行います。

(O)のサービス一時停止のときは、再開アクション( Svc_Continue)と停止アクション( Svc_Stop)で上記と同様の処理をします。

現在のサービスの状態が停止中、実行中、一時停止中以外は (P)のルーチンが実行されます。これはサービスの状態がPendingということなのでSleepで制御を一時停止してループしています。((a)～(a')のループ)

最後に各ハンドルをCloseして戻値を返します。

これでサービスの状態の取得と変更ができるようになったので、次回はスタートアップの種類の取得／変更について書きます。