Function datetonum(ByVal str1 As String)
Dim length As Integer
Dim str2 As String
Dim char1 As Char
Dim marker As Integer = 1
Dim month As String
Dim day As String
Dim year As String
Dim num1 As Integer
Dim num2 As Integer
length = Len(str1)
For i As Integer = 1 To length
char1 = Mid(str1, i, 1)
If char1 = "/" Then
marker = marker + 1
Else
If marker = 1 Then
month = month & char1
End If
If marker = 2 Then
day = day & char1
End If
If marker = 3 Then
year = year & char1
End If
End If
Next
If month <= 9 Then
month = "0" & month
End If
If day <= 9 Then
day = "0" & day
End If
year = Mid(year, 1, 4)
num1 = day + monthtodays(month, year) + yearstodays(year)
Return num1
End Function
Function yearstodays(ByVal num1 As Integer)
Dim years As Integer = 1
Dim leap As Boolean = False
Dim days As Integer = 0
Dim test As Integer
Do While years <= num1
leap = False
test = years Mod 4
If years Mod 4 = 0 And years > 3 Then
If Not years Mod 100 = 0 Then
leap = True
Else
If years Mod 400 = 0 Then
leap = True
Else
leap = False
End If
End If
End If
If leap Then
days = days + 366
Else
days = days + 365
End If
years = years + 1
Loop
Return days - 365
End Function
Function monthtodays(ByVal num1 As Integer, ByVal year As String)
Dim leap As Boolean
If year Mod 4 = 0 And year > 3 Then
If Not year Mod 100 = 0 Then
leap = True
Else
If year Mod 400 = 0 Then
leap = True
End If
End If
End If
If leap = False Then
Select Case (num1)
Case 1 ' jan
Return 0
Case 2 'feb
Return 31 ' for jan
Case 3 'mar
Return 28 + 31 'for jan and feb
Case 4 'apr
Return 31 + 28 + 31
Case 5 'may
Return 31 + 28 + 31 + 30
Case 6 'june
Return 31 + 28 + 31 + 30 + 31
Case 7 'july
Return 31 + 28 + 31 + 30 + 31 + 30
Case 8 'aug
Return 31 + 28 + 31 + 30 + 31 + 30 + 31
Case 9 'sep
Return 31 + 28 + 31 + 30 + 31 + 30 + 31 + 31
Case 10 'oct
Return 31 + 28 + 31 + 30 + 31 + 30 + 31 + 31 + 30
Case 11 'nov
Return 31 + 28 + 31 + 30 + 31 + 30 + 31 + 31 + 30 + 31
Case 12 'dec
Return 31 + 28 + 31 + 30 + 31 + 30 + 31 + 31 + 30 + 31 + 30
End Select
Else 'leap is true
Select Case (num1)
Case 1 ' jan
Return 0
Case 2 'feb
Return 31
Case 3 'mar
Return 31 + 29
Case 4 'apr
Return 31 + 29 + 31
Case 5 'may
Return 31 + 29 + 31 + 30
Case 6 'june
Return 31 + 29 + 31 + 30 + 31
Case 7 'july
Return 31 + 29 + 31 + 30 + 31 + 30
Case 8 'aug
Return 31 + 29 + 31 + 30 + 31 + 30 + 31
Case 9 'sep
Return 31 + 29 + 31 + 30 + 31 + 30 + 31 + 31
Case 10 'oct
Return 31 + 29 + 31 + 30 + 31 + 30 + 31 + 31 + 30
Case 11 'nov
Return 31 + 29 + 31 + 30 + 31 + 30 + 31 + 31 + 30 + 31
Case 12 'dec
Return 31 + 29 + 31 + 30 + 31 + 30 + 31 + 31 + 30 + 31 + 30
End Select
End If
End Function
Function numtodate(ByVal int1 As Integer)
Dim year As String
Dim month As Integer = 1
Dim days As Integer = 1
Dim test As Integer = int1
Dim leap As Boolean = False
Dim returndate As String
year = findyear(int1)
month = findmonth(int1 - yearstodays(year), year)
days = int1 - monthtodays(month, year) - yearstodays(year)
If month <= 9 Then
month = "0" & month
End If
If days <= 9 Then
days = "0" & days
End If
year = Mid(year, 1, 4)
returndate = month & "/" & days & "/" & year
Return returndate
End Function
Function findyear(ByVal int1 As Integer)
Dim year As Integer = 1
Dim averageyear As Double = 365.2425
year = Math.Floor((int1 + 365.0) / averageyear)
Return year
End Function
Function findmonth(ByVal int1 As Integer, ByVal years As Integer)
Dim leap As Boolean = False
Dim count1 As Integer
Dim test As Integer
Dim month As Integer
If years Mod 4 = 0 And years > 3 Then
If Not years Mod 100 = 0 Then
leap = True
Else
If years Mod 400 = 0 Then
leap = True
Else
leap = False
End If
End If
End If
For count1 = 1 To 12
If leap = False Then
Select Case (count1)
Case 1 ' jan
test = 0
Case 2 'feb
test = 31 ' for jan
Case 3 'mar
test = 28 + 31 'for jan and feb
Case 4 'apr
test = 31 + 28 + 31
Case 5 'may
test = 31 + 28 + 31 + 30
Case 6 'june
test = 31 + 28 + 31 + 30 + 31
Case 7 'july
test = 31 + 28 + 31 + 30 + 31 + 30
Case 8 'aug
test = 31 + 28 + 31 + 30 + 31 + 30 + 31
Case 9 'sep
test = 31 + 28 + 31 + 30 + 31 + 30 + 31 + 31
Case 10 'oct
test = 31 + 28 + 31 + 30 + 31 + 30 + 31 + 31 + 30
Case 11 'nov
test = 31 + 28 + 31 + 30 + 31 + 30 + 31 + 31 + 30 + 31
Case 12 'dec
test = 31 + 28 + 31 + 30 + 31 + 30 + 31 + 31 + 30 + 31 + 30
End Select
Else 'leap is true
Select Case (count1)
Case 1 ' jan
test = 0
Case 2 'feb
test = 31
Case 3 'mar
test = 31 + 29
Case 4 'apr
test = 31 + 29 + 31
Case 5 'may
test = 31 + 29 + 31 + 30
Case 6 'june
test = 31 + 29 + 31 + 30 + 31
Case 7 'july
test = 31 + 29 + 31 + 30 + 31 + 30
Case 8 'aug
test = 31 + 29 + 31 + 30 + 31 + 30 + 31
Case 9 'sep
test = 31 + 29 + 31 + 30 + 31 + 30 + 31 + 31
Case 10 'oct
test = 31 + 29 + 31 + 30 + 31 + 30 + 31 + 31 + 30
Case 11 'nov
test = 31 + 29 + 31 + 30 + 31 + 30 + 31 + 31 + 30 + 31
Case 12 'dec
test = 31 + 29 + 31 + 30 + 31 + 30 + 31 + 31 + 30 + 31 + 30
End Select
End If
If int1 > test Then
month = count1
End If
Next count1
Return month
End Function