CloseSocket-Funktion Diese Funktion zerstört ein Socket und trennt eine eventuelle Verbindung mit diesem.
Betriebssystem:  Win95, Win98, WinNT 3.1, Win2000, WinME	Views:  11.995

Deklaration:

Declare Function CloseSocket Lib "wsock32.dll" (ByVal s As Long) As Long

Beschreibung:
Diese Funktion zerstört ein Socket und trennt eine eventuelle Verbindung mit diesem.

Parameter:

s	Erwartet den ID eines zuvor erstellten Sockets.

Rückgabewert:
Ist die Funktion erfolgreich, so wird der Wert "0" zurückgegeben, andernfallsWert "-1". Für erweiterte Fehlerinformationen rufen Sie die WSAGetLastError-Funktion auf.

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 Hardtype-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 Hosts ermitteln
  pHost = gethostbyname(HostName)
  If pHost = 0 Then Exit Function
 
  ' HOSTENT-Struktur kopieren
  MoveMemory HostInfo, ByVal pHost, Len(HostInfo)
 
  ' Pointer der 1. 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