Тайм-кодер

Imports Microsoft.VisualBasic
Imports Microsoft.VisualBasic.Strings
 
Public Class Form1
 
    Dim SecAllYear As UInt64
    Dim TimeCode36 As String
 
    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
        DateTimeNow()
    End Sub
 
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        DateTimeNow()
    End Sub
 
    Private Sub DateTimeNow()
        Dim DTN As Date = Date.Now
        Label3.Text = DTN.ToString
        Label4.Text = SecondsCounter().ToString
        Label6.Text = Converter(SecAllYear).ToString
    End Sub
 
    Private Function SecondsCounter()
        'Вычисляем секунды прошедших лет
        Dim ThisYear As UInt32 = Date.Now.Year
        Dim LeapYear As UInt32 = (ThisYear - 1) \ 4
        Dim LeanYear As UInt32 = LeapYear \ 100 + 1
        LeapYear = LeapYear - LeanYear
        LeanYear = ThisYear - LeapYear
        Dim LastYearSec As UInt64 = LeapYear * 31622400 + LeanYear * 31536000
        'Вычисляем секунды текущего года
        Dim DOY As UInt32 = Date.Now.DayOfYear
        Dim HTD As UInt32 = Date.Now.Hour
        Dim MTD As UInt32 = Date.Now.Minute
        Dim STD As UInt32 = Date.Now.Second
        Dim SecDayThisYear As UInt32 = (DOY - 1) * 86400
        Dim SecThisDay As UInt32 = 0
        Dim SecThisHou As UInt32 = 0
        If HTD <> 0 Then SecThisDay = HTD * 3600
        If MTD <> 0 Then SecThisHou = MTD * 60
        'Суммируем все секунды прошедших лет и текущего года
        SecAllYear = LastYearSec + SecDayThisYear + SecThisDay + SecThisHou + STD
        Return SecAllYear
    End Function
 
    Private Function Converter(ByVal TimeCode10 As UInt64)
        Dim AlphaBeta As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
        Dim ChrResult As String = Nothing
        Dim ConResult As UInt64
        Dim SubResult As UInt64
        Dim SecResult As UInt64
        Do While TimeCode10 > 35
            ConResult = TimeCode10 \ 36
            SecResult = ConResult * 36
            SubResult = TimeCode10 - SecResult
            ChrResult = Mid(AlphaBeta, SubResult + 1, 1) & ChrResult
            TimeCode10 = ConResult
        Loop
        TimeCode36 = Mid(AlphaBeta, TimeCode10 + 1, 1) & ChrResult
        Return TimeCode36.PadLeft(8, "0")
    End Function
 
    Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
        Dim RandYear As UInt32 = DateTimePicker1.Value.Year
        Dim LeapYear As UInt32 = (RandYear - 1) \ 4
        Dim LeanYear As UInt32 = LeapYear \ 100 + 1
        LeapYear = LeapYear - LeanYear
        LeanYear = RandYear - LeapYear
        Dim RandYearSec As UInt64 = LeapYear * 31622400 + LeanYear * 31536000
        Dim DOY As UInt32 = DateTimePicker1.Value.DayOfYear
        Dim HTD As UInt32 = DateTimePicker2.Value.Hour
        Dim MTD As UInt32 = DateTimePicker2.Value.Minute
        Dim STD As UInt32 = DateTimePicker2.Value.Second
        Dim SecDayRandYear As UInt32 = (DOY - 1) * 86400
        Dim SecRandDay As UInt32 = 0
        Dim SecRandHou As UInt32 = 0
        If HTD <> 0 Then SecRandDay = HTD * 3600
        If MTD <> 0 Then SecRandHou = MTD * 60
        SecAllYear = RandYearSec + SecDayRandYear + SecRandDay + SecRandHou + STD
        TextBox1.Text = SecAllYear.ToString
    End Sub
 
    Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
        If TextBox1.Text = "" Or IsNumeric(TextBox1.Text) = False Then
            MsgBox("Введите число от 0 до 2.821.109.907.455.")
        ElseIf CULng(TextBox1.Text) > 2821109907455 Then
            MsgBox("Введите число не больше 2.821.109.907.455.")
        Else
            Dim AlphaBeta As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
            Dim ChrResult As String = Nothing
            Dim ConResult As UInt64
            Dim SubResult As UInt64
            Dim SecResult As UInt64
            Dim TimeCode10 As ULong = CULng(TextBox1.Text)
            Do While TimeCode10 > 35
                ConResult = TimeCode10 \ 36
                SecResult = ConResult * 36
                SubResult = TimeCode10 - SecResult
                ChrResult = Mid(AlphaBeta, SubResult + 1, 1) & ChrResult
                TimeCode10 = ConResult
            Loop
            TimeCode36 = Mid(AlphaBeta, TimeCode10 + 1, 1) & ChrResult
            Label8.Text = TimeCode36.PadLeft(8, "0")
        End If
    End Sub
 
End Class