• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Lisans Süresinin Gösterilmesi

T

TURKOLOG

Altın Üye
Katılım
13 Kasım 2008
Mesajlar
745
Excel Vers. ve Dili
2016 64 TR
Herkese Merhaba
Private Sub Workbook_Open() alanında bulunan lisans işlemleri lisans süresi (kalan lisans süresi) ilk açılısta Giriş userformunun ilk açılısında caption alanında bir kereye mahsus görünüyor daha sonra Giriş userformunu açsamda caption kısmında görünmüyor.
Kod: 
Private Sub Workbook_Open()

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Lisanslama Kodları Başlangıç

Dim Seri, HddKontrolSeri, Lisans, LisansKntrl, Kontrol As String
Dim HddKontrol As Variant
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Surucu = FSO.GetDrive("C:")
HDDSeriNo = Surucu.serialnumber
Set Surucu = Nothing
Set FSO = Nothing
LisansKntrl = GetSetting("ProV1", "V1", "SerialKontrol")
Lisans = Replace(LisansKntrl, "-", "")

Kontrol = Mid(Lisans, 2, 1) & Mid(Lisans, 19, 1) & Mid(Lisans, 18, 1) & Mid(Lisans, 15, 1) & "-" & _
           Mid(Lisans, 8, 1) & Mid(Lisans, 13, 1) & Mid(Lisans, 4, 1) & Mid(Lisans, 5, 1) & "-" & _
           Mid(Lisans, 12, 1) & Mid(Lisans, 1, 1) & Mid(Lisans, 10, 1) & Mid(Lisans, 9, 1) & "-" & _
           Mid(Lisans, 16, 1) & Mid(Lisans, 17, 1) & Mid(Lisans, 14, 1) & Mid(Lisans, 7, 1) & "-" & _
           Mid(Lisans, 6, 1) & Mid(Lisans, 3, 1) & Mid(Lisans, 20, 1) & Mid(Lisans, 11, 1)

Seri = GetSetting("ProV1", "V1", "Serial")
HddKontrolSeri = GetSetting("ProV1", "V1", "Serial")
HddKontrol = Replace(HddKontrolSeri, "-", "")
HDDSeriNo = Replace(HDDSeriNo, "-", "")
HDDSeriNo = Mid(HDDSeriNo, 1, 7)
HddKontrol = Mid(HddKontrol, 11, 1) & Mid(HddKontrol, 12, 1) & Mid(HddKontrol, 14, 1) & Mid(HddKontrol, 15, 1) & Mid(HddKontrol, 16, 1) & Mid(HddKontrol, 18, 1) & Mid(HddKontrol, 19, 1)

If Seri = Empty Or Kontrol <> Seri Or HDDSeriNo <> HddKontrol Then
    MsgBox "Ürünün kayıt numarası hatalı. Lütfen program yetkilisi ile görüşünüz. ", vbCritical + vbOKOnly, "Hatalı Lisans Kodu"
   LisansAktif.Show
Exit Sub
Else
EndDate = DateValue(GetSetting("ProV1", "V1", "EndDate"))
kalangun = DateDiff("d", Date, EndDate)
Giriş.Caption = "Lisansınız " & kalangun & " gün sonra sonlanacaktır. "
If EndDate < Date Then
    If EndDate < Now Then MsgBox "Lisans Kullanım Süreniz Bitmistir. Lütfen program yetkilisi ile görüşünüz.", vbCritical + vbOKOnly, "Lisans Kullanım Süresi Doldu..."
    Unload Form
      LisansAktif.Show: Exit Sub
        End If
        End If
        'Form.Show

'Lisanslama Kodları Bitiş

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

EndDate = DateValue(GetSetting("ProV1", "V1", "EndDate"))
kalangun = DateDiff("d", Date, EndDate)
Giriş.Caption = "Lisansınız " & kalangun & " gün sonra sonlanacaktır. "

Bu kırmızı alan sayesinde Giriş formu ilk girişte açıldığında caption kısmında lisans kalan süresini gösteriyor.

YAPAMADIĞIM
1.Giriş formu her tıklandığında captin kısmında kalan lisans süresi gösterilsin
2.Sorgu Userformu da her tıklandığında caption kısmında kalan lisans süresi gösterilsin.
3.Ekteki excelde Lisans Süresi adlı form tıklanınca Lisan başlama tarihi bitiş tarihi ve kalan lisans gün sayısı görünsün istiyorum
ama yapamadım . Yardım edebilecek olan var mı ?
 

Ekli dosyalar

İlgili 3 satır kodu IF sorgusunun öncesine alınız.
C++: 
'..........Önceki kodlar'
EndDate = DateValue(GetSetting("ProV1", "V1", "EndDate"))
kalangun = DateDiff("d", Date, EndDate)
Giriş.Caption = "Lisansınız " & kalangun & " gün sonra sonlanacaktır. "

If Seri = Empty Or Kontrol <> Seri Or HDDSeriNo <> HddKontrol Then
    MsgBox "Ürünün kayıt numarası hatalı. Lütfen program yetkilisi ile görüşünüz. ", vbCritical + vbOKOnly, "Hatalı Lisans Kodu"
   LisansAktif.Show
Exit Sub
Else
'burdan kaldırıp yukarı taşıdık
'......diğer satırlarınız

If EndDate < Date Then
 
Eleştirimi bağışlayın ama;

Her sistem yüklemesinde değişen volume number kullanarak kayıt defterinde bakılması ilk muhtemel yerde kriptosuz saklamak beyhude bir çaba kanımca...


.
 
NextLevel' Alıntı:
İlgili 3 satır kodu IF sorgusunun öncesine alınız.
C++: 
'..........Önceki kodlar'
EndDate = DateValue(GetSetting("ProV1", "V1", "EndDate"))
kalangun = DateDiff("d", Date, EndDate)
Giriş.Caption = "Lisansınız " & kalangun & " gün sonra sonlanacaktır. "

If Seri = Empty Or Kontrol <> Seri Or HDDSeriNo <> HddKontrol Then
    MsgBox "Ürünün kayıt numarası hatalı. Lütfen program yetkilisi ile görüşünüz. ", vbCritical + vbOKOnly, "Hatalı Lisans Kodu"
   LisansAktif.Show
Exit Sub
Else
'burdan kaldırıp yukarı taşıdık
'......diğer satırlarınız

If EndDate < Date Then
Genişletmek için tıkla ...
Hocam malesef çalışmadı kod
 
Lisans Hesapla Formunu yaptım ama Label2 Yani Lisans Başlangıç Tarihini getiremedim . Yardım edebilecek olan var mı acaba

Kod: 
Private Sub UserForm_Initialize()
'''''''''''''''''''''''''''''''''''''Lisans SüresiGöster'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
EndDate = DateValue(GetSetting("ProV1", "V1", "EndDate"))
kalangun = DateDiff("d", Date, EndDate)
Label6 = "Lisansınız " & kalangun & " gün sonra sonlanacaktır. "  'burası 365 gün şeklinde geliyor
Label4 = EndDate  'burası  misal 27.04.2020 şeklinde geliyor
Label2 = StartDate 'burasını yapamadım
 If EndDate < Date Then
       
'''''''''''''''''''''''''''''''''''''Lisans SüresiGöster'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   End If
End Sub

Label2 = Label4 - Label6 dersek Label4 27.04.2020 şeklinde Label6 ise 365 veya 10 gün şeklinde geliyor
Napsak ki misal Label4 deki 27.04.2020 tarihinden Label6 daki misal 10 veya 102 gün çıkarılıp Lisans Başlangıç tarihi 27.04.2020 den 10 gün veya 102 gün geriye giderek misal 17.04.2020 şeklinde görünsün.
 

Ekli dosyalar

Lisans başlama tarihini gösteremedim . Bu konuda yardım edebilecek olan yok mu

Kod: 
Private Sub UserForm_Initialize()
'''''''''''''''''''''''''''''''''''''Lisans SüresiGöster'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
EndDate = DateValue(GetSetting("ProV1", "V1", "EndDate"))
kalangun = DateDiff("d", Date, EndDate)
Label6 = "Lisansınız " & kalangun & " gün sonra sonlanacaktır. "
Label4 = EndDate
Label2 = StartDate 'burasını yapamadım
 If EndDate < Date Then
  
    
    
    data = GetSetting("ProV1", "V1", "Licence Manager")
    SaveSetting "ProV1", "V1", "StartDate", Format(Now, "dd.mm.yyyy")
       StartDate = DateValue(GetSetting("ProV1", "V1", "Licence Manager"))
'''''''''''''''''''''''''''''''''''''Lisans SüresiGöster'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   End If



End Sub
 

Ekli dosyalar

Kod: 
Private Sub UserForm_Initialize()
'''''''''''''''''''''''''''''''''''''Lisans SüresiGöster'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
EndDate = DateValue(GetSetting("ProV1", "V1", "EndDate"))
StartDate = DateValue(GetSetting("ProV1", "V1", "StartDate"))
basla = DateDiff("d", Date, StartDate)

kalangun = DateDiff("d", Date, EndDate)
Label6 = "Lisansınız " & kalangun & " gün sonra sonlanacaktır. "
Label4 = EndDate
Label2 = StartDate

Label7 = "Lisansınız " & basla & " gün önce başladı "
Label10 = (EndDate - (kalangun))
 

      
'''''''''''''''''''''''''''''''''''''Lisans SüresiGöster'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 

End Sub

bu kodlarla kendi sorunumu çözdüm. Birine lazım olur diye paylaşıyorum.
 
Sayın Türkolog kod paylaşımı için teşekkürler lisanslama dosyasını paylaşabilirmisin acaba istifade etsek
 
Tamamlaninca ekleyeceğim. Şu an tam anlamı ile olmadi .
 
Tamam Teşekkürler
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst