Option Explicit
Private Sub Command1_Click()
Dim str1 As String, str2 As String
str1 = InputBox("Introducir fecha instalación", , Now)
str2 = CamuflarFecha(str1)
MsgBox "Fecha de instalación: " & vbCrLf _
& str1 & String(2, vbCrLf) & "Camuflada: " & vbCrLf & str2 _
& String(2, vbCrLf) & "Esta cadena la leerías desde archivo de texto"
MsgBox "Dias que han pasado: " & DateDiff("d", DescubrirFecha(str2), Now)
End Sub
Private Function CamuflarFecha(ByVal Fecha As Date) As String
Dim bytDia As Byte
Dim bytMes As Byte
Dim bytAnho1 As Byte
Dim bytAnho2 As Byte
bytDia = CByte(Day(Fecha))
bytMes = CByte(Month(Fecha))
bytAnho1 = CByte(Left(Year(Fecha), 2))
bytAnho2 = CByte(Right(Year(Fecha), 2))
Randomize Timer
Dim int1 As Integer, str1 As String
For int1 = 1 To bytDia + 31
str1 = str1 & Chr(Rnd * 255)
Next int1
CamuflarFecha = Chr(bytDia + 61) & str1 & Chr(bytAnho1 + 10)
str1 = ""
For int1 = 1 To bytDia + 11
str1 = str1 & Chr(Rnd * 255)
Next int1
CamuflarFecha = CamuflarFecha & str1 & Chr(bytMes + 13)
str1 = ""
For int1 = 1 To bytMes + 5
str1 = str1 & Chr(Rnd * 255)
Next int1
CamuflarFecha = CamuflarFecha & str1 & Chr(bytAnho2)
For int1 = 1 To bytMes + 3
CamuflarFecha = CamuflarFecha & Chr(Rnd * 255)
Next int1
End Function
Private Function DescubrirFecha(ByVal Clave As String) As Date
Dim bytDia As Byte
Dim bytMes As Byte
Dim bytAnho1 As Byte
Dim bytAnho2 As Byte
bytDia = Asc(Left(Clave, 1)) - 61
Clave = Mid(Clave, bytDia + 33)
bytAnho1 = Asc(Left(Clave, 1)) - 10
Clave = Mid(Clave, bytDia + 13)
bytMes = Asc(Left(Clave, 1)) - 13
Clave = Mid(Clave, bytMes + 7)
bytAnho2 = Asc(Left(Clave, 1))
DescubrirFecha = String(2 - Len(CStr(bytDia)), "0") & bytDia _
& "/" & String(2 - Len(CStr(bytMes)), "0") & bytMes _
& "/" & String(2 - Len(CStr(bytAnho1)), "0") & bytAnho1 _
& String(2 - Len(CStr(bytAnho2)), "0") & bytAnho2
End Function