I recently updated my application to use oauth for a swagger interface, which requires opening a webpage to a specific URL and getting the user to authorize access. I then listen for the response sent to the local host and process the access token, etc. To do this I just call process.Start(URL)
Here is my code:
Private Sub GetAuthorizationfromWeb()
Try
' Build the authorization call
Dim URL As String = ESIAuthorizeURL & "?response_type=code" & "&redirect_uri=http://"
URL &= LocalHost & ":" & LocalPort & "&client_id=" & ClientID & "&scope=" & ScopesString
Process.Start(URL)
Dim mySocket As Socket = Nothing
Dim myStream As NetworkStream = Nothing
Dim myReader As StreamReader = Nothing
Dim myWriter As StreamWriter = Nothing
myListner.Start()
mySocket = myListner.AcceptSocket() ' Wait for response
Debug.Print("After socket listen")
myStream = New NetworkStream(mySocket)
myReader = New StreamReader(myStream)
myWriter = New StreamWriter(myStream)
myWriter.AutoFlush = True
Do
AuthStreamText &= myReader.ReadLine & "|"
If AuthStreamText.Contains("code") Then
Exit Do
End If
Loop Until myReader.EndOfStream
myWriter.Write("Login Successful!" & vbCrLf & vbCrLf & "You can close this window.")
myWriter.Close()
myReader.Close()
myStream.Close()
mySocket.Close()
myListner.Stop()
Application.DoEvents()
Catch ex As Exception
Application.DoEvents()
End Try
End Sub
All of it works fine with Firefox and to some extent Chrome when they are set as the default browser. However, when I try to launch the URL with Edge or Internet Explorer set as my default browser, it just opens a blank web page or the home page. There is no attempt to navigate to the URL set as the argument.
I tried to find another way to do this but basically process.Start seems to be the only option. I'm not going to embed a webbrowser in my code for security reasons.
Any thoughts?
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.
I am writing software for a POS terminal. This terminal has a printer that is attached to a cash drawer. I need to send a code to the printer, and listen for what is returned to determine whether or not the cash drawer is open. Using MSComm, I had logic that worked in VB6, so I know the actual Hex code I am sending is correct.
This code always returns "Error: Serial Port read timed out". I do not know what I am doing wrong with the read portion. Please advise, how do I listen for what the port is sending back as a response?
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
' Receive strings from a serial port.
Dim returnStr As String = ""
Dim x As Integer = 0
Dim com3 As IO.Ports.SerialPort = Nothing
logfile.WriteLine("STARTCASHDRAWERSTATUSCHECK")
Try
com3 = My.Computer.Ports.OpenSerialPort("COM3")
com3.WriteLine(ChrW(&H1B) & ChrW(&H75) & ChrW(&H0))
com3.BaudRate = SetPortBaudRate(9600)
com3.Parity = IO.Ports.Parity.None
com3.DataBits = SetPortDataBits(8)
com3.StopBits = SetPortStopBits(1)
com3.Handshake = IO.Ports.Handshake.RequestToSend
com3.ReadTimeout = 10000
Do
x = x + 1
Dim Incoming As String = com3.ReadLine()
logfile.WriteLine(x & "incoming" & Incoming & "x")
If Incoming Is Nothing Then
logfile.WriteLine("Button2resultEXITDO" & x)
Exit Do
Else
returnStr &= Incoming & vbCrLf
End If
If x > 10 Then
Exit Do
End If
Loop
Catch ex As TimeoutException
returnStr = "Error: Serial Port read timed out."
Finally
If com3 IsNot Nothing Then com3.Close()
End Try
logfile.WriteLine("Button2result:" & returnStr)
End Sub
Thanks in advance!
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.
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