Título: [SRC] Sockets - VB6
Publicado por: F3B14N en 15 Julio 2010, 06:30 am
Socket:Option Explicit
Private Declare Function socket Lib "WSOCK32" (ByVal af As Long, ByVal s_type As Long, ByVal protocol As Long) As Long Private Declare Function closesocket Lib "WSOCK32" (ByVal s As Long) As Long Private Declare Function connect Lib "WSOCK32" (ByVal s As Long, addr As SOCKADDR, ByVal NameLen As Long) As Long Private Declare Function send Lib "WSOCK32" (ByVal s As Long, Buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long Private Declare Function recv Lib "WSOCK32" (ByVal s As Long, Buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long Public Declare Function inet_addr Lib "WSOCK32" (ByVal cp As String) As Long Private Declare Function WSAStartup Lib "WSOCK32" (ByVal wVR As Long, lpWSAD As Long) As Long Private Declare Function WSACleanup Lib "WSOCK32" () As Long Private Declare Function WSAAsyncSelect Lib "WSOCK32" (ByVal s As Long, ByVal hWnd As Long, ByVal wMsg As Long, ByVal lEvent As Long) As Long
Private Declare Function CreateWindowExA Lib "USER32" (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 RegisterClassExA Lib "USER32" (pcWndClassEx As WNDCLASSEX) As Integer Private Declare Function DefWindowProcA Lib "USER32" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Type WNDCLASSEX cbSize As Long style As Long lpfnWndProc As Long cbClsExtra As Long cbWndExtra As Long hInstance As Long hIcon As Long hCursor As Long hbrBackground As Long lpszMenuName As String lpszClassName As String hIconSm 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
Private Const AF_INET = 2 Private Const PF_INET = 2 Private Const FD_READ = &H1& Private Const FD_WRITE = &H2& Private Const FD_CONNECT = &H10& Private Const FD_CLOSE = &H20& Private Const SOCK_STREAM = 1 Private Const IPPROTO_TCP = 6 Private Const WINSOCK_MESSAGE = 1025
Private wHwnd As Long
Public Function htons(ByVal lPort As Long) As Integer htons = ((((lPort And &HFF000000) \ &H1000000) And &HFF&) Or ((lPort And &HFF0000) \ &H100&) Or ((lPort And &HFF00&) * &H100&) Or ((lPort And &H7F&) * &H1000000) Or (IIf((lPort And &H80&), &H80000000, &H0)) And &HFFFF0000) \ &H10000 End Function
'-------- Public Function ProcessMessage(ByVal hWnd As Long, ByVal lMessage As Long, ByVal wParam As Long, ByVal lParam As Long) As Long If lMessage = WINSOCK_MESSAGE Then Dim bBuffer(1 To 1024) As Byte Select Case lParam Case FD_CONNECT: Call WsSendData(wParam, StrConv("AAAAAAAAAA", vbFromUnicode)) Case FD_WRITE: Case FD_READ: Call recv(wParam, bBuffer(1), 1024, 0) MsgBox StrConv(bBuffer, vbUnicode) Case FD_CLOSE: 'Jmp connect Routine End Select Exit Function End If ProcessMessage = DefWindowProcA(hWnd, lMessage, wParam, lParam) End Function '--------
Public Function WsInitialize(ByVal MyWndProc As Long, ByVal szSocketName As String) As Boolean Dim WNDC As WNDCLASSEX If wHwnd = 0 Then WNDC.cbSize = LenB(WNDC) WNDC.lpfnWndProc = MyWndProc WNDC.hInstance = App.hInstance WNDC.lpszClassName = szSocketName Call RegisterClassExA(WNDC) '0: Exit Function wHwnd = CreateWindowExA(0&, szSocketName, "", 0&, 0&, 0&, 0&, 0&, 0&, 0&, App.hInstance, 0&) '0: Call UnregisterClass(szSocketName, App.hInstance) End If Call WSAStartup(&H101, 0&) Initialize = True End Function Public Sub WsTerminate() Call WSACleanup End Sub
Public Function WsConnect(lRemoteHost As String, lPort As Long) As Long Dim SockData As SOCKADDR Dim hSocket As Long Dim lWsMsg As Long SockData.sin_family = AF_INET SockData.sin_port = htons(lPort) 'If sockdata.sin_port = INVALID_SOCKET Then Exit Function SockData.sin_addr = inet_addr(lRemoteHost) 'If sockdata.sin_addr = INADDR_NONE Then Exit Function hSocket = socket(PF_INET, SOCK_STREAM, IPPROTO_TCP) 'If hSocket < 0 Then Exit Function
Call connect(hSocket, SockData, 16) ' If hSocket Then WsClose Exit Function If WSAAsyncSelect(hSocket, wHwnd, ByVal WINSOCK_MESSAGE, ByVal FD_READ Or FD_WRITE Or FD_CONNECT Or FD_CLOSE) Then lWsMsg = FD_CLOSE Else lWsMsg = FD_CONNECT End If Call ProcessMessage(0, WINSOCK_MESSAGE, hSocket, FD_CONNECT): WsConnect = hSocket End Function Public Function WsSendData(ByVal SocketIndex As Long, bMessage() As Byte) As Long If UBound(bMessage) > -1 Then WsSendData = send(SocketIndex, bMessage(0), (UBound(bMessage) - LBound(bMessage) + 1), 0) End If End Function Call: Private Sub Main() If WsInitialize(AddressOf ProcessMessage, "Server") Then If WsConnect("127.0.0.1", 7777) Then Do DoEvents Loop End If End If End Sub No tiene mucha ciencia, es algo tiny de lo que se usa normalmente OCX, SocketPlus, SocketMaster, etc... Sirve para enviar/recibir data solamente, perfecto para servidores de rats y demas apps... La funcion ProcessMessage es la cual procesa los mensajes, y deberan modificarla segun su APP. :P Estoy seguro que se puede limpiar mas aún, eliminando la ***** de crear una Clase y una Ventana, pero no se me ocurre su remplaz mas prolijo :P La funcion htons es de Karcrack.Ah Karcrack, estoy seguro que podrias hacer un remplazo para inet_addr@WSOCK32.DLL, yo intente, pero no entendi la logica de lo que hace esa hermosa API :-X Espero que les sea util el codigo, Saludos, y Felicidades por la Copa a la gente de España ;-) desde Uruguay :D
Título: Re: [SRC] Sockets - VB6
Publicado por: cobein en 15 Julio 2010, 09:32 am
Ahi arme algunas funciones de reemplazo, se pueden optimizar pero las deje asi para que se comprendan facilmente. Private Type tLong lLong As Long End Type
Private Type tByteWord b0 As Byte: b1 As Byte: b2 As Byte: b3 As Byte End Type
Private Function inet_ntoa_(ByVal inn As Long) As String Dim tb As tByteWord Dim tl As tLong tl.lLong = inn LSet tb = tl inet_ntoa_ = tb.b0 & "." & tb.b1 & "." & tb.b2 & "." & tb.b3 End Function
Private Function inet_addr_(ByVal cp As String) As Long Dim svData() As String Dim i As Long svData = Split(cp, ".") inet_addr_ = "&h" & Padd2(svData(3)) & Padd2(svData(2)) & Padd2(svData(1)) & Padd2(svData(0)) End Function
Private Function htons_(ByVal hostshort As Long) As Integer Dim tb As tByteWord Dim tl As tLong tl.lLong = hostshort LSet tb = tl htons_ = "&h" & Padd2(tb.b0) & Padd2(tb.b1) End Function
Private Function Padd2(bData As Variant) As String Padd2 = Right$("0" & Hex(bData), 2) End Function
Título: Re: [SRC] Sockets - VB6
Publicado por: BlackZeroX en 15 Julio 2010, 09:38 am
@Cobein: Son de agradecer O.O!¡.
Ese htons_ si es pequeño!¡.
Dulces Lunas!¡.
Título: Re: [SRC] Sockets - VB6
Publicado por: Karcrack en 15 Julio 2010, 14:53 pm
Interesante funcion LSet... aun asi trabajar con bits es mas rapido >:D :xD
Buen trabajo Cobein :-* :rolleyes:
|