[vb] Extra Snippets

Extra.vb

Imports System.Net.Sockets

Module Extra

#Region "DoubleBuffered Buff // Use Buff.DoubleBuff(<Control>)"
    Friend NotInheritable Class Buff
        Friend Shared Sub DoubleBuff(Contt As Control)
            Dim ConttType As Type = Contt.[GetType]()
            Dim propInfo As System.Reflection.PropertyInfo = ConttType.GetProperty("DoubleBuffered", System.Reflection.BindingFlags.Instance Or System.Reflection.BindingFlags.NonPublic)
            propInfo.SetValue(Contt, True, Nothing)
        End Sub
    End Class
#End Region

#Region "File Size"
    Function GetFileSize(ByVal byteLength As Long) As String
        Dim sizer As String = Nothing
        If byteLength >= 1048576 And byteLength <= 1073741823 Then
            sizer = FormatNumber(byteLength / 1048576, 2).ToString & "MB"
        ElseIf byteLength >= 1024 And byteLength <= 1048575 Then
            sizer = FormatNumber(byteLength / 1024, 2) & "KB"
        Else
            sizer = FormatNumber(byteLength, 0) & "B"
        End If
        Return sizer
    End Function
#End Region

#Region "Network Time Retriever"
    'stackoverflow.com/questions/1193955/how-to-query-an-ntp-server-using-c
    Friend Function GetNetworkTime() As DateTime
        If Not My.Computer.Network.IsAvailable Then
            Return Now
            Exit Function
        End If
        Try
            'default Windows time server
            Const ntpServer As String = "pool.ntp.org"
            ' NTP message size - 16 bytes of the digest (RFC 2030)
            Dim ntpData = New Byte(47) {}
            'Setting the Leap Indicator, Version Number and Mode values
            ntpData(0) = &H1B
            'LI = 0 (no warning), VN = 3 (IPv4 only), Mode = 3 (Client Mode)
            Dim addresses = System.Net.Dns.GetHostEntry(ntpServer).AddressList
            'The UDP port number assigned to NTP is 123
            Dim ipEndPoint = New System.Net.IPEndPoint(addresses(0), 123)
            'NTP uses UDP
            Dim socket = New Socket(AddressFamily.InterNetwork, SocketType.Dgram, ProtocolType.Udp)
            socket.Connect(ipEndPoint)
            'Stops code hang if NTP is blocked
            socket.ReceiveTimeout = 700
            socket.Send(ntpData)
            socket.Receive(ntpData)
            socket.Close()
            'Offset to get to the "Transmit Timestamp" field (time at which the reply
            'departed the server for the client, in 64-bit timestamp format."
            Const serverReplyTime As Byte = 40
            'Get the seconds part
            Dim intPart As ULong = BitConverter.ToUInt32(ntpData, serverReplyTime)
            'Get the seconds fraction
            Dim fractPart As ULong = BitConverter.ToUInt32(ntpData, serverReplyTime + 4)
            'Convert From big-endian to little-endian
            intPart = SwapEndianness(intPart)
            fractPart = SwapEndianness(fractPart)
            Dim milliseconds = (intPart * 1000) + ((fractPart * 1000) / &H100000000L)
            '**UTC** time
            Dim networkDateTime = (New DateTime(1900, 1, 1, 0, 0, 0, DateTimeKind.Utc)).AddMilliseconds(CLng(milliseconds))
            Return CType(IIf(networkDateTime.ToLocalTime() < CType("01/01/2016 00:00:00.000", DateTime), Now, networkDateTime.ToLocalTime()), DateTime)
            'or ---------------------------------------------------------
            'Dim datatableXXX As New DataTable
            'Using conX As New SqlConnection(stringCon), comX As New SqlCommand, adapterX As New SqlDataAdapter
            '    dataTableX.Dispose()
            '    dataTableX = New DataTable
            '    comX.Connection = conX
            '    comX.CommandTimeout = 1
            '    comX.CommandText = "set nocount on; " & "select cast(SYSDATETIME() as varchar(32)) as 'ServerTime'"
            '    adapterX.SelectCommand = comX
            '    adapterX.Fill(datatableXXX)
            'End Using
            'Return CDate(IIf(CType(datatableXXX.Rows(0).Item("ServerTime").ToString, DateTime) < CType("2015-08-07 00:00:00.0000000", DateTime), Now, datatableXXX.Rows(0).Item("ServerTime").ToString))
            'datatableXXX.Dispose()
        Catch ex As Exception
            Return Now
        End Try
    End Function
    'stackoverflow.com/a/3294698/162671
    Private Function SwapEndianness(x As ULong) As UInteger
        Return CUInt(((CLng(x) And &HFF) << 24) + ((CLng(x) And &HFF00) << 8) + ((CLng(x) And &HFF0000) >> 8) + ((CLng(x) And &HFF000000UI) >> 24))
    End Function
#End Region

#Region "Form Open Check"
    Public Function IsFormOpen(ByVal frm As Form) As Boolean
        If Application.OpenForms.OfType(Of Form).Contains(frm) Then
            Return True
        Else
            Return False
        End If
    End Function
#End Region

End Module