Soyez le premier à donner votre avis sur cette source.
Snippet vu 5 233 fois - Téléchargée 42 fois
Private Const AF_INET = 2 Private Const INVALID_SOCKET = -1 Private Const WSA_DESCRIPTIONLEN = 256 Private Const WSA_DescriptionSize = WSA_DESCRIPTIONLEN + 1 Private Const WSA_SYS_STATUS_LEN = 128 Private Const WSA_SysStatusSize = WSA_SYS_STATUS_LEN + 1 Private Const INADDR_NONE = &HFFFF Private Const hostent_size = 16 Private Type WSADataType wVersion As Integer wHighVersion As Integer szDescription As String * WSA_DescriptionSize szSystemStatus As String * WSA_SysStatusSize iMaxSockets As Integer iMaxUdpDg As Integer lpVendorInfo As Long End Type Private Type HostEnt h_name As Long h_aliases As Long h_addrtype As Integer h_length As Integer h_addr_list 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 Declare Function WSAIsBlocking Lib "wsock32.dll" () As Long Private Declare Function WSACleanup Lib "wsock32.dll" () As Long Private Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVR As Long, lpWSAD As WSADataType) As Long Private Declare Function htons Lib "wsock32.dll" (ByVal hostshort As Long) As Integer Private Declare Function ntohs Lib "wsock32.dll" (ByVal netshort As Long) As Integer Private Declare Function socket Lib "wsock32.dll" (ByVal af As Long, ByVal s_type As Long, ByVal protocol 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 inet_addr Lib "wsock32.dll" (ByVal cp As String) As Long Private Declare Function gethostbyname Lib "wsock32.dll" (ByVal host_name As String) As Long Private Declare Sub MemCopy Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal cb&) Private Declare Function inet_ntoa Lib "wsock32.dll" (ByVal inn As Long) As Long Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Any) As Long Private Declare Function WSACancelBlockingCall Lib "wsock32.dll" () As Long Private saZero As sockaddr Private WSAStartedUp As Boolean Private lSocket As Long '***************************************************** Private Sub Form_Load() Dim sSave As String '************ Demarrage de WinSock Dim StartupData As WSADataType If Not WSAStartedUp Then If Not WSAStartup(&H101, StartupData) Then WSAStartedUp = True sSave = StartupData.szDescription Else WSAStartedUp = False End If End If site = InputBox("Site internet à chercher (faut pas mettre http://):", "Recherche d' IP") ' *** version de winsock If InStr(1, sSave, Chr$(0)) > 0 Then sSave = Left$(sSave, InStr(1, sSave, Chr$(0)) - 1) 'connecte au site ip = ConnectSock(site, 80, 0, False) If Len(ip) >= 14 Then MsgBox ip End Sub Function ConnectSock(ByVal Host$, ByVal Port&, retIpPort$, ByVal Async%) As String Dim s&, SelectOps&, Dummy& Dim sockin As sockaddr SockReadBuffer$ = "" sockin = saZero sockin.sin_family = AF_INET sockin.sin_port = htons(Port) 'port If sockin.sin_port = INVALID_SOCKET Then ConnectSock = INVALID_SOCKET MsgBox "Problème de port!" Exit Function End If ' recupere add IP bizzare(-60...) sockin.sin_addr = GetHostByNameAlias(Host$) ' verifie If sockin.sin_addr = INADDR_NONE Then ConnectSock = INVALID_SOCKET MsgBox "Problème d' addrese!" Exit Function End If retIpPort$ = getascip$(sockin.sin_addr) & ":" & ntohs(sockin.sin_port) ConnectSock = retIpPort$ End Function ' recuperer IP Function GetHostByNameAlias(ByVal hostname$) As Long On Error Resume Next Dim phe& Dim heDestHost As HostEnt Dim addrList& Dim retIP& retIP = inet_addr(hostname) 'doit etre =-1 If retIP = INADDR_NONE Then phe = gethostbyname(hostname) 'connection-->donne 1IP If phe <> 0 Then MemCopy heDestHost, ByVal phe, hostent_size MemCopy addrList, ByVal heDestHost.h_addr_list, 4 MemCopy retIP, ByVal addrList, heDestHost.h_length Else retIP = INADDR_NONE End If End If GetHostByNameAlias = retIP '=? If Err Then GetHostByNameAlias = INADDR_NONE End Function Function getascip(ByVal inn As Long) As String On Error Resume Next Dim lpStr& Dim nStr& Dim retString$ retString = String(32, 0) '32*chr(0) :petits carrés lpStr = inet_ntoa(inn) If lpStr = 0 Then getascip = "255.255.255.255" Exit Function End If nStr = lstrlen(lpStr) '14 If nStr > 32 Then nStr = 32 MemCopy ByVal retString, ByVal lpStr, nStr retString = Left(retString, nStr) 'ip+carres getascip = retString 'IP !!! If Err Then getascip = "255.255.255.255" End Function Private Sub Form_Unload() 'Cancel As Integer) Dim Ret& 'Ferme le socket closesocket lSocket 'Fin de winsock If WSAIsBlocking() Then Ret = WSACancelBlockingCall() End If Ret = WSACleanup() WSAStartedUp = False End Sub
Private Sub Command1_Click()
Winsock1.Connect "www.babeuk.net", 80
End Sub
Private Sub Winsock1_Connect()
MsgBox Winsock1.RemoteHostIP
Winsock1.Close
End Sub
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.