Как сделать прогу сервисом?

Программирование на Visual Basic, главный форум. Обсуждение тем программирования на VB 1—6.
Даже если вы плохо разбираетесь в VB и программировании вообще — тут вам помогут. В разумных пределах, конечно.
Правила форума
Темы, в которых будет сначала написано «что нужно сделать», а затем просьба «помогите», будут закрыты.
Читайте требования к создаваемым темам.
Tok
Обычный пользователь
Обычный пользователь
 
Сообщения: 51
Зарегистрирован: 28.09.2003 (Вс) 16:14
Откуда: Алчевск (Украина)

Как сделать прогу сервисом?

Сообщение Tok » 18.04.2004 (Вс) 4:26

Как сделать прогу сервисом? Со всеми "делами" - описаниями, зависимостями и т.д.
Back from the dead
I am resurrected
to spew, putrefaction...
http://gutted.nm.ru

gaidar
System Debugger
System Debugger
 
Сообщения: 3152
Зарегистрирован: 23.12.2001 (Вс) 13:22

Re: Как сделать прогу сервисом?

Сообщение gaidar » 18.04.2004 (Вс) 12:14

Tok писал(а):Как сделать прогу сервисом? Со всеми "делами" - описаниями, зависимостями и т.д.


Только очень обходными путями с использованием "сторонних" контролов.
А вообще - писать на VB6 сервисы - идея довольно-таки дурная, при наличии уже отработаных средств в VC, или в .NET :)

А за примерами - сюда: www.pscode.com И ище services
The difficult I’ll do right now. The impossible will take a little while. (c) US engineers in WWII
I don't always know what I'm talking about, but I know I'm right. (c) Muhammad Ali

hCORe
VB - Экстремал
VB - Экстремал
Аватара пользователя
 
Сообщения: 2332
Зарегистрирован: 22.02.2003 (Сб) 15:21
Откуда: parent directory

Сообщение hCORe » 18.04.2004 (Вс) 14:08

При помощи разных ухищрений (например, утилиты srvany.exe, которая превращает любую программу в службу) на уровне системы тоже можно. Но вот то, что ты сможешь работать напрямую с ядром - вряд ли :evil:
Моду создают модоки, а распространяют модозвоны.

gaidar
System Debugger
System Debugger
 
Сообщения: 3152
Зарегистрирован: 23.12.2001 (Вс) 13:22

Сообщение gaidar » 18.04.2004 (Вс) 16:21

hCORe писал(а):При помощи разных ухищрений (например, утилиты srvany.exe, которая превращает любую программу в службу) на уровне системы тоже можно. Но вот то, что ты сможешь работать напрямую с ядром - вряд ли :evil:


Ну, скажем так, сервисом от этого программа не станет :), а лишь каким-то подобием.
The difficult I’ll do right now. The impossible will take a little while. (c) US engineers in WWII
I don't always know what I'm talking about, but I know I'm right. (c) Muhammad Ali

codemaster
Постоялец
Постоялец
Аватара пользователя
 
Сообщения: 604
Зарегистрирован: 13.02.2004 (Пт) 13:35

Re: Как сделать прогу сервисом?

Сообщение codemaster » 18.04.2004 (Вс) 19:08

gaidar писал(а):Только очень обходными путями с использованием "сторонних" контролов.

Зачем сторонние когда есть "родные" примеры от MSDN
http://msdn.microsoft.com/archive/defau ... srvocx.asp
gaidar писал(а):А вообще - писать на VB6 сервисы - идея довольно-таки дурная, при наличии уже отработаных средств в VC, или в .NET :)

Идея неплохая Главное внятно представлять чем этот сервис будет заниматься

gaidar
System Debugger
System Debugger
 
Сообщения: 3152
Зарегистрирован: 23.12.2001 (Вс) 13:22

Сообщение gaidar » 18.04.2004 (Вс) 22:09

Кхм. Все-таки - всовывать еще и "левый" ActiveX, это не то. То ли дело простенький сервис, написаный на Си :) - один exe и никаких проблем. О! Вспомнил, на www.pscode.com мой пример на C++ есть :).

А на VB и с левым OCX - это не для высокопроизводительных систем.
The difficult I’ll do right now. The impossible will take a little while. (c) US engineers in WWII
I don't always know what I'm talking about, but I know I'm right. (c) Muhammad Ali

codemaster
Постоялец
Постоялец
Аватара пользователя
 
Сообщения: 604
Зарегистрирован: 13.02.2004 (Пт) 13:35

Сообщение codemaster » 19.04.2004 (Пн) 10:43

gaidar писал(а):Кхм. Все-таки - всовывать еще и "левый" ActiveX, это не то. То ли дело простенький сервис, написаный на Си :) - один exe и никаких проблем. О! Вспомнил, на www.pscode.com мой пример на C++ есть :).

А на VB и с левым OCX - это не для высокопроизводительных систем.



Наверное решающими должны быть сроки выполнения и навыки
Что касается производительности то это вопрос открытый
Был у нас боец индус активно пользовавший
СString и подобное от MFC производительность была ....... :D :D

Konst_One
Член-корреспондент академии VBStreets
Член-корреспондент академии VBStreets
Аватара пользователя
 
Сообщения: 3041
Зарегистрирован: 09.04.2004 (Пт) 13:47
Откуда: Химки

Сообщение Konst_One » 19.04.2004 (Пн) 10:55

Можно.
Код: Выделить всё
'Модуль сервиса
'NTService.bas
'
Public Type ServiceConfigType
  ServiceName As String
  DisplayName As String
  FileName As String
  StartType As Long
  AccountName As String
  Password As String
  Parameters As String
End Type

Public ServiceConfig As ServiceConfigType
Private Declare Function CreateThread Lib "kernel32" (ByVal lpThreadAttributes As Long, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, ByVal lpParameter As Long, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long

Private ServiceStatus As SERVICE_STATUS
Private hServiceStatus As Long

Private Const ERROR_SERVICE_DOES_NOT_EXIST = 1060&
Private Const SERVICE_WIN32_OWN_PROCESS = &H10&
'Private Const SERVICE_WIN32_SHARE_PROCESS = &H20&
'Private Const SERVICE_WIN32 = SERVICE_WIN32_OWN_PROCESS + _
                                 SERVICE_WIN32_SHARE_PROCESS
'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)
'//
'// Start Type
'//
Private Enum SERVICE_START_TYPE
    SERVICE_BOOT_START = &H0
    SERVICE_SYSTEM_START = &H1
    SERVICE_AUTO_START = &H2
    SERVICE_DEMAND_START = &H3
    SERVICE_DISABLED = &H4
End Enum

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

' This function fills Service Account field in form.
' It returns nonzero value on error
Public Function GetServiceConfig(ByVal ServiceName As String) As Long
Dim hSCManager As Long, hService As Long
Dim r As Long, SCfg() As QUERY_SERVICE_CONFIG, r1 As Long, s As String

ServiceConfig.ServiceName = ""
hSCManager = OpenSCManager(vbNullString, vbNullString, _
                       SC_MANAGER_CONNECT)
If hSCManager <> 0 Then
    hService = OpenService(hSCManager, ServiceName, 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
                    ServiceConfig.ServiceName = ServiceName
                    ServiceConfig.StartType = SCfg(1).dwStartType
                    ' AccountName
                    s = Space$(255)
                    lstrcpy s, SCfg(1).lpServiceStartName
                    ServiceConfig.AccountName = Left$(s, lstrlen(s))
                    lstrcpy s, SCfg(1).lpDisplayName
                    ServiceConfig.DisplayName = Left$(s, lstrlen(s))
                    lstrcpy s, SCfg(1).lpBinaryPathName
                    ServiceConfig.FileName = Left$(s, lstrlen(s))
                    Dim Pos As Long
                    Pos = InStr(1, ServiceConfig.FileName, " ")
                    If Pos > 0 Then
                      ServiceConfig.Parameters = Mid(ServiceConfig.FileName, Pos + 1)
                      ServiceConfig.FileName = Left(ServiceConfig.FileName, Pos - 1)
                    End If
                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 returns current service status or 0 on error
Public 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, ServiceConfig.ServiceName, 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

' This function installs service on local computer
' It returns nonzero value on error
Public Function SetNTService() As Long
Dim hSCManager As Long
Dim hService As Long, DomainName As String

If Len(ServiceConfig.AccountName) = 0 Then
  ServiceConfig.AccountName = "LocalSystem"
End If
'If AccountName <> "LocalSystem" Then
'' Add domain name to account string
'    If InStr(1, AccountName, "\") = 0 Then
'        DomainName = GetDomainName()
'        If DomainName = "" Then DomainName = "."
'        AccountName = DomainName & "\" & AccountName
'    End If
'End If
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, ServiceConfig.ServiceName, _
                       ServiceConfig.DisplayName, SERVICE_ALL_ACCESS, _
                       SERVICE_WIN32_OWN_PROCESS, _
                       SERVICE_AUTO_START, SERVICE_ERROR_NORMAL, _
                       Trim(ServiceConfig.FileName & " " & ServiceConfig.Parameters), vbNullString, _
                       vbNullString, vbNullString, ServiceConfig.AccountName, _
                       ServiceConfig.Password)
    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
Public 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, ServiceConfig.ServiceName, _
                       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
Public 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, ServiceConfig.ServiceName, 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
Public 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, ServiceConfig.ServiceName, 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

' The FncPtr function returns function pointer.
Function FncPtr(ByVal fnp As Long) As Long
    FncPtr = fnp
End Function

' The StartAsService function creates Service Dispatcher thread.
Public Function StartAsService() As Long
    Dim ThreadId As Long
    StartAsService = CreateThread(0&, 0&, AddressOf ServiceThread, 0&, 0&, ThreadId)
End Function

' The ServiceThread sub starts the service.
' This sub returns control only after service termination.
Private Sub ServiceThread(ByVal dummy As Long)
    Dim ServiceTableEntry As SERVICE_TABLE
    ServiceTableEntry.lpServiceName = ServiceNamePtr
    ServiceTableEntry.lpServiceProc = FncPtr(AddressOf ServiceMain)
    StartServiceCtrlDispatcher ServiceTableEntry
End Sub

' The ServiceMain sub - main service sub.
' It initializes service,
' sets event hStartEvent, and waits hStopEvent event.
' When hStopEvent fires, this sub exits and service stops.
Private Sub ServiceMain(ByVal dwArgc As Long, ByVal lpszArgv As Long)
    ServiceStatus.dwServiceType = SERVICE_WIN32_OWN_PROCESS
    ServiceStatus.dwControlsAccepted = SERVICE_ACCEPT_STOP _
                                    Or SERVICE_ACCEPT_SHUTDOWN
    ServiceStatus.dwWin32ExitCode = 0&
    ServiceStatus.dwServiceSpecificExitCode = 0&
    ServiceStatus.dwCheckPoint = 0&
    ServiceStatus.dwWaitHint = 0&
    hServiceStatus = RegisterServiceCtrlHandler(Service_Name, _
                           AddressOf Handler)
    SetServiceState SERVICE_START_PENDING
    ' Set hStartEvent. It unlocks main application thread
    ' which allows to do some work in it
    SetEvent hStartEvent
    ' Wait until hStopEvent fires
    WaitForSingleObject hStopEvent, INFINITE
End Sub
   
' The Handler sub processes commands from Service Dispatcher.
' It sets event hStopEvent when processes command
' SERVICE_CONTROL_STOP or SERVICE_CONTROL_SHUTDOWN.
Private Sub Handler(ByVal fdwControl As Long)
    Select Case fdwControl
        Case SERVICE_CONTROL_SHUTDOWN, SERVICE_CONTROL_STOP
            SetServiceState SERVICE_STOP_PENDING
            SetEvent hStopPendingEvent
        Case Else
            SetServiceState
    End Select
End Sub

' The SetServiceState sub changes service state.
' If parameter omitted, it confirms previous state.
Public Sub SetServiceState(Optional ByVal NewState As SERVICE_STATE = 0&)
    If NewState <> 0& Then ServiceStatus.dwCurrentState = NewState
    SetServiceStatus hServiceStatus, ServiceStatus
End Sub

'модуль программы
'mMain.bas
'
Public Service_Name As String
Public Const INFINITE = -1&      '  Infinite timeout
Private Const WAIT_TIMEOUT = 258&

Public Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion(1 To 128) As Byte      '  Maintenance string for PSS usage
End Type

Public Const VER_PLATFORM_WIN32_NT = 2&

Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hWnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long

Public hStopEvent As Long
Public hStartEvent As Long
Public hStopPendingEvent As Long
Public IsNT As Boolean
Public IsNTService As Boolean
Public ServiceName() As Byte
Public ServiceNamePtr As Long
'
'
Public AppName   As String
Public CmdArgs As CommandArguments
'

Public Sub Idle(Optional msec As Long = 0)
Dim EndTime As Long
  EndTime = GetTickCount() + msec
  Do
    DoEvents
    Sleep 1
  Loop While GetTickCount() < EndTime
End Sub


Private Sub Main()
 
  AppName = App.EXEName
   
  ' коллекция параметров коммандной строки
  Set CmdArgs = New CommandArguments
 
  ' описание сервиса
  NTService.ServiceConfig.FileName = App.Path & "\" & App.EXEName & ".exe"
  NTService.ServiceConfig.DisplayName = CmdArgs("display", App.ProductName)
 
  If CmdArgs.Exists("install") Then
    ' инсталляция
    Service_Name = CmdArgs("install", AppName)
    NTService.ServiceConfig.ServiceName = Service_Name
    NTService.ServiceConfig.Parameters = "-service " & Service_Name & _
                              " -config """ & CmdArgs("config", App.Path & "\" & defConfigIni) & """" & _
                              " -refreshtimeout 10000"
    NTService.SetNTService

  ElseIf CmdArgs.Exists("uninstall") Then
    ' деинсталляция
    Service_Name = CmdArgs("uninstall", AppName)
    NTService.ServiceConfig.ServiceName = Service_Name
    NTService.DeleteNTService

  ElseIf CmdArgs.Exists("start") Then
    ' старт
    Service_Name = CmdArgs("start", AppName)
    NTService.ServiceConfig.ServiceName = Service_Name
    NTService.StartNTService
 
  ElseIf CmdArgs.Exists("stop") Then
    ' стоп
    Service_Name = CmdArgs("stop", AppName)
    NTService.ServiceConfig.ServiceName = Service_Name
    NTService.StopNTService
 
  Else
    'собственно работа
    mMain.GetConfigParams
    '
   
    If CmdArgs.Exists("service") Then
   
        LogInfo VBA.Command$
       
      Dim hnd As Long
      Dim h(0 To 1) As Long
      ' Check OS type
      IsNT = CheckIsNT()
      ' Creating events
      hStopEvent = CreateEvent(0, 1, 0, vbNullString)
      hStopPendingEvent = CreateEvent(0, 1, 0, vbNullString)
      hStartEvent = CreateEvent(0, 1, 0, vbNullString)
      ServiceName = StrConv(Service_Name, vbFromUnicode)
      ServiceNamePtr = VarPtr(ServiceName(LBound(ServiceName)))
      If IsNT Then
          ' Trying to start service
          hnd = StartAsService
          h(0) = hnd
          h(1) = hStartEvent
          ' Waiting for one of two events: sucsessful service start (1) or
          ' terminaton of service thread (0)
          IsNTService = WaitForMultipleObjects(2&, h(0), 0&, INFINITE) = 1&
          If Not IsNTService Then
              CloseHandle hnd
              'MsgBox "This program must be started as service."
              MessageBox 0&, "This program must be started as a service.", App.Title, vbInformation Or vbOKOnly Or vbMsgBoxSetForeground
          End If
      Else
          MessageBox 0&, "This program is only for Windows NT/2000/XP.", App.Title, vbInformation Or vbOKOnly Or vbMsgBoxSetForeground
      End If
        If IsNTService Then
          ' ******************
          ' Here you may initialize and start service's objects
          ' These objects must be event-driven and must return control
          ' immediately after starting.
          ' ******************
          SetServiceState SERVICE_RUNNING
         
          '
          'здесь можно проинициализировать сервис
          '
          If mMain.ImportProcessStarted Then
          Do
              ' ******************
              ' It is main service loop. Here you may place statements
              ' which perform useful functionality of this service.
              ' ******************
              ' Loop repeats every second. You may change this interval.
              '
              '
              'а здесь выполняем нужные нам действия
              ProcessData
              '
          Loop While WaitForSingleObject(hStopPendingEvent, RefreshTimeout) = WAIT_TIMEOUT
          End If
          ' ******************
          ' Here you may stop and destroy service's objects
          ' ******************
          SetServiceState SERVICE_STOPPED
          SetEvent hStopEvent
          ' Waiting for service thread termination
          WaitForSingleObject hnd, INFINITE
          CloseHandle hnd
        End If
        CloseHandle hStopEvent
        CloseHandle hStartEvent
        CloseHandle hStopPendingEvent
        '
        '
        'здесь нужно удалить глобальные переменные
        '
    Else
        '
        'здесь показываем форму настроек, если запускаем без параметров
        f_Options.Show
    End If
  End If
 
  Set CmdArgs = Nothing
 
 
End Sub


Tok
Обычный пользователь
Обычный пользователь
 
Сообщения: 51
Зарегистрирован: 28.09.2003 (Вс) 16:14
Откуда: Алчевск (Украина)

Сообщение Tok » 20.04.2004 (Вт) 4:31

Может примерчик дадите по использованию данного кода? Сам пытаюсь, но безуспешно :cry:
Back from the dead
I am resurrected
to spew, putrefaction...
http://gutted.nm.ru

Sebas
Неуловимый Джо
Неуловимый Джо
Аватара пользователя
 
Сообщения: 3626
Зарегистрирован: 12.02.2002 (Вт) 17:25
Откуда: столько наглости такие вопросы задавать

Сообщение Sebas » 20.04.2004 (Вт) 8:49

Tok писал(а):Может примерчик дадите по использованию данного кода? Сам пытаюсь, но безуспешно :cry:

Тебе ж ссылку на Микрософт дали! У меня NTSVC.OCX работает без проблем. Проверено! Бываю лажи с установкой службы, а в работе нет.

Используй! К тому же по сравнению с кодом выше, объём на порядок меньше.
- Я никогда не понимал, почему они приходят ко мне чтобы умирать?

sebas<-@->mail.ru


Вернуться в Visual Basic 1–6

Кто сейчас на конференции

Сейчас этот форум просматривают: Yandex-бот и гости: 18

    TopList