vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
sevAniGif - als kostenlose Vollversion auf unserer vb@rchiv CD Vol.5  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Newsletter  | Impressum  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2015
 
zurück
Rubrik: Internet & Netzwerk22.03.05
CloseSocket-Funktion

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

Betriebssystem:  Win95, Win98, WinNT 3.1, Win2000, WinMEViews:  5.475 

Summer-Special bei Tools & Components!
Gute Laune Sommer bei Tools & Components
Top Summer-Special - Sparen Sie teilweise über 100,- EUR
Alle sev-Entwicklerkomponenten und Komplettpakete jetzt bis zu 25% reduziert!
zum Beispiel:
  • Developer CD nur 455,- EUR statt 569,- EUR
  • sevDTA 2.0 nur 224,30 EUR statt 299,- EUR
  •  
  • vb@rchiv   Vol.6 nur 18,70 EUR statt 24,95 EUR
  • sevCoolbar 3.0 nur 58,70 EUR statt 69,- EUR
  • - Werbung -Und viele weitere Angebote           Aktionspreise nur für kurze Zeit gültig

    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:
    sErwartet 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

    Diese Seite wurde bereits 5.475 mal aufgerufen.

    nach obenzurück
     
       

    Druckansicht Druckansicht Copyright ©2000-2015 vb@rchiv Dieter Otter
    Alle Rechte vorbehalten.

    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.

    Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel