Link to home
Create AccountLog in
Visual Basic Classic

Visual Basic Classic

--

Questions

--

Followers

Top Experts

Avatar of Ryan_R
Ryan_R🇦🇺

Start (Restart) Messenger service in VB6,
i wuold like to start/restart the Messenger service in win2000pro / XP Pro from my VB6 app so that i can send messages via the network. There was something else that i wanted to incorporate into this (and split points later) but i can't remember it right now - will adjust when i think of it.

Zero AI Policy

We believe in human intelligence. Our moderation policy strictly prohibits the use of LLM content in our Q&A threads.


Avatar of vinnyd79vinnyd79


Shell Environ("ComSpec") & " /c net start messenger", vbHide

Avatar of Ryan_RRyan_R🇦🇺

ASKER

thanks, that's worth half the points until i figure out what the other half is for (i knew i shoud've writting it down) - will probably have it tomorrow morning

Reward 1Reward 2Reward 3Reward 4Reward 5Reward 6

EARN REWARDS FOR ASKING, ANSWERING, AND MORE.

Earn free swag for participating on the platform.


Avatar of Ryan_RRyan_R🇦🇺

ASKER

do i go the first link or second one?

The first option is a simple way to start a service by calling the net start command.
Change it to 'net stop' to stop a service. If you change vbHide to vbNormalFocus you will see the command window open,run the command and close.

The answer in the second link is the API method to start/stop and query services.
This would be a better way to go, but is a bit more code.

Avatar of Ryan_RRyan_R🇦🇺

ASKER

ok thanks

Free T-shirt

Get a FREE t-shirt when you ask your first question.

We believe in human intelligence. Our moderation policy strictly prohibits the use of LLM content in our Q&A threads.


Avatar of jkaiosjkaios🇲🇭

The following codes requires a reference to the "Active DS Type Library" (activeds.tlb)
Once the referene is set, the code will work on any machine provided that you have the
proper security privileges.


Example:

Private Sub Command1_Click()
  If StartService() Then
     Msgbox "The Messenger service started successfully"
  End If
End Sub

Private Sub Command2_Click()
  If StopService(, , True) Then
     Msgbox "The Messenger service stopped successfully and was disabled"
  End If
End Sub

You can start and stop any service by specifying the name of the service in the second parameter
of each function.  You can also start and stop any service on any computer by specifying the name
of the desired computer in the first parameter.  If you omitted, the local computer is used.

================================================================
Option Explicit

' Constants for Service Status
Private Const STATUS_STOPPED = &H1
Private Const STATUS_START_PENDING = &H2
Private Const STATUS_STOP_PENDING = &H3
Private Const STATUS_RUNNING = &H4
Private Const STATUS_CONTINUE_PENDING = &H5
Private Const STATUS_PAUSE_PENDING = &H6
Private Const STATUS_PAUSED = &H7
Private Const STATUS_STARTING = &H8

' Startup Type enumerators
Public Enum STARTUP_TYPE_ENUM
   ST_AUTO = 2
   ST_MANUAL = 3
   ST_DISABLED = 4
End Enum

================================================================
Public Function StartService(Optional ByVal sMachine As String, _
                             Optional ByVal ServiceName As String = "Messenger", _
                             Optional ByVal lStartupType As STARTUP_TYPE_ENUM = ST_AUTO) As Boolean
 
 Dim oComp As ActiveDs.IADsComputer
 Dim oSvc1 As ActiveDs.IADsService
 Dim oSvc2 As ActiveDs.IADsServiceOperations
 Dim sComputerName As String
 
 On Error GoTo Err_Handler
 
 If sMachine = "" Then
   sMachine = Environ$("ComputerName")
 End If
 
 sComputerName = "WinNT://" & sMachine & ",computer"
 
 Set oComp = GetObject(sComputerName)
 Set oSvc1 = oComp.GetObject("Service", ServiceName)
 Set oSvc2 = oComp.GetObject("Service", ServiceName)
 
 ' First, check the service start-up type
 ' and set it to the specified startup type
 If oSvc1.StartType <> lStartupType Then
    oSvc1.StartType = lStartupType
    oSvc1.SetInfo     'Apply changes
 End If
 
 ' Second, check the current status
 ' and then start it as necessary
 If oSvc2.Status = STATUS_STOPPED Then
    oSvc2.Start
 End If
 
 StartService = True
 
 Exit Function
Err_Handler:
 StartService = False
 'MsgBox Err.Number & " - " & Err.Description
 
End Function

================================================================
Public Function StopService(Optional ByVal sMachine As String, _
                            Optional ByVal ServiceName As String = "Messenger", _
                            Optional ByVal bDisable As Boolean) As Boolean

 Dim oComp As ActiveDs.IADsComputer
 Dim oSvc1 As ActiveDs.IADsService
 Dim oSvc2 As ActiveDs.IADsServiceOperations
 Dim sComputerName As String
 
 On Error GoTo Err_Handler
 
 If sMachine = "" Then
   sMachine = Environ$("ComputerName")
 End If
 
 sComputerName = "WinNT://" & sMachine & ",computer"
 
 Set oComp = GetObject(sComputerName)
 Set oSvc1 = oComp.GetObject("Service", ServiceName)
 Set oSvc2 = oComp.GetObject("Service", ServiceName)
 
 ' First, check to see if service is
 ' currently runnng and stop it
 If oSvc2.Status = STATUS_RUNNING Then
    oSvc2.Stop
 End If
 
 ' Second, check the startup type to see
 ' if it has not already been disabled
 If bDisable Then
   If oSvc1.StartType <> STARTUP_DISABLED Then
      oSvc1.StartType = STARTUP_DISABLED
      oSvc1.SetInfo     'Apply changes
   End If
 End If
 
 StopService = True
 
 Exit Function
Err_Handler:
 StopService = False
 'MsgBox Err.Number & " - " & Err.Description
 
End Function
================================================================

Avatar of Ryan_RRyan_R🇦🇺

ASKER

the other part of the q. was this:

i want to query if the PC the app is run on is connected to the LAN (if there is any network connection)
i would run this code in a timer with a small interval - so i don't want the proc to take too long.
Thanks (worth the other half of the points)

Avatar of Ryan_RRyan_R🇦🇺

ASKER

i'm sure there was a link around here that said Alter question or Alter Title, or has that disappeared now that ther are comments on here?

Reward 1Reward 2Reward 3Reward 4Reward 5Reward 6

EARN REWARDS FOR ASKING, ANSWERING, AND MORE.

Earn free swag for participating on the platform.


Avatar of Ryan_RRyan_R🇦🇺

ASKER

would i be correct in assuming that the current users subscribed to this post are unsure of the 2nd part of this q. Fell free to post an "i dunno"

Not sure if this is an option for you, but this is an example of pinging the default gateway with 1 packet to see if a reply is received. Try adding this to a form with a command button and a timer.


Option Explicit
Private Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, _
    phWritePipe As Long, lpPipeAttributes As Any, ByVal nSize As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, ByVal lpBuffer As String, _
    ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Any) As Long
Private Declare Function CreateProcessA Lib "kernel32" (ByVal lpApplicationName As Long, _
    ByVal lpCommandLine As String, lpProcessAttributes As SECURITY_ATTRIBUTES, _
    lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, _
    ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, _
    ByVal lpCurrentDirectory As Long, lpStartupInfo As STARTUPINFO, _
    lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hHandle As Long) As Long

Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type

Private Type STARTUPINFO
    cb As Long
    lpReserved As Long
    lpDesktop As Long
    lpTitle As Long
    dwX As Long
    dwY As Long
    dwXSize As Long
    dwYSize As Long
    dwXCountChars As Long
    dwYCountChars As Long
    dwFillAttribute As Long
    dwFlags As Long
    wShowWindow As Integer
    cbReserved2 As Integer
    lpReserved2 As Long
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type

Private Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessID As Long
    dwThreadID As Long
End Type

Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const STARTF_USESTDHANDLES = &H100&
Private Const STARTF_USESHOWWINDOW = &H1
Private DefaultGateway As String

Private Sub Form_Load()
DefaultGateway = GetDefaultGateway
End Sub

Private Sub Timer1_Timer()
If PingGateway = False Then
    MsgBox "Not Connected"
End If
End Sub

Private Function RunCommand(sCmd As String) As String
Dim proc As PROCESS_INFORMATION
Dim start As STARTUPINFO
Dim sa As SECURITY_ATTRIBUTES
Dim hReadPipe As Long, hWritePipe As Long
Dim ret As Long, lngBytesread As Long
Dim strBuff As String * 256, RetData As String
sa.nLength = Len(sa)
sa.bInheritHandle = 1&
sa.lpSecurityDescriptor = 0&
ret = CreatePipe(hReadPipe, hWritePipe, sa, 0)
start.cb = Len(start)
start.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
start.hStdOutput = hWritePipe
start.hStdError = hWritePipe
ret = CreateProcessA(0&, sCmd, sa, sa, 1&, _
        NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
ret = CloseHandle(hWritePipe)
RetData = ""
Do
    ret = ReadFile(hReadPipe, strBuff, 256, lngBytesread, 0&)
    RetData = RetData & Left(strBuff, lngBytesread)
Loop While ret <> 0
ret = CloseHandle(proc.hProcess)
ret = CloseHandle(proc.hThread)
ret = CloseHandle(hReadPipe)
RunCommand = RetData
End Function

Private Function GetDefaultGateway() As String
Dim sCmd As String, pos As Integer
sCmd = RunCommand("ipconfig")
pos = InStr(sCmd, "Default Gateway")
pos = InStr(pos, sCmd, ":") + 1
GetDefaultGateway = Trim$(Mid$(sCmd, pos, 15))
End Function

Private Function PingGateway() As Boolean
Dim sCmd As String, pos As Integer
sCmd = RunCommand("ping -n 1 " & DefaultGateway)
pos = InStr(sCmd, "Received = 1")
If pos > 0 Then
    PingGateway = True
Else
    PingGateway = False
End If
End Function



Avatar of Ryan_RRyan_R🇦🇺

ASKER

thanks - will try tonight

Free T-shirt

Get a FREE t-shirt when you ask your first question.

We believe in human intelligence. Our moderation policy strictly prohibits the use of LLM content in our Q&A threads.


Avatar of Ryan_RRyan_R🇦🇺

ASKER

after altering the code in the above post i got it to work - so will give points for that

btw i just used the lines:

tmrLan.Timer
sCmd = RunCommand("ipconfig")
if instr(UCase(scmd), "DISCONNECTED" then
   ' disconnected icon
else
  '  connected icon
endif

Regarding the Services part - works fine except for one thing - Messenger service by default on XP is DISABLED - which means my app can't run it (no errors generated - except when i query if it's running it says that it's stopped)

How in VB6 can i change it from Disabled to Automatic?

Thanks. almost done with this Q.
Ryan R

This should do it:

Option Explicit
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const ERROR_SUCCESS = 0&
Private Const REG_DWORD = 4

Private Sub Command1_Click()
Call EnableMessengerService
End Sub

Private Sub EnableMessengerService()
Dim lResult As Long, keyhand As Long, r As Long
r = RegCreateKey(HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Services\Messenger", keyhand)
lResult = RegSetValueEx(keyhand, "Start", 0&, REG_DWORD, 2, 4) ' 2=automatic
r = RegCloseKey(keyhand)
End Sub

Avatar of Ryan_RRyan_R🇦🇺

ASKER

thanks for that - will try tonight and get back here either on weekend or monday

Reward 1Reward 2Reward 3Reward 4Reward 5Reward 6

EARN REWARDS FOR ASKING, ANSWERING, AND MORE.

Earn free swag for participating on the platform.


Avatar of Ryan_RRyan_R🇦🇺

ASKER

ok that code was great - changed it from disabled to auto no probs

However, when i run both items of code in the same app (leaving time inbetween running the two proc's) the code to change from Diasabled works but the code to start Messenger does absolutely NOTHING now - any ideas why???

Thanks

Avatar of Ryan_RRyan_R🇦🇺

ASKER



any ideas guys?


I think you need to use ChangeServiceConfig API.

Free T-shirt

Get a FREE t-shirt when you ask your first question.

We believe in human intelligence. Our moderation policy strictly prohibits the use of LLM content in our Q&A threads.


Avatar of Ryan_RRyan_R🇦🇺

ASKER

can you point me in the right direction here, thanks.

I'll try to put together an example but might not have the time until tomorrow.

Avatar of Ryan_RRyan_R🇦🇺

ASKER

that's ok - will wait til then

Reward 1Reward 2Reward 3Reward 4Reward 5Reward 6

EARN REWARDS FOR ASKING, ANSWERING, AND MORE.

Earn free swag for participating on the platform.


ASKER CERTIFIED SOLUTION
Avatar of vinnyd79vinnyd79

Link to home
membership
Log in or create a free account to see answer.
Signing up is free and takes 30 seconds. No credit card required.
Create Account

Avatar of Ryan_RRyan_R🇦🇺

ASKER

i assume you mean to call it like as follows:

If module1.EnableMessengerService = True Then
      module1.StartMessengerService
End If

'''''''''''

That worked no probs... thanks a lot vinnyd79. Will close Q now.

Ryan R

As long as the EnableMessengerService and StartMessengerService routines are declared as Public you shouldn't need to add module1.

Avatar of Ryan_RRyan_R🇦🇺

ASKER

oh well, works now anyway. (I'll have to go through and get rid off all the code i'm not using now... app was running a little slow last time i tesyed it - or my pc was playing up again - will find out soon)

Thanks again...

Free T-shirt

Get a FREE t-shirt when you ask your first question.

We believe in human intelligence. Our moderation policy strictly prohibits the use of LLM content in our Q&A threads.

Visual Basic Classic

Visual Basic Classic

--

Questions

--

Followers

Top Experts

Visual Basic is Microsoft’s event-driven programming language and integrated development environment (IDE) for its Component Object Model (COM) programming model. It is relatively easy to learn and use because of its graphical development features and BASIC heritage. It has been replaced with VB.NET, and is very similar to VBA (Visual Basic for Applications), the programming language for the Microsoft Office product line.