추신. 서비스 종류등은 클래스 내부에 StartNTService()에서 지정할 수 있습니다.

사용 전 기본설정

자 클래스니까 또 선언하고 세팅해야 합니다.

dim servDM as claDamuriService
Set servDM = new claDamuriService

기본설정

servDM.SetName "Service Name", "Service Name", app.path & "\Service.exe"

서비스 명과 서비스의 주체인 실행파일을 지정합니다.
- [1] Service Name - 내부 서비스 명
- [2] Service Name - 서비스 이름 (서비스 관리자에서 이름 컬럼에서 나올 이름을 지정)
- [3] 서비스가 시작될 프로세스의 파일명을 포함한 전체경로

운용 방법

사용법은 무진장 간단합니다. 클래스 개조해서 이름을 아래 함수에서 받아서 처리하면 궂이 위에 기본설정이 필요하지 않을 수도 있게 할 수 있을 것 같지요. 가능합니다. ㅋ
소스 보시면 알게되겠지만 서비스 시작같은 경우 내부적으로 상태값을 가져와 Start상태가 아닐때만 서비스를 시작합니다. 다른 함수들도 다 마찬가지 이구요.

서비스 시작

servDM.StartSVC

서비스 종료

servDM.StopSVC

서비스 등록

servDM.RegSVC

서비스 해지

servDM.UnregSVC

소스 전문

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "claDamuriService"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
' Use "RegSVC, StartSVC, StopSVC and UnRegSVC

Option Explicit

Private Type OSVERSIONINFO
        dwOSVersionInfoSize As Long
        dwMajorVersion As Long
        dwMinorVersion As Long
        dwBuildNumber As Long
        dwPlatformId As Long
        szCSDVersion(1 To 128) As Byte
End Type
Private Const VER_PLATFORM_WIN32_NT = 2&

Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long

Private Declare Function ShellExecute Lib "shell32" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private Const SW_SHOWNORMAL = 1&
Dim ServState As SERVICE_STATE, Installed As Boolean

Private Const ERROR_SERVICE_DOES_NOT_EXIST = 1060&
Private Const SERVICE_WIN32_OWN_PROCESS = &H10&
Private Const SERVICE_KERNEL_DRIVER = &H1&
Private Const SERVICE_WIN32_SHARE_PROCESS = &H20&
Private Const SERVICE_WIN32 = SERVICE_WIN32_OWN_PROCESS + _
                                                                 SERVICE_WIN32_SHARE_PROCESS
Private Const SERVICE_FILE_SYSTEM_DRIVER = &H2&
Private Const SERVICE_ACCEPT_STOP = &H1
Private Const SERVICE_ACCEPT_PAUSE_CONTINUE = &H2
Private Const SERVICE_ACCEPT_SHUTDOWN = &H4
Private Const SC_MANAGER_CONNECT = &H1&
Private Const SC_MANAGER_CREATE_SERVICE = &H2&
Private Const SC_MANAGER_ENUMERATE_SERVICE = &H4
'Private Const SC_MANAGER_LOCK = &H8
'Private Const SC_MANAGER_QUERY_LOCK_STATUS = &H10
'Private Const SC_MANAGER_MODIFY_BOOT_CONFIG = &H20
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const SERVICE_QUERY_CONFIG = &H1&
Private Const SERVICE_CHANGE_CONFIG = &H2&
Private Const SERVICE_QUERY_STATUS = &H4&
Private Const SERVICE_ENUMERATE_DEPENDENTS = &H8&
Private Const SERVICE_START = &H10&
Private Const SERVICE_STOP = &H20&
Private Const SERVICE_PAUSE_CONTINUE = &H40&
Private Const SERVICE_INTERROGATE = &H80&
Private Const SERVICE_USER_DEFINED_CONTROL = &H100&
Private Const SERVICE_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or _
                                    SERVICE_QUERY_CONFIG Or _
                                    SERVICE_CHANGE_CONFIG Or _
                                    SERVICE_QUERY_STATUS Or _
                                    SERVICE_ENUMERATE_DEPENDENTS Or _
                                    SERVICE_START Or _
                                    SERVICE_STOP Or _
                                    SERVICE_PAUSE_CONTINUE Or _
                                    SERVICE_INTERROGATE Or _
                                    SERVICE_USER_DEFINED_CONTROL)
Private Const SERVICE_AUTO_START As Long = 2
Private Const SERVICE_DEMAND_START As Long = 3
Private Const SERVICE_ERROR_NORMAL As Long = 1
Private Const ERROR_INSUFFICIENT_BUFFER = 122&

Private Enum SERVICE_CONTROL
        SERVICE_CONTROL_STOP = 1&
        SERVICE_CONTROL_PAUSE = 2&
        SERVICE_CONTROL_CONTINUE = 3&
        SERVICE_CONTROL_INTERROGATE = 4&
        SERVICE_CONTROL_SHUTDOWN = 5&
End Enum

Public Enum SERVICE_STATE
        SERVICE_STOPPED = &H1
        SERVICE_START_PENDING = &H2
        SERVICE_STOP_PENDING = &H3
        SERVICE_RUNNING = &H4
        SERVICE_CONTINUE_PENDING = &H5
        SERVICE_PAUSE_PENDING = &H6
        SERVICE_PAUSED = &H7
End Enum

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

Private Type QUERY_SERVICE_CONFIG
        dwServiceType As Long
        dwStartType As Long
        dwErrorControl As Long
        lpBinaryPathName As Long
        lpLoadOrderGroup As Long
        dwTagId As Long
        lpDependencies As Long
        lpServiceStartName As Long
        lpDisplayName As Long
End Type

Private Declare Function OpenSCManager _
          Lib "advapi32" Alias "OpenSCManagerA" _
          (ByVal lpMachineName As String, ByVal lpDatabaseName As String, _
          ByVal dwDesiredAccess As Long) As Long
Private Declare Function CreateService _
          Lib "advapi32" Alias "CreateServiceA" _
          (ByVal hSCManager As Long, ByVal lpServiceName As String, _
          ByVal lpDisplayName As String, ByVal dwDesiredAccess 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 String, _
          ByVal lpDependencies As String, ByVal lp As String, _
          ByVal lpPassword As String) As Long
Private Declare Function DeleteService _
          Lib "advapi32" (ByVal hService As Long) As Long
Private Declare Function CloseServiceHandle _
          Lib "advapi32" (ByVal hSCObject As Long) As Long
Private Declare Function OpenService _
          Lib "advapi32" Alias "OpenServiceA" _
          (ByVal hSCManager As Long, ByVal lpServiceName As String, _
          ByVal dwDesiredAccess As Long) As Long   '** Change SERVICE_NAME as needed
Private Declare Function QueryServiceConfig Lib "advapi32" _
          Alias "QueryServiceConfigA" (ByVal hService As Long, _
          lpServiceConfig As QUERY_SERVICE_CONFIG, _
          ByVal cbBufSize As Long, pcbBytesNeeded As Long) As Long
Private Declare Function QueryServiceStatus Lib "advapi32" _
        (ByVal hService As Long, lpServiceStatus As SERVICE_STATUS) As Long
Private Declare Function ControlService Lib "advapi32" _
                (ByVal hService As Long, ByVal dwControl As SERVICE_CONTROL, _
                lpServiceStatus As SERVICE_STATUS) As Long
Private Declare Function StartService Lib "advapi32" _
                Alias "StartServiceA" (ByVal hService As Long, _
                ByVal dwNumServiceArgs As Long, ByVal lpServiceArgVectors As Long) As Long
Private Declare Function NetWkstaUserGetInfo Lib "Netapi32" (ByVal reserved As Any, ByVal Level As Long, lpBuffer As Any) As Long
Private Declare Function NetApiBufferFree Lib "Netapi32" (ByVal lpBuffer As Long) As Long

Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long

Private SERVICE_NAME As String
Private SERVICE_DISPLAY_NAME As String
Private SERVICE_FILE_NAME As String

Public AppPath As String

Public Function SetName(ServiceName As String, ServiceDisplayName As String, ServiceExecutefullPath As String)
    SERVICE_NAME = ServiceName
    SERVICE_DISPLAY_NAME = ServiceDisplayName
    SERVICE_FILE_NAME = ServiceExecutefullPath
End Function

' This function returns current service status
' or 0 on error
Private Function GetServiceStatus() As SERVICE_STATE
    Dim hSCManager As Long, hService As Long, Status As SERVICE_STATUS
    hSCManager = OpenSCManager(vbNullString, vbNullString, _
                                               SC_MANAGER_CONNECT)
    If hSCManager <> 0 Then
        hService = OpenService(hSCManager, SERVICE_NAME, SERVICE_QUERY_STATUS)
        If hService <> 0 Then
                If QueryServiceStatus(hService, Status) Then
                        GetServiceStatus = Status.dwCurrentState
                End If
                CloseServiceHandle hService
        End If
        CloseServiceHandle hSCManager
    End If
End Function

Public Function QueryServiceStat() As String
    Dim nStat As SERVICE_STATE
    nStat = GetServiceStatus
    Select Case nStat
        Case SERVICE_STOPPED
            QueryServiceStat = "Service Is Stopped"
        Case SERVICE_START_PENDING
            QueryServiceStat = "Service Start Pending"
        Case SERVICE_STOP_PENDING
            QueryServiceStat = "Service Stop Pending"
        Case SERVICE_RUNNING
            QueryServiceStat = "Service Is Running"
        Case SERVICE_CONTINUE_PENDING
            QueryServiceStat = "Service Continue Pending"
        Case SERVICE_PAUSE_PENDING
            QueryServiceStat = "Service Pause Pending"
        Case SERVICE_PAUSED
            QueryServiceStat = "Service Paused"
        Case &HFF
            QueryServiceStat = "Service not found"
    End Select
End Function

' This function fills Service Account field in form.
' It returns nonzero value on error

Private Function GetServiceConfig() As Long
    Dim hSCManager As Long, hService As Long
    Dim r As Long, SCfg() As QUERY_SERVICE_CONFIG, r1 As Long, s As String
    
    hSCManager = OpenSCManager(vbNullString, vbNullString, _
                                               SC_MANAGER_CONNECT)
    If hSCManager <> 0 Then
            hService = OpenService(hSCManager, SERVICE_NAME, SERVICE_QUERY_CONFIG)
            If hService <> 0 Then
                    ReDim SCfg(1 To 1)
                    If QueryServiceConfig(hService, SCfg(1), 36, r) = 0 Then
                            If Err.LastDllError = ERROR_INSUFFICIENT_BUFFER Then
                                    r1 = r \ 36 + 1
                                    ReDim SCfg(1 To r1)
                                    If QueryServiceConfig(hService, SCfg(1), r1 * 36, r) <> 0 Then
                                            s = Space$(255)
                                            lstrcpy s, SCfg(1).lpServiceStartName
                                            s = Left$(s, lstrlen(s))
                                    Else
                                            GetServiceConfig = Err.LastDllError
                                    End If
                            Else
                                    GetServiceConfig = Err.LastDllError
                            End If
                    End If
                    CloseServiceHandle hService
            Else
                    GetServiceConfig = Err.LastDllError
            End If
            CloseServiceHandle hSCManager
    Else
            GetServiceConfig = Err.LastDllError
    End If
End Function

' This function installs service on local computer
' It returns nonzero value on error
Private Function SetNTService() As Long
    Dim hSCManager As Long
    Dim hService As Long, DomainName As String
    
    hSCManager = OpenSCManager(vbNullString, vbNullString, _
                                               SC_MANAGER_CREATE_SERVICE)
    If hSCManager <> 0 Then
    ' Install service to manual start. To set service to autostart
    ' replace SERVICE_DEMAND_START to SERVICE_AUTO_START
            hService = CreateService(hSCManager, SERVICE_NAME, _
                                               SERVICE_DISPLAY_NAME, SERVICE_ALL_ACCESS, _
                                               SERVICE_KERNEL_DRIVER, _
                                               SERVICE_DEMAND_START, SERVICE_ERROR_NORMAL, _
                                               SERVICE_FILE_NAME, vbNullString, _
                                               vbNullString, vbNullString, vbNullString, _
                                               vbNullString)
                            
            If hService <> 0 Then
                    CloseServiceHandle hService
            Else
                    SetNTService = Err.LastDllError
            End If
            CloseServiceHandle hSCManager
    Else
            SetNTService = Err.LastDllError
    End If
End Function

' This function uninstalls service
' It returns nonzero value on error
Private Function DeleteNTService() As Long
    Dim hSCManager As Long
    Dim hService As Long, Status As SERVICE_STATUS
    
    hSCManager = OpenSCManager(vbNullString, vbNullString, _
                                               SC_MANAGER_CONNECT)
    If hSCManager <> 0 Then
            hService = OpenService(hSCManager, SERVICE_NAME, _
                                               SERVICE_ALL_ACCESS)
            If hService <> 0 Then
    ' Stop service if it is running
                    ControlService hService, SERVICE_CONTROL_STOP, Status
                    If DeleteService(hService) = 0 Then
                            DeleteNTService = Err.LastDllError
                    End If
                    CloseServiceHandle hService
            Else
                    DeleteNTService = Err.LastDllError
            End If
            CloseServiceHandle hSCManager
    Else
            DeleteNTService = Err.LastDllError
    End If

End Function

' This function returns local network domain name
' or zero-length string on error
Public Function GetDomainName() As String
    Dim lpBuffer As Long, l As Long, p As Long
    If NetWkstaUserGetInfo(0&, 1&, lpBuffer) = 0 Then
        CopyMemory p, ByVal lpBuffer + 4, 4
        l = lstrlenW(p)
        If l > 0 Then
                GetDomainName = Space$(l)
                CopyMemory ByVal StrPtr(GetDomainName), ByVal p, l * 2
        End If
        NetApiBufferFree lpBuffer
    End If
End Function

' This function starts service
' It returns nonzero value on error
Private Function StartNTService() As Long
Dim hSCManager As Long, hService As Long
hSCManager = OpenSCManager(vbNullString, vbNullString, _
                                           SC_MANAGER_CONNECT)
If hSCManager <> 0 Then
        hService = OpenService(hSCManager, SERVICE_NAME, SERVICE_START)
        If hService <> 0 Then
                If StartService(hService, 0, 0) = 0 Then
                        StartNTService = Err.LastDllError
                End If
        CloseServiceHandle hService
        Else
                StartNTService = Err.LastDllError
        End If
CloseServiceHandle hSCManager
Else
        StartNTService = Err.LastDllError
End If
End Function

' This function stops service
' It returns nonzero value on error
Private Function StopNTService() As Long
    Dim hSCManager As Long, hService As Long, Status As SERVICE_STATUS
    hSCManager = OpenSCManager(vbNullString, vbNullString, _
                                               SC_MANAGER_CONNECT)
    If hSCManager <> 0 Then
        hService = OpenService(hSCManager, SERVICE_NAME, SERVICE_STOP)
        If hService <> 0 Then
            If ControlService(hService, SERVICE_CONTROL_STOP, Status) = 0 Then
                StopNTService = Err.LastDllError
            End If
        CloseServiceHandle hService
        Else
            StopNTService = Err.LastDllError
        End If
    CloseServiceHandle hSCManager
    Else
        StopNTService = Err.LastDllError
    End If
End Function

Private Function CheckService() As SERVICE_STATE
    If GetServiceConfig() = 0 Then
        Installed = True
        ServState = GetServiceStatus()
        CheckService = ServState
        Select Case ServState
            Case SERVICE_RUNNING
            Case SERVICE_STOPPED
            Case Else
        End Select
    Else
        Installed = False
    End If
End Function

Public Sub RegSVC()
        CheckService
        If Not Installed Then
                SetNTService
        End If
        CheckService
        'MsgBox ("It's installed")
End Sub

Public Sub UnRegSVC()
    CheckService
    If Installed Then
        DeleteNTService
    End If
'MsgBox ("Now it's uninstalled")
End Sub

Public Sub StartSVC()
    CheckService
    If ServState = SERVICE_STOPPED Then
        StartNTService
    End If
    CheckService
        'MsgBox ("Now it's Started")
End Sub

Public Sub StopSVC()
    CheckService
    If ServState = SERVICE_RUNNING Then
            StopNTService
    End If
    CheckService
        'MsgBox ("Now it's Stopped")
End Sub

VB 6.0에서 윈도우 서비스를 클래스로 운용하는 방법

사용 전 기본설정

운용 방법

소스 전문

첨부 파일

댓글 (0)

다른 게시글