Deklaration: Declare Function Connect Lib "wsock32.dll" ( _ ByVal s As Long, _ name As sockaddr, _ ByVal namelen As Long) As Long Beschreibung: Parameter:
Rückgabewert: Beispiel: ' Fügen sie diesen Code in ein öffentliches Modul ein Private Declare Function gethostbyname Lib "wsock32.dll" ( _ ByVal name As String) As Long Private Declare Function socket Lib "wsock32.dll" ( _ ByVal af As Long, _ ByVal prototype 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" ( _ ByVal s As Long, _ name As SOCKADDR, _ ByVal namelen As Long) As Long Private Declare Function send Lib "wsock32.dll" ( _ ByVal s As Long, _ buf As Any, _ ByVal length As Long, _ ByVal flags As Long) As Long Private Declare Function recv Lib "wsock32.dll" ( _ ByVal s As Long, _ buf As Any, _ ByVal length As Long, _ ByVal flags As Long) As Long Private Declare Function ioctlsocket Lib "wsock32.dll" ( _ ByVal s As Long, _ ByVal cmd As Long, _ argp As Long) As Long Private Declare Function inet_addr Lib "wsock32.dll" ( _ ByVal cp As String) As Long Private Declare Function htons Lib "wsock32.dll" ( _ ByVal hostshort As Integer) As Integer Private Declare Function WSAGetLastError Lib "wsock32.dll" () As Long Private Declare Sub MoveMemory Lib "kernel32" _ Alias "RtlMoveMemory" ( _ Destination As Any, _ Source As Any, _ ByVal length As Long) Private Type HOSTENT hname As Long haliases As Long haddrtype As Integer hlength 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 ' eine der HOSTENT-haddrtype-Konstanten Private Const AF_INET = 2 ' Internet Protokoll (UDP/IP oder TCP/IP). ' socket prototype-Konstanten Private Const SOCK_STREAM = 1 ' 2-wege Stream. Bei AF_INET ist es das ' TCP/IP Protokoll Private Const SOCK_DGRAM = 2 ' Datagramm Basierende verbindung. Bei AF_INET ' ist es das UDP Protokoll ' recv flags-Konstanten Private Const MSG_PEEK = &H2 ' Daten aus dem Puffer lesen, aber nicht aus ' dem Puffer entfernen ' ioctlsocket cmd-Konstanten Private Const FIONBIO = &H8004667E ' Setzen ob die Funktion bei der nächsten ' Datenanfrage zurückkehren soll ' IP-Adresse einer Internetadresse ermitteln Public Function GetIP(ByVal HostName As String) As String Dim pHost As Long, HostInfo As HOSTENT Dim pIP As Long, IPArray(3) As Byte ' Informationen des Host ermitteln pHost = gethostbyname(HostName) If pHost = 0 Then Exit Function ' HOSTENT-Struktur kopieren MoveMemory HostInfo, ByVal pHost, Len(HostInfo) ' Pointer der 1ten Ip-Adresse ermitteln ReDim IpAddress(HostInfo.hlength - 1) MoveMemory pIP, ByVal HostInfo.haddrlist, 4 MoveMemory IPArray(0), ByVal pIP, 4 GetIP = IPArray(0) & "." & IPArray(1) & "." & IPArray(2) & "." & IPArray(3) End Function ' Mit einem Server verbinden Public Function ConnectToServer(ByVal ServerIP As String, ByVal ServerPort _ As Long) As Long Dim hSock As Long, Retval As Long, ServerAddr As SOCKADDR ' Socket erstellen hSock = socket(AF_INET, SOCK_STREAM, 0&) If hSock = -1 Then ConnectToServer = -1 Exit Function End If ' mit dem Server verbinden With ServerAddr .sin_addr = inet_addr(ServerIP) .sin_port = htons(ServerPort) .sin_family = AF_INET End With Retval = connect(hSock, ServerAddr, Len(ServerAddr)) If Retval << 0 Then Call closesocket(hSock) ConnectToServer = -1 Exit Function End If ' Rückkehren der Funktion nach dem Abfragen von ankommenden Daten erzwingen Retval = ioctlsocket(hSock, FIONBIO, 1&) ' Socket-ID zurückgeben ConnectToServer = hSock End Function ' Sock/Verbindung schließen Public Function Disconnect(ByRef Sock As Long) Call closesocket(hSock) Sock = 0 End Function ' Daten senden Public Function SendData(ByVal Sock As Long, ByVal Data As String) As Long SendData = send(Sock, ByVal Data, Len(Data), 0&) End Function ' Sind Daten angekommen ? Public Function DataComeIn(ByVal Sock As Long) As Long Dim Tmpstr As String * 1 DataComeIn = recv(Sock, ByVal Tmpstr, Len(Tmpstr), MSG_PEEK) If DataComeIn = -1 Then DataComeIn = WSAGetLastError() End If End Function ' Daten ermitteln Public Function GetData(ByVal Sock As Long) As String Dim Tmpstr As String * 4096, Retval As Long Retval = recv(Sock, ByVal Tmpstr, Len(Tmpstr), 0&) GetData = Left$(Tmpstr, Retval) End Function ' Fügen Sie diesen Code in eine Form mit einem Command-Button und einem ' Textfeld ein Private Declare Function WSAStartup Lib "wsock32.dll" ( _ ByVal wVersionRequested As Integer, _ lpWSAData As WSAData) As Long Private Declare Function WSACleanup Lib "wsock32.dll" () As Long Private Type WSAData wVersion As Integer wHighVersion As Integer szDescription As String * 257 szSystemStatus As String * 129 iMaxSockets As Long iMaxUdpDg As Long lpVendorInfo As Long End Type Dim hSock As Long ' Winsocksitzung starten Private Sub Form_Load() Dim Retval As Long, WSD As WSAData Retval = WSAStartup(&H202, WSD) If Retval << 0 Then MsgBox "Die Winsocksitzung konnte nicht gestartet werden." Unload Me Exit Sub End If End Sub ' Winsocksitzung beenden Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) Call Disconnect(hSock) Call WSACleanup End Sub ' Verbinden mit dem Server und abrufen eines HTML Dokuments Private Sub Command1_Click() Dim ServerIP As String ' eventuell vorherigen Sock schließen If hSock << 0 Then Call Disconnect(hSock) End If ' ServerIP ermitteln ServerIP = GetIP("www.vbapihelpline.de") If ServerIP = "" Then MsgBox "Server wurde nicht gefunden." Exit Sub End If ' Verbinden mit dem Server hSock = ConnectToServer(ServerIP, 80) If hSock = -1 Then MsgBox "Verbindung mit dem Server ist fehlgeschlagen" hSock = 0 Exit Sub End If Text1.Text = "" ' Anfrage für den Abruf eines Dokuments senden Call SendData(hSock, "GET http://www.vbapihelpline.de/index.php _ HTTP/1.1" & vbCrLf) Call SendData(hSock, "Host: LonelySuicide666" & vbCrLf) Call SendData(hSock, "User-Agent: LS666 HTTP-Client" & vbCrLf & vbCrLf) ' Empfang abfragen Timer1.Interval = 1 Timer1.Enabled = True End Sub ' Daten vom Server ermitteln Private Sub Timer1_Timer() If DataComeIn(hSock) <= 1 Then ' Sind Daten gekommen ? Text1.Text = Text1.Text & Replace(GetData(hSock), vbLf, vbCrLf) DataArraived = True End If End Sub Diese Seite wurde bereits 27.465 mal aufgerufen. |
vb@rchiv CD Vol.6 Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! Online-Update-Funktion Entwickler-Vollversionen u.v.m. Buchempfehlung Tipp des Monats März 2024 Dieter Otter UTF-8 Konvertierung von Dateien und Strings VB6 selbst verfügt über keine Funktionen zur UTF-8 Konvertierung von Daten. Mit Hilfe des ADODB.Stream-Objekts lassen sich diese fehlenden Funktionen aber schnell nachrüsten. Neu! sevPopUp 2.0 Dynamische Kontextmenüs! Erstellen Sie mit nur wenigen Zeilen Code Kontextmenüs dynamisch zur Laufzeit. Vordefinierte Styles (XP, Office, OfficeXP, Vista oder Windows 8) erleichtern die Anpassung an die eigenen Anwendung... |
||||||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |