Hvordan skal man lave en trail version

Hej.

Hvis ikke du vil indbygge en fast udløbsdato - og så forlænge den hen ad vejen, skal der jo skrives nogle værdier til en fil eller til Registry om hvornår programmet er installeret.
I nogle af mine database-programmer har jeg begrænset antallet af poster, der kan oprettes.  Så behøver jeg ikke forny den demo, der kan downloades fra min hjemmeside.

I form load i en del af mine programmer står f.eks. således - i eksemplet er det udkommenteret.

'---- Begrænsning i demo-version. ----
'If Year(Now) >= 2005 Then
  'If Month(Now) >= 10 Then
    'MsgBox ("Demoversionen er udløbet, der kan ikke mere gemmes!")
    'knmugem.Enabled = False
    'knbdgem.Enabled = False
    'kngemlab.Enabled = False
  'End If
'End If

Programmet kan fortsat vise eksisterende data, men der kan ikke gemmes nye.

Det med en tilsendt nøgle kræver at programmet hver gang leveres af dig, og ikke blot kan downloades.

M.v.h. Jørn

Joe det er vel godt nok,men ikke helt det jeg søger
SKal have det som en trail version med kode.
og den skal ikke bare være til at ændre ved ex at ændre i en fil.
når man så har indtastet en rigtig kode, skal den virke normalt igen.
samt ikke komme og spørge efter den mere.

Eksempel på registry

Option Explicit
Dim Trialkode
Dim AntalRunTimes As Integer

Private Sub Form_Load()

'Hent Trialkode
Trialkode = GetSetting(appname:=App.Title, section:="User", Key:="Serial")

If Trialkode <> "1234-56780" Then
'lav begrænsninger her, evt antalgange programmet må kører
Call Max10RunTimes
End If
'Normalt

'Gem Trialkode
SaveSetting App.Title, "User", "Serial", Trialkode

MsgBox "ANTAL KØRT= " & AntalRunTimes
End Sub

Function Max10RunTimes()

'Hent Antal kørtegange
AntalRunTimes = GetSetting(appname:=App.Title, section:="User", Key:="TimesRun", Default:="0")

'Nuværende værdi
AntalRunTimes = AntalRunTimes + 1

'Gem ny værdu
SaveSetting App.Title, "User", "TimesRun", AntalRunTimes

If AntalRunTimes > 10 Then
MsgBox "TRAIL VERSION UDLØBET"
Unload Me
End If
End Function

Hvosa en smutter her er den igen med, hvor der ikke bliver spurgt mere når koden er indtastet...

Option Explicit
Dim Trialkode
Dim AntalRunTimes As Integer

Private Sub Form_Load()

'Hent Trialkode
Trialkode = GetSetting(appname:=App.Title, section:="User", Key:="Serial")

If Trialkode <> "1234-56780" Then
Trialkode = InputBox("TrialKode:", "TrialKode", "test")
'lav begrænsninger her, evt antalgange programmet må kører
End If

If Trialkode <> "1234-56780" Then
Call Max10RunTimes
End If


'Normalt

'Gem Trialkode
SaveSetting App.Title, "User", "Serial", Trialkode

MsgBox "ANTAL KØRT= " & AntalRunTimes
End Sub

Function Max10RunTimes()

'Hent Antal kørtegange
AntalRunTimes = GetSetting(appname:=App.Title, section:="User", Key:="TimesRun", Default:="0")

'Nuværende værdi
AntalRunTimes = AntalRunTimes + 1

'Gem ny værdu
SaveSetting App.Title, "User", "TimesRun", AntalRunTimes

If AntalRunTimes > 10 Then
MsgBox "TRAIL VERSION UDLØBET"
Unload Me
End If
End Function

virker jo rimeligt, skal dog lige ændres så den ikke popper op efter du har indtastet den rigtige,
skriver 0 gange

Hvor gemmes det henne ?
skal jo have det slettet igen fra min pc

HKEY_CURRENT_USER\SOFTWARE\VB and VBA Program Settings

Hvis du skal bruge det til et program du er ved at sælge er det nok bedre med et bedre interface screenshot:
http://blueice.users.whitehat.dk/temp/vb6/trial.jpg <= ligger kun på nettet til og med den( 10/8-2005)

Lav en form ved navn frmtrial og lad den starte op, så loader den din normale start form (form1)

|---- frmtrial ----|
'Følgende skal være på formen:
' 4 labels (lblTitle, lblVersion, lblDescription, lblDisclaimer)
' 1 textbox's (txtTrialCode)'
' 2 Knapper (cmdOK, cmdCancel)


Option Explicit

    Dim Trialkode As String
    Dim AntalRunTimes As Integer
    Dim RuntimesLeft As Integer

    Const RigtigKode As String = "1234-56780" 'rigtig trialkode
    Const MaxRunTimes As Integer = 10 'max antal kørsler

Private Function TrailOK()
    Unload Me
    Form1.Show
End Function

Private Sub cmdOK_Click()
    Call CheckTrial
End Sub
Private Sub cmdCancel_Click()
    Unload Me
End Sub


Private Sub Form_Load()

  'Hent Antal kørtegange
    AntalRunTimes = GetSetting(appname:=App.Title, section:="User", Key:="TimesRun", Default:="0")


    'Læg 1 til nuværende værdi og gem Regdb i HKEY_CURRENT_USER\SOFTWARE\VB and VBA Program Settings\[DIT PROGRAMNAVN\User
    AntalRunTimes = AntalRunTimes + 1
    SaveSetting App.Title, "User", "TimesRun", AntalRunTimes
   
   
  'Program title & labels
    Me.Caption = App.Title & "- Trial Version"
    lblVersion.Caption = " Version " & App.Major & "." & App.Minor & "." & App.Revision
    lblTitle.Caption = App.Title
   
   
    'Ændring i lbls Hvis udløbet
    If AntalRunTimes <= MaxRunTimes Then
        RuntimesLeft = MaxRunTimes - AntalRunTimes
       
        lblDisclaimer.Caption = "You must enter trial to continue to use this program" & vbNewLine & _
        "Times left:" & RuntimesLeft
    Else
        lblDisclaimer.Caption = "You must enter trial to continue to use this program" & vbNewLine & _
        "Trial Version has expired !!"
    End If
 
 
    'Hent Trialkode fra regdb
    Trialkode = GetSetting(appname:=App.Title, section:="User", Key:="Serial")
   
   
    'Hvis Trail koden er korrect kald TrailOK (Luk denne form og start ny)
    If Trialkode = RigtigKode Then
        Call TrailOK
        Exit Sub
    End If
     
End Sub

Function CheckTrial()
    'Hvis ingen trialkode er indtastet og der stadig evalueres
    If txtTrialCode = "" Then
        If AntalRunTimes <= MaxRunTimes Then
            Call TrailOK
            Exit Function
        End If
    End If
   
    'Hvis TrialKoden er den rigtigt
    If txtTrialCode = RigtigKode Then
        'Gem TrialKode
        SaveSetting App.Title, "User", "Serial", txtTrialCode
        Call TrailOK
        Exit Function
    'Hvis TrialKoden er forkert
    Else
        If AntalRunTimes > MaxRunTimes Then
                MsgBox "Incorect Trial Code          ", vbCritical, "Trail Version Expired"
        Else
                MsgBox "Incorect Trial Code          ", vbExclamation, "Incorect Trial Code"
        End If
    End If

End Function

|----frmtrial----|

<ole>

- og patch'en til din trial-version ser sådan ud (forudsat, dit program hedder 'myExe.exe'):

--------------------- Form1 ---------------------
Private Sub Form_Load()
    SaveSetting "myExe", "User", "TimesRun", 0
    Shell App.Path & "\myExe.exe"
    Unload Me
End Sub
--------------------- Form1 ---------------------

- lav en exe med denne form - læg denne i samme mappe som programmet og kør den i stedet  ;o)

/mvh
</bole>

ole, du kan også bare være ærlig, og købe programmet når prøvetiden udløber

force_master > En lille ting du skal vide, som du kan se er dette nemt at "cracke" se eksemplet fra olebole 27/07-2005 00:46:27.

Hvis du skal lave en "stærk" trial version, kan du evt bruge NogetHardware id som du ændre til en kode, eller fx windows serialkode du laver om via en funktion. fx at du rykker alle tegn 2 gang