Service - VBA(VB6) - Win32 API編その３

・スタートアップの種類の取得

前ページで準備ができたところでスタートアップの種類の取得のコーディングをします。 Functionプロシージャで、プロシージャ名はGetStartMode、引数はサービス名を受け取る String型、戻り値はここで定義したQUERY_SERVICE_CONFIG構造体のdwStartTypeメンバで受け取れる定数です。

    
'スタートアップの種類の取得
'引数 argsName : サービス名
'戻値 QUERY_SERVICE_CONFIG構造体のdwStartModeで受け取ることができる定数
Public Function GetStartMode(ByVal argsName As String) As Long

    Dim vlRet        As Long
    Dim vlHSCManager As Long    'サービス制御マネージャのデータベースハンドル
    Dim vlHService   As Long    'サービスのハンドル
    Dim vbyBuf()     As Byte    'QUERY_SERVICE_CONFIGの結果を受け取るバッファ
    Dim vlSize       As Long    'QUERY_SERVICE_CONFIGの結果を受け取るサイズ
    Dim vtSvcConf    As QUERY_SERVICE_CONFIG


    Do    
        'サービス制御マネージャのデータベースOpen
        vlHSCManager = OpenSCManager("", "ServicesActive", SC_MANAGER_CONNECT)  '(A)
        If vlHSCManager = 0 Then
            vlRet = SERVICE_NONE: Exit Do
        End If

        'サービスOpen
        vlHService = OpenService(vlHSCManager, argsName, SERVICE_QUERY_CONFIG)  '(B)
        If vlHService = 0 Then
            vlRet = SERVICE_NONE: Exit Do
        End If

        '結果を受け取るQUERY_SERVICE_CONFIG構造体のサイズ取得
        ReDim vbyBuf(0)             '(C)
        vlSize = 0     

        If QueryServiceConfig(vlHService, vbyBuf(0), vlSize, vlSize) = 0 And _
                            Err.LastDllError <> ERROR_INSUFFICIENT_BUFFER Then  '(D)
            vlRet = SERVICE_NONE: Exit Do
        End If

        'バッファに結果取得
        ReDim vbyBuf(vlSize)        '(E)
    
        If QueryServiceConfig(vlHService, vbyBuf(0), vlSize, vlSize) = 0 Then   '(F)
            vlRet = SERVICE_NONE: Exit Do
        End If

        'QUERY_SERVICE_CONFIG構造体に受け取ったバッファからコピー
        CopyMemory vtSvcConf, vbyBuf(0), LenB(vtSvcConf)    '(G)

        vlRet = vtSvcConf.dwStartType

        Exit Do
    Loop

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

    GetStartMode = vlRet
End Function

(A)、(B)はサービスの状態の取得／設定で使いましたので説明は省きます。ただ、QueryServiceConfigを有効にするために、OpenService関数の第三引数で SERVICE_QUERY_CONFIG定数に変わっています。

Byte型の配列vbyBufに対象サービスのサービス構成パラメータの結果を受け取りますが、先にも書きましたように結果を受け入れるためのサイズはこの時点ではわからないのでわざとQueryServiceConfig関数を失敗させるために(C)で第二、第三引数に渡す値を最小に設定します。

(D)でERROR_INSUFFICIENT_ERROR(領域不足)で失敗しますが、第四引数に必要バイト数が変数vlSizeに返ってきます。このサイズを元に(E)で再度配列のサイズを設定しなおします。

これで結果を第二引数に受け取る準備ができましたので、Byte型配列vbyBufの先頭アドレスを(F)で渡してあげます。

成功したら、ここで説明したようにvbyBufからvtSvcConf構造体にメモリコピーする操作をします。 CopyMemoryの定義を見ると分かるように第一、第二引数は参照渡しなので、それぞれ構造体名、配列の先頭の変数名を指定するとそのアドレスが渡ることになります。コピーするサイズはこの図で説明したようにQUERY_SERVICE_CONFIG型のサイズですからLenB(vtSvcConf)を設定します。

そして目的のdwStartTypeの値を取得して、最後に各ハンドルを閉じます。

・おまけ

せっかく苦労して文字列のサービス構成パラメータを取得したので、これも出力してみましょう。ポインタから文字列を取得するにはlstrcpyを使うことは前に書きました。 Win32Api.txt からコピーしましょう。

Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" _
        (ByVal lpString1 As String, _
         ByVal lpString2 As String) As Long

lstrcpyのC言語の定義は以下のようです。

LPTSTR lstrcpy(
    LPTSTR   lpString1,   // コピー先のバッファ
    LPCTSTR  lpString2    // コピー元の文字列
);

これから第一引数は、コピー先のメモリ領域の先頭アドレス、コピー元の文字列が格納されているメモリ領域の先頭アドレスです。ここで第二引数は、前項目のQUERY_SERVICE_CONFIG 構造体のインスタンスvtSvcConfのメンバ、例えばlpBinaryPathNameを指定することになりますが、ここはポインタのLong型に変更していたので>String型では不味いのでLong型に変更します。

Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" _
        (ByVal lpString1 As String, _
         ByVal lpString2 As Long) As Long

それでは、GetStartModeプロシージャに変更を加えます。

'スタートアップの種類の取得
'引数 argsName : サービス名
'戻値 QUERY_SERVICE_CONFIG構造体のdwStartModeで受け取ることができる定数
Public Function GetStartMode(ByVal argsName As String) As Long


    Dim vlRet        As Long
    Dim vlHSCManager As Long     'サービス制御マネージャのデータベースハンドル
    Dim vlHService   As Long 'サービスのハンドル
    Dim vbyBuf()     As Byte 'QUERY_SERVICE_CONFIGの結果を受け取るバッファ
    Dim vlSize       As Long 'QUERY_SERVICE_CONFIGの結果を受け取るサイズ
    Dim vtSvcConf    As QUERY_SERVICE_CONFIG

    Dim vsValue      As String
    Dim vvData       As Variant
    Dim i            As Long

    Do
        'サービス制御マネージャのデータベースOpen
        vlHSCManager = OpenSCManager("", "ServicesActive", SC_MANAGER_CONNECT)   '(A)
        If vlHSCManager = 0 Then
            vlRet = SERVICE_NONE: Exit Do
        End If

        'サービスOpen
        vlHService = OpenService(vlHSCManager, argsName, SERVICE_QUERY_CONFIG)  '(B)
        If vlHService = 0 Then
            vlRet = SERVICE_NONE: Exit Do
        End If

        '結果を受け取るQUERY_SERVICE_CONFIG構造体のサイズ取得
        ReDim vbyBuf(0)          '(C)
        vlSize = 0

        If QueryServiceConfig(vlHService, vbyBuf(0), vlSize, vlSize) = 0 And _
                            Err.LastDllError <> ERROR_INSUFFICIENT_BUFFER Then  '(D)
            vlRet = SERVICE_NONE: Exit Do
        End If

        'バッファに結果取得
        ReDim vbyBuf(vlSize)      '(E)
    
        If QueryServiceConfig(vlHService, vbyBuf(0), vlSize, vlSize) = 0 Then   '(F)
            vlRet = SERVICE_NONE: Exit Do
        End If

        'QUERY_SERVICE_CONFIG構造体に受け取ったバッファからコピー
        CopyMemory vtSvcConf, vbyBuf(0), LenB(vtSvcConf)     '(G)

        vvData = Array(vtSvcConf.lpBinaryPathName, "lpBinaryPathName", _
                       vtSvcConf.lpDependencies, "lpDependencies", _
                       vtSvcConf.lpDisplayName, "lpDisplayName", _
                       vtSvcConf.lpLoadOrderGroup, "lpLoadOrderGroup", _
                       vtSvcConf.lpServiceStartName, "lpServiceStartName")

        For i = 0 To UBound(vvData) Step 2
            vsValue = Space(255)
            lstrcpy vsValue, CLng(vvData(i))
            Debug.Print vvData(i + 1) & " : " & vsValue
        Next i

        vvData = Array(vtSvcConf.dwErrorControl, "dwErrorControl", _
                       vtSvcConf.dwServiceType, "dwServiceType", _
                       vtSvcConf.dwStartType, "dwStartType", _     
                       vtSvcConf.dwTagId, "dwTagId")

        For i = 0 To UBound(vvData) Step 2
            Debug.Print vvData(i + 1) & " : " & vvData(i)
        Next i
  
        vlRet = vtSvcConf.dwStartType

        Exit Do
    Loop

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

    GetStartMode = vlRet
End Function

・スタートアップの種類の変更

スタートアップの種類の変更はChangeServiceConigを使います。いつものように Win32Api.txtからコピーします。

Private Declare Function ChangeServiceConfig Lib "advapi32.dll" Alias _
                                                    "ChangeServiceConfigA" _
                (ByVal hService As Long, _
                 ByVal dwServiceType As Long, _
                 ByVal dwStartType As Long, _
                 ByVal dwErrorControl As Long, _
                 ByVal lpBinaryPathName As String, _
                 ByVal lpLoadOrderGroup As String, _
                 lpdwTagId As Long, _
                 ByVal lpDependencies As String, _
                 ByVal lpServiceStartName As String, _
                 ByVal lpPassword As String, _
                 ByVal lpDisplayName As String) As Long

引数がたくさんあってややこしそうですが、第一引数のhService、第十引数の lpPassword以外はQUERY_SERVICE_CONFIG構造体のメンバで、変更するのはdwStartTypeのみです。このうち、lpdwTagIdだけは参照渡しです。MSDNの解説には

============================================================================
［出力］タグ値を受け取る変数へのポインタを指定します。このタグ値は、lpLoadOrderGroup パラメータで指定されたグループで一意の値です。既存のタグを変更しない場合は、NULLを指定します。 ============================================================================
とあります。Long型の変数を宣言して、この引数に設定するようですが、変更しないのでNULL、つまり0を設定したいのですが、参照渡しではメモリのアドレスが0を渡さなければならなくてやりづらいので、値渡しで0を渡すように変更します。

最後の引数lpDisplayNameですが、スタートアップの種類の取得で書いたように、結果を受け取るQUERY_SERVICE_CONFIGのそのメンバはポインタのLong型で受けているので、そのままLong型の値を渡せるようにString型からLong型に変更します。

Private Declare Function ChangeServiceConfig Lib "advapi32.dll" Alias _
                                                    "ChangeServiceConfigA" _
                (ByVal hService As Long, _
                 ByVal dwServiceType As Long, _
                 ByVal dwStartType As Long, _
                 ByVal dwErrorControl As Long, _
                 ByVal lpBinaryPathName As String, _
                 ByVal lpLoadOrderGroup As String, _
                 ByVal lpdwTagId As Long, _
                 ByVal lpDependencies As String, _
                 ByVal lpServiceStartName As String, _
                 ByVal lpPassword As String, _
                 ByVal lpDisplayName As Long) As Long

他のString型のメンバはどうなの？ということになりそうですが、これらの値は変更しない場合NULL(0)を与えてやればよいので、vbNullStringを渡せばいいでしょう。 (受け取ったQUERY_SERVICE_CONFIGの値をつかわないということです)

あと、OpenServiceの第三引数でChangeServiceConfigが変更できるように設定する定数を設定し、もうひとつ、ChangeServiceConfigのdwServiceType、dwErrorControl引数に変更しないよう設定する定数SERVICE_NO_CHANGEを定義します。

'OpenService用定数
Private Const SERVICE_CHANGE_CONFIG = &H2

'ChangeServiceConfig用定数
Private Const SERVICE_NO_CHANGE = &HFFFF

それでは実装します。

'スタートアップの種類変更
'引数 argsName : サービス名
'     arglStartMode : 変更するスタートアップの種類(Auto, Manual, Disable)
'戻値 成功 True, 失敗 False
Public Function ChangeStartMode(ByVal argsName As String, _
                                ByVal arglStartMode As Long) As Boolean
    Dim vyRet        As Boolean
    Dim vlHSCManager As Long
    Dim vlHService   As Long
    Dim vbyBuf()     As Byte
    Dim vlSize       As Long
    Dim vtSvcConf    As QUERY_SERVICE_CONFIG

    Do
        vlHSCManager = OpenSCManager("", "ServicesActive", SC_MANAGER_CONNECT)
        If vlHSCManager = 0 Then
            vyRet = False: Exit Do
        End If

        vlHService = OpenService(vlHSCManager, argsName, SERVICE_QUERY_CONFIG _
                                                      Or SERVICE_CHANGE_CONFIG)
        If vlHService = 0 Then
            vyRet = False: Exit Do
        End If

        ReDim vbyBuf(0)
        vlSize = 0
        If QueryServiceConfig(vlHService, vbyBuf(0), vlSize, vlSize) = 0 And _
                                Err.LastDllError <> ERROR_INSUFFICIENT_BUFFER Then
            vyRet = False: Exit Do
        End If

        ReDim vbyBuf(vlSize)
        If QueryServiceConfig(vlHService, vbyBuf(0), vlSize, vlSize) = 0 Then
            vyRet = False: Exit Do
        End If

        CopyMemory vtSvcConf, vbyBuf(0), LenB(vtSvcConf)        '(A)

        If ChangeServiceConfig(hService:=vlHService, _
                                dwServiceType:=SERVICE_NO_CHANGE, _
                                dwStartType:=arglStartMode, _
                                dwErrorControl:=SERVICE_NO_CHANGE, _
                                lpBinaryPathName:=vbNullString, _
                                lpLoadOrderGroup:=vbNullString, _
                                lpdwTagId:=0&, _
                                lpDependencies:=vbNullString, _
                                lpServiceStartName:=vbNullString, _
                                lpPassword:=vbNullString, _
                                lpDisplayName:=vtSvcConf.lpDisplayName) = 0 Then
            vyRet = False: Exit Do    
        End If

        vyRet = True

        Exit Do
    Loop

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

    ChangeStartMode = vyRet
End Function

(A)までは、スタートアップの種類の取得とほぼ同様です。ChangeServiceConfigの各引数に、変更しない場合は、SERVICE_NO_CHANGEまたはvbNullStringを与えて、dwStartTypeだけ変更しています。

・最後に

これでAPIを使ったサービスの制御について終わりますが、他のAPIを使用する際にも応用が利くように前提知識も少し書いたつもりです。いずれにしてもAPIはC言語で書かれているのでメモリ周りを意識しながらのコーディングは避けられないと個人的には思いますが、VBA(VB6)はもともとそういうことを意識しなくてもプログラムできるように作られた言語のひとつだと思いますので、無理して使う必要もないかもしれません。

次は、APIを使った方法からみると天国のようなやり方を書いてみます。