Soru Lisans Yapma

TURKOLOG · 22 Mart 2020

Herkese Merhaba
Excelde lisans yapma ile ilgili bir dosya buldum lisans işlemi yapıyor ama lisans anahtarı nasıl üretiliyor onu beceremedim . yani sistem lisans için kendi saat ve dakikası nı alarak veri veriyor ama bu veriyı nerede dosyayı açacak geçerli anahtar yapacağıma dair user form eksik kalmış ilgilinenler için Lisans kontrol adında bir user form oluşturdum isteğim bu lisans kontrol userformuna lisansaktif userformunda verilen kodu girince bana aanhtar kodu versin yardım edebilecekler varda çok sevinirim.

Programın mantığı : O anki saat ve tarihten bir kaç ve HDDSerino danda bir kaç karekter alır.O anki saniyenin birler basamağını Select Case yöntemi ile kontrol eder ve buna göre değişkenlere harf atar değişkenlere atanan harfler ile az önce saat,tarih,HDDSerino dan aldığımız sayısal veriler ile serpiştirilerek harmanlanır ve serila üretilir.Üretilen serial , bu serialin kontrol seriali , başlama tarihi bitiş tarihi bir yerlere yazılır.(Bilenler bilir bu yerleri).Sonrasında program çalıştığında bitiş tarihini , lisans ını ve HddSerinosunu kontrol ederek çalışır.Birinde soruna rastlasın uyarı verir.

Buradan Dosyayı İndirebilirsiniz

TURKOLOG · 23 Mart 2020

Lisan kodunun çözümü konusunda yardım edebilecek olan var mı

TURKOLOG · 28 Mart 2020

Lisans Serial Üretmek Ve Kullanıcılara Serial Vermek Programından üretilen seriali Serial Test Programına giriyorum kabul deediyor ama ikinci açılışta hata veriyor . Bakabilecek olan var mı
İndirme Linki

ibere · 28 Mart 2020

Umarım birileri yardımcı olur, bende çok merak ediyorum.

TURKOLOG · 28 Mart 2020

Ben baya arıyorum . Güzel bir şey olsun diye ama takıldığım yerler oluyor işte.

TURKOLOG · 30 Mart 2020

Ekteki dosyamda kullanıcı adı Administrator Şifresi 0000

Private Sub Workbook_Open() başlığı altında aşağıdaki kod kullanıcı adı ve şifresini çalıştırıyor

Kod:

Private Sub Workbook_Open()

ThisWorkbook.Kontrol

yer = Worksheets("yetki").Shapes("sifre").OLEFormat.Object.Characters.Text
ActiveWorkbook.Protect Password:=yer, Structure:=False ', Windows:=True' kapatmak

For j = 1 To ActiveWorkbook.Sheets.Count
If Sheets(j).Name <> "anasayfa" Then
Sheets(Sheets(j).Name).Visible = False
End If
Next
ActiveWorkbook.Protect Password:=yer, Structure:=True ', Windows:=True' kapatmak


kayıt = ThisWorkbook.Path & "\şifreli_işlem.1st" ' işlemlerin kayıt altına alındığı dosya


alan1 = RightPadChar("Program acildi", " ", 35) & "/"
alan2 = RightPadChar(Format(Now, "dd:mm:yyyy  : hh:mm:ss"), " ", 39) & "/"
alan3 = RightPadChar("", " ", 22) & "/"
alan4 = RightPadChar("Programa giris islemi yapildi", " ", 35) & "/"


yaz = alan1 & alan2 & alan3 & alan4



i = 1
On Error Resume Next
Do While i <> Len(yaz) + 1
yazi = Mid(yaz, i, 1)
yazi = Chr(Asc(yazi) + 120)
kon = kon + yazi
i = i + 1
Loop


Open kayıt For Append As #1
Print #1, kon
'Print #1, alan1 & alan2 & alan3
Close #1


Application.Visible = False
Form.Show
ActiveWorkbook.Save


Application.DisplayAlerts = True
ver = ThisWorkbook.Path & "\"
ser = "Yedek " & CreateObject("Scripting.FileSystemObject").GetBaseName(ThisWorkbook.FullName) & ".xlk"
eskısıl = ver & ser
If CreateObject("Scripting.FileSystemObject").FileExists(eskısıl) = True Then
Kill eskısıl
End If
'On Error Resume Next
Application.DisplayAlerts = False

End Sub

Aşağıdaki kod da lisans kontrol kodu Bu kodda Private Sub Workbook_Open() başlığı altında çalışıyor

Kod:

Private Sub Workbook_Open()
'Application.Visible = false
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"))
 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..."
      LisansAktif.Show: Exit Sub
        End If
        End If
        Form.Show
End Sub

Yapmaya çalıştığım fakat yapamadığım olay şu:
Excel açılır açılmaz excel sayfası gizlenecek ve LisansAktif userformu kontrol edilecek lisan yapılmamış ise lisanslama için LisansAktif userformu açılacak Lisans yapılmış ise Form adlı userform açılacak . İki aynı başlık altındaki kodu birleştirmek gerekiyor.

Dosyayı İndir

TURKOLOG · 2 Nisan 2020

Yardım edebilecek olan var mı

TURKOLOG · 20 Nisan 2020

Herkese Merhaba sorunumun büyük bir bölümünü hallettim . Bu seferde şöyle bir sorun oluştu.
LisansAktif userformuna doğru lisans kodunu girince Lisans etkinleştirme başarılı bir şekilde tamamlandı.İyi çalışmalar dileriz... diyor buraya kadar yaptım ve her şey normal.
SORUNUM
Lisans etkinleştirme başarılı bir şekilde tamamlandı.İyi çalışmalar dileriz... ddikten sonra bu bilgisayarda ilk kez lisans girilmiş ise 10 gün çalışıp 11. günde tekrar doğru lisans girilince Lisans etkinleştirme başarılı bir şekilde tamamlandı.İyi çalışmalar dileriz... dedikten sonra 365 gün lisanslaması lazım ama Malesef her açısımda lisans istiyor giriyorum dosyayı kapatıyorum. Tekrar açtığımda yine lisans istiyor yine giriyorum. Kısır bir döngüye girdim.
Oysaki ilk lisans 10 gün geçerli olacak 11. gün girilen lisansla 365 gün artık lisans sormayacak 366. gün lisans soracak her doğru lisansta 365 gün atacak takvim . Yardım edebilecek olan var mı

Modul Kodları

Kod:

Sub start()
z5 = Mid(Time$, 8, 1)
Select Case z5
Case 1: y1 = "A": y2 = "V": y3 = "Y": y4 = "E": y5 = "X": y6 = "B": y7 = "Z"
Case 2: y1 = "B": y2 = "K": y3 = "Z": y4 = "F": y5 = "Q": y6 = "D": y7 = "N"
Case 3: y1 = "C": y2 = "M": y3 = "X": y4 = "G": y5 = "W": y6 = "H": y7 = "S"
Case 4: y1 = "D": y2 = "N": y3 = "W": y4 = "H": y5 = "Y": y6 = "Q": y7 = "D"
Case 5: y1 = "E": y2 = "Q": y3 = "Q": y4 = "K": y5 = "S": y6 = "R": y7 = "R"
Case 6: y1 = "F": y2 = "P": y3 = "A": y4 = "L": y5 = "H": y6 = "Y": y7 = "P"
Case 7: y1 = "G": y2 = "R": y3 = "B": y4 = "M": y5 = "U": y6 = "W": y7 = "J"
Case 8: y1 = "H": y2 = "S": y3 = "C": y4 = "N": y5 = "V": y6 = "L": y7 = "E"
Case 9: y1 = "L": y2 = "T": y3 = "D": y4 = "X": y5 = "K": y6 = "M": y7 = "A"
End Select
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Surucu = FSO.GetDrive("C:")
HDDSeriNo = Surucu.serialnumber
Set Surucu = Nothing
Set FSO = Nothing
z1 = Replace(Time$, ":", "")
z2 = Replace(Date$, "-", "")
z3 = Replace(HDDSeriNo, "-", "")
z4 = Mid(z1, 5, 1) & y1 & Mid(z1, 6, 1) & y2 & "-" & _
     Mid(z1, 3, 1) & y3 & Mid(z1, 4, 1) & _
     Mid(z2, 1, 1) & "-" & y4 & Mid(z2, 2, 1) & Mid(z3, 1, 1) & _
     Mid(z3, 2, 1) & "-" & y5 & Mid(z3, 3, 1) & Mid(z3, 4, 1) & Mid(z3, 5, 1) & "-" & _
      y6 & Mid(z3, 6, 1) & Mid(z3, 7, 1) & y7
  
    SaveSetting "ProV1", "V1", "StartDate", Format(Now, "dd.mm.yyyy")
    SaveSetting "ProV1", "V1", "EndDate", Format(Now + 10, "dd.mm.yyyy")
    SaveSetting "ProV1", "V1", "Licence Manager", 1
    SaveSetting "ProV1", "V1", "Serial", z4

End Sub

LisansAktif UserFormu Kodları

Kod:

Sub start()
z5 = Mid(Time$, 8, 1)
Select Case z5
Case 1: y1 = "A": y2 = "V": y3 = "Y": y4 = "E": y5 = "X": y6 = "B": y7 = "Z"
Case 2: y1 = "B": y2 = "K": y3 = "Z": y4 = "F": y5 = "Q": y6 = "D": y7 = "N"
Case 3: y1 = "C": y2 = "M": y3 = "X": y4 = "G": y5 = "W": y6 = "H": y7 = "S"
Case 4: y1 = "D": y2 = "N": y3 = "W": y4 = "H": y5 = "Y": y6 = "Q": y7 = "D"
Case 5: y1 = "E": y2 = "Q": y3 = "Q": y4 = "K": y5 = "S": y6 = "R": y7 = "R"
Case 6: y1 = "F": y2 = "P": y3 = "A": y4 = "L": y5 = "H": y6 = "Y": y7 = "P"
Case 7: y1 = "G": y2 = "R": y3 = "B": y4 = "M": y5 = "U": y6 = "W": y7 = "J"
Case 8: y1 = "H": y2 = "S": y3 = "C": y4 = "N": y5 = "V": y6 = "L": y7 = "E"
Case 9: y1 = "L": y2 = "T": y3 = "D": y4 = "X": y5 = "K": y6 = "M": y7 = "A"
End Select
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Surucu = FSO.GetDrive("C:")
HDDSeriNo = Surucu.serialnumber
Set Surucu = Nothing
Set FSO = Nothing
z1 = Replace(Time$, ":", "")
z2 = Replace(Date$, "-", "")
z3 = Replace(HDDSeriNo, "-", "")
z4 = Mid(z1, 5, 1) & y1 & Mid(z1, 6, 1) & y2 & "-" & _
     Mid(z1, 3, 1) & y3 & Mid(z1, 4, 1) & _
     Mid(z2, 1, 1) & "-" & y4 & Mid(z2, 2, 1) & Mid(z3, 1, 1) & _
     Mid(z3, 2, 1) & "-" & y5 & Mid(z3, 3, 1) & Mid(z3, 4, 1) & Mid(z3, 5, 1) & "-" & _
      y6 & Mid(z3, 6, 1) & Mid(z3, 7, 1) & y7
  
    SaveSetting "ProV1", "V1", "StartDate", Format(Now, "dd.mm.yyyy")
    SaveSetting "ProV1", "V1", "EndDate", Format(Now + 10, "dd.mm.yyyy")
    SaveSetting "ProV1", "V1", "Licence Manager", 1
    SaveSetting "ProV1", "V1", "Serial", z4

End Sub
Private Sub CommandButton1_Click()
Dim Lisans, kontrol As Variant
Lisans = Replace(TextBox2, "-", "")
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)

If TextBox1 <> kontrol Then
    MsgBox "Lisans kayıt numarası hatalı. Lütfen program yetkilisi ile görüşünüz. ", vbCritical + vbOKOnly, Başlık
    Else
    Data = GetSetting("ProV1", "V1", "Licence Manager")
    SaveSetting "ProV1", "V1", "StartDate", Format(Now, "dd.mm.yyyy")
If Data = "1" Then
    SaveSetting "ProV1", "V1", "EndDate", Format(Now + 365, "dd.mm.yyyy")
Else
    SaveSetting "ProV1", "V1", "EndDate", Format(Now + 10, "dd.mm.yyyy")
End If
    SaveSetting "ProV1", "V1", "Licence Manager", 1
    SaveSetting "ProV1", "V1", "Serial", TextBox1
    SaveSetting "ProV1", "V1", "SerialKontrol", TextBox2
   
MsgBox "Lisans etkinleştirme başarılı bir şekilde tamamlandı.İyi çalışmalar dileriz...", vbInformation + vbOKOnly, Başlık
End If
Unload LisansAktif
Form.Show
End Sub

TURKOLOG · 20 Nisan 2020

Bu konuda yardım edebilecek olan var mı acaba

berkem13 · 3 Mayıs 2021

Bu konuyu ben de merak ediyorum. Umarım üstadlar inceler.

doganyorulmazjeo · 30 Ekim 2022

bu konu hakkinda çözüm bulundumu bende forumda geziniyordumda yardimci olan biri cikarmi

Soru Lisans Yapma

TURKOLOG

Ekli dosyalar

TURKOLOG

TURKOLOG

Ekli dosyalar

ibere

TURKOLOG

TURKOLOG

Ekli dosyalar

TURKOLOG

TURKOLOG

TURKOLOG

berkem13

doganyorulmazjeo