VB.NET StreamReader can't follow Process - vb.net

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

Related

VBA/Access: How to stop "You... FORM to be active window"

I want to be able to tell IF a form is the active window.
It seems simply invoking that method produces an error. I guess I could catch that error and run with it, but it's a backwards way of doing it.
Screen.ActiveForm.Name
This needs a form to be active. If I am breaking any rules of stackOverflow please be kind and remind me as I am new to forum.
Screen.parent, screen.activeControl, etc. What if VBA editor is open, as often it is?
Function CStatus(strStatus, ByRef intType As Integer, Optional ByRef erNo, Optional erMsg, Optional strDatum)
'pXname = "CStatus"
'pXStack = Left(pXStack, 500) & ">" & pXname
'Updates and manages the status bar
Dim strPreamble As String, strOut As String, strForm As String, strComment As String, strSQL As String, strPxStack As String, strCErrStack As String
Dim intColor As Double
Dim intPreLen As Integer
'On Error GoTo err_hand
'Color Codes
'12632256 = Lt Grey
'33023 = Orange
'65280 = Green
'16744576 = Steel Grey
'Define "Constants"
intPreLen = 350 'Length of previous message cache
'** Fix missings
If (IsMissing(strDatum) = True) Then strDatum = "[N/A]"
'** Other inits
strWindow = Screen.Parent.Name
strForm = Screen.ActiveForm.Name
'** intDebug ' Minimum Level of to report to status
'bEcho = True 'Whether to echo to status
intColor = errNoColor(intType)
'Error-level idiot explanations
strComment = "0"
If IsMissing(erNo) Then erNo = 0
If (IsNull(erMsg) = False) Then
If IsMissing(erMsg) = False Then strComment = erMsg
End If
strComment = errorTree(erNo)
strPreamble = Left(strPreamble, intPreLen) & "..."
strErrStack = Left(strErrStack, intPreLen) & " > " & pXname & ":" & intType
strCErrStack = strErrStack
reS:
If ((strForm = "finvmain") Or (strForm = "fclips")) Then Screen.ActiveForm.timeStatusUpdated = Now() 'Small field keeps time
If bEcho = True Then
strPxStack = ""
strCErrStack = "" 'Internal error stack
End If
strOut = Now() & " " & intType & " (" & strType & "): " & erNo & " " & strCErrStack & " >> " & strComment & " / " & strStatus & " [" & strDatum & "] .. " & strPreamble
If bEcho = True Then
If (strForm = "fInvMain") Then Screen.ActiveForm.txtStatus2 = Screen.ActiveForm.txtStatus 'Added second window to show previous message
Screen.ActiveForm.txtStatus = strOut
End If
Screen.ActiveForm.txtStatus.ForeColor = intColor
If strForm = "fInvMain" Then strTag = Screen.ActiveForm.Controls("txttag").value
'***Event Log
If erNo = "" Then erNo = 0
If IsMissing(erMsg) = True Then erMsg = ""
If IsMissing(strDatum) = True Then strDatum = ""
If Len(strPreamble) < 2 Then strPreamble = "[None]"
'Fixxed - Syntax Error for Some Odd Reason! Apr 27th
If ((strTag = Empty) And (strForm = "fInvMain")) Then strTag = Screen.ActiveForm.txtTag 'Attempt to add tag# to entry
strStatus = cleanString(strStatus)
strDatum = cleanString(strDatum)
strComment = cleanString(strComment)
strSQL = "INSERT INTO tEvents(txtdate, myerrno, interrno, myerrmsg, interrmsg, txtform, stack, process, Datum, idLink) VALUES ('" & Now() & "','" & intType & "','" & erNo & "','" & strStatus & "','" & strComment & "','" & strForm & "','" & strErrStack & "','" & pXname & "','" & strDatum & "','" & strTag & "');"
CurrentDb.Execute strSQL, dbFailOnError
Exit Function
err_hand:
If Err.Number = 2475 Then
bEcho = False
Resume reS
Else: MsgBox "555: CStatus Internal Error, Turn off error handling to view"
End If
End Function
I need a boolean true or false IF form is active. If it isn't, I can't put stuff into a textbox in that.
To determine if a particular form is open then set focus to form:
If CurrentProject.AllForms("finvmain").IsLoaded
strForm = "finvmain"
Elseif CurrentProject.AllForms("fclips").IsLoaded Then
strForm = "fclips"
End If
If strForm <> "" Then DoCmd.SelectObject acForm, strForm

Procedure in VB.net works correctly only in debug mode

I have this procedure in visual basic that works for years in Visual Studio 2010 (2015) in windows 7 machine, but I change pc and now in Windows 10 Visual Studio 2017 it only works in debug mode. In runtime mode the procedure loop correctly for 2 time and exit with out error (exit code 0 on console).
In this procedure I loop in array of file information, read email in pdf file and send an email:
Private Sub elaboraFile(lDirectoryFile As String)
Dim i As Integer
Dim eMail, Denominazione, totaleFatt As String
For i = 0 To listaFatture.Length - 1
If File.Exists(lDirectoryFile & "\" & listaFatture(i).nomeFile) Then
' create a new PDF reader based on the PDF template document
Dim pdfReader As PdfReader = New PdfReader(lDirectoryFile & "\" & listaFatture(i).nomeFile)
Dim currentText As String
Dim strategy As New SimpleTextExtractionStrategy()
currentText = PdfTextExtractor.GetTextFromPage(pdfReader, 1, strategy)
currentText = Encoding.UTF8.GetString(ASCIIEncoding.Convert(Encoding.Default, Encoding.UTF8, Encoding.Default.GetBytes(currentText)))
Dim inizioEmail As Integer
Dim inizioDenomCompleta As String
inizioEmail = currentText.IndexOf("E-Mail: ")
If inizioEmail < 1 Then
'Errore indirizzo mail non trovato
listBoxErrori.Items.Add("mail non presente: " & listaFatture(i).nomeFile & " - " & listaFatture(i).denomParziale)
Else
inizioDenomCompleta = currentText.IndexOf(listaFatture(i).denomParziale)
eMail = currentText.Substring(inizioEmail + 8, inizioDenomCompleta - inizioEmail - 8 - 1)
If IsValidEmail(eMail) Then
'Estrazione denominazione Ditta
'inizio: valore di denomParziale
'fine: Spettabile
Denominazione = currentText.Substring(inizioDenomCompleta, currentText.IndexOf("Spettabile") - inizioDenomCompleta - 1)
ListBox1.Items.Add(listaFatture(i).nomeFile & " - " & eMail & " - " & Denominazione)
ListBox1.TopIndex = ListBox1.Items.Count - 1
Dim ldataFattura As String
ldataFattura = Strings.Right(listaFatture(i).dataFattura, 2) & "/"
ldataFattura = ldataFattura & listaFatture(i).dataFattura.Substring(4, 2) & "/"
ldataFattura = ldataFattura & Strings.Left(listaFatture(i).dataFattura, 4)
'Mail
Dim testoMail As String
testoMail = "Buongiorno <b>" & Denominazione & "</b>, <br />" & vbCrLf &
" <br />" & vbCrLf &
"Fattura nr <b>" & listaFatture(i).nrFattura & "</b> del <b>" & ldataFattura & "</b> <br />"
If SendMailAIM(eMail, "Invio fattura", testoMail, lDirectoryFile & "\" & listaFatture(i).nomeFile) = False Then
listBoxErrori.Items.Add("Errore invio mail - " & listaFatture(i).nomeFile & " - " & eMail & " - " & Denominazione & " - " & totaleFatt)
listBoxErrori.TopIndex = listBoxErrori.Items.Count - 1
End If
Else
listBoxErrori.Items.Add("mail errata: " & eMail & " nomefile:" & listaFatture(i).nomeFile & " - " & listaFatture(i).denomParziale)
End If
End If
pdfReader.Close()
pdfReader = Nothing
ResponsiveSleep(7000)
Try
File.Delete(lDirectoryFile & "\" & listaFatture(i).nomeFile)
Catch ex As Exception
listBoxErrori.Items.Add("Impossibile cancellare il file " & listaFatture(i).nomeFile)
End Try
ProgressBar1.PerformStep()
Else
listBoxErrori.Items.Add("Fattura non presente - " & listaFatture(i).nomeFile)
ProgressBar1.PerformStep()
End If
Me.Refresh()
Next
MsgBox("Elaborazione Terminata")
End Sub

Issue in Command line argument/String to unzip .7z files when filename contains space

I checked .7z website FAQ and other related website for my issue. But didn't find best solution for this issue.
When .7z filename has no space then my cmd is running perfectecly for Unzip. But when zip foldername contain space then its not working.
Dim args As String = "e " + """" + zipFileFolder + """" + " -o" + ToFolder + "" + " -p""Password123""" + " -aoa"
example: Zip file name:
3344-2633-9058-4583_37DB40L1KLJU_15_07_2017__18_40_39_FSserviceLog.7z
then it is running perfectly but for this file name:
6530-0567-9050-2878
AVsetting_WD-WXS1A176FF0E_15_05_2017__17_57_37-F6serviceLog.7z
where space is there between 2878 and AVsetting, then my cmd is not working. Please guild me for this.
Please check following code:
Function extract7z(zipFileFolder As String, ToFolder As String)
Try
Dim args As String = "e " & """" & zipFileFolder & """" & " -o" & ToFolder & "" & " -p""cyberspa123""" & " -aoa"
Dim p As New Process
Dim pInfo As New ProcessStartInfo
pInfo.FileName = exePath
pInfo.Arguments = args
pInfo.WindowStyle = ProcessWindowStyle.Hidden
p.StartInfo = pInfo
p.Start()
p.WaitForExit()
' System.Diagnostics.Process.Start(exePath, args)
'Threading.Thread.Sleep(1000)
' System.IO.File.Delete(zipFileFolder)
For Each foundFile As String In My.Computer.FileSystem.GetFiles(ToFolder)
Dim check As String = System.IO.Path.GetExtension(foundFile)
If (check = ".7z") Then
Dim zipFolderpath1 As String = System.IO.Path.GetFullPath(ToFolder & "/" & System.IO.Path.GetFileNameWithoutExtension(foundFile))
extract7z(foundFile, zipFolderpath1)
End If
Next
Catch ex As Exception
Console.WriteLine(ex.Message.ToString)
MessageBox.Show(ex.Message.ToString)
End Try
End Function

How to add new display in textbox without replacing the first input

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

PingOptions.TTL in vb.net always shows 128 as the result

I'm coding a simple ping command in vb.net using the System.Net.NetworkInformation.PingReply and System.Net.NetworkInformation.PingOptions. But the PingOptions.Ttl always shows 128 as the output. Below is a part of my code:
Dim buffer As Byte() = Encoding.ASCII.GetBytes(data)
Dim Myreply As System.Net.NetworkInformation.PingReply = MyPing.Send("10.99.162.201", 1000, buffer, options)
If Myreply.Status = Net.NetworkInformation.IPStatus.Success Then
PingResult = ("Reply from" & " " & Myreply.Address.ToString & ":" & _
"bytes=" & Myreply.Buffer.Length.ToString & _
" " & "time=" & Myreply.RoundtripTime.ToString & "ms" & " " & "TTL=" & options.Ttl)
ElseIf Myreply.Status = Net.NetworkInformation.IPStatus.TimedOut Then
PingResult = ("Request timed out.")
Else
PingResult = ("Error")
End If
Can somebody help me check what is missing to get the correct result? Thanks.
Windows OS TTL is 128
and Linux's TTL is 64