VB6 - DOS Date/Time Conversions [Archive] - ForumsHQ
Posted: Fri Sep 26, 2003 5:49 pm
DOS date and time stamps are stored as an integer, here are some functions I wrote to convert them.
DOS date to human readable date
Public Function DOSDate2Date(ByVal value As Long) As String
Dim BinaryDate As String, Month As String, Day As String, Year As String
Dim temp As String
If value = 0 Then GoTo NoDate:
BinaryDate = Dec2Bin(value)
If Len(BinaryDate) 10 Then GoTo BadFormat:
Year = Dec2Bin((Val(Right(value, 4) - 1980)))
Month = Dec2Bin(Val(Left(value, 2)))
Day = Dec2Bin(Val(Right(Left(value, 5), 2)))
If Len(Year) 7 Then Year = "1111111"
If Len(Month) > 4 Then Month = "1111"
If Len(Day) > 5 Then Day = "11111"
Date2DOSDate = Bin2Dec(Year & Month & Day)
Exit Function
NoDate:
Date2DOSDate = 0
Exit Function
BadFormat:
MsgBox "Incorrect Date format!", vbExclamation
Date2DOSDate = -1
Exit Function
error:
MsgBox "Incorrect Date format!", vbExclamation
HandleError
Date2DOSDate = -1
End Function
Human readable time to DOS time
Public Function Time2DOSTime(ByVal value As String) As Long
On Error GoTo error:
Dim BinaryTime As String, Hour As String, Minute As String, Second As String
Dim temp As String
If value = "00:00:00" Then GoTo NoTime:
If Len(value) 8 Then GoTo BadFormat:
Hour = Dec2Bin(Val(Left(value, 2)))
Minute = Dec2Bin(Val(Right(Left(value, 5), 2)))
Second = Dec2Bin((Val(Right(value, 2)) / 2))
If Len(Hour) 5 Then Hour = "11111"
If Len(Minute) > 6 Then Minute = "111111"
If Len(Second) > 5 Then Second = "11111"
Time2DOSTime = Bin2Dec(Hour & Minute & Second)
Exit Function
NoTime:
Time2DOSTime = 0
Exit Function
BadFormat:
MsgBox "Incorrect time format!", vbExclamation
Time2DOSTime = -1
Exit Function
error:
MsgBox "Incorrect time format!", vbExclamation
HandleError
Time2DOSTime = -1
End Function
Binary to Decimal conversion function (not written by me)
Public Function Bin2Dec(ByVal BinValue As String) As Long
Dim lngValue As Long
Dim x As Long
Dim k As Long
k = Len(BinValue) ' will only work with 32 or fewer "bits"
For x = k To 1 Step -1 ' work backwards down string
If Mid$(BinValue, x, 1) = "1" Then
If k - x > 30 Then ' bit 31 is the sign bit
lngValue = lngValue Or -2147483648# ' avoid overflow error
Else
lngValue = lngValue + 2 ^ (k - x)
End If
End If
Next x
Bin2Dec = lngValue
End Function
Decimal to Binary conversion function (not written by me)
Public Function Dec2Bin(ByVal mynum As Variant) As String
Dim loopcounter As Integer
If mynum >= 2 ^ 31 Then
Dec2Bin = "Number too big"
Exit Function
End If
Do
If (mynum And 2 ^ loopcounter) = 2 ^ loopcounter Then
Dec2Bin = "1" & Dec2Bin
Else
Dec2Bin = "0" & Dec2Bin
End If
loopcounter = loopcounter + 1
Loop Until 2 ^ loopcounter > mynum
End Function
Error Handler
Public Sub HandleError()
MsgBox Err.Source & vbCrLf & "Error " & Err.Number & ": " & Err.Description, vbExclamation
Err.Clear
End Sub
DOS date to human readable date
Public Function DOSDate2Date(ByVal value As Long) As String
Dim BinaryDate As String, Month As String, Day As String, Year As String
Dim temp As String
If value = 0 Then GoTo NoDate:
BinaryDate = Dec2Bin(value)
If Len(BinaryDate) 10 Then GoTo BadFormat:
Year = Dec2Bin((Val(Right(value, 4) - 1980)))
Month = Dec2Bin(Val(Left(value, 2)))
Day = Dec2Bin(Val(Right(Left(value, 5), 2)))
If Len(Year) 7 Then Year = "1111111"
If Len(Month) > 4 Then Month = "1111"
If Len(Day) > 5 Then Day = "11111"
Date2DOSDate = Bin2Dec(Year & Month & Day)
Exit Function
NoDate:
Date2DOSDate = 0
Exit Function
BadFormat:
MsgBox "Incorrect Date format!", vbExclamation
Date2DOSDate = -1
Exit Function
error:
MsgBox "Incorrect Date format!", vbExclamation
HandleError
Date2DOSDate = -1
End Function
Human readable time to DOS time
Public Function Time2DOSTime(ByVal value As String) As Long
On Error GoTo error:
Dim BinaryTime As String, Hour As String, Minute As String, Second As String
Dim temp As String
If value = "00:00:00" Then GoTo NoTime:
If Len(value) 8 Then GoTo BadFormat:
Hour = Dec2Bin(Val(Left(value, 2)))
Minute = Dec2Bin(Val(Right(Left(value, 5), 2)))
Second = Dec2Bin((Val(Right(value, 2)) / 2))
If Len(Hour) 5 Then Hour = "11111"
If Len(Minute) > 6 Then Minute = "111111"
If Len(Second) > 5 Then Second = "11111"
Time2DOSTime = Bin2Dec(Hour & Minute & Second)
Exit Function
NoTime:
Time2DOSTime = 0
Exit Function
BadFormat:
MsgBox "Incorrect time format!", vbExclamation
Time2DOSTime = -1
Exit Function
error:
MsgBox "Incorrect time format!", vbExclamation
HandleError
Time2DOSTime = -1
End Function
Binary to Decimal conversion function (not written by me)
Public Function Bin2Dec(ByVal BinValue As String) As Long
Dim lngValue As Long
Dim x As Long
Dim k As Long
k = Len(BinValue) ' will only work with 32 or fewer "bits"
For x = k To 1 Step -1 ' work backwards down string
If Mid$(BinValue, x, 1) = "1" Then
If k - x > 30 Then ' bit 31 is the sign bit
lngValue = lngValue Or -2147483648# ' avoid overflow error
Else
lngValue = lngValue + 2 ^ (k - x)
End If
End If
Next x
Bin2Dec = lngValue
End Function
Decimal to Binary conversion function (not written by me)
Public Function Dec2Bin(ByVal mynum As Variant) As String
Dim loopcounter As Integer
If mynum >= 2 ^ 31 Then
Dec2Bin = "Number too big"
Exit Function
End If
Do
If (mynum And 2 ^ loopcounter) = 2 ^ loopcounter Then
Dec2Bin = "1" & Dec2Bin
Else
Dec2Bin = "0" & Dec2Bin
End If
loopcounter = loopcounter + 1
Loop Until 2 ^ loopcounter > mynum
End Function
Error Handler
Public Sub HandleError()
MsgBox Err.Source & vbCrLf & "Error " & Err.Number & ": " & Err.Description, vbExclamation
Err.Clear
End Sub