example needed urgent : trial soft , limitation use

[ladoo]

there is 2 things am after

1: limitation the software use when programme is launched , an example will be great such as limiting command1_click to be pressed once a day then order package

2: extend limitation buy a file or some sort how do i do it.

3: even when programme restarted limitation still use shown and order page shown or pop-up

4: has to be comparable with all windows


================================================================

is there a way to make php script to change user serial online, is it safe
so if user loose there serial, reformat pc with customer number they can get new serial key online.

[Nightwalker83]

If you are asking for a 30 day trial sort of thing search the forum because this has been asked and answered before.

[ladoo]

guys is this good
http://www.planet-source-code.com/vb...72227&lngWId=1

'This is a basic way of adding trial days to your program
'Use this code as you like
'By DreamVB
'http://www.bm-it-solutions.co.uk/

Private TrialVal As Integer
Private iVal As Integer
Private Const MaxDays As Integer = 1
Private Filename As String

Private Function FixPath(ByVal lPath As String) As String
    If Right$(lPath, 1) = "\" Then
        FixPath = lPath
    Else
        FixPath = lPath & "\"
    End If
End Function

Private Function FindFile(lzFileName As String) As Boolean
On Error Resume Next
    FindFile = (GetAttr(lzFileName) And vbNormal) = vbNormal
    Err.Clear
End Function

Public Sub PutByte(ByteVal As Byte)
Dim fp As Long
Dim mByte As Byte
    'Puts a single byte to a file
    fp = FreeFile
    Open Filename For Binary As #fp
        Put #fp, 1, ByteVal
    Close #fp
End Sub

Private Function GetByte() As Byte
Dim fp As Long
Dim mByte As Byte
    'Returns a single byte form a file
    fp = FreeFile
    Open Filename For Binary As #fp
        Get #fp, , mByte
    Close #fp
    
    GetByte = mByte
End Function

Private Sub WriteDateToFile()
Dim fp As Long
Dim dDate As Date
Dim mByte As Byte

    fp = FreeFile
    'Writes date to the file
    Open Filename For Binary As #fp
        dDate = (Date + 30)
        mByte = 1
        Put #fp, , mByte
        Put #fp, , dDate
    Close #fp
    
End Sub

Private Sub cmdCancel_Click()
    Call Unload(frmTrial)
End Sub

Private Sub cmdTry_Click()
    
    If (iVal > MaxDays) Then
        MsgBox "Your trail preiord has ended", vbInformation, "Trial Finsihed"
    Else
        MsgBox "Load your program here.", vbInformation, frmTrial.Caption
    End If
    
End Sub

Private Sub Form_Load()
Dim Date1 As Date
Dim Date2 As Date
Dim fp As Long
Dim mByte As Byte

    'Trial Date file, better hideing this in System folder or maybe at the end of a file
    'so no ones knows were it is
    
    Filename = FixPath(App.Path) & "trial.txt"
    
    'Write trial date to file if not found
    If Not FindFile(Filename) Then Call WriteDateToFile

    'Open Date file and see what the date is
    fp = FreeFile
    Open Filename For Binary As #fp
        Get #fp, , mByte
        Get #fp, , Date2
    Close #fp
    
    lblTitle1.Caption = "You may use this program for " & MaxDays & " days"
    
    'Current Date
    Date1 = Date
    'Find out how many days we have left
    TrialVal = (MaxDays - DateDiff("d", Date1, Date2) + 1)
    iVal = TrialVal
    
    'Check to see if user trys to switch back the date
    If (TrialVal <= 0) Then
        TrialVal = MaxDays
        iVal = (MaxDays + 1)
        'Add finish flag
        Call PutByte(0)
    End If

    'Check to see if the user trys to put date forward
    If (TrialVal > MaxDays) Then
        TrialVal = MaxDays
        iVal = (MaxDays + 1)
        'Add finish flag
        Call PutByte(0)
    End If
    
    'Check if date change flag was added
    If (GetByte = 0) Then
        TrialVal = MaxDays
        iVal = (MaxDays + 1)
    End If
    
    'Update displays
    lblCount.Caption = "Day " & TrialVal & " of " & MaxDays
    pBar.Value = TrialVal
    

End Sub

Private Sub Form_Resize()
    Line1.X2 = Me.ScaleWidth
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set frmTrial = Nothing
End Sub

Private Sub pTop_Resize()
    Line1.X2 = pTop.ScaleWidth
    
End Sub