Serial port acting weird after hibernate/resume? - vb.net

Guys I am having a weird problem with my vb.net application after the computer goes into hibernate mode and resumes. Before it goes into sleep mode I close all my serial ports and set it to nothing...
Private Sub SystemEvents_PowerModeChanged(ByVal sender As Object, ByVal e As PowerModeChangedEventArgs)
oEventLog.WriteEntry("Power change detected: " & e.Mode.ToString)
txtStatus.AppendText("Power change detected: " & e.Mode.ToString & vbCrLf)
If e.Mode <> PowerModes.Resume Then
Try
If Input IsNot Nothing Then
Input.Dispose()
Input.Close()
Input = Nothing
End If
If Output IsNot Nothing Then
Output.Dispose()
Output.Close()
Output = Nothing
End If
Catch
txtStatus.AppendText(Err.Description)
End Try
Else
initilizeSerialPorts()
End If
End Sub
When the computer resumes I initialize my serial ports again. The problem is when I try to open them again it says they are already in use. So I loaded up process explorer to see what has it open and it's still my application! So it seems closing them and setting them to nothing does nothing. If I close my application and re-run it everything works just fine.
Private Function initilizeSerialPorts() As Boolean
If Input IsNot Nothing Then
Input.Dispose()
Input.Close()
Input = Nothing
End If
If Output IsNot Nothing Then
Output.Dispose()
Output.Close()
Output = Nothing
End If
Input = New SerialPort(cmboInput.SelectedItem.ToString)
Output = New SerialPort(cmboOutput.SelectedItem.ToString, Input.BaudRate, Input.Parity, Input.DataBits, Input.StopBits)
Me.Refresh()
****MSGBOX HERE MAKES IT WORK?!!****
Try
If Not Input.IsOpen Then
Input.Open()
Else
MsgBox("Unable to open the serial port " & Input.PortName)
Return False
End If
Catch
MsgBox("Unable to initalize serial port " & Input.PortName & vbCrLf & "Error: " & Err.Number.ToString & " " & Err.Description)
End Try
Try
If Not Output.IsOpen Then
Output.Open()
Else
MsgBox("Unable to open the serial port " & Output.PortName)
Return False
End If
Catch
MsgBox("Unable to initalize serial port " & Output.PortName & vbCrLf & "Error: " & Err.Number.ToString & " " & Err.Description)
End Try
Return True
End Function
Ok here is the kicker...if I put a message box before I open my port again it works? No message box and I get a failed to open port message it's in use. Any ideas why this might be happening?
Thanks in advance

Related

Closing my application After Exception shows using try,catch method VB.NET

I have function that check internet connection before my application continue working, using ping sometimes my connection are limited and that make my program crash. i want to close my application when it happen. can you help me ?
this is my sample code
If My.Computer.Network.IsAvailable Then
Try
Dim pingreq As Ping = New Ping()
Dim pinging As PingReply = pingreq.Send("www.google.com")
Dim latency As Integer = pinging.RoundtripTime
Dim status = pinging.ToString
Catch err As PingException
write_log(Date.Now.ToString("dd:MM:yyyy - HH:mm:ss") & "||" & "Connection Error" & err.ToString() & err.Message)
If Not err Is Nothing Then
Timer1.Stop()
Me.Close()
constat = 0
End If
End Try
Else
Timer1.Stop()
Me.Close()
End If

Timer to skip to connect to next computer in for each loop while connecting remotely using RegistryKey.OpenRemoteBaseKey

I built a tool (with Visual Studio 2015 Express - Visual Basic) that will check the mcafee dat version and date from the registry on computers input either manually, in a text file, or selected from active directory. The tool works it successfully returned all the information for 714 out of 970 computers/laptops. The majority of the failures were either because they could not be resolved in DNS or weren't pingable and the tools identifies those and successfully logs them. It took a little over 15 minutes for the tool to retrieve the information and log it in a spreadsheet. The issue is that on 19 of the failures I got one of the two following errors and those 19 took the majority of the 15 minutes for the tool get and log all the information:
Attempted to perform an unauthorized operation
The network path was not found
Is there a way of using a timer so that the program will attempt to connect to the registry at this point... rk1 = RegistryKey.OpenRemoteBaseKey(RegistryHive.LocalMachine, strComputer, RegistryView.Registry64) and then after a certain amount of time stop and move to the next computer in the for each loop? I have only been programming for a little over a year and I have learned exclusively through trial/error and google so please have patience with me as I am not a seasoned programmer. Here is the code:
The program works well my objective here is to improve it by making it skip to the next computer when it hangs for an extended period of time. I have filtered out the computers that can't be resolved in DNS or aren't pingable.
For Each sel In picker.SelectedObjects
Try
If HostIsResolvable(sel.Name) Then
Try
reply = ping.Send(sel.Name, 1)
If reply.Status = IPStatus.Success Then
IPAddr = reply.Address.ToString()
Try
comsys(sel.Name)
Dim rk1 As RegistryKey
Dim rk2 As RegistryKey
rk1 = RegistryKey.OpenRemoteBaseKey
(RegistryHive.LocalMachine, sel.Name,
RegistryView.Registry64)
rk2 = rk1.OpenSubKey
("SOFTWARE\Wow6432Node\McAfee\AVEngine")
mAV = rk2.GetValue("AVDatVersion").ToString
mAD = rk2.GetValue("AVDatDate").ToString
objExcel.Cells(y, 1) = sel.Name
objExcel.Cells(y, 2) = IPAddr
objExcel.Cells(y, 3) = commodel
objExcel.Cells(y, 4) = comuser
objExcel.Cells(y, 5) = "DAT Version Number: " & mAV
objExcel.Cells(y, 6) = "DAT Date: " & mAD
y = y + 1
Catch ex As Exception
My.Computer.FileSystem.WriteAllText(Dell
& "\McAfeeDATeNumFailed.txt", sel.Name & "-Unable to
connect. Make sure this computer is on the network,
has remote administration enabled, and that both
computers are running the remote registry service.
Error message: " & ex.Message & vbCrLf, True)
End Try
Else
My.Computer.FileSystem.WriteAllText(Dell
& "\McAfeeDATeNumFailed.txt", sel.Name & " is not
pingable! " & vbCrLf, True)
End If
Catch ex As Exception
My.Computer.FileSystem.WriteAllText(Dell
& "\McAfeeDATeNumFailed.txt", sel.Name & "Ping error:
Unable to connect. Make sure this computer is on the
network, has remote administration enabled, and that
both computers are running the remote registry
service. Error message: " & ex.Message & vbCrLf, True)
End Try
Else
My.Computer.FileSystem.WriteAllText(Dell
& "\McAfeeDATeNumFailed.txt", sel.Name & " could not be
resolved in DNS! " & vbCrLf, True)
End If
Catch ex As Exception
My.Computer.FileSystem.WriteAllText(Dell
& "\McAfeeDATeNumFailed.txt", sel.Name & "DNS error: Unable to
connect. Make sure this computer is on the network, has remote
administration enabled, andd that both computers are running the
remote registry service. Error message: " & ex.Message &
vbCrLf, True)
End Try
sel = Nothing
Next
You need to put your request in another thread. This thread can be aborted.
Sub Main()
Dim thrd As New Thread(AddressOf endlessLoop) 'thread with your sub
thrd.Start() 'Start thread
thrd.Join(1000) 'Block until completion or timeout
If thrd.IsAlive Then
thrd.Abort() 'abort thread
Else
'thread finished already
End If
End Sub
Sub endlessLoop()
Try
While True
'Your Code
End While
Catch ex As ThreadAbortException
'Your code when thread is killed
End Try
End Sub
Hope this helps.
'***** EDIT ***
Your code could look like this (I didn't checked if there are any variables to pass in Sub)
For Each sel In picker.SelectedObjects
Try
If HostIsResolvable(sel.Name) Then
Try
reply = ping.Send(sel.Name, 1)
If reply.Status = IPStatus.Success Then
IPAddr = reply.Address.ToString()
call timerThread 'New
Else
My.Computer.FileSystem.WriteAllText(Dell
& "\McAfeeDATeNumFailed.txt", sel.Name & " is not
pingable! " & vbCrLf, True)
End If
Catch ex As Exception
My.Computer.FileSystem.WriteAllText(Dell
& "\McAfeeDATeNumFailed.txt", sel.Name & "Ping error:
Unable to connect. Make sure this computer is on the
network, has remote administration enabled, and that
both computers are running the remote registry
service. Error message: " & ex.Message & vbCrLf, True)
End Try
Else
My.Computer.FileSystem.WriteAllText(Dell
& "\McAfeeDATeNumFailed.txt", sel.Name & " could not be
resolved in DNS! " & vbCrLf, True)
End If
Catch ex As Exception
My.Computer.FileSystem.WriteAllText(Dell
& "\McAfeeDATeNumFailed.txt", sel.Name & "DNS error: Unable to
connect. Make sure this computer is on the network, has remote
administration enabled, andd that both computers are running the
remote registry service. Error message: " & ex.Message &
vbCrLf, True)
End Try
sel = Nothing
Next
Sub timerThread()
Dim thrd As New Thread(AddressOf registryRequest) 'thread with your sub
thrd.Start() 'Start thread
thrd.Join(15000) 'Block until completion or timeout (15 seconds)
If thrd.IsAlive Then
thrd.Abort() 'abort thread
Else
'thread finished already
End If
End Sub
Sub registryRequest()
Try
comsys(sel.Name)
Dim rk1 As RegistryKey
Dim rk2 As RegistryKey
rk1 = RegistryKey.OpenRemoteBaseKey
(RegistryHive.LocalMachine, sel.Name,
RegistryView.Registry64)
rk2 = rk1.OpenSubKey
("SOFTWARE\Wow6432Node\McAfee\AVEngine")
mAV = rk2.GetValue("AVDatVersion").ToString
mAD = rk2.GetValue("AVDatDate").ToString
objExcel.Cells(y, 1) = sel.Name
objExcel.Cells(y, 2) = IPAddr
objExcel.Cells(y, 3) = commodel
objExcel.Cells(y, 4) = comuser
objExcel.Cells(y, 5) = "DAT Version Number: " & mAV
objExcel.Cells(y, 6) = "DAT Date: " & mAD
y = y + 1
Catch ex As ThreadAbortException
My.Computer.FileSystem.WriteAllText(Dell
& "\McAfeeDATeNumFailed.txt", sel.Name & "-Unable to
connect. Make sure this computer is on the network,
has remote administration enabled, and that both
computers are running the remote registry service.
Error message: " & ex.Message & vbCrLf, True)
End Try
End Sub
This works great but I am sure it can be improved so please respond with suggestions if you have them. Here is the code:
Try
Dim source1 As New CancellationTokenSource
Dim token As CancellationToken = source1.Token
Dim T20 As Task = Task.Factory.StartNew(Function() getping((sel.Name), token))
T20.Wait(30)
If T20.Status = TaskStatus.Running Then
source1.Cancel()
My.Computer.FileSystem.WriteAllText(Dell & "\McAfeeDATeNumFailed.txt", sel.Name & " Ping timed out. The task was disposed of at " & ex_time & "." & vbCrLf & vbCrLf, True)
End If
Dim source2 As New CancellationTokenSource
Dim token2 As CancellationToken = source2.Token
Dim T21 As Task = Task.Factory.StartNew(Function() comsys((sel.Name), token2))
T21.Wait(500)
If T21.Status = TaskStatus.Running Then
source2.Cancel()
My.Computer.FileSystem.WriteAllText(Dell & "\McAfeeDATeNumFailed.txt", sel.Name & " RPC error. The task was disposed of at " & ex_time & "." & vbCrLf & vbCrLf, True)
End If
Dim source3 As New CancellationTokenSource
Dim token3 As CancellationToken = source3.Token
Dim T22 As Task = Task.Factory.StartNew(Function() getregvalues((sel.Name), token3))
T22.Wait(600)
If T22.Status = TaskStatus.Running Then
source3.Cancel()
My.Computer.FileSystem.WriteAllText(Dell & "\McAfeeDATeNumFailed.txt", sel.Name & " Error retrieving registry value. The task was disposed of at " & ex_time & "." & vbCrLf & vbCrLf, True)
End If
IPAddr = reply.Address.ToString()
objExcel.Cells(y, 1) = sel.Name
objExcel.Cells(y, 2) = IPAddr
objExcel.Cells(y, 3) = commode
objExcel.Cells(y, 4) = comuser
objExcel.Cells(y, 5) = "DAT Version Number: " & mAV
objExcel.Cells(y, 6) = "DAT Date: " & mAD
y = y + 1
IPAddr = Nothing
reply = Nothing
commodel = Nothing
comuser = Nothing
sel = Nothing
Thread.Sleep(10)
Catch ex As Exception
End Try
I will try that and time it both ways. I added a continue for here and it cut it from 6 and a half minutes down to 3 and a half minutes (if it wasn't pingable then move on to the next computer instead of running the other 2 tasks).
If T20.Status = TaskStatus.Running Then
source1.Cancel()
Continue For
End If
I started to change the wait to a loop and I remembered that it takes that amount of time to successfully retrieve the remote information and get it into excel without missing data in the excel spreadsheet. For example I dropped the time to 10 ms and some of the computers didn't respond to the ping fast enough so that computer and it's information wasn't added to the spreadsheet. Likewise, I reduced the ms on the registry task and the registry information for that computer was missing in the spreadsheet.

VB.NET Parameter is not valid

I have used dotnetbar devcomponents advanced treeview to create multiple directory trees for one of my projects. Functionality wise, everything is working fine.
I have now added images to the directory file nodes (e.g. pdf image if its a pdf file) and published the application. The application runs without any errors first time on any machine, but once I close this File Management form (I have a control panel form with buttons that is the initial startup form. The buttons take me to other forms. On button click, it hides the control panel and displays the corresponding form through showdialog - File Management form is one of those buttons) and reopen it again - I get the following error:
parameter_is_not_valid
It then fails to load the nodes and after a couple of tries, Microsoft .Net Framework window appears and ends the application.
I get the images from my resource file. Please see the code for LoadAllSubDirectoriesFiles where the error occurs:
Private Sub LoadAllSubDirectoriesFiles(ByVal uParent As DevComponents.AdvTree.Node)
' Initialise Error Checking
Dim uStackframe As New Diagnostics.StackFrame
Dim ufile As IO.FileInfo = Nothing
Try
If uParent.Name.Length <> 248 Then
Dim files As IO.FileInfo() = uParent.Tag.GetFiles()
For Each file As IO.FileInfo In files
If (Not file.Attributes.ToString.Contains("Hidden")) Then
Dim uNode As DevComponents.AdvTree.Node = New DevComponents.AdvTree.Node()
uNode.Tag = file
uNode.Name = file.FullName.ToLower
uNode.Text = file.Name
If file.Extension = ".msg" Then
uNode.Image = My.Resources.Resources.Mail3
ElseIf file.Extension = ".txt" Then
uNode.Image = My.Resources.Resources.Document
ElseIf file.Extension = ".pdf" Then
uNode.Image = My.Resources.Resources.pdf
ElseIf file.Extension = ".doc" OrElse file.Extension = ".docx" Then
uNode.Image = My.Resources.Resources.doc
ElseIf file.Extension = ".xlsx" Then
uNode.Image = My.Resources.Resources.excel
ElseIf file.Extension = ".pub" Then
uNode.Image = My.Resources.Resources.publisher
ElseIf file.Extension = ".pptx" Then
uNode.Image = My.Resources.Resources.powerpoint
ElseIf file.Extension = ".bmp" OrElse file.Extension = ".png" OrElse file.Extension = ".jpg" OrElse file.Extension = ".gif" OrElse file.Extension = ".tif" Then
uNode.Image = My.Resources.Resources.bitmap_image
ElseIf file.Extension = ".zip" OrElse file.Extension = ".rar" Then
uNode.Image = My.Resources.Resources.zip
Else
uNode.Image = My.Resources.Resources.unknown
End If
uNode.DragDropEnabled = True
uParent.Nodes.Add(uNode)
End If
Next
End If
Catch ex As Exception
' Catch Error
If Err.Number <> 0 Then
WriteAuditLogRecord(uStackframe.GetMethod.DeclaringType.FullName, uStackframe.GetMethod.Name.ToString, "Error", ex.Message & vbCrLf & vbCrLf & ex.StackTrace, 0)
MsgBox("System Error Ref: " & sAuditID & vbCrLf & uStackframe.GetMethod.DeclaringType.FullName & " / " & uStackframe.GetMethod.Name.ToString & vbCrLf & ex.Message & vbCrLf & vbCrLf & ex.StackTrace & Chr(13) & sErrDescription & vbCrLf & vbCrLf & "Press Control + C to copy this error report", MsgBoxStyle.Exclamation + MsgBoxStyle.OkOnly, "Business Management System - Unexepected Error Ref: " & sAuditID)
End If
Finally
' CleanUp
End Try
End Sub
I have spent 2 days now trying to figure out the cause and fix for this problem. There were posts that talked about the image being disposed and not being able to retrieve the image reference [ http://blog.lavablast.com/post/2007/11/29/The-Mysterious-Parameter-Is-Not-Valid-Exception.aspx ] , cloning the image before disposing etc.
I have given disposing and cloning a go, but the error still stands. Been trying couple of other things, but still unsuccessful.
Any suggestions to what is wrong?
EDIT 1
Before closing the form, I clear all the treenodes and then use Me.Close()
Private Sub tsbClose_Click(sender As Object, e As EventArgs) Handles tsbClose.Click
atRootFolder.Nodes.Clear()
atAllDirectories.Nodes.Clear()
atScannedFiles.Nodes.Clear()
atFiles.Nodes.Clear()
atInbox.Nodes.Clear()
atSent.Nodes.Clear()
Me.Close()
End Sub
EDIT 2
My treeviews have hundreds of nodes, child nodes etc. Please see the image of my File Management form ( this is the first time it was loaded, no errors) I had to hide the text due to client confidentiality, but I hope it makes sense. Each image is a node.
imgur.com/QQ2FzFV
I had tried to use GC.Collect to see if it works, and surprising it did. Sadly it worked on one machine and didn't in another. Therefore, instead of calling images directly from my resources, I have stored all required images in an image list which I have attached to my treeviews. It's working like a charm.

Writing To Text File, File In Use By Another Process, Multithreaded Application .NET

Afternoon,
I have a program whereby I really need to be keeping a log of some kind to ascertain what the program is doing. Essentially the software monitors for a window on the desktop to live pause a call recording on our Call Recorder Server.
Lets on argument say a Call Recording itself was pulled up by a monitoring agent and they state that a certain sensitive part of the conversation has been recorded when really it should have been silenced, if they were to say the agent hadn't done their job and clicked the pause recording button OR the onfocus action hadn't occurred I would have a situation whereby I would need to prove what the software was doing at the same.
I decided that I would write the actions of the software to a .txt file stored in the users app data.
This works for the most part, however every now and then even though the .txt is never accessed by any other program I get 'This file is in use by another process'.
This application is multithreaded and does make very frequent calls to write to the log, I am using the below code:
Private Sub WriteToLog(ByVal strSubTitle As String, ByVal strLogInfo As String)
Try
If My.Computer.FileSystem.FileExists(strLogFilePath) = True Then
'Delete yesterdays log file
Dim strFileDate As Date = File.GetCreationTime(strLogFilePath)
strFileDate = FormatDateTime(strFileDate, DateFormat.ShortDate)
'If strFileDate < Date.Today Then
' My.Computer.FileSystem.DeleteFile(strLogFilePath)
'End If
Using outFile As IO.StreamWriter = My.Computer.FileSystem.OpenTextFileWriter(strLogFilePath, True)
outFile.WriteLine("" & Date.Today & "," & Date.Now.ToLongTimeString & ", " & strUsername & ", " & strSubTitle & ", " & Replace(strLogInfo, ",", "|") & "")
outFile.Close()
End Using
''CSV File
'outFile.WriteLine("" & Date.Today & "," & Date.Now.ToLongTimeString & ", " & strUsername & ", " & strSubTitle & ", " & Replace(strLogInfo, ",", "|") & "")
'outFile.Close()
Else
Using outFile As IO.StreamWriter = My.Computer.FileSystem.OpenTextFileWriter(strLogFilePath, False)
outFile.WriteLine("" & Date.Today & "," & Date.Now.ToLongTimeString & ", " & strUsername & ", " & strSubTitle & ", " & Replace(strLogInfo, ",", "|") & "")
outFile.Close()
End Using
'CSV File
'outFile.WriteLine("Date, Time, Username, Sub(Process), Information")
'outFile.WriteLine("" & Date.Today & "," & Date.Now.ToLongTimeString & ", " & strUsername & ", " & strSubTitle & ", " & Replace(strLogInfo, ",", "|") & "")
'outFile.Close()
End If
Catch ex As Exception
CreateErrorFile(ex.Message, ex.StackTrace, "Log Write Failure!")
End Try
End Sub
Is there any advice/pointers someone could state as to why this would be saying another process is using the file.
I'm guessing the situation would occur when two separate threads try to do the 'WriteToLog' Sub while one or the other is writing to the file.
Am I on the right tracks? If so how could I rectify this?
Cheers,
James
You will either want to make it so that only one thread has the ability to write to the log file by using the Invoke method from the secondary thread(s) to call the write functionality on the main thread, or you can use one of .NET's various synchronization mechanisms.
Here is a simple example of the first approach:
Private Sub BackgroundMethod()
'do stuff
Me.Invoke(New Action(Of String)(AddressOf WriteToLog), "write a line blah blah")
'do more stuff
End Sub
Private Sub WriteToLog(valueToWrite As String)
System.IO.File.AppendAllLines(MyLogFilePath, {valueToWrite})
End Sub
Here's an example using a SyncLock block:
Private lock As New Object()
Private Sub BackgroundMethod()
'do stuff
WriteToLog("write a line blah blah")
'do more stuff
End Sub
Private Sub WriteToLog(valueToWrite As String)
SyncLock (lock)
System.IO.File.AppendAllLines(MyLogFilePath, {valueToWrite})
End SyncLock
End Sub
MSDN has good information on synchronization mechanisms: http://msdn.microsoft.com/en-us/library/ms228964%28v=vs.110%29.aspx
I would use a global Queue where new entries get added to and if the log writer is not busy then start it to write down all available lines.
sth like:
Private LogList As New Queue(Of String)
Private WriterBusy As Boolean = False
Private Sub WriteToLog(ByVal strSubTitle As String, ByVal strLogInfo As String)
LogList.Enqueue("" & Date.Today & "," & Date.Now.ToLongTimeString & ", " & strUsername & ", " & strSubTitle & ", " & Replace(strLogInfo, ",", "|") & "")
If WriterBusy = True Then Exit Sub
WriterBusy = True
Try
If My.Computer.FileSystem.FileExists(strLogFilePath) = True Then
...
Using outFile As IO.StreamWriter = My.Computer.FileSystem.OpenTextFileWriter(strLogFilePath, True)
While LogList.Count > 0
outFile.WriteLine(LogList.Dequeue)
End While
outFile.Close()
End Using
...
End Try
WriterBusy = False
End Sub

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.