Uptime with PerformanceCounters

Sub Main()

        Dim arguments As String() = Environment.GetCommandLineArgs()

        Dim b64 As Boolean = False

        Dim bRun As Boolean = True

        Dim pc As PerformanceCounter = New PerformanceCounter("System", "System Up Time")

        Dim oldColor As ConsoleColor = Console.ForegroundColor

        'If LogonUser("user", "domain", "password", 2, 0, tokenHandle) Then

        '    'Console.WriteLine("Logon Successful")

        '    newId = New WindowsIdentity(tokenHandle)

        '    impersonatedUser = newId.Impersonate()

        '    Console.ForegroundColor = ConsoleColor.DarkCyan

        '    Console.WriteLine(funFormatColumns("", 45, True) & funFormatColumns("User: " & newId.Name.ToString, 30, False))

        'Else

        '    Console.ForegroundColor = ConsoleColor.Red

        '    Console.WriteLine("Logon Failed")

        'End If

        'Console.WriteLine("User: " & newId.Name.ToString)

        If arguments.Length > 1 Then

            pc.MachineName = arguments(1)

            Console.ForegroundColor = ConsoleColor.Blue

            Console.WriteLine("Machine: " & pc.MachineName.ToString)

            Console.WriteLine()

            If Not Valid_Ping(pc.MachineName.ToString) Then bRun = False

        End If

        If bRun Then

            ' Console.WriteLine(">>> " & pc.MachineName.ToString)

            Try

                pc.NextValue() ' This returns zero for a reason I don't know

                If pc.MachineName.ToString = "." Then

                    If Directory.Exists("c:\program files (x86)") Then

                        b64 = True

                    End If

                Else

                    If Directory.Exists("\\" & pc.MachineName.ToString & "\c$\program files (x86)") Then

                        b64 = True

                    End If

                End If

                ' This call to NextValue gets the correct value

                Dim duration As TimeSpan = TimeSpan.FromSeconds(pc.NextValue())

                'Console.WriteLine(duration.ToString)

                Console.ForegroundColor = ConsoleColor.Green

                Console.Write(funFormatColumns(duration.Days & " Days " & duration.Hours & " Hours " & duration.Minutes & " Minutes " & duration.Seconds & " Seconds", 45, True))

                'Console.WriteLine()

                Console.ForegroundColor = ConsoleColor.Gray

                Console.WriteLine(funFormatColumns("(" & DateTime.Now.Subtract(duration) & ")", 33, False))

            Catch e As Exception

                Console.ForegroundColor = ConsoleColor.Red

                Console.WriteLine("Failed: " & e.Message.ToString)

            End Try

            'Catch

            'End Try

        End If

        'impersonatedUser.Undo()

        'impersonatedUser.Dispose()

        'newId.Dispose()

        'CloseHandle(tokenHandle)

        ' newId = WindowsIdentity.GetCurrent

        'Console.ForegroundColor = ConsoleColor.DarkCyan

        'Console.WriteLine(funFormatColumns("", 45, True) & funFormatColumns("User: " & newId.Name.ToString, 30, False))

        Console.ForegroundColor = oldColor

        'Console.ReadLine()

    End Sub


Valid_Ping


    Private Function Valid_Ping(ByVal SystemName As String) As Boolean

        Dim PingReplied As Boolean = False

        Try

            Dim PingSender As New Ping

            Dim Options As New PingOptions

            ' Use default TTL of 128

            ' Change to not fragment

            Options.DontFragment = True

            ' Create 32 byte data buffer to send

            Dim PingData As String = "******Computer*****Details******"

            Dim Pingbuffer() As Byte = Encoding.ASCII.GetBytes(PingData)

            Dim PingTimeout As Integer = 120

            Dim PingReply As PingReply = PingSender.Send(SystemName, PingTimeout, Pingbuffer)

            If PingReply.Status = IPStatus.Success Then

                PingReplied = True

            Else

                PingReplied = False

            End If

            Return PingReplied

        Catch ex As Exception

            Return PingReplied

        End Try

    End Function

Is Port Open?

Function IsPortOpen(sServerName As String, Optional PortToCheck As Int16 = 0) As Boolean
        Dim MyTCPClient As TcpClient
        Dim MyStream As NetworkStream
        Dim SendBuffer(128) As Byte
        Dim ReadBuffer(128) As Byte
        Dim ReturnVal As String
        Dim ReturnLength As Integer
        Dim oTimer As New System.Timers.Timer
        oTimer.Interval = 2000

       'AddHandler oTimer.Elapsed, AddressOf Timer_Tick
        'oTimer.Start()

        Try
            Console.WriteLine(sServerName & ":" & PortToCheck)
            MyTCPClient = New TcpClient(sServerName, PortToCheck)
            MyStream = MyTCPClient.GetStream
            'Send something (username/HELO/whatever)
            'SendBuffer = Encoding.ASCII.GetBytes("HELO" & vbNewLine)
            'MyStream.Write(SendBuffer, 0, SendBuffer.Length)
            ''Get server's response
            'ReturnLength = MyStream.Read(ReadBuffer, 0, ReadBuffer.Length)
            'If ReturnLength = 0 Then
            '    Console.WriteLine("Server responded but with an empty string")
            '    Return True
            'End If
            'ReturnVal = Encoding.ASCII.GetString(ReadBuffer)
            'Console.WriteLine(ReturnVal)

        Catch ex As Exception
            'MessageBox.Show("An error occurred - " & vbNewLine & ex.Message, "Connect Failed", MessageBoxButtons.OK, MessageBoxIcon.Error)
            Return False

        End Try
        Return True

    End Function

 

 IP Check RegEx (VBscript)

wscript.echo IP_Valide("10.12.2.125")

Function IP_Valide(ip)

   IP_Valide=false

    Set myRegExp = New RegExp

     myRegExp.IgnoreCase = True

     myRegExp.Global = True

     myRegExp.Pattern ="^((25[0-5]|2[0-4]\d|1?\d?\d)\.){3}(25[0-5]|2[0-4]\d|1?\d?\d)$"

     set myMatches =  myRegExp.execute(ip)

    'IP_Valide= myRegExp.execute( ip)

     For Each myMatch in myMatches

        'msgbox myMatch.Value, 0, "Found Match"

        IP_Valide=true

     Next

End function


Get MAC Address

    Function getMacAddress()
        Dim nics() As NetworkInterface = NetworkInterface.GetAllNetworkInterfaces()
        Return nics(0).GetPhysicalAddress.ToString
    End Function


IsDayTime Check time between two dates


   Public Function IsDayTime(ByVal startTime As DateTime, ByVal endTime As DateTime, ByVal testtime As DateTime) As Boolean

        Return testtime.TimeOfDay >= startTime.TimeOfDay AndAlso testtime.TimeOfDay <= endTime.TimeOfDay

        'Return DateTime.Now.TimeOfDay >= startTime.TimeOfDay AndAlso DateTime.Now.TimeOfDay <= endTime.TimeOfDay

    End Function

  

Delay between then and now Pause if you will

Function PauseIt(iSeconds As Integer) As Boolean
        Dim bRun As Boolean = True
        Dim dNow As DateTime = Now

        While bRun
            Try
                Application.DoEvents()
              If DateDiff(DateInterval.Second, dNow, Now) > iSeconds Then
                    bRun = False
                    Exit While
              End If
            Catch ex As Exception
            End Try
        End While
    End Function

PauseIt

    Sub PauseIt(iSeconds As Integer)
        Dim dNow As DateTime = Now
        While DateDiff(DateInterval.Second, dNow, Now) < iSeconds
            Threading.Thread.Sleep(100)
        End While
    End Sub

Round to Quarter Hour

'https://vbdotnetforums.com/threads/update-time-to-the-nearest-15-minutes.13307/

Function RoundToQuarterHour(ByVal inDateTime As DateTime) As DateTime

Dim minutes As Integer
Dim addMinutes As Double

minutes = inDateTime.Minute

Do While (minutes + addMinutes) Mod 15 <> 0
  addMinutes += 1
Loop

inDateTime = inDateTime.AddMinutes(addMinutes)

RoundToQuarterHour = inDateTime

End Function

Get Day of Week as String

         Dim myCulture As System.Globalization.CultureInfo = Globalization.CultureInfo.CurrentCulture
                Dim dayOfWeek As DayOfWeek = myCulture.Calendar.GetDayOfWeek(sqlReader("TheDate"))
                ' dayOfWeek.ToString() would return "Sunday" but it's an enum value,
                ' the correct dayname can be retrieved via DateTimeFormat.
                ' Following returns "Sonntag" for me since i'm in germany '
                Dim dayName As String = myCulture.DateTimeFormat.GetDayName(dayOfWeek)

Remove List View items more completely

   If ListView1.Items.Count > 0 Then

                For i = ListView1.Items.Count - 1 To 0 Step -1
                    ListView1.Items.Remove(ListView1.Items(i))
                Next i
 End If

Get ContextMenu's Listview

  Dim sc As Control = CType(sender.Owner, ContextMenuStrip).SourceControl
  Dim t As Control = CType(sc, ListView)
  Debug.Print("t.name = " & t.Name)


Remove HTML characters from string

    'https://stackoverflow.com/questions/17665582/stripping-out-html-tags-in-string

<Extension()> Public  Function funRemoveHTML(sourcestring As String) As String

        'Dim sourcestring As String = "replace with your source string"

        Dim replacementstring As String = ""

        Dim matchpattern As String = "<(?!br)(?:[^>=]|='[^']*'|=""[^""]*""|=[^'""][^\s>]*)*>"  'leave the <br> tag

        'Dim matchpattern As String = "<(?:[^>=]|='[^']*'|=""[^""]*""|=[^'""][^\s>]*)*>" 'removes all html

        'For the return value, making <br> into vbCrLf

        Return Replace(Replace((Regex.Replace(sourcestring, matchpattern, replacementstring, RegexOptions.IgnoreCase Or RegexOptions.IgnorePatternWhitespace Or RegexOptions.Multiline Or RegexOptions.Singleline)), "<br />", vbCrLf), "<BR>", vbCrLf)

    End Function

IsFileOpen

' Jeremy Thompson's code from here

    Private Sub IsFileOpen(ByVal file As FileInfo)

        Dim stream As FileStream = Nothing

        Try

            Debug.Print("Testing " & file.FullName.ToString)

            stream = file.Open(FileMode.Open, FileAccess.ReadWrite, FileShare.None)

            stream.Close()

        Catch ex As Exception

            If TypeOf ex Is IOException Then 'AndAlso IsFileLocked(ex) Then

                ' do something here, either close the file if you have a handle, show a msgbox, retry  or as a last resort terminate the process - which could cause corruption and lose data

                'Form1.ListView1.Items.Add("******" & file.FullName.ToString)

                Debug.Print("******" & file.Name.ToString)

                ListViewAddItem("******" & file.Name.ToString, "-", "-")

                Application.DoEvents()

            End If

        End Try

    End Sub

https://stackoverflow.com/questions/36950966/detect-if-any-file-in-use-by-other-process-of-a-directory-in-vb

Get the first/latest file in a pattern from a folder/directory


Dim myFile = Directory.GetFiles("\\cnn\dashboarddocs\EPSi", "Daily_Volume_Trends*.pdf").OrderByDescending(Function(f) New FileInfo(f).LastWriteTime).First()

Recursive Get all files in Folder structure

Function GetAllFiles(sPath As String, oDateTime As DateTime) As List(Of String)
        For Each oFile As String In IO.Directory.GetFiles(sPath)
            If FileSystem.FileDateTime(oFile) >= oDateTime Then
                oListOfFiles.Add(oFile) ' & "|" & FileSystem.FileDateTime(oFile))
            End If
        Next

        For Each oFolder As String In IO.Directory.GetDirectories(sPath)
            GetAllFiles(oFolder, oDateTime)
        Next
End Function

Restart AppPool

RestartAppPool(_arguments(0).ToString, "stop")

RestartAppPool(_arguments(0).ToString, "start")


Sub RestartAppPool(sAppPoolName As String, sVerb As String)

        ' Add code here to perform any tear-down necessary to stop your service.

        Dim pProcess As New Process

        pProcess.StartInfo.CreateNoWindow = True

        'pProcess.StartInfo.UserName = ""

        'pProcess.StartInfo.Password = ToSecureString("")

        pProcess.StartInfo.UseShellExecute = False

        'pProcess.StartInfo.Domain = ""

        pProcess.StartInfo.FileName = My.Application.GetEnvironmentVariable("SYSTEMROOT") & "\System32\inetsrv\appcmd.exe"

        pProcess.StartInfo.Arguments = " " & sVerb & " apppool /apppool.name:""" & sAppPoolName & """"

        '" user /server:" & servername

        pProcess.StartInfo.WindowStyle = ProcessWindowStyle.Hidden

        pProcess.StartInfo.RedirectStandardOutput = True

        pProcess.StartInfo.RedirectStandardError = True

        Try

            'TextBox1.AppendText("Query:  " & servername & " " & Now & vbCrLf)

            Dim blnOk As Boolean = pProcess.Start()

            WriteFile("Successfully started Process: " & pProcess.StartInfo.FileName & " " & pProcess.StartInfo.Arguments, sLogFile)

            If blnOk Then

                WriteFile("  blnOK" & pProcess.StandardOutput.ReadToEnd.ToString, sLogFile)

            Else

                WriteFile("  !blnOK" & pProcess.StandardError.ReadToEnd.ToString, sLogFile)

            End If

            If Not pProcess.WaitForExit(1000 * 60) Then

                'TextBox1.AppendText("60 second timeout on : " & servername & " " & Now & "  Aborting." & vbCrLf)

                WriteFile("60 second timeout! " & Now, sLogFile)

                pProcess.Kill()

                'Return

            Else

            End If

        Catch ex As Exception

            My.Application.Log.WriteEntry("Exception in RerstartAppPool! " & ex.Message.ToString, TraceEventType.Error, 1001)

            WriteFile("Exception in RerstartAppPool! " & ex.Message.ToString, sLogFile)

        End Try

    End Sub