Question

Locked

Setting Trial Period / Timer for Software

By mjromano ·
Hi everyone,

My company has developed an estimating software based in Excel with VB. They are interested in rolling out the software, but want to put some restrictions on it. Right now I'm using the following code to make the software run on a 30-day trial. The code definitely works, but is easily worked around if the user ever finds the log file. Also, the security differences between XP and Vista pose a problem for the code:

Option Explicit

Private Sub Workbook_Open()
Dim StartTime#, CurrentTime#

'*****************************************
'SET YOUR OWN TRIAL PERIOD BELOW
'Integers (1, 2, 3,...etc) = number of days use
'1/24 = 1Hr, 1/48 = 30Mins, 1/144 = 10Mins use

Const TrialPeriod# = 30 '< 30 days trial

'set your own obscure path and file-name
Const ObscurePath$ = "C:\"
Const ObscureFile$ = "TestFileLog.Log"
'*****************************************

If Dir(ObscurePath & ObscureFile) = Empty Then
StartTime = Format(Now, "#0.#########0")
Open ObscurePath & ObscureFile For Output As #1
Print #1, StartTime
Else
Open ObscurePath & ObscureFile For Input As #1
Input #1, StartTime
CurrentTime = Format(Now, "#0.#########0")
If CurrentTime < StartTime + TrialPeriod Then
Close #1
Exit Sub
Else
If [A1] <> "Expired" Then
MsgBox "Sorry, your trial period has expired - your data" & vbLf & _
"will now be extracted and saved for you..." & vbLf & _
"" & vbLf & _
"This workbook will then be made unusable."
Close #1
SaveShtsAsBook
[A1] = "Expired"
ActiveWorkbook.Save
Application.Quit
ElseIf [A1] = "Expired" Then
Close #1
Application.Quit
End If
End If
End If
Close #1
End Sub

Sub SaveShtsAsBook()
Dim Sheet As Worksheet, SheetName$, MyFilePath$, N&
MyFilePath$ = ActiveWorkbook.Path & "\" & _
Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
With Application
.ScreenUpdating = False
.DisplayAlerts = False
On Error Resume Next '<< a folder exists
MkDir MyFilePath '<< create a folder
For N = 1 To Sheets.Count
Sheets(N).Activate
SheetName = ActiveSheet.Name
Cells.Copy
Workbooks.Add (xlWBATWorksheet)
With ActiveWorkbook
With .ActiveSheet
.Paste
'//N.B. to remove all the cell formulas,
'//uncomment the 4 lines of code below...
'With Cells
'.Copy
'.PasteSpecial Paste:=xlPasteValues
'End With
.Name = SheetName
[A1].Select
End With
'save book in this folder
.SaveAs Filename:=MyFilePath _
& "\" & SheetName & ".xls"
.Close SaveChanges:=True
End With
.CutCopyMode = False
Next
End With
Open MyFilePath & "\READ ME.log" For Output As #1
Print #1, "Thank you for trying out this product."
Print #1, "If it meets your requirements, visit"
Print #1, "http://www.xxxxx/xxxx to purchase"
Print #1, "the full (unrestricted) version..."
Close #1
End Sub


So my question is, what else can I do to put a timer on the software? I know I'm pretty limited on what I can do since I'm working with Excel, but there has to be a better way. Any advice / suggestions on this matter are greatly appreciated.

Thanks

This conversation is currently closed to new comments.

3 total posts (Page 1 of 1)  
| Thread display: Collapse - | Expand +

All Answers

Collapse -

Set the software in question wth permissions.

That way you have your timer code as well as permissions for the software in question.

Please post back if you have any more problems or questions.
If this info is useful, please mark it helpful. Thanks

Collapse -

More details on permissions

by mjromano In reply to Set the software in quest ...

I'm going to be sending this out to some of our customers, so local permissions would have no effect, correct?

Collapse -

Most probably..

But if you tested it and it works fine then ok.
There is always something that will crack software one way or another, so your software timer will do a good job. Hope all goes well.
Anyway if they need help with the software in question they will call you.

Please post back if you have any more problems or questions.

Back to Software Forum
3 total posts (Page 1 of 1)  

Related Discussions

Related Forums