hi simb,
also wenn du alle bestehenden dfü netzwerk verbindungen killen willst, dann kannst du das leider net mit nem winsock control tun, da das immer nur eine einzige verbindung verwaltet, die von dir selber aufgebaut wurde und nur eine tcp/ip verbindung oder udp verbindung ist. das hat alles gar nichts mit dem aufbauen der verbindung von deinem rechner zum server deines providers oder dergleichen zutun, was eine dfü netzwerk verbindung wäre.
so nun folgt ein etwas längerer teil source code, mit dem du das erreichst, was du machen wolltest, wie du sehen wirst ist das ganze etwas komplizierter, falls ich ausversehen irgend eine funktion oder deklaration vergessen habe mit zu kopieren, dann sag bitte bescheid.
--------------------------
Type vbRasConn
hRasConn As Long
sEntryName As String
sDeviceType As String
sDeviceName As String
sPhonebook As String
lngSubEntry As Long
guidEntry(15) As Byte
End Type
Type vbRasConnStatus
lRasConnState As RASCONNSTATE
dwError As Long
sDeviceType As String
sDeviceName As String
sNTPhoneNumber As String
End Type
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Public Declare Function RasHangUp Lib "rasapi32.dll" Alias "RasHangUpA" (ByVal hRasConn As Long) As Long
Public Declare Function RasGetConnectStatus Lib "rasapi32.dll" Alias "RasGetConnectStatusA" (ByVal hRasConn As Long, lpRASCONNSTATUS As Any) As Long
Public Sub KillConnections()
Dim aktConn As Long
Dim rtn As Long, lngError As Long
Dim myConnStatus As vbRasConnStatus
Dim arrayConns() As vbRasConn
rtn = EnumConnections(arrayConns)
If checkRasConArray(arrayConns, 1) = True Then
For aktConn = 0 To UBound(arrayConns, 1)
rtn = RasHangUp(arrayConns(aktConn).hRasConn)
Do
Sleep 0&
lngError = VBRasGetConnectStatus(arrayConns(aktConn).hRasConn, myConnStatus)
Loop While lngError <> ERROR_INVALID_HANDLE
Next aktConn
End If
End Sub
Public Function checkRasConArray(connArray() As vbRasConn, dimension As Integer) As Boolean
On Error GoTo notDefined:
Dim tmpBound As Long
tmpBound = UBound(connArray, dimension)
checkRasConArray = True
Exit Function
notDefined:
checkRasConArray = False
End Function
Function EnumConnections(aVBRasConns() As vbRasConn) As Long
On Error GoTo catchErr:
Dim rtn As Long
Dim b() As Byte
Dim aLens As Variant, dwSize As Long
Dim lpcB As Long, lpConns As Long
Dim i As Long
ReDim b(3)
aLens = Array(692&, 676&, 412&, 32&)
For i = 0 To 3
dwSize = aLens(i)
CopyMemory b(0), dwSize, 4
lpcB = 4
rtn = RasEnumConnections(b(0), lpcB, lpConns)
If rtn <> 632 And rtn <> 610 Then Exit For
Next i
EnumConnections = lpConns
If lpConns = 0 Then Exit Function
lpcB = dwSize * lpConns
ReDim b(lpcB - 1)
CopyMemory b(0), dwSize, 4
rtn = RasEnumConnections(b(0), lpcB, lpConns)
ReDim aVBRasConns(lpConns - 1)
For i = 0 To lpConns - 1
With aVBRasConns(i)
CopyMemory .hRasConn, b(i * dwSize + 4), 4
If dwSize = 32& Then
CopyByteToTrimmedString .sEntryName, b(i * dwSize + 8 ), 21&
Else
CopyByteToTrimmedString .sEntryName, b(i * dwSize + 8 ), 257&
CopyByteToTrimmedString .sDeviceType, b(i * dwSize + 265), 17&
CopyByteToTrimmedString .sDeviceName, b(i * dwSize + 282), 129&
If dwSize > 412& Then
CopyByteToTrimmedString .sPhonebook, b(i * dwSize + 411), 260&
CopyMemory .lngSubEntry, b(i * dwSize + 672), 4
If dwSize > 676& Then
CopyMemory .guidEntry(0), b(i * dwSize + 676), 16
End If
End If
End If
End With
Next i
Exit Function
catchErr:
MsgBox "Unerwarteter Fehler aufgetreten." & vbCrLf & "Nummer : " & Trim(Str(Err.Number)) & vbCrLf & "Text : " & Err.Description, vbCritical, "Fehler Aufgetreten"
Resume Next
End Function
Function VBRasGetConnectStatus(hRasConn As Long, udtVBRasConnStatus As vbRasConnStatus) As Long
On Error GoTo catchErr:
Dim rtn As Long
Dim i As Long, dwSize As Long
Dim aVarLens As Variant
Dim b() As Byte
aVarLens = Array(288&, 160&, 64&)
For i = 0 To 2
dwSize = aVarLens(i)
ReDim b(dwSize - 1)
CopyMemory b(0), dwSize, 4
rtn = RasGetConnectStatus(hRasConn, b(0))
If rtn <> 632 Then Exit For
Next i
VBRasGetConnectStatus = rtn
If rtn <> 0 Then Exit Function
With udtVBRasConnStatus
CopyMemory .lRasConnState, b(4), 4
CopyMemory .dwError, b( 8 ), 4
CopyByteToTrimmedString .sDeviceType, b(12), 17&
If dwSize = 64& Then
CopyByteToTrimmedString .sDeviceName, b(29), 33&
ElseIf dwSize = 160& Then
CopyByteToTrimmedString .sDeviceName, b(29), 129&
Else
CopyByteToTrimmedString .sDeviceName, b(29), 129&
CopyByteToTrimmedString .sNTPhoneNumber, b( 158 ), 129&
End If
End With
Exit Function
catchErr:
MsgBox "Unerwaterter Fehler isdt aufgetreten." & vbCrLf & "Nummer : " & Trim(Str(Err.Number)) & vbCrLf & "Text : " & Err.Description, vbCritical, "Fehler Aufgetreten"
Resume Next
End Function
Public Sub CopyByteToTrimmedString(strToCopyTo As String, bPos As Byte, lngMaxLen As Long)
On Error GoTo catchErr:
Dim strTemp As String
Dim lngLen As Long
strTemp = String(lngMaxLen + 1, 0)
CopyMemory ByVal strTemp, bPos, lngMaxLen
lngLen = InStr(strTemp, Chr$(0)) - 1
strToCopyTo = Left$(strTemp, lngLen)
Exit Sub
catchErr:
MsgBox "Unerwarteter Fehler ist aufgetreten." & vbCrLf & "Nummer : " & Trim(Str(Err.Number)) & vbCrLf & "Text : " & Err.Description, vbCritical, "Fehler Aufgetreten"
Resume Next
End Sub
------------------------------
so das war es auch schon nett nicht
???
-buttfinga-
![[HaBo]](/styles/default/logoklein.png){kind=small}
