User Form İle Lisans Girme

[askm]

Kodlarınızı aşağıdaki şekilde değiştirin. Her defasında numeric olmuyor bu numara.

Private Sub Workbook_Open()
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Surucu = FSO.GetDrive("C:")

If IsNumeric(Left(Surucu.SerialNumber, 1)) = False Then
    UserForm1.TextBox1.Text = Mid(Surucu.SerialNumber, 2, Len(Surucu.SerialNumber) - 1)
Else
    UserForm1.TextBox1.Text = Surucu.SerialNumber
End If
If Surucu.SerialNumber = -564566904 Then
MsgBox " Kayıtlı Kullanıcı Olduğunuz İçin Teşekkür Ederiz."
Exit Sub
Else
MsgBox "Geçersiz Lisans. Lütfen Geçerli Bir Lisans Anahtarı Giriniz!"
UserForm1.Show
End If
End Sub

Private Sub CommandButton1_Click()
Dim FSO As Object, Surucu As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Surucu = FSO.GetDrive("C:")
Seri = Surucu.SerialNumber
If IsNumeric(Left(Surucu.SerialNumber, 1)) = False Then
    UserForm1.TextBox1.Text = Mid(Surucu.SerialNumber, 2, Len(Surucu.SerialNumber) - 1)
Else
    UserForm1.TextBox1.Text = Surucu.SerialNumber
End If
Set Surucu = Nothing
Set FSO = Nothing
End Sub

 

[__TR__]

Sayın Ömer Baran ve askfm, yardımlarınız için çok teşekkür ederim. Kodu şimdi deneyeceğim, sadece şunu sormak istiyorum; bu kod eğer serialin başında "-" işareti yoksa ilk rakam veya harf ne varsa onuda iptal edermi ? yoksa sadece "-" işaretinimi iptal edecek? bilgi amaçlı bir sorudur tekrardan çok teşekkür ederim.

 

[__TR__]

Daha öncede sormuştum sorumu yinelemek istiyorum. Textbox'a girdiğim veriyi sabit kalacak şekilde nasıl kaydedebilirim her açılışta tekrar yazılmaması adına ?

Kaydet butonuna tanımladığım kod aşağıdadır, buna nasıl bir ekleme yapmam gerek veya başka bir kodlama nasıl olmalı?

Private Sub CommandButton2_Click()
i = TextBox2
If i = Empty Or i = TextBox1.Text Or i <> TextBox3.Text Then
MsgBox "Eksik Yada Hatalı Giriş. Lütfen Lisans Anahtarını Kontrol Ediniz!", , "UYARI GEÇERSİZ LİSANS"
ElseIf TextBox2.Value = Val(TextBox1.Value * 90) Then
MsgBox "Sayın " & Application.UserName & " Programınız Lisanslanmıştır. İyi Günlerde Kullanınız!", , "GEÇERLİ LİSANS"
Unload UserForm1
End If
End Sub

If i = Empty Or i = TextBox1.Text Or i <> TextBox3.Text Then yukarıdaki kodun bu kısmındaki TextBox3 ifadesi yerine *90 şartınıda değiştirebilirsek sorun tamamen çözüme kavuşmuş olacak.

 

[askm]

Sadece size açılabilecek bir sayfa ekler. Kullanıcı username ya da seri size ait ise o sayfa açık değilse gizli olur. O sayfaya kaydeder.

 

[__TR__]

Sadece mantık yürüterek soruyorum, Unload UserForm1 yaptırımı gibi örneğin Save UserForm1 yada Save UserForm1.TextBox2 gibi bir koşul sağlayamaz mıyız ?

 

[askm]

Değilkenler geçicidir. Hücreye txt ye ya da access e kayıt yapmanız gerekir.

 

[halit3]

Sayın Ömer Baran ve askfm, yardımlarınız için çok teşekkür ederim. Kodu şimdi deneyeceğim, sadece şunu sormak istiyorum; bu kod eğer serialin başında "-" işareti yoksa ilk rakam veya harf ne varsa onuda iptal edermi ? yoksa sadece "-" işaretinimi iptal edecek? bilgi amaçlı bir sorudur tekrardan çok teşekkür ederim.

Alternatif kod
kod seri numaranın önündeki eksi değer varsa siler

Sub CommandButton1_Click()
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
UserForm1.TextBox1.Text = Math.Abs(FSO.GetDrive("C:").SerialNumber)
Set FSO = Nothing
End Sub

 

[__TR__]

Yardımlarınız için çok teşekkür ederim. Şuan tek sorun Textboxa girilecek olan değerin kayıtlı kalması, eğer bu sorunda çözülürse istenilen sonuca ulaşılmış olacak.

Sayın askm, önerinizi gerçekleştirebilecek bir kod paylaşmanız mümkünmüdür?

 

[askm]

Ekteki şekilde deneyin.

 

[__TR__]

Maalesef gold üye olmadığım için indiremedim.

 

[askm]

Kodlar aşağıdadır.
BuÇalışmaKitabı kısmına

Private Sub Workbook_Open()
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Surucu = FSO.GetDrive("C:")
Dim serino As String
If IsNumeric(Left(Surucu.SerialNumber, 1)) = False Then
serino = Mid(Surucu.SerialNumber, 2, Len(Surucu.SerialNumber) - 1)
UserForm1.TextBox1.Text = Mid(Surucu.SerialNumber, 2, Len(Surucu.SerialNumber) - 1)

Else
UserForm1.TextBox1.Text = Surucu.SerialNumber
serino = Surucu.SerialNumber
End If

If serino = 641351642 Then '564566904
    Sheets("Bilgi").Visible = True
Else
    Sheets("Bilgi").Visible = xlSheetVeryHidden
End If

If serino = Sheets("Bilgi").Range("A1").Value Then '564566904

MsgBox " Kayıtlı Kullanıcı Olduğunuz İçin Teşekkür Ederiz."
Exit Sub
Else
MsgBox "Geçersiz Lisans. Lütfen Geçerli Bir Lisans Anahtarı Giriniz!"
UserForm1.Show
End If
End Sub

Kaydet Butonu

Private Sub CommandButton2_Click()
i = TextBox2
If i = Empty Or i = TextBox1.Text Or i <> TextBox3.Text Then
MsgBox "Eksik Yada Hatalı Giriş. Lütfen Lisans Anahtarını Kontrol Ediniz!", , "UYARI GEÇERSİZ LİSANS"
ElseIf TextBox2.Value = Val(TextBox1.Value * 90) Then
Sheets("Bilgi").Visible = True
Sheets("Bilgi").Range("A1") = TextBox1.Value
Sheets("Bilgi").Range("B1") = Val(TextBox1.Value * 90)
MsgBox "Sayın " & Application.UserName & " Programınız Lisanslanmıştır. İyi Günlerde Kullanınız!", , "GEÇERLİ LİSANS"
Unload UserForm1
Sheets("Bilgi").Visible = xlSheetVeryHidden
End If
End Sub

 

[__TR__]

Sayın askm, kodlarınızı denedim, kaydet butonunda sıkıntı var (kaydet butonu kayıt işlemi yapmıyor, textboxa değer giriliyor fakat işlem yapmıyor) ama mantığını anladım, yanlış değilse; siz seriali hücreye yazdırıp eğer seçilen hücrede belirlenen değer varsa kullanıma izin veriyor.

Hocam haala araştırmaya devam ediyorum, mümkünmü bilmiyorum ama eğer textbox içerisine kaydetmek mümkünse ilk tercihim bu eğer değilse son çare sizin yönteminizi kullanacağım. Yardımlarınız için çok teşekkür ederim.

 

[Korhan Ayhan]

Merhaba,

Ürettiğiniz kodu Textbox nesnesine kayıt edemezsiniz.

Vba kodları ile regedite yazdırabilirsiniz.
Vba kodları ile text dosyasına yazdırabilirsiniz.
Vba kodları ile dosyanın kod bölümüne yazdırabilirsiniz. (Ek güvenlik ayarı isteyecektir)

İşinize yararsa bu adımları araştırın.

 

[askm]

Bilgi adında bir sayfa ekleyip denediniz mi. Mantık eğer sayfa sizin serial ise açılıyor. Yoksa gizli oluyor. Kayıt için de önce sayfa gözüküyor. Kayıt yapıp gizliyor.

Korhan Bey regedit ve kod kısmı ile ilgili örnek veya link verebilir misiniz. Googleden baktım bulamadım. Belki de yanlış ifade ile aradım.

 

[__TR__]

Denedim hocam, bende Korhan beyin mesajını gördükten sonra nette ve form içersinde regedit ve txt ile alaklı örnek arayıp inceliyorum. Sorunsuz bir şekilde çalışan kod bulabilirsem buradan paylaşacağım.

 

[askm]

Txt bulabiliriz. Ama regedit ve vba (özellikle vba ilk defa duyuyorum) telefondan bakarak bulamadım. Pc başında bakarak gerek.

 

[Zeki Gürsoy]

VBA projesi kilitli olacağından vba modulune yazdırma işe yaramayacaktır.

 

[__TR__]

Private Sub CommandButton1_Clic()
if TextBox1.Value + 100 Then
DeğerKaydet HCU, "ExelWeb\Forum", "mrXL", "ExcelWeb Forum Üyesi"
MsgBox "Kayıtlı Kullanıcı Olduğunuz için Teşekkür Ederim", , "Tebrikler!"
Unload Me
Else
MsgBox "Yanlış veya Eksik Şifre Girdinix. Tekrar Deneyiniz!", vbCritical, "Şifre Hatası"
TextBox1 = ""
TextBox1.SetFocus
End if
End Sub

İnternette yaptığım araştırmalar neticesinde şöyle bir kod buldum ama sanırım eksik yada hata var.

Kodun yapması gereken: HKEY_CURRENT_USER\ExelWeb\Forum anahtarı içinde mrXL adında yeni bir dizine değeri açacak ve bu dize değerine de ExcelWeb Forum Üyesi verisini kaydetmesi gerek.

 

[Korhan Ayhan]

Forumda örnekler var, aşağıdaki ifadelerle arama yapınız.

RegWrite
RegRead

 

[__TR__]

Sayın askm rahatça kontrol edebilmesi adına bulduğum kodu buradan paylaşıyorum.

HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main dizinine yeni bir DWORD değeri oluşturup. Adı "ornek" değerini (1) yapak için kullanılan kodlama

Kaynak: Regstry'de Yeni Anahtar Oluşturma

Kayıt Ekleme Makrosu

Sub WriteReg()
    Dim WSH_Shell As Object
    RegKey = "HKCU\Software\Microsoft\Internet Explorer\Main\Ornek "
    Set WSH_Shell = CreateObject("WScript.Shell")
    WSH_Shell.RegWrite RegKey, 1, "REG_DWORD"
End Sub

Kayıt Silme Makrosu

Sub DelReg()
    Dim WSH_Shell As Object
    RegKey = "HKCU\Software\Microsoft\Internet Explorer\Main\Ornek "
    Set WSH_Shell = CreateObject("WScript.Shell")
    WSH_Shell.RegDelete RegKey
End Sub