BLOQUEUR DE COMPTE-À-REBOURDS POUR LOGICIELS EN VERSION D'ÉVALUATION

Option Explicit

Sub Main()
Dim st(0 To 2) As SYSTEMTIME    ' EXE target system times (from API)

Dim changeDateMode As String    ' Mode used to change the system date
Dim cmdString As String         ' Command string containing the arguments
Dim EXEtarget As String         ' EXEcutable file to cheat with
Dim today As Date               ' Today date

' Set default values
changeDateMode = "creationdate"

' Memorize today date
today = Date

    ' Display software informations in case there's no command line
    If Command$ = "" Then
    Call MsgBox("REJUVENATE is an utility used to change the system date just before launching an EXEcutable file." + vbCrLf + _
    "The previous date is restored just after this operation." + vbCrLf + vbCrLf + _
    "Use : Rejuvenate.exe target.exe" + vbCrLf + vbCrLf + _
    "[-creationdate] : Change system date with the EXE target creation date <DEFAULT>" + vbCrLf + _
    "[-lastmodificationdate] : Change system date with the EXE target last modification date" + vbCrLf + _
    "[-lastaccessdate] : Change system date with the EXE target last access date" + vbCrLf + _
    "[-date:mm/dd/yyyy] : Change system date with the specified date" + vbCrLf _
    , vbInformation)
    End
    End If

    ' Set EXE target path
    If InStr(Command$, "-") = 0 Then
    EXEtarget = Command$
    Else
    EXEtarget = Left(Command$, InStr(Command$, "-") - 1)
    cmdString = UCase(Mid(Command$, InStr(Command$, "-"), Len(Command$) - InStr(Command$, "-") + 1))
    End If

    ' Analyse command string
    If InStr(cmdString, "-LASTMODIFICATIONDATE") <> 0 Then
    changeDateMode = "lastmodificationdate"
    End If
    
    If InStr(cmdString, "-LASTACCESSDATE") <> 0 Then
    changeDateMode = "lastaccessdate"
    End If
    
    If InStr(cmdString, "-DATE:") <> 0 Then
    changeDateMode = Mid(cmdString, InStr(cmdString, "-date:") + 1, 15)
    End If
    
    ' Exit if the EXE target is not valid
    If Dir(EXEtarget) = "" Then
    Call MsgBox("Target EXE doesn't exist", vbExclamation)
    End
    End If

    ' Change system date
    If GetFileTimes(EXEtarget, st(0), st(1), st(2)) Then
    
        If changeDateMode = "creationdate" Then
        Date = Str(st(0).wMonth) + "/" + Str(st(0).wDay) + "/" + Str(st(0).wYear)
        ElseIf changeDateMode = "lastmodificationdate" Then
        Date = Str(st(2).wMonth) + "/" + Str(st(2).wDay) + "/" + Str(st(2).wYear)
        ElseIf changeDateMode = "lastaccessdate" Then
        Date = Str(st(1).wMonth) + "/" + Str(st(1).wDay) + "/" + Str(st(1).wYear)
        ElseIf Left(changeDateMode, 5) = "date:" Then
        Date = Right(changeDateMode, 10)
        End If
    
    DoEvents
    End If

' Launch the EXE target
Shell (EXEtarget)

' Restore today date
Date = today

End Sub 

Télécharger le zip