Hey guys I'm trying to stop one service and then restart a different service.
Right now I have this code to restart a service
Public Sub RestartService(ByVal myServiceName As String)
Dim DataSource As String = TextBox1.Text
Dim sStatus As String
Dim myController As ServiceController
myController = New ServiceController
myController.MachineName = DataSource
myController.ServiceName = myServiceName
TextBox2.Text += "Stopping service """ & myServiceName & """...." & vbNewLine
If myController.Status = ServiceProcess.ServiceControllerStatus.Stopped Then
TextBox2.Text += "Service """ & myServiceName & """ is already stopped" & vbNewLine
Else
Try
myController.Refresh()
sStatus = myController.Status.ToString
myController.Stop()
myController.WaitForStatus(ServiceControllerStatus.Stopped)
TextBox2.Text += "Service """ & myServiceName & """ stopped..." & vbNewLine
TextBox2.Text += "Starting service """ & myServiceName & """...." & vbNewLine
myController.Refresh()
sStatus = myController.Status.ToString
myController.Start()
myController.WaitForStatus(ServiceControllerStatus.Running)
TextBox2.Text += "Service """ & myServiceName & """ started..." & vbNewLine
Catch exp As Exception
TextBox2.Text += exp.Message
End Try
End If
End Sub
And this one to Stop a service:
Public Sub StopService(ByVal myServiceName As String)
Dim DataSource As String = TextBox1.Text
Dim sStatus As String
Dim myController As ServiceController
myController = New ServiceController
myController.MachineName = DataSource
myController.ServiceName = myServiceName
TextBox2.Text += "Stopping service """ & myServiceName & """...." & vbNewLine
If myController.Status = ServiceProcess.ServiceControllerStatus.Stopped Then
TextBox2.Text += "Service """ & myServiceName & """ is already stopped" & vbNewLine
Else
Try
myController.Refresh()
sStatus = myController.Status.ToString
myController.Stop()
myController.WaitForStatus(ServiceControllerStatus.Stopped)
TextBox2.Text += "Service """ & myServiceName & """ stopped..." & vbNewLine
Catch exp As Exception
TextBox2.Text += "Could not stop service """ & myServiceName & """" & vbNewLine
End Try
End If
End Sub
But when I try to click this button, it only stops the first service and it doesn't restart the second service.
Private Sub Button19_Click(sender As Object, e As EventArgs) Handles
Button19.Click
If MsgBox("Are you sure you want to restart Spooler Service?", vbYesNo) = vbNo Then Exit Sub
StopService("LPDSVC")
RestartService("Spooler")
End Sub
What am I missing inbetween stop and restartservice?
Turns out that the code is right and its working, I was testing it in the wrong way.
Its solved 😂😂😂😂😂
Related
I'm using a COM interface to export animations from a third-party program. I'm sending an exporting COM command with script from my tool with a shell command.
There's a problem with when I send the animation export command to the third-party tool. It starts to export, but my tool is sending a second animation export command while the last one is not finished. How can I prevent from this situation?
I'd like to sending my shell command from the for loop after the file was created.
My code is like below.
Private Sub tlbCheckSolveEvaCtrl_exportmodeshape_Click(sender As Object, e As EventArgs) Handles tlbCheckSolveEvaCtrl_exportmodeshape.Click
Try
Dim strArgument As String
Dim strfilePathEV As String
Dim strfilePathANI As String
Dim strfilePathPIC As String
strfilePathEV = strProjMdlDir & My.Settings.txtCheckSolverOuputDir & strProjMdlName & ".ev.sbr"
strfilePathANI = strProjMdlDir & "\" & My.Settings.txtProjDirDOC & "\" & My.Settings.txtProjDirANI & "\"
strfilePathPIC = strProjMdlDir & "\" & My.Settings.txtProjDirDOC & "\" & My.Settings.txtProjDirPIC & "\"
For i As Integer = 0 To dgvCheckSolveEva.RowCount - 1
strArgument = strfilePathEV & " " & _
strfilePathANI & strProjMdlName & "_" & i & ".mpg" & " " & _
i
Shell(My.Settings.txtSpckDir & "simpack-post.exe -s qs_mode_shape.qs " & strArgument)
Next
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
I'd like to continue my for loop if strfilePathANI & strProjMdlName & "_" & i & ".mpg", the animation file was created, so I can start to export the next one.
The best way would be to use the .NET Process class and call the WaitForExit() method in order to wait for simpack-post.exe to close itself.
Shell() is an outdated function from the VB6-era which exists purely for partial backwards compatibility with that language. It shouldn't be used in new code.
Basic example:
Dim filePath As String = Path.Combine(My.Settings.txtSpckDir, "simpack-post.exe")
Process.Start(filePath, "-s qs_mode_shape.qs " & strArgument).WaitForExit()
The problem with this of course is that it might block the UI thread and thus cause it to freeze, depending on how long it takes for the process to exit. Therefore we should wrap it in a Task:
Dim c As Integer = dgvCheckSolveEva.RowCount - 1
Task.Run( _
Sub()
For i As Integer = 0 To c
strArgument = strfilePathEV & " " & _
strfilePathANI & strProjMdlName & "_" & i & ".mpg" & " " & _
i
Dim filePath As String = Path.Combine(My.Settings.txtSpckDir, "simpack-post.exe")
Process.Start(filePath, "-s qs_mode_shape.qs " & strArgument).WaitForExit()
Next
End Sub _
)
Just note that you cannot directly access the UI from within the task. If you want to do so you need to Invoke.
EDIT:
If you are targeting .NET Framework 3.5 or lower, or using VS 2008 or lower, tasks aren't available and we have to resort to using regular threads and/or regular methods instead of lamba expressions.
Note that the same rules apply, though - you cannot access the UI without invoking.
.NET 3.5 (or lower) using VS 2010 (and higher):
Dim c As Integer = dgvCheckSolveEva.RowCount - 1
Dim t As New Thread( _
Sub()
For i As Integer = 0 To c
strArgument = strfilePathEV & " " & _
strfilePathANI & strProjMdlName & "_" & i & ".mpg" & " " & _
i
Dim filePath As String = Path.Combine(My.Settings.txtSpckDir, "simpack-post.exe")
Process.Start(filePath, "-s qs_mode_shape.qs " & strArgument).WaitForExit()
Next
End Sub _
)
t.IsBackground = True
t.Start()
.NET 3.5 (or lower) using VS 2008 (or lower):
Private Sub tlbCheckSolveEvaCtrl_exportmodeshape_Click(sender As Object, e As EventArgs) Handles tlbCheckSolveEvaCtrl_exportmodeshape.Click
...your code...
Dim c As Integer = dgvCheckSolveEva.RowCount - 1
Dim t As New Thread(New ParameterizedThreadStart(AddressOf ExportAnimationsThread))
t.IsBackground = True
t.Start(c)
...your code...
End Sub
Private Sub ExportAnimationsThread(ByVal Count As Integer)
For i As Integer = 0 To Count
strArgument = strfilePathEV & " " & _
strfilePathANI & strProjMdlName & "_" & i & ".mpg" & " " & _
i
Dim filePath As String = Path.Combine(My.Settings.txtSpckDir, "simpack-post.exe")
Process.Start(filePath, "-s qs_mode_shape.qs " & strArgument).WaitForExit()
Next
End Sub
Hi I am creating a chat like application. Can you kindly help me?
When I am entering a new message the initial displayed message is getting replaced :(
Please see my codes below:
Private Sub saveMessage()
FileName = Format(Now, "MMddyyyyhhmmss")
Dim RecipientFile As String
If CurrentRecipient = "Edward" Then
RecipientFile = RecipientFolder & FileName & ".txt"
ElseIf CurrentRecipient = "Criziel" Then
RecipientFile = RecipientFolder & FileName & ".txt"
ElseIf CurrentRecipient = "Jerome" Then
RecipientFile = RecipientFile & FileName & ".txt"
Else
Exit Sub
End If
Dim Writer As IO.StreamWriter
Writer = New IO.StreamWriter(RecipientFile)
Writer.Write(MainRichTextBox.Text)
Writer.Close()
ShowtextRichTextBox.Text = (User & " : ") & MainRichTextBox.Text
MainRichTextBox.Clear()
End Sub
Thank you in advance ! :*
Your below code is just assigning (replacing) the latest value to the Rich TextBox,
ShowtextRichTextBox.Text = (User & " : ") & MainRichTextBox.Text
Instead, you should append the text as below,
ShowtextRichTextBox.Text &= (User & " : ") & MainRichTextBox.Text
Also, you can try the inbuild method of RichTextBox to append the text like, ShowtextRichTextBox.AppendText((User & " : ") & MainRichTextBox.Text)
Note: When appending, you should also add newline before the new text like, ShowtextRichTextBox.Text &= Environment.NewLine & (User & " : ") & MainRichTextBox.Text.
Modified code,
Private Sub saveMessage()
FileName = Format(Now, "MMddyyyyhhmmss")
Dim RecipientFile As String
If CurrentRecipient = "Edward" Then
RecipientFile = RecipientFolder & FileName & ".txt"
ElseIf CurrentRecipient = "Criziel" Then
RecipientFile = RecipientFolder & FileName & ".txt"
ElseIf CurrentRecipient = "Jerome" Then
RecipientFile = RecipientFile & FileName & ".txt"
Else
Exit Sub
End If
Dim Writer As IO.StreamWriter
Writer = New IO.StreamWriter(RecipientFile)
Writer.Write(MainRichTextBox.Text)
Writer.Close()
ShowtextRichTextBox.Text &= Environment.NewLine & (User & " : ") & MainRichTextBox.Text
MainRichTextBox.Clear()
End Sub
I have written a URL monitoring program in vb using .net 4.0. Basically it sets a timer checks the url every 60 minutes using an htpwebreques/httpwebresponse and sends an email if the url is down. However the memory used by the application keeps increasing every time the url is checked. This will obviously eventually cause a problem as the app is designed to run permanently monitoring a website for availability and the monitoring machine will eventually run out of resources.
Code for my CheckURL routine below. Any advice greatly appreciated, thanks in advance.
Private Sub checkURL()
Timer1.Stop()
Dim wReq As HttpWebRequest
Dim wResp As HttpWebResponse ' WebResponse
wReq = HttpWebRequest.Create(url)
wReq.Method = "HEAD"
Try
wResp = wReq.GetResponse()
If wResp.StatusCode = 200 Then
txtResponse.Text = wResp.StatusCode & ": " & wResp.StatusDescription & vbNewLine & "The " & siteName & " is up"
'Only send success results if specified
If sendOnFailure = False Then
sendResults = True
End If
Else txtResponse.Text = "There may be a problem with the " & siteName & vbNewLine & "Please verify manually that it is operational." & vbNewLine & "The response received was:" & vbNewLine & "Status Code: " & wResp.StatusCode & " - " & wResp.StatusDescription
sendResults = True
End If
wResp.Close()
wResp = Nothing
wReq = Nothing
Catch ex As Exception
txtResponse.Text = "There may be a problem with the " & siteName & vbNewLine & "The error returned was:" & vbNewLine & ex.ToString
sendResults = True
End Try
txtLastCheck.Text = Now.ToString("d MMM yyyy HH:mm")
setNextCheck()
End Sub
First, you should use Option Strict On, which will show you where you have variable type mismatches and may even suggest corrections for you, for example, see where the DirectCast operator is used in the following code.
Second, HttpWebResponse has a .Dispose() method, so you should call that when you have finished using it, or, as Zaggler pointed out, you can use Using to ensure that unmanaged resources are cleaned up properly, thus removing the memory leak you are concerned with. Note that there may be other similar problems in the code we can't see.
You should not set things to Nothing in an attempt to get rid of them - doing so messes with the garbage collector and does nothing to ensure their clean disposal.
Option Strict On
' ....
Private Sub checkURL()
timer1.Stop()
Dim wReq As HttpWebRequest = DirectCast(HttpWebRequest.Create(url), HttpWebRequest)
wReq.Method = "HEAD"
Try
Using wResp As HttpWebResponse = DirectCast(wReq.GetResponse(), HttpWebResponse)
If wResp.StatusCode = 200 Then
txtResponse.Text = wResp.StatusCode & ": " & wResp.StatusDescription & vbNewLine & "The " & siteName & " is up"
'Only send success results if specified
If sendOnFailure = False Then
sendResults = True
End If
Else txtResponse.Text = "There may be a problem with the " & siteName & vbNewLine & "Please verify manually that it is operational." & vbNewLine & "The response received was:" & vbNewLine & "Status Code: " & wResp.StatusCode & " - " & wResp.StatusDescription
sendResults = True
End If
wResp.Close()
End Using
Catch ex As Exception
txtResponse.Text = "There may be a problem with the " & siteName & vbNewLine & "The error returned was:" & vbNewLine & ex.ToString
sendResults = True
End Try
txtLastCheck.Text = Now.ToString("d MMM yyyy HH:mm")
setNextCheck()
End Sub
I tried to get output in console program, but i got error
maybe I think that the error is about 'deadlock'
I pass night without sleep doing search solution that this error, I can't find
anyone can help me?
Someone tell me about the solution to fix it, it seems to make inherit system.
and he refer : http://programming.nullanswer.com/question/27270022
but this is java not vb.net.
Error Message:
'CTextConsoleWin32::GetLien: !GetNumberOfConsoleInputEvents'
Dim cmdCommand As String
getgame()
Serverlog.Clear()
Serverlog.Text += "ServerName : " & SelectedServer.Item(8) & " / " & "Server Download Path : " & SelectedServer.Item(9) & vbCrLf
Dim mapname As String = Split(SelectedServer.Item(2), ".bsp")(0)
cmdCommand = "-console -game " & SelectedServerGame & " -tickrate " & SelectedServer.Item(5) & " -port " & SelectedServer.Item(11) & " -maxplayers_override " & SelectedServer.Item(4) & " +map " & mapname
Serverlog.Text += (cmdCommand) & vbCrLf
Dim start_info As New ProcessStartInfo()
start_info.FileName = SelectedServer.Item(0)
start_info.UseShellExecute = False
'start_info.CreateNoWindow = True
start_info.RedirectStandardError = True
start_info.RedirectStandardOutput = True
start_info.RedirectStandardInput = True
'start_info.WindowStyle = ProcessWindowStyle.Hidden
start_info.Arguments = cmdCommand
Dim proc As New Global.System.Diagnostics.Process
proc.StartInfo = start_info
proc.Start()
Dim std_out As StreamReader = proc.StandardOutput
Do
proc.WaitForInputIdle()
Dim line As String = Await std_out.ReadLineAsync()
'Serverlog.Text += std_out.ReadLine & vbCrLf
Serverlog.Invoke(Sub() Serverlog.Text += line & vbCrLf)
Loop While proc.HasExited = False
I was making a mod installer for a Minecraft community, when I ended with this problem:
Here's my code:
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Button1.Enabled = False
Button2.Enabled = False
ComboBox1.Enabled = False
Button1.Text = "DOWNLOADING... DO NOT QUIT!"
Dim selected As String
Dim issel As Boolean
issel = False
selected = ComboBox1.SelectedItem
If selected = "Minecade Mod 1.7.2" Then
selected = "5"
issel = True
End If
If selected = "Minecade Mod 1.7.2 with OptiFine Standard" Then
selected = "3"
issel = True
End If
If selected = "Minecade Mod 1.7.2 with Optifine Ultra" Then
selected = "4"
issel = True
End If
If selected = "Minecade Mod 1.7.2 with Optifine Standard and Minecade Capes" Then
selected = "1"
issel = True
End If
If selected = "Minecade Mod 1.7.2 with Optifine Ultra and Minecade Capes" Then
selected = "2"
issel = True
End If
If issel = False Then
MsgBox("Invalid Selection! Try again.")
Else
Dim answ As Integer
answ = MsgBox("You have chosen the mod with the ID of: " & selected & "." & vbCrLf & "Do you want to install this mod?", vbYesNo)
If answ = 6 Then
If My.Computer.FileSystem.FileExists("C:\Documents and Settings\All Users\Documents\JOWD\MineCadeMod\1.7.2modded" & selected & ".zip") Then
Dim answOverW As Integer = MsgBox("The file already exists on the download location. Do you wish to download the file again (NO) or do you want to continue with the old one (YES)? (Preferred: Yes)", vbYesNo)
'6y7n
End If
'Installation process begins
Try
Dim dlPath As String = Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments) & "JOWD\MineCadeMod\1.7.2modded" & selected & ".zip"
My.Computer.Network.DownloadFile("http://files.casualnetwork.net/installers/moddedminec/1.7.2modded" & selected & ".zip", dlPath, "", "", False, 500, True)
Dim Unpackandinstall As Boolean = MsgBox("Download succesful. Do you want to unpack and install the archieve?", vbYesNo)
If Unpackandinstall = True Then
'UNPACK -------
'''Error occures inside the TRY tags here!'''
Try
Dim filePath As String
filePath = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & ".minecraft\versions\1.7.2modded" & selected
Dim startPath As String = Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments) & "JOWD\MineCadeMod\1.7.2modded" & selected & ".zip"
Dim zipPath As String = filePath
Dim extractPath As String = filePath
My.Computer.FileSystem.CreateDirectory(filePath)
ZipFile.CreateFromDirectory(startPath, zipPath)
ZipFile.ExtractToDirectory(zipPath, extractPath)
MsgBox("Decompression, installation and finishing done! Ready to play!")
Catch ex As Exception
MsgBox("Error in decompression and installment proceidure." & vbCrLf & vbCrLf & ex.Message & vbCrLf & vbCrLf & "Report to JOWD, as this should NOT happen!")
Button1.Enabled = True
Button2.Enabled = True
ComboBox1.Enabled = True
Button1.Text = "Download and Install!"
End Try
'''Error area ends!'''
End If
Catch ex As Exception
Button1.Enabled = True
Button2.Enabled = True
ComboBox1.Enabled = True
Button1.Text = "Download and Install!"
MsgBox("Download failed. Error code below!" & vbCrLf & vbCrLf & ex.Message & vbCrLf & vbCrLf & "Check the main topic for a possible solution, if nothing applies leave a reply!")
Exit Sub
End Try
Else
'installation process aborted.
End If
End If
End Sub
I will be happy to answer any question related to my problem, I've tried to look help anywhere but nothing helps me!
Thanks.
Read! Edited.
Regarding the 2 answers from David Sdot and Visual Vincent, - Their answers did not fix my problem.
I tried to use the following line on the code:
filePath = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\versions\1.7.2modded" & selected
Same error occurred.
Still looking for more advices from you!
Leave a comment if you want the project file to test it out.
Read! Edited.
Here's the source for the app, do your testing there!
http://files.casualnetwork.net/installers/moddedminec/source/MinecadeModInstaller_Min.zip
Ok so here's my solution to your problem:
Here, I used a WebClient instead of My.Computer.Network.DownloadFile, since I think it's better. (You use whatever you want of course)
Dim Download As New WebClient
Download.DownloadFileAsync(New Uri("http://files.casualnetwork.net/installers/moddedminec/1.7.2modded" & selected & ".zip"), dlPath)
I also noticed some stuff that had to be changed in your code.
For some reason you tried to zip your file into itself:
ZipFile.CreateFromDirectory(startPath, zipPath)
Remove this. :)
And you also tried to extract .minecraft\versions\1.7.2modded to itself by doing this:
Dim startPath As String = Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments) & "\JOWD\MineCadeMod\1.7.2modded" & selected & ".zip"
Dim zipPath As String = filePath
Dim extractPath As String = filePath
ZipFile.ExtractToDirectory(zipPath, extractPath)
Simply change zipPath from:
Dim zipPath As String = filePath
To:
Dim zipPath As String = startPath
Now the zipping should work fine :)
One more thing I noticed is that you couldn't skip the unzip part even if you pressed "No" in the MsBox. So I changed that code a little:
Dim Unpackandinstall As DialogResult
Unpackandinstall = MessageBox.Show("Download succesful. Do you want to unpack and install the archieve?", "", MessageBoxButtons.YesNo)
If Unpackandinstall = Windows.Forms.DialogResult.Yes Then
...
End If
Here's the whole Try block:
Try
Dim Download As New WebClient
Dim dlPath As String = Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments) & "\JOWD\MineCadeMod\1.7.2modded" & selected & ".zip"
Download.DownloadFileAsync(New Uri("http://files.casualnetwork.net/installers/moddedminec/1.7.2modded" & selected & ".zip"), dlPath)
Dim Unpackandinstall As DialogResult
Unpackandinstall = MessageBox.Show("Download succesful. Do you want to unpack and install the archieve?", "", MessageBoxButtons.YesNo)
If Unpackandinstall = Windows.Forms.DialogResult.Yes Then
Try
Dim filePath As String
filePath = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\.minecraft\versions\1.7.2modded" & selected
Dim startPath As String = Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments) & "\JOWD\MineCadeMod\1.7.2modded" & selected & ".zip"
Dim zipPath As String = startPath
Dim extractPath As String = filePath
My.Computer.FileSystem.CreateDirectory(filePath)
'ZipFile.CreateFromDirectory(startPath, zipPath)
ZipFile.ExtractToDirectory(zipPath, extractPath)
MsgBox("Decompression, installation and finishing done! Ready to play!")
Catch ex As Exception
MsgBox("Error in decompression and installment proceidure." & vbCrLf & vbCrLf & ex.Message & vbCrLf & vbCrLf & "Report to JOWD, as this should NOT happen!")
Button1.Enabled = True
Button2.Enabled = True
ComboBox1.Enabled = True
Button1.Text = "Download and Install!"
End Try
End If
Catch ex As Exception
Button1.Enabled = True
Button2.Enabled = True
ComboBox1.Enabled = True
Button1.Text = "Download and Install!"
MsgBox("Download failed. Error code below!" & vbCrLf & vbCrLf & ex.Message & vbCrLf & vbCrLf & "Check the main topic for a possible solution, if nothing applies leave a reply!")
Exit Sub
End Try
And just replace
Download.DownloadFileAsync(New Uri("http://files.casualnetwork.net/installers/moddedminec/1.7.2modded" & selected & ".zip"), dlPath)
With your My.Computer.Network code if you'd rather use that instead. :)
Hope this helps!
filePath = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & ".minecraft\versions\1.7.2modded" & selected
The path return by Environment.GetFolderPath has no \ at the end and you prepended a dot instead.
filePath = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\minecraft\versions\1.7.2modded" & selected