stop windows service on an event - vb.net

I need to stop the service on an event .where i am sending file through ftp and ftp response is generating in text file.
So i am checking the response in text file ,if failoure message is there then i need to stop the service.But because this one is not an exception so i am not able to call OnStart method where i can stop the service.
How to stop the service in class?
Dim text As String = "Error: Could not open connection"
Dim lines() As String = Filter(System.IO.File.ReadAllLines(SFtpLogFullPath), text)
If UBound(lines) = -1 Then
'MsgBox("not found")
Else
'MsgBox("found")
Dim UpdFailFTPStatus As New AseCommand("update tb_kamp_filesprocess set FileFTPStatus = '" & "" & "' where FILENAME = '" & fileName & "' ", _SQLConnection)
recordsAffected = UpdFailFTPStatus.ExecuteNonQuery()
ExecuteSP("ml_test_kamp")
writelog("Error occured during SFTP ")
'Need to stop the service here
Exit Sub
End If

Related

Dynamically creating multiple background workers and passing them arguments

I've written an app that basically does constant pings to a list of hosts and logs the results.
I have a function...
Public Function doping(ByRef host As String)
Dim Result As Net.NetworkInformation.PingReply
Dim SendPing As New Net.NetworkInformation.Ping
Dim ResponseTime As Long
Dim timestamp As String = System.DateTime.Now.ToString("dd-MM-yyyy HH:mm:ss")
Try
Result = SendPing.Send(host, 300)
ResponseTime = Result.RoundtripTime
If Result.Status = Net.NetworkInformation.IPStatus.Success Then
DynaLogging(timestamp & " - Reply from " & host & ": bytes=32 time=" & ResponseTime.ToString & " TTL=??", host & ".log")
TextBox2.Text = timestamp & " - Reply from " & host & " : time =" & ResponseTime.ToString & br & TextBox2.Text
Else
DynaLogging(timestamp & " - No reply received from " & host, host & ".log")
TextBox2.Text = timestamp & " - No reply received from " & host & br & TextBox2.Text
End If
Catch ex As Exception
End Try
End Function
And I've got a timer, which currently fires off the following in a background worker...
On Error Resume Next
For Each hostyhost As String In ListBox1.Items
doping(hostyhost)
Next
This works a treat until one of the hosts in the list is not responding, then the backgroundworker waits because it can only process one ping at a time and so if one host is delayed, the remaining hosts have to wait before they are checked and the whole process slows down.
I could do with somehow dynamically creating multiple background workers at runtime but I do not know how to create a background worker dynamically which can be passed an argument.
I looked at this post about creating bgw's at runtime, but have no idea how to deploy this for what I need.
Can anyone point me in the right direction?
Why not a Parallel ForEach?
Dim Items As List(Of String) = New List(Of String)
For Each item As String In ListBox1.Items
Items.Add(item.ToString())
Next
Parallel.ForEach(Items, Sub(hostyhost)
doping(hostyhost)
End Sub)
It's included in the .NET Framework 4.0 under the System.Threading namespace and will take care of almost everything, without writing a million lines of code.

File not getting created - Visual Basic

I'm making a skype tool, and I'm creating the config file automatically, or at least that's what I think I am doing. The problem is just that for some reason the FileNotFoundException is fired because of some of my code is refering to the file which doesn't exist yet. So is visual basic checking for exceptions before firing code, or am I doing something wrong?
Here's my file creation code:
If My.Computer.FileSystem.DirectoryExists("C:\BaconSkypeTool") Then
Else
My.Computer.FileSystem.CreateDirectory("C:\BaconSkypeTool")
End If
If My.Computer.FileSystem.FileExists(Path) Then
Else
Dim fs As FileStream = File.Create(Path)
Dim line1 As Byte() = New UTF8Encoding(True).GetBytes("This is the configuration file for BaconSkypeTool" & vbCrLf & "Please do not change anything in here if you don't know what you're doing." & vbCrLf & vbCrLf & "Values below" & vbCrLf & "ChangeStatusInCall = True" & vbCrLf & "Status = Online" & vbCrLf & "Enable .cancel command = True")
fs.Write(line1, 0, line1.Length)
fs.Close()
End If
And here's the code that fires the exception:
skype.CurrentUserStatus = SKYPE4COMLib.TOnlineStatus.olsOnline
Dim text = My.Computer.FileSystem.ReadAllText("C:\BaconSkypeTool\config.cfg")
Dim textAfterStatus As String = Nothing
Dim indexOfStatus = text.IndexOf("Status = ")
Dim text1 As String = Nothing
If indexOfStatus >= 0 Then
textAfterStatus = text.Substring(indexOfStatus + "Status = ".Length)
text1 = textAfterStatus.Split("Blacklist").First().Trim()
End If
The file creation is at the top of my file and therefore should be the first thing to be fired, but maybe that's just something I think.

Using SSIS Script Task to download files from FTP

I am trying to download files from FTP using SSIS script task, I have written some code to download files from FTP using the ftpWebRequest class which is working. But I also need to take in to account that we might be asked to download it from a sFTP. Since many are suggesting that WinSCP assemblies are the best way to download sFTP files, can some provide me with some examples to download files using a SSIS script with the WinSCP classes.
PS: I am new to Vb.net
Yes, as people have said the only option is to use a library like WinSCP.
Take a look at the examples here on the WinSCP website - http://winscp.net/eng/docs/script_vbnet_robust_example
Here is the source code from the example
Imports System
Imports System.IO
Imports System.Diagnostics
Imports System.Xml
Imports System.Xml.XPath
Imports System.Configuration.ConfigurationManager
Public Class SFTP
' SFTP support, built on WinSCP
Public Shared Function PutSFTP(ByRef filename As String, ByRef remotehost As String, ByRef username As String, ByRef password As String, _
Optional ByVal outfilename As String = Nothing, Optional ByVal output As String = Nothing,
Optional ByRef errmsg As String = Nothing) As Boolean
' Run hidden WinSCP process
Dim winscp As Process = New Process()
Dim logname As String = Path.ChangeExtension(Path.GetTempFileName, "xml")
With winscp.StartInfo
' SFTPExecutable needs to be defined in app.config to point to winscp.com
Try
.FileName = AppSettings("SFTPExecutable")
If .FileName Is Nothing OrElse .FileName.Length = 0 Then Throw (New Exception("from PutSFTP: SFTPExecutable not set in config file."))
Catch ex As Exception
errmsg = ex.Message
Return False
End Try
.Arguments = "/xmllog=" + logname
.UseShellExecute = False
.RedirectStandardInput = True
.RedirectStandardOutput = True
.CreateNoWindow = True
End With
Try
winscp.Start()
Catch ex As Exception
errmsg = "from PutSFTP: Could not run the WinSCP executable " & winscp.StartInfo.FileName & Environment.NewLine & ex.Message
Return False
End Try
' Feed in the scripting commands
With winscp.StandardInput
.WriteLine("option batch abort")
.WriteLine("option confirm off")
.WriteLine("open sftp://" & username & ":" & password & "#" & remotehost & "/")
If outfilename Is Nothing Then .WriteLine("put " & filename) Else .WriteLine("put " & filename & " """ & outfilename & """")
.Close()
End With
If output IsNot Nothing Then output = winscp.StandardOutput.ReadToEnd()
' Wait until WinSCP finishes
winscp.WaitForExit()
' Parse and interpret the XML log
' (Note that in case of fatal failure the log file may not exist at all)
If Not File.Exists(logname) Then
errmsg = "from PutSFTP: The WinSCP executable appears to have crashed."
Return False
End If
Dim log As XPathDocument = New XPathDocument(logname)
Dim ns As XmlNamespaceManager = New XmlNamespaceManager(New NameTable())
ns.AddNamespace("w", "http://winscp.net/schema/session/1.0")
Dim nav As XPathNavigator = log.CreateNavigator()
' Success (0) or error?
Dim status As Boolean = (winscp.ExitCode = 0)
If Not status Then
errmsg = "from PutSFTP: There was an error transferring " & filename & "."
' See if there are any messages associated with the error
For Each message As XPathNavigator In nav.Select("//w:message", ns)
errmsg &= Environment.NewLine & message.Value
Next message
End If
Try
My.Computer.FileSystem.DeleteFile(logname)
Catch ex As Exception
' at least we tried to clean up
End Try
Return status
End Function
End Class

Executing msg.exe from Visual Basic application

I am trying to take text fields for old hostname, new hostname, username, and password and remotely change computer names. That part is working fantastic. It was all great until my manager saw it in action, since we have a policy against downloading and using freeware.
It's not freeware if I made it. Unfortunately, he sent it to my director, and know my director knows I know a little bit about Visual Basic, so he wants to loop the names from a CSV file, change the name, and send a message to the end user instructing them to save their files and reboot.
Unfortunately, net send has gone the way of XP since Vista. However, from Vista - Win8.1, there's a utility called msg.exe in C:\Windows\System32. In order to use it, the target computer has to have the registry value AllowRemoteRPC in HKLM\SYSTEM\CurrentControlSet\Control\Terminal Services set to 1.
So here's what the app does:
Reads the DWORD key AllowRemoteRPC and stores it to a variable (MyVal), changes the key to 1, attempts to send the message alerting the user they need to restart, changes the key back to MyVal, and then executes netdom renamecomputer and renames the PC. Everything works perfectly EXCEPT sending the message. I can open up a command prompt and type:
msg /server:hostname * /v /time:3600 "my message here
And it works perfectly (after manually editing the registry key to the needed value).
However, running it from VB doesn't work. Here's what I've tried:
"msg /server:" & hostname & " * /v /time:3600 ""my message here"""
"cmd.exe /D /c msg /server:" & hostname & " * /v /time:3600 ""my message here"""
Neither seems to work. I know the registry value is being changed. I put message boxes after each step in my and refreshed the regedit to actually see the value of the DWORD key, and it is changing. Everything APPEARS to be going smoothly, the message is just not getting sent.
I do have these commands running as arguments to a function I created in order to create a process so I could output the streamreader to a listbox.
Here's my code. Please keep in mind, I'm barely over 2 months into learning visual basic, so it's probably not the prettiest code out there:
Imports System
Imports System.IO
Imports System.Diagnostics
Imports System.Security.Permissions
Imports Microsoft.Win32
Public Class applicationMain
Private Sub btnExecute_Click(sender As Object, e As EventArgs) Handles btnExecute.Click
Dim oldPC As String = txtOldPC.Text
Dim newPC As String = txtNewPC.Text
Dim username As String = txtUsername.Text
Dim password As String = txtPassword.Text
If oldPC <> "" And newPC <> "" And username <> "" And password <> "" Then
Dim MyReg As Microsoft.Win32.RegistryKey = Microsoft.Win32.RegistryKey.OpenRemoteBaseKey(Microsoft.Win32.RegistryHive.LocalMachine, oldPC)
Dim MyRegKey As Microsoft.Win32.RegistryKey
Dim MyVal As String
lbOutput.Items.Clear()
MyRegKey = MyReg.OpenSubKey("System\CurrentControlSet\Control\Terminal Server")
MyVal = MyRegKey.GetValue("AllowRemoteRPC", RegistryValueKind.DWord)
MyRegKey.Close()
lbOutput.Items.Add("Processing registry changes...")
Try
MyRegKey = MyReg.OpenSubKey("System\CurrentControlSet\Control\Terminal Server", True)
MyRegKey.SetValue("AllowRemoteRPC", &H1, RegistryValueKind.DWord)
Catch ex As Exception
MessageBox.Show("An Error Has Occured:" & vbCrLf & vbCrLf & ex.ToString())
lbOutput.Items.Add("")
lbOutput.Items.Add("ABORTED!")
Exit Sub
End Try
lbOutput.Items.Add("Success!")
lbOutput.Items.Add("Sending message to user:")
Try
ExecuteCommand("cmd.exe", "/D /c msg /SERVER:" & oldPC & ".na.int.grp * /v /TIME:3600 ""Changes have been made by IS to your computer that require a restart. Please save your files and restart your computer to avoid service interruption.""")
Catch ex As Exception
MessageBox.Show("An Error Has Occured:" & vbCrLf & vbCrLf & ex.ToString())
lbOutput.Items.Add("")
lbOutput.Items.Add("ABORTED!")
MyRegKey = MyReg.OpenSubKey("System\CurrentControlSet\Control\Terminal Server", True)
MyRegKey.SetValue("AllowRemoteRPC", MyVal, RegistryValueKind.DWord)
Exit Sub
End Try
lbOutput.Items.Add(" Message: ""Changes have been made by IS to your computer that require a restart. Please save your files and restart your computer to avoid service interruption."" ")
lbOutput.Items.Add("Reverting registry changes...")
Try
MyRegKey = MyReg.OpenSubKey("System\CurrentControlSet\Control\Terminal Server", True)
MyRegKey.SetValue("AllowRemoteRPC", MyVal, RegistryValueKind.DWord)
Catch ex As Exception
MessageBox.Show("An Error Has Occured:" & vbCrLf & vbCrLf & ex.ToString())
lbOutput.Items.Add("")
lbOutput.Items.Add("ABORTED!")
Exit Sub
End Try
Try
ExecuteCommand("netdom", "renamecomputer " & oldPC & " /newname:" & newPC & " /userD:na\" & username & " /passwordd:" & password & " /usero:na\" & username & " /passwordo:" & password & " /Force")
Catch ex As Exception
MessageBox.Show("An Error Has Occured:" & vbCrLf & vbCrLf & ex.ToString())
lbOutput.Items.Add("")
lbOutput.Items.Add("ABORTED!")
Exit Sub
End Try
lbOutput.Items.Add("Success!")
lbOutput.Items.Add("")
lbOutput.Items.Add("Rename successful for " & oldPC & "!")
lbOutput.Items.Add("******************************************************************")
lbOutput.Items.Add("")
End If
End Sub
Private Function ExecuteCommand(ByVal cmd As String, ByVal arguments As String)
Dim cmdProcess As New Process()
Dim cmdProcessStartInfo As New ProcessStartInfo()
Dim cmdStreamReader As IO.StreamReader
Dim output As String
cmdProcessStartInfo.UseShellExecute = False
cmdProcessStartInfo.CreateNoWindow = True
cmdProcessStartInfo.RedirectStandardOutput = True
cmdProcessStartInfo.FileName = cmd
cmdProcessStartInfo.Arguments = arguments
cmdProcess.StartInfo = cmdProcessStartInfo
cmdProcess.Start()
cmdStreamReader = cmdProcess.StandardOutput
Do While cmdStreamReader.EndOfStream = False
output = cmdStreamReader.ReadLine()
lbOutput.SelectedIndex = lbOutput.Items.Count - 1
lbOutput.Items.Add(output)
Loop
cmdProcess.WaitForExit()
cmdProcess.Close()
Return vbNull
End Function
End Class
What do you know. There's actually nothing wrong with my code at all. While trying to play around with the paths variable, I decided "Fuhgeddaboudit, I'll just add the executable to the project!". Right clicked the project, Add -> Existing Item. Selected Executable as the type, and went to C:\Windows\System32 and, get this now, msg.exe wasn't there. At all. Opened Explorer and went to System32, msg.exe was there. For whatever reason, Visual Studio cannot see the program at all. Which is in and of itself weird.
So I copied msg.exe to my desktop, added it to source, the program works like a charm now.

ActiveX calling URL page

I'm using the following code inside an ActiveX Script job on SQl Server to call an URL every X minutes.
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run "iexplore.exe http://www.google.com.br"
Set WsShell = Nothing
it is working but the processes created keep running:
Any way of changin that code to call the URL and kill the recent called process or call it with a "time-to-live". I think it is more secure, I wouldn't want to kill the wrong process.
Following up on the suggestion by #Ted, you can also fetch a URL using native Microsoft capabilities in an in-process fashion. You can do this via a component known as WinHTTP (the latest appears to be WinHTTP 5.1).
See my script below which includes a function to simply obtain the status of a URL. When I run this script I get the following output:
http://www.google.com => 200 [OK]
http://www.google.com/does_not_exist => 404 [Not Found]
http://does_not_exist.google.com => -2147012889
[The server name or address could not be resolved]
If you want the actual content behind a URL, try oHttp.ResponseText. Here's the WinHTTP reference if you are interested in other capabilities as well.
Option Explicit
Dim aUrlList
aUrlList = Array( _
"http://www.google.com", _
"http://www.google.com/does_not_exist", _
"http://does_not_exist.google.com" _
)
Dim i
For i = 0 To UBound(aUrlList)
WScript.Echo aUrlList(i) & " => " & GetUrlStatus(aUrlList(i))
Next
Function GetUrlStatus(sUrl)
Dim oHttp : Set oHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
On Error Resume Next
With oHttp
.Open "GET", SUrl, False
.Send
End With
If Err Then
GetUrlStatus = Err.Number & " [" & Err.Description & "]"
Else
GetUrlStatus = oHttp.Status & " [" & oHttp.StatusText & "]"
End If
Set oHttp = Nothing
End Function
The way you start IE is external, you have little control over the process once it is started.
A better interactive way is like this
Function GetData(strUrl) 'As String
Set web = CreateObject("InternetExplorer.Application")
web.Navigate strUrl
Do While web.Busy
wscript.sleep 100
Loop
Set doc = Nothing
Do Until Not doc Is Nothing
Set doc = web.Document
Loop
strWebPage = doc.all(1).innerHTML 'This does return the head sections
web.Quit
GetData = strWebPage
End Function
wscript.echo GetData("www.google.com")
UPDATE: As it stands now, it looks like this is not a viable solution. After multiple invocations, IE processes begin to accumulate with this approach as well. It appears this behavior has something to do with IE's session management. IE doesn't like to be abruptly terminated.
I found some very useful information about managing processes via WMI here. Using that as a basis, I came up with the code I show below. One of the nice aspects of the WMI approach is that you are given access to the unique ID for the process. I consider my code a starting point as I'm sure further improvements are possible (including the addition of exception handling).
Perhaps others with deeper knowledge of WMI can offer additional advice.
PS: Hope you like that I wrapped this functionality inside a VBScript class called Process.
Option Explicit
' Const PROG = "notepad.exe"
Const TARGET = "http://www.google.com"
Dim PROG : PROG = "C:\Program Files\Internet Explorer\iexplore.exe " & TARGET
Const ABOVE_NORMAL = 32768 ' what are the other priority constants?
Dim oProc : Set oProc = New Process
oProc.Name = PROG
' oProc.Priority = ABOVE_NORMAL
oProc.Launch
WScript.Echo "Launched '" & PROG & "' with process ID '" & oProc.ID & "'"
WScript.Sleep 5000
oProc.Terminate
WScript.Echo "Process " & oProc.ID & " killed."
Set oProc = Nothing
' ----------------------------------------------------------------------
Class Process
Public Computer
Public Name
Public Priority
Public ID
Public IsRunning
Private mHandle
Private Sub Class_Initialize()
Me.Computer = "."
Me.Name = Null
Me.ID = -1
Me.Priority = Null
Me.IsRunning = False
Set mHandle = Nothing
End Sub
Private Sub Class_Terminate()
Set mHandle = Nothing
End Sub
Public Sub Launch()
Dim oWmi, oStartup, oConfig
Dim nPid
Set oWmi = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& Me.Computer & "\root\cimv2")
Set oStartup = oWmi.Get("Win32_ProcessStartup")
If Not IsNull(Me.Priority) Then
Set oConfig = oStartup.SpawnInstance_
oConfig.PriorityClass = Me.Priority
End If
Set mHandle = GetObject("winmgmts:root\cimv2:Win32_Process")
mHandle.Create Me.Name, Null, oConfig, nPid
' WScript.Echo "TypeName Is [" & TypeName(mHandle) & "]"
Me.ID = nPid
Me.IsRunning = True
End Sub
Public Sub Terminate()
' mHandle.Terminate ' hmmm, doesn't work...
Dim oWmi
Dim colProcessList, oProc
Set oWmi = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& Me.Computer & "\root\cimv2")
Set colProcessList = oWmi.ExecQuery _
("Select * from Win32_Process Where ProcessId = '" & Me.ID & "'")
For Each oProc In colProcessList ' should be only one process
' WScript.Echo "TypeName Is [" & TypeName(oProc) & "]"
oProc.Terminate
Next
Me.IsRunning = False
End Sub
End Class
Could you consider using a lightweight command line URL retrieval program, like CURL ( http://curl.haxx.se/docs/manpage.html ) or WGET ( http://www.gnu.org/software/wget/ )? These programs can be executed from the command line quite simply:
wget http://www.google.com
curl http://www.google.com
You can execute them from VBScript like this:
sub shell(cmd)
' Run a command as if you were running from the command line
dim objShell
Set objShell = WScript.CreateObject( "WScript.Shell" )
objShell.Run(cmd)
Set objShell = Nothing
end sub
shell "wget http://www.google.com"
The only downside to this is that WGET and CURL won't execute javascript, download affiliated images, or render the HTML; they will simply download the web page. In my experience, I use CURL and WGET regularly as long as I only have to retrieve a single HTML page; but if I have to render something or trigger AJAX functions I use an automatable web browser toolkit like Selenium, WATIN, or IMacros.