vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
NEU! sevCoolbar 2.0 - Professionelle Toolbars im modernen Design!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Newsletter  | Impressum  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2014
 
zurück
Rubrik: Internet & Netzwerk22.03.05
Connect-Funktion

Diese Funktion erstellt eine Verbindung zwischen einem erstellten Socket und einem anderen (evtl. ein Internet oder Netzwerkserver) Socket.

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

Deklaration:

Declare Function Connect Lib "wsock32.dll" ( _
  ByVal s As Long, _
  name As sockaddr, _
  ByVal namelen As Long) As Long

Beschreibung:
Diese Funktion erstellt eine Verbindung zwischen einem erstellten Socket und einem anderen (evtl. ein Internet oder Netzwerkserver) Socket.

Parameter:
sErwartet den ID des Sockets, mit dem die Verbindung aufgebaut werden soll.
nameErwartet eine SOCKADDR-Struktur, die mit den Verbindungsdaten des zu verbindenden Servers gefüllt ist.
namelenErwartet die Größe der SOCKADDR-Struktur in Bytes.

Rückgabewert:
Ist die Funktion erfolgreich, so wird der Wert "0" zurückgegeben, andernfalls derWert "-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-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 11.516 mal aufgerufen.

nach obenzurück
 
   

Druckansicht Druckansicht Copyright ©2000-2014 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