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
Related
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
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
I have the following code to check windows updates
Function CheckWinUpdates() As Integer
CheckWinUpdates = 0
Dim WUSession As UpdateSession
Dim WUSearcher As UpdateSearcher
Dim WUSearchResults As ISearchResult
Try
WUSession = New UpdateSession
WUSearcher = WUSession.CreateUpdateSearcher()
WUSearchResults = WUSearcher.Search("IsInstalled=0 and Type='Software'")
CheckWinUpdates = WUSearchResults.Updates.Count
Catch ex As Exception
CheckWinUpdates = -1
End Try
If CheckWinUpdates > 0 Then
Try
'Dim Update As IUpdate
Dim i As Integer = 0
For i = 0 To WUSearchResults.Updates.Count - 1
'Update = WUSearchResults.Updates.Item(i)
EventLog.WriteEntry("Item is type: " & WUSearchResults.Updates.Item(i).ToString, EventLogEntryType.Information, 85)
EventLog.WriteEntry("Deadline: " & WUSearchResults.Updates.Item(i).Deadline.ToString, EventLogEntryType.Information, 85)
EventLog.WriteEntry("Type: " & WUSearchResults.Updates.Item(i).Type.ToString, EventLogEntryType.Information, 85)
EventLog.WriteEntry("Released on: " & WUSearchResults.Updates.Item(i).LastDeploymentChangeTime, EventLogEntryType.Information, 85)
EventLog.WriteEntry("This windows update is required: " & WUSearchResults.Updates.Item(i).Title, EventLogEntryType.Information, 85)
'EventLog.WriteEntry("This windows update is required: " & Update.Title & vbCrLf & "Released on: " &
' Update.LastDeploymentChangeTime & vbCrLf & "Type: " & Update.Type.ToString & vbCrLf &
' "Deadline: " & Update.Deadline.ToString & vbCrLf & vbCrLf & "Item is type: " & Update.ToString, EventLogEntryType.Information, 85)
Next
Catch ex As Exception
EventLog.WriteEntry("Error while attempting to log required updates:" & vbCrLf & ex.Message, EventLogEntryType.Error, 86)
End Try
End If
WUSearchResults = Nothing
WUSearcher = Nothing
WUSession = Nothing
End Function
My intention with this is to a) get the number of windows updates that are applicable, and b) to look at what other properties are available, and more specifically see how many are older than a week or 2.
I know that UpdateSearcher doesn't allow to search by date, so I am looking to iterate through each item and then later report on each one.
At the moment my function does quite happily return the number of updtes, but when I try to get any of the properties I get "Object reference not set to an instance of an object".
Any ideas where I'm going wrong?
I got this working, turns it it doesn't like the deadline property, I don't know it comes up with "object reference not set", but for what I need it doesn't matter.
The problem of this script is that it shows an unknown error Message while running the script.
I called the function by echo method in my ftp which is "filezilla".
every thing is working fine as it logs into the server check for the path, open channel for data writing. Still dont know where is the problem
Function FTPUpload(sSite, sUsername, sPassword, sLocalFile, sRemotePath)
'This script is provided under the Creative Commons license located
'at http://creativecommons.org/licenses/by-nc/2.5/ . It may not
'be used for commercial purposes with out the expressed written consent
'of NateRice.com
Const OpenAsDefault = -2
Const FailIfNotExist = 0
Const ForReading = 1
Const ForWriting = 2
Set oFTPScriptFSO = CreateObject("Scripting.FileSystemObject")
Set oFTPScriptShell = CreateObject("WScript.Shell")
sRemotePath = Trim(sRemotePath)
sLocalFile = Trim(sLocalFile)
'----------Path Checks---------
'Here we willcheck the path, if it contains
'spaces then we need to add quotes to ensure
'it parses correctly.
If InStr(sRemotePath, " ") > 0 Then
If Left(sRemotePath, 1) <> """" And Right(sRemotePath, 1) <> """" Then
sRemotePath = """" & sRemotePath & """"
End If
End If
If InStr(sLocalFile, " ") > 0 Then
If Left(sLocalFile, 1) <> """" And Right(sLocalFile, 1) <> """" Then
sLocalFile = """" & sLocalFile & """"
End If
End If
'Check to ensure that a remote path was
'passed. If it's blank then pass a "\"
If Len(sRemotePath) = 0 Then
'Please note that no premptive checking of the
'remote path is done. If it does not exist for some
'reason. Unexpected results may occur.
sRemotePath = "\"
End If
'Check the local path and file to ensure
'that either the a file that exists was
'passed or a wildcard was passed.
If InStr(sLocalFile, "*") Then
If InStr(sLocalFile, " ") Then
FTPUpload = "Error: Wildcard uploads do not work if the path contains a " & _
"space." & vbCRLF
FTPUpload = FTPUpload & "This is a limitation of the Microsoft FTP client."
Exit Function
End If
ElseIf Len(sLocalFile) = 0 Or Not oFTPScriptFSO.FileExists(sLocalFile) Then
'nothing to upload
FTPUpload = "Error: File Not Found."
Exit Function
End If
'--------END Path Checks---------
'build input file for ftp command
sFTPScript = sFTPScript & "USER " & sUsername & vbCRLF
sFTPScript = sFTPScript & sPassword & vbCRLF
sFTPScript = sFTPScript & "cd " & sRemotePath & vbCRLF
sFTPScript = sFTPScript & "binary" & vbCRLF
sFTPScript = sFTPScript & "prompt n" & vbCRLF
sFTPScript = sFTPScript & "put " & sLocalFile & vbCRLF
sFTPScript = sFTPScript & "quit" & vbCRLF & "quit" & vbCRLF & "quit" & vbCRLF
sFTPTemp = oFTPScriptShell.ExpandEnvironmentStrings("%TEMP%")
sFTPTempFile = sFTPTemp & "\" & oFTPScriptFSO.GetTempName
sFTPResults = sFTPTemp & "\" & oFTPScriptFSO.GetTempName
'Write the input file for the ftp command
'to a temporary file.
Set fFTPScript = oFTPScriptFSO.CreateTextFile(sFTPTempFile, True)
fFTPScript.WriteLine(sFTPScript)
fFTPScript.Close
Set fFTPScript = Nothing
oFTPScriptShell.Run "%comspec% /c FTP -n -s:" & sFTPTempFile & " " & sSite & _
" > " & sFTPResults, 0, TRUE
Wscript.Sleep 1000
'Check results of transfer.
Set fFTPResults = oFTPScriptFSO.OpenTextFile(sFTPResults, ForReading, _
FailIfNotExist, OpenAsDefault)
sResults = fFTPResults.ReadAll
fFTPResults.Close
oFTPScriptFSO.DeleteFile(sFTPTempFile)
oFTPScriptFSO.DeleteFile (sFTPResults)
If InStr(sResults, "226 Transfer complete.") > 0 Then
FTPUpload = True
ElseIf InStr(sResults, "File not found") > 0 Then
FTPUpload = "Error: File Not Found"
ElseIf InStr(sResults, "cannot log in.") > 0 Then
FTPUpload = "Error: Login Failed."
Else
FTPUpload = "Error: Unknown."
End If
Set oFTPScriptFSO = Nothing
Set oFTPScriptShell = Nothing
WScript.Echo "Process Completed (" & Now & ")"
End Function
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