[Erhan Dinçer]

Kodları:
Modüle içinde

Kod: Tümünü seç

Dim EndDate, StartDate As Date
Dim Licence As Double
Dim Lisans As Double
Dim FSO As Object, Surucu As Object
Dim HDDSeriNo
Dim Versiyon_No As Double
Dim Yapım_No As Double
Sub Auto_Open()
If GetSetting("ExcelVBA.Net", "ErhanD", "StartDate") = Empty Then
    SaveSetting "ExcelVBA.Net", "ErhanD", "StartDate", Format(Now, "dd.mm.yyyy")
    SaveSetting "ExcelVBA.Net", "ErhanD", "EndDate", Format(Now + 0, "dd.mm.yyyy")
    SaveSetting "ExcelVBA.Net", "ErhanD", "Licence Manager", 1
End If
    EndDate = DateValue(GetSetting("ExcelVBA.Net", "ErhanD", "EndDate"))
    Licence = GetSetting("ExcelVBA.Net", "ErhanD", "Licence Manager")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Surucu = FSO.GetDrive("C:")

HDDSeriNo = Surucu.serialnumber
Versiyon_No = Application.Version
Yapım_No = Application.Build
Lisans = HDDSeriNo + Versiyon_No + Yapım_No + 1 ' Burası size kalmış
Set Surucu = Nothing
Set FSO = Nothing

If Licence = 1 Then
    If EndDate < Now Then MsgBox "Demo Süresi bitmistir.":  frmLisans.Show: Exit Sub Else MsgBox "Demo Süresi devam etmektedir.": Exit Sub
End If
If Licence <> Lisans Then
    MsgBox "Ürünün kayıt numarası hatalı. Lütfen program yetkilisi ile görüşünüz. ", vbCritical + vbOKOnly, Başlık
    frmLisans.Show
Else
    frmANA.Show
End If
End Sub


frmLisans adında bir userform oluşturun ve içerine 4 adet Textbox ve 1 adet Commandbutton ekleyin. Kodları:

Kod: Tümünü seç

Dim EndDate, StartDate As Date
Dim Licence As Double
Dim Lisans As Double
Dim FSO As Object, Surucu As Object
Dim HDDSeriNo
Dim Versiyon_No As Double
Dim Yapım_No As Double

Private Sub CommandButton1_Click()
SaveSetting "ExcelVBA.Net", "ErhanD", "Licence Manager", TextBox4.Value
Licence = GetSetting("ExcelVBA.Net", "ErhanD", "Licence Manager")
Lisans = HDDSeriNo * Versiyon_No + Yapım_No + 1
If Licence <> Lisans Then MsgBox "Ürünün kayıt numarası hatalı. Lütfen program yetkilisi ile görüşünüz. ", vbCritical + vbOKOnly, Başlık: Exit Sub
MsgBox "KAYITLI KULLANICI"
End Sub

Private Sub TextBox4_Change()
If Not IsNumeric(TextBox4) Then MsgBox "Sayı olmalı": Exit Sub
End Sub

Private Sub UserForm_Initialize()
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Surucu = FSO.GetDrive("C:")
HDDSeriNo = Surucu.serialnumber
Set Surucu = Nothing
Set FSO = Nothing
Versiyon_No = Application.Version
Yapım_No = Application.Build
TextBox1 = Versiyon_No
TextBox2 = Yapım_No
TextBox3 = HDDSeriNo

End Sub
Sub ass()
Lisans = HDDSeriNo + Versiyon_No + Yapım_No + 1 ' Burası size kalmış
If GetSetting("ExcelVBA.Net", "ExcelVBA.Net", "StartDate") = Empty Then
    SaveSetting "ExcelVBA.Net", "ExcelVBA.Net", "StartDate", Format(Now, "dd.mm.yyyy")
    SaveSetting "ExcelVBA.Net", "ExcelVBA.Net", "EndDate", Format(Now + 30, "dd.mm.yyyy")
    SaveSetting "ExcelVBA.Net", "ExcelVBA.Net", "Licence Manager", 1
End If
EndDate = DateValue(GetSetting("ExcelVBA.Net", "ExcelVBA.Net", "EndDate"))
Licence = GetSetting("ExcelVBA.Net", "ExcelVBA.Net", "Licence Manager")
If Licence = 1 Then
    If EndDate < Now Then MsgBox "Demo Süresi bitmistir.": Exit Sub
Else
If Licence <> Lisans Then MsgBox "Ürünün kayıt numarası hatalı. Lütfen program yetkilisi ile görüşünüz. ", vbCritical + vbOKOnly, Başlık: Exit Sub
End If
MsgBox "KAYITLI KULLANICI"
End Sub


Son olarak frmANA adında bir userform oluşturun.

İndirmek için resme tıkla

[Tarkan VURAL]

Emeğinize sağlık Erhan bey.

Şunu ekleyebilir miyiz ?

Kod: Tümünü seç

Now + 30,

yazan kısım 30 günlük demo sürümü olduğunu açıklıyor. Bunu 45 ya da 90 yaparsak Registry 'deki kayıt buna belirlediğimiz kadar izin verecek değil mi ? Bu kayıdın registry 'den crack yani kırılma ihtimaline karşılık yapabileceğimiz bir şey var mı ? Kod gizlemeyi de kırdıklarını farz edersek ? Kullanıcıya ilk etapta ürünün tam versiyonunu vermemek mi gerek, başka çözüm var mı acaba ?

[Erhan Dinçer]

Emeğinize sağlık Erhan bey.

Şunu ekleyebilir miyiz ?

Kod: Tümünü seç

Now + 30,

yazan kısım 30 günlük demo sürümü olduğunu açıklıyor. Bunu 45 ya da 90 yaparsak Registry 'deki kayıt buna belirlediğimiz kadar izin verecek değil mi ? Bu kayıdın registry 'den crack yani kırılma ihtimaline karşılık yapabileceğimiz bir şey var mı ? Kod gizlemeyi de kırdıklarını farz edersek ? Kullanıcıya ilk etapta ürünün tam versiyonunu vermemek mi gerek, başka çözüm var mı acaba ?

45 yada 90 yaparsanız o kadar demoya izin verecektir. Doğru söylüyorsunuz. Kırılırsa kodlarla tam sürüm elde edilebilir. Bunun için yapabilecek bir şey var tabiki. Farklı bir adreste dosya kaydetip o dosya ile kontrol sağlanabilir.

[Tarkan VURAL]

Bence bu kontrolu sağlamak için bilgisayardaki bir dosya adresini değil de; internetteki bir adrese yüklenecek bir veriyi kullanmak daha mantıklı.
Siz nasıl düşünüyorsunuz ?

[Erhan Dinçer]

Bence bu kontrolu sağlamak için bilgisayardaki bir dosya adresini değil de; internetteki bir adrese yüklenecek bir veriyi kullanmak daha mantıklı.
Siz nasıl düşünüyorsunuz ?

Güzel fikir,fakat interneti olmayabilir kişinin. Ama yinede en doğrusu internet adresine yazdırmak.

[sw33tking]

merhabalar,

uzun süredir sitenizi takip ediyorum. yaptığım bir bordro uygulamasında yukarıdaki lisanslamayı yapmayı düşünüyordum. uygulamaya çalıştım ama aşağıdaki kodta hata veriyor. hem module içinde hemde frmlisans içerisinde.

"Licence = GetSetting("ExcelVBA.Net", "ErhanD", "Licence Manager")

yardımlarınız için şimdiden teşekkürler

[belerafon]

Bunların yapılmış olduğu örnek bir çalışma dosyasını paylaşabilir misiniz lütfen? Yukarıda bir rapid linki var fakat çalışmıyor...

[Tarkan VURAL]

Bendeki örnek dosyayı ekliyorum.

[Osman AKYÜZ]

Tarkan bey örnek dosyanızı göremiyorum.Kontrol edebilirmisiniz...

[Tarkan VURAL]

Hangi konuda ekleyecektim de ekleyememişim hatırlayamadım.

[Osman AKYÜZ]

Lisans kodu üreten örnek çalışmanızı ekleyecektiniz sanırım ...

[Tarkan VURAL]

Yok. Örnek çalışma da bulunamadı. Acaba o anda bir örnek hazırladım da sonra kaydetmeyip kapattım mı ?

[alican60]

Osman Bey elimde benzer bir çalışma var nereden bulduğumu hatırlamıyorum.Umarım işinize yarar.

[Arslanbey]

Tarkan hocam lisanslama ile ilgili sizden örnek dosya bekliyoruz.

[Tarkan VURAL]

Dosya örneğim yok, bulamadım. Yenisini hazırlamak lazım.

[Arslanbey]

Tarkan hocam hazırlıya bilirmisiniz peki rica etsek bekleyen tek ben değilim.

[Osman AKYÜZ]

Sn.Tarkan üstadım yorulmayın bir iki örnek incelemesi ve bir konuda şifreleme ile ilgili bir yazınız ilham kaynağı oldu vede kendi programımı yaptım.Faydalı olması dilağiyle....

Yorumlar ve geliştirebileceğimiz yönler hakkında dönüş yaparsanız memnun olurum...

[Osman AKYÜZ]

Öncelikle test çalışmasını açın lisans kayıtlı olmadığı için uyarı verecektir.
Açılan lisans etkinleştir penceresindeki seriali kopyalayın diğer çalışmayı açın ve düğmeye tıklayın.
açılan formda yazılı seriali silin ve kopyaladığınız seriali yapıştırın.Serial ürete tıklayın
alt kısıma üretilen seriali kopyalayın ve test çalışmasındaki lisans aktifleştirme formuna 2. textbox a
yapıştırın ve olay tamamdır.Kodları inceleyip kendinize uyarlayabilirsiniz...

[Osman AKYÜZ]

Bir şey daha ilk lisanslama yaptığınızda 10 gün demo kullanacaksınız.10 gün sonra tekrar lisanslama yaparak 365 gün yani 1 yıl kullanabileceksiniz.

[Arslanbey]

Öncelikle örneğiniz çok güzel emeğinize sağlık peki bunu internetden istediğimiz adrese nasıl yönlendirebiliriz lisans alması için.