Mensajes

Hola: Cada vez que recibes una imagen debes dibujarla en el picture. Si no se dibuja es porque simplemente no llegó, revisa si está enviando correctamente.

Seria bueno pusieras el codigo para ayudarte

Saludos

Hola: He dado vueltas por todo internet intentando buscar una respuesta pero ha sido inútil.

Estoy programando una sencilla aplicación que reproduzca MP3.
pongo como ejemplo el siguiente código, que funciona al copiar cualquier MP3 a c:\archivo.mp3, iniciando un proyecto nuevo en VB6 y poner lo siguiente:

Código (vb) [Seleccionar] Expandir

Private Declare Function mciExecute Lib "winmm.dll" _
(ByVal lpstrCommand As String) As Long
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 Sub Form_Load()
Dim File As String
File = "C:\archivo.mp3"
mciRet = mciSendString("open " & File & " type MPEGVideo Alias MP3", 0&, 0&, 0&)
If mciRet <> 0 Then
   MsgBox "Error abriendo MP3"
Else: mciExecute "Play MP3"
End If
End Sub


Este código me reproduce perfectamente el archivo MP3

Pero sucede que mi PC tiene 2 tarjetas de sonido. La predeterminada y otra adicional. Necesito reproducir el MP3 utilizando la otra tarjeta de sonido, y no encuentro por ningún lado cómo hacerlo.

Sé que en Soporte de Microsoft existe un código muy bueno, el problema es que utiliza "mci32.ocx" y sólo reproduce WAV.

Yo estoy utilizando directamente la API mediante "winmm.dll"

¿Alguna ayuda?

Saludos.

Lo que pasa es que hago la tipica llamada ws_Connect y cuando la conexión falla, no salta ws_Error si no que la ejecución se detiene con un "run-time error".

Lo extraño es que en el pc donde estoy programando, funciona bien

Saludos.

Buenas. Acudo a UDS. luego de haber preguntado, averiguado, googleado sin encontrar respuesta.

Diseñé una aplicación que utiliza MSWINSCK.OCX.

Existe una Sub para manejar los errores de Winsock, que sería:

Código (vb) [Seleccionar] Expandir

Private Sub ws_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)

Sin embargo, mi aplicación hace caso omiso a esta instrucción. Cuando ocurre un error Winsock, aparece el típico cartelito de "Run-time error", deteniéndose la ejecución. Lo normal sería que ante un error saltara la Sub ws_Error. Pero esto no sucede.

¿Por qué pasará esto?

Gracias.

Hola: Si estas usando un array de winsock el procedimiento no es el correcto. Debería ser:

Código (vb) [Seleccionar] Expandir

Private Sub Winsock1_Connect(Index As Integer)
MsgBox "Funciono"
End Sub

Saludos

Hola: Si existe una función:

DateDiff

http://msdn.microsoft.com/es-es/library/b5xbyt6f(VS.80).aspx

Hola: Es el eterno problema de las dependencias de VB. Tienes que registrar esa OCX en el equipo con Vista/Seven donde vas a correr el ejecutable. Una opción sería crear un instalador que la registre. La 3º pero más complicada es usar la API de las funciones que dependen de ese control. ¿Es para un diálogo para abrir o guardar archivos? Si es así, te paso el código.

Saludos

http://www.recursosvisualbasic.com.ar/htm/trucos-codigofuente-visual-basic/269-cifrar-descifrar.htm

Hola: Si quieres aprender a manejar sockets en VB sin usar dependencias, te recomiendo utilizar directamente la API. En este mismo foro publiqué un tutorial de la API winsock Cliente/Servidor, aunque todavía me falta publicar la 2º parte (servidor).

Si utilizas un módulo hecho por otro, es muy probable que nunca llegues a entenderlo.

Saludos

[Utilizando la API de Winsock]

Hola: Soy nuevo en el foro pero siempre lo visito. He querido aportar con algo ahora, espero a más de alguien pueda serle útil 

Utilizando la API de Winsock

Quizás una de las preguntas que mas se han hecho quienes intentan programar una aplicación Cliente-Servidor bajo Windows, es "¿Cómo uso la API de Winsock?" o "¿Cómo evito el uso de MSWINSCK.OCX?"

En este, y otros foros, se ha hecho muchas veces esta pregunta, y es poco lo que se ha conseguido.

Es sin duda uno de los temas donde se encuentra poca información, y la poca que hay está en inglés, y los manuales o tutoriales que hay son extensos y poco entendibles. Como último recurso sólo nos queda utilizar un módulo ya hecho por otro programador, con cientos de líneas que no entendemos.

La buena noticia es que todos podemos realizar una aplicación utilizando la API de Winsock en pocas lineas de código y un módulo ni tan extenso.

Es por eso que después de mucho averiguar, y leer, logré entender y poner en práctica el funcionamiento de la API de Winsock. Quizás no en un 100%, pero me permitió encontrar algunas funciones en un módulo y crear una aplicación funcional utilizando este método.

En este tutorial intentaré explicar paso a paso cómo realizar una sencilla aplicación Cliente y otra Servidor utilizando 100% la API y evitando el uso de cualquier OCX.

Manos a la obra:

El Cliente

Vamos a abrir VB6 y abrimos un proyecto nuevo. Añadimos los controles necesarios:



Como pueden ver, lleva Label, Textbox, Command, Listview. El texto rojo indica los nombre que les asigné a los controles para que luego no les de error el código.

Ahora vamos al MODULO:

Primero debemos declarar, entre otras cosas, las funciones para utilizar los sockets en Windows y además otras funciones para crear la subclase que nos permitirá interceptar los mensajes que se envién a la ventana (esto lo explicaremos mas adelante)

Código (vb) [Seleccionar] Expandir


Option Explicit

Private Declare Function accept Lib "wsock32.dll" (ByVal s As Long, _
addr As SOCKADDR, addrlen As Long) As Long
Private Declare Function bind Lib "wsock32.dll" (ByVal s As Long, addr As SOCKADDR, _
ByVal namelen As Long) As Long
Private Declare Function closesocket Lib "wsock32.dll" (ByVal s As Long) As Long
Private Declare Function Connect Lib "wsock32.dll" Alias "connect" (ByVal s As Long, _
addr As SOCKADDR, ByVal namelen As Long) As Long
Private Declare Function htonl Lib "wsock32.dll" (ByVal hostlong As Long) As Long
Private Declare Function htons Lib "wsock32.dll" (ByVal hostshort As Long) As Integer
Private Declare Function inet_ntoa Lib "wsock32.dll" (ByVal inn As Long) As Long
Private Declare Function Listen Lib "wsock32.dll" Alias "listen" (ByVal s As Long, _
ByVal backlog As Long) As Long
Private Declare Function recv Lib "wsock32.dll" (ByVal s As Long, buf As Any, _
ByVal buflen As Long, ByVal Flags As Long) As Long
Private Declare Function Send Lib "wsock32.dll" Alias "send" (ByVal s As Long, _
buf As Any, ByVal buflen As Long, ByVal Flags As Long) As Long
Private Declare Function Socket Lib "wsock32.dll" Alias "socket" (ByVal af As Long, _
ByVal s_type As Long, ByVal protocol As Long) As Long
Private Declare Function gethostbyname Lib "wsock32.dll" (ByVal host_name As String) As Long
Private Declare Function gethostname Lib "wsock32.dll" (ByVal host_name As String, _
ByVal namelen As Long) As Long
Private Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVR As Long, _
lpWSAD As WSADataType) As Long
Private Declare Function WSACleanup Lib "wsock32.dll" () As Long
Private Declare Function WSAIsBlocking Lib "wsock32.dll" () As Long
Private Declare Function WSACancelBlockingCall Lib "wsock32.dll" () As Long
Private Declare Function inet_addr Lib "wsock32.dll" (ByVal cp As String) As Long
Private Declare Function WSAAsyncSelect Lib "wsock32.dll" (ByVal s As Long, _
ByVal hWnd As Long, ByVal wMsg As Long, ByVal lEvent As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" _
(ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName 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 hMenu As Long, _
ByVal hInstance As Long, lpParam As Any) As Long
Private Declare Function DestroyWindow Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Any) As Long
Private Declare Function GetTickCount Lib "kernel32.dll" () As Long
Private Declare Sub CopyMemoryIP Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, _
ByVal hpvSource As Long, ByVal cbCopy As Long)
Private Declare Sub MemCopy Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal cb As Long)
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)


Como pueden ver hemos llamado a "wsock32.dll" que contiene todas las funciones Winsock que necesitamos.

Ahora vamos a definir los tipos de datos necesarios para trabajar con Winsock:

Código (vb) [Seleccionar] Expandir

Private Type WSADataType
wVersion As Integer
wHighVersion As Integer
szDescription As String * 257
szSystemStatus As String * 129
iMaxSockets As Integer
iMaxUdpDg As Integer
lpVendorInfo As Long
End Type

Private Type HostEnt
hName As Long
hAliases As Long
hAddrType As Integer
hLen As Integer
hAddrList As Long
End Type

Private Type SOCKADDR
sin_family As Integer
sin_port As Integer
sin_addr As Long
sin_zero As String * 8
End Type

Las Constantes:

Código (vb) [Seleccionar] Expandir

Private Const WINSOCK_MESSAGE As Long = 1025
Private Const INADDR_NONE As Long = &HFFFF
Private Const INADDR_ANY As Long = &H0
Private Const IPPROTO_TCP As Long = 6
Private Const INVALID_SOCKET As Long = -1
Private Const SOCKET_ERROR As Long = -1
Private Const SOCK_STREAM As Long = 1
Private Const AF_INET As Long = 2
Private Const PF_INET As Long = 2
Private Const FD_READ As Long = &H1&
Private Const FD_WRITE As Long = &H2&
Private Const FD_OOB As Long = &H4&
Private Const FD_ACCEPT As Long = &H8&
Private Const FD_CONNECT As Long = &H10&
Private Const FD_CLOSE As Long = &H20&
Private Const GWL_WNDPROC As Long = (-4)

Las Variables:

Código (vb) [Seleccionar] Expandir

Private PrevProc As Long
Private bIsInit As Boolean
Private hWin As Long
Private m_ObjectHost As Object
Private TimeOut As Long

Public PortOpen As Collection
Public PortSesion As Collection

Public Sockets As Collection
Public IPAddresses As Collection
Public PortConection As Collection

Public CurrentSocketHandle As Long

Listo. Ahora seguimos (en el mismo módulo). Vamos a crear las funciones que nos permitirán crear y utilizar los socket.

Aquí debemos llamar a la API "CreateWindowEx" para crear el socket. A la función le pasaremos como argumento ObjectHost, que es la ventana o formulario principal. De esta forma, podemos posteriormente interceptar los mensajes que lleguen a este socket, por ejemplo cuando el Servidor nos envié datos o nos cierre la conexión:

Código (vb) [Seleccionar] Expandir


Public Function InitWinSock(ObjectHost As Object) As Boolean

Dim StartupData As WSADataType

Set Sockets = New Collection
Set IPAddresses = New Collection
Set PortOpen = New Collection
Set PortSesion = New Collection
Set PortConection = New Collection

Set m_ObjectHost = ObjectHost

If Not bIsInit Then
If Not WSAStartup(&H101, StartupData) Then
bIsInit = True
hWin = CreateWindowEx(0&, "STATIC", "SOCKET_WINDOW", _
0&, 0&, 0&, 0&, 0&, 0&, 0&, App.hInstance, ByVal 0&)
PrevProc = SetWindowLong(hWin, GWL_WNDPROC, _
AddressOf WindowProc)
Else
bIsInit = False
End If
End If

InitWinSock = bIsInit

End Function


Ahora creamos una función que será llamada en el Form_Unload:

Código (vb) [Seleccionar] Expandir


Public Sub TerminateWinSock()

Dim Ret As Long
Dim Cnt As Long

For Cnt = 1 To Sockets.Count
WsClose Sockets.Item(1)
Next

For Cnt = 1 To PortSesion.Count
closesocket PortSesion.Item(1)
PortSesion.Remove (1)
PortOpen.Remove (1)
Next

If WSAIsBlocking Then WSACancelBlockingCall

Call WSACleanup

bIsInit = False
SetWindowLong hWin, GWL_WNDPROC, PrevProc
DestroyWindow hWin

Set Sockets = Nothing
Set IPAddresses = Nothing
Set PortConection = Nothing
Set PortSesion = Nothing
Set PortOpen = Nothing

End Sub


Importante: Cuando ejecuten la aplicación desde el IDE de VB, no lo hagan con el botón "Stop", sino que deben cerrar la aplicación, ya que de lo contrario VB se cerrará y no preguntará por guardar cambios.

Una función muy importante: La que nos permite abrir la conexión:

Código (vb) [Seleccionar] Expandir


Public Function WsConnect(ByVal Host As String, _
ByVal Port As Long) As Long

Dim s As Long
Dim Sockin As SOCKADDR

Sockin.sin_family = AF_INET
Sockin.sin_port = htons(Port)

If Sockin.sin_port = INVALID_SOCKET Then Exit Function

Sockin.sin_addr = GetHostByNameAlias(Host$)

If Sockin.sin_addr = INADDR_NONE Then Exit Function

s = Socket(PF_INET, SOCK_STREAM, IPPROTO_TCP)
If s < 0 Then Exit Function

If Connect(s, Sockin, 16) <> 0 Then
If s Then closesocket s
Exit Function
End If

If WSAAsyncSelect(s, hWin, ByVal WINSOCK_MESSAGE, _
ByVal FD_READ Or FD_WRITE Or FD_CONNECT Or FD_CLOSE) Then
closesocket s
Else
IPAddresses.Add GetAscIp(Sockin.sin_addr), CStr(s)
Sockets.Add s, CStr(s)
PortConection.Add Port, CStr(s)
CurrentSocketHandle = s
WsConnect = s
End If

End Function


Otra función importante. Para enviar datos al servidor:

Código (vb) [Seleccionar] Expandir


Public Function SendData(Socket As Long, Data As Variant) As Boolean
Dim Ret As Long
Dim TheMsg() As Byte, sTemp$
TheMsg = ""

Select Case VarType(Data)
Case 8209 'byte array
sTemp = Data
TheMsg = sTemp
Case 8 'String
sTemp = StrConv(Data, vbFromUnicode)
Case Else
sTemp = CStr(Data)
sTemp = StrConv(Data, vbFromUnicode)
End Select
TheMsg = sTemp

If UBound(TheMsg) > -1 Then
Ret = Send(Socket, TheMsg(0), (UBound(TheMsg) - LBound(TheMsg) + 1), 0)

If Ret = SOCKET_ERROR Then
TimeOut = GetTickCount + 5000
Do While Ret = SOCKET_ERROR
Ret = Send(Socket, TheMsg(0), (UBound(TheMsg) - LBound(TheMsg) + 1), 0)
DoEvents
Sleep 10
If TimeOut < GetTickCount Then Exit Do
Loop
End If
SendData = Ret <> SOCKET_ERROR
End If

End Function


Para cerrar la conexión:

Código (vb) [Seleccionar] Expandir


Public Function WsClose(ByVal s As Long) As Boolean
On Local Error Resume Next
WsClose = closesocket(s)
IPAddresses.Remove CStr(s)
Sockets.Remove CStr(s)
PortConection.Remove CStr(s)
End Function


Estas funciones nos devuelven la IP local y el HOST local:

Código (vb) [Seleccionar] Expandir


Public Function GetLocalIp() As String

Dim sHostName As String * 256
Dim lpHost As Long
Dim Host As HostEnt
Dim dwIPAddr As Long
Dim tmpIPAddr() As Byte
Dim i As Integer
Dim sIPAddr As String

lpHost = gethostbyname(sHostName)

CopyMemoryIP Host, lpHost, Len(Host)
CopyMemoryIP dwIPAddr, Host.hAddrList, 4
ReDim tmpIPAddr(1 To Host.hLen)
CopyMemoryIP tmpIPAddr(1), dwIPAddr, Host.hLen
For i = 1 To Host.hLen
sIPAddr = sIPAddr & tmpIPAddr(i) & "."
Next
GetLocalIp = Mid$(sIPAddr, 1, Len(sIPAddr) - 1)

End Function


Public Function LocalHostName() As String
Dim sHostName As String * 256
If gethostname(sHostName, 256) <> INVALID_SOCKET Then
LocalHostName = Trim$(sHostName)
End If
End Function



Esta es la función de la que hablábamos anteriormente. Nos permite interceptar los mensajes que Windows nos envía a la ventana:

Código (vb) [Seleccionar] Expandir


Private Function WindowProc(ByVal hWnd As Long, _
ByVal uMsg As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long

On Local Error Resume Next

If uMsg = WINSOCK_MESSAGE Then

Dim mIP As String
Dim mPuerto As String

CurrentSocketHandle = wParam

Select Case lParam

Case FD_ACCEPT
Dim s As Long, tempAddr As SOCKADDR
s = accept(wParam, tempAddr, Len(tempAddr))

mIP = GetAscIp(tempAddr.sin_addr)
mPuerto = PortOpen(CStr(wParam))

IPAddresses.Add mIP, CStr(s)
Sockets.Add s, CStr(s)
PortConection.Add mPuerto, CStr(s)

Call m_ObjectHost.Socket_Conect(s, mIP, mPuerto)

Case FD_CONNECT
'Debug.Print "FD_CONNECT"

Case FD_WRITE
'Debug.Print "FD_WRITE"

Case FD_READ
Dim sTemp As String, lRet As Long, szBuf As String

Do
szBuf = String(1024, 0)
lRet = recv(wParam, ByVal szBuf, Len(szBuf), 0)
If lRet > 0 Then sTemp = sTemp + Left$(szBuf, lRet)
Loop Until lRet <= 0

If LenB(sTemp) > 0 Then
mIP = IPAddresses(CStr(wParam))
mPuerto = PortConection(CStr(wParam))

Call m_ObjectHost.Socket_DataArrival(wParam, _
mIP, mPuerto, sTemp)
End If

Case Else 'FD_CLOSE
mPuerto = PortConection(CStr(wParam))
mIP = IPAddresses(CStr(wParam))
WsClose wParam

Call m_ObjectHost.Socket_Close(wParam, mIP, mPuerto)

End Select

Else
WindowProc = CallWindowProc(PrevProc, hWnd, uMsg, wParam, lParam)
End If

End Function


Por último, otras funciones para tratar IP y Hosts:

Código (vb) [Seleccionar] Expandir


Private Function GetHostByNameAlias(ByVal HostName As String) As Long

On Error Resume Next
Err.Clear

Dim heDestHost As HostEnt
Dim addrList As Long
Dim retIP As Long
Dim phe As Long

retIP = inet_addr(HostName)

If retIP = INADDR_NONE Then
phe = gethostbyname(HostName)
If phe <> 0 Then
MemCopy heDestHost, ByVal phe, 16
MemCopy addrList, ByVal heDestHost.hAddrList, 4
MemCopy retIP, ByVal addrList, heDestHost.hLen
Else
retIP = INADDR_NONE
End If
End If

GetHostByNameAlias = retIP

If Err Then GetHostByNameAlias = INADDR_NONE
End Function

Private Function GetAscIp(ByVal inn As Long) As String
On Error Resume Next
Dim lpStr&
Dim nStr&
Dim retString$

retString = String(32, 0)

lpStr = inet_ntoa(inn)
If lpStr = 0 Then
GetAscIp = "255.255.255.255"
Exit Function
End If
nStr = lstrlen(lpStr)
If nStr > 32 Then nStr = 32
MemCopy ByVal retString, ByVal lpStr, nStr
retString = Left(retString, nStr)
GetAscIp = retString
If Err Then GetAscIp = "255.255.255.255"
End Function



Muy bién. Con esto hemos terminado el módulo.

Lo llamaremos: WinSock32


Ahora, el código del formulario. Creo que no hace falta explicarlo ya que todo corresponde a funciones que ya todos saben manejar (eso creo).

Lo principal aquí es que se establece una conexión, se envián y se reciben datos.

Código (vb) [Seleccionar] Expandir


Option Explicit

Dim Conectado As Boolean

Private Sub Form_Load()
Conectado = False
WinSock32.InitWinSock Me ' Aqui inicializamos el socket
txtIP = WinSock32.GetLocalIp ' Obtenemos nuestra IP local
End Sub

Private Sub cmdConectar_Click()
cmdConectar.Enabled = False
lblEstado.Caption = "Intentando conectar": DoEvents
If WinSock32.WsConnect(txtIP, txtPuerto) Then 'Si la conexion es exitosa
lblEstado.Caption = "Conectado con " & txtIP & " en el puerto " & _
txtPuerto
Conectado = True
Else
lblEstado.Caption = "Error al conectar" 'No se pudo conectar
cmdConectar.Enabled = True
Conectado = False
End If
End Sub

Private Sub cmdEnviar_Click()
If WinSock32.SendData(CurrentSocketHandle, txtMsg.Text) Then 'Intentamos enviar datos al servidor
lstShow.AddItem "[Cliente]: " & txtMsg.Text
txtMsg.Text = ""
Else
lblEstado.Caption = "Error al enviar mensaje" 'No se pudo enviar
End If
End Sub

Private Sub txtMsg_Change()
'Funcion para habilitar/deshabilitar el boton Enviar
If Conectado = False Then Exit Sub
If txtMsg.Text = vbNullString Then
cmdEnviar.Enabled = False
Else
cmdEnviar.Enabled = True
End If
End Sub

Public Sub Socket_DataArrival(ID As Long, IP As String, Puerto As String, _
Data As String) 'Funcion que intercepta datos que llegan al socket
lstShow.AddItem "[Servidor]: " & Data
End Sub

Public Sub Socket_Close(ID As Long, IP As String, Puerto As String) 'Si se cierra la conexion
cmdConectar.Enabled = True
lblEstado.Caption = "Desconectado"
Conectado = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
WinSock32.TerminateWinSock 'Importante llamada al descargar formulario
End Sub


Ahora compilamos y ejecutamos. Tenemos listo nuestro Cliente Winsock sin usar un OCX.

Lo más bonito de todo esto, es que el programa está testeado en Windows XP, Vista y Seven y funciona perfectamente

En la 2º parte, explicaremos cómo programar la parte servidor (la que pone a la escucha un puerto y recibe la conexión) también utilizando llamadas a la API.

De esta manera, nuestra aplicación será 100% portable, ya que no tiene absolutamente ninguna dependencia con Controles ActiveX

Nota Final: Lo importante de todo esto es quienes quieran aprender, traten de ENTENDER el código. No basta con COPIAR y PEGAR, pues de esa manera nunca podrán aprender.

Espero que a más de alguien le sirva.

Pronto la 2º parte...

Saludos!