Visual Basic Şifre Oluşturucu

İlk Önce Formumuzu Bu şekilde ya da kafanıza göre tasarlayın



Daha sonra bir module oluşturun




Option Explicit

Public Type tagInitCommonControlsEx
lngSize As Long
lngICC As Long
End Type
Public Declare Function InitCommonControlsEx Lib "comctl32.dll" (iccex As tagInitCommonControlsEx) As Boolean
Public Const ICC_USEREX_CLASSES = &H200
Public Sub Main()
On Error Resume Next
Dim iccex As tagInitCommonControlsEx
With iccex
.lngSize = LenB(iccex)
.lngICC = ICC_USEREX_CLASSES
End With
InitCommonControlsEx iccex

On Error GoTo 0
frmMain.Show

End Sub


Bu kodları da forma yapıştırın

Private Const WM_COPY = &H301
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Dim arrUpper As String
Dim arrLower As String
Dim arrNumber As String
Dim arrKarakterler As String
Dim arrOzel As String
Dim strSifre As String
Dim intKarakterNo As Integer
Sub KutuDurumu()
'// Oluşturma butonu durumu ayarlanıyor
If blnUpper = False And blnLower = False And blnNumber = False And blnOzel = False Then
cmdOlustur.Enabled = False
Else
cmdOlustur.Enabled = True
End If
End Sub
Private Sub blnLower_Click()
Call KutuDurumu
End Sub
Private Sub blnNumber_Click()
Call KutuDurumu
End Sub
Private Sub blnOzel_Click()
Call KutuDurumu
End Sub
Private Sub arrOzelKarakterler_Change()
'// Oluşturma butonu durumu ayarlanıyor
If arrOzelKarakterler.Text = "" Then
cmdOlustur.Enabled = False
Else
cmdOlustur.Enabled = True
End If
End Sub
Private Sub arrOzelKarakterler_KeyPress(KeyAsci As Integer)
'// Özel karakter alanına boşluk karakterinin girilebilmesi engelleniyor
If KeyAsci = 32 Then
KeyAsci = 0
Beep
End If
End Sub
Private Sub blnOzelKarakterler_Click()
'// Form elementleri ayarlanıyor
blnUpper.Enabled = False
blnLower.Enabled = False
blnNumber.Enabled = False
blnOzel.Enabled = False
arrOzelKarakterler.Enabled = True
arrOzelKarakterler.BackColor = &H80000005

'// Oluşturma butonu durumu ayarlanıyor
If arrOzelKarakterler.Text = "" Then
cmdOlustur.Enabled = False
Else
cmdOlustur.Enabled = True
End If
End Sub
Private Sub blnTumKarakterler_Click()
'// Form elementleri ayarlanıyor
blnUpper.Enabled = True
blnLower.Enabled = True
blnNumber.Enabled = True
blnOzel.Enabled = True
arrOzelKarakterler.Enabled = False
arrOzelKarakterler.BackColor = &H8000000B
'// Oluşturma butonu durumu ayarlanıyor
If blnUpper = False And blnLower = False And blnNumber = False Then
cmdOlustur.Enabled = False
Else
cmdOlustur.Enabled = True
End If
End Sub
Private Sub Kopyala(ByVal hwnd As Long)
'// Kopyalama Fonksiyonu
SendMessage hwnd, WM_COPY, 0, ByVal 0&
End Sub
Private Sub blnUpper_Click()
'// Oluşturma butonu durumu ayarlanıyor
If blnUpper = False And blnLower = False And blnNumber = False And blnOzel = False Then
cmdOlustur.Enabled = False
Else
cmdOlustur.Enabled = True
End If
End Sub
Private Sub cmdKopyala_Click()
'// Şifre kutusundaki metin kopyalanıyor
If Len(txtSifre) > 0 Then
txtSifre.SelStart = 0
txtSifre.SelLength = Len(txtSifre.Text)
Call Kopyala(txtSifre.hwnd)
MsgBox "Şifre hafızaya kopyalandı." & vbCrLf & vbCrLf & "Şifreyi bir metin alanına yapıştırabilirsiniz.", vbOKOnly + vbInfo, "Şifre Oluşturucu v0.1"
Else
MsgBox "Kopyalamadan önce şifreyi oluşturmalısınız.", vbOKOnly + vbCritical, "Şifre Kopyalanamadı!"

End If
End Sub
Private Sub cmdOlustur_Click()
'// Varsayılan değerler giriliyor
arrKarakterler = ""
strSifre = ""

'// Tüm Karakterler Seçiliyse
If blnTumKarakterler.Value = True Then
'Büyük harfler
arrUpper = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
'Küçük harfler
arrLower = "abcdefghijklmnopqrstuvwxyz"
'Rakamlar
arrNumber = "0123456789"
'Özel karakterler
arrOzel = "!^+%&()=?_£#${[]}\|*@€~"
If blnUpper <> 0 Or blnLower <> 0 Or blnNumber <> 0 Or blnOzel <> 0 Then
If blnUpper = 1 Then arrKarakterler = arrKarakterler & arrUpper
If blnLower = 1 Then arrKarakterler = arrKarakterler & arrLower
If blnNumber = 1 Then arrKarakterler = arrKarakterler & arrNumber
If blnOzel = 1 Then arrKarakterler = arrKarakterler & arrOzel
End If

'// Özel Karakterler Seçiliyse
ElseIf blnOzelKarakterler.Value = True Then
'// Boşluk karakteri temizleniyor
arrOzelKarakterler.Text = Replace(arrOzelKarakterler.Text, " ", "", 1, -1, 1)
arrKarakterler = arrOzelKarakterler.Text
End If

'// Karakter sayısı 0'dan fazlaysa şifre üretiliyor
If Len(arrKarakterler) > 0 Then

'// Karakter sayısı 0'dan fazlaysa şifre üretiliyor
If intUzunluk > 0 Then

'// Şifreye üst sınır konuluyor
If intUzunluk > 50 Then
intUzunluk.Text = "6"
MsgBox "Şifre en fazla 50 karakter olabilir!", vbOKOnly + vbCritical, "Şifre Oluşturulamadı!"
Else
'// Şifre olışturuluyor
For i = 1 To intUzunluk
Randomize Timer
intKarakterNo = Int(Rnd * Len(arrKarakterler) + 1)
strSifre = strSifre & Mid(arrKarakterler, intKarakterNo, 1)
Next
txtSifre.Text = strSifre
End If
Else
MsgBox "Şifre en az 1 karakter olmalıdır!", vbOKOnly + vbCritical, "Şifre Oluşturulamadı!"
End If
Else
MsgBox "Şifre oluşturulacak karakterleri seçmelisiniz!", vbOKOnly + vbCritical, "Şifre Oluşturulamadı!"
End If

If txtSifre.Text = "" Then
cmdKopyala.Enabled = False
cmdTemizle.Enabled = False
Else
cmdKopyala.Enabled = True
cmdTemizle.Enabled = True
End If

End Sub
Private Sub cmdTemizle_Click()
'// Şifre kutusu temizleniyor
txtSifre.Text = ""
cmdKopyala.Enabled = False
cmdTemizle.Enabled = False
End Sub
Private Sub cmKapat_Click()
'// Program kapatma butonu
Unload Me
End Sub
Private Sub Form_Load()
'// Karakter ayarı kutuları düzenleniyor
blnUpper.Enabled = True
blnLower.Enabled = True
blnNumber.Enabled = True
blnOzel.Enabled = True
arrOzelKarakterler.Enabled = False
If txtSifre.Text = "" Then
cmdKopyala.Enabled = False
cmdTemizle.Enabled = False
Else
cmdKopyala.Enabled = True
cmdTemizle.Enabled = True
End If
End Sub
Private Sub Image1_Click()
End Sub
Private Sub intUzunluk_KeyPress(KeyAscii As Integer)
'// Uzunluk alanına sadece sayı girilebilmesi sağlanıyor
If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
KeyAscii = 0
Beep
End If
End Sub
Private Sub Label1_Click()
ShellExecute GetActiveWindow(), "Open", "http://www.mydesign.gen.tr", "", 0&, 1
End Sub
Private Sub Label2_Click()
ShellExecute GetActiveWindow(), "Open", "http://www.d0gma.org", "", 0&, 1
End Sub
Private Sub txtSifre_KeyPress(KeyAscii As Integer)
'// Şifre alanının değiştirilmesi engelleniyor
KeyAscii = 0
End Sub