Exported VBA
This commit is contained in:
215
wgmaster/vba/MTcpSocket.bas
Normal file
215
wgmaster/vba/MTcpSocket.bas
Normal file
@ -0,0 +1,215 @@
|
||||
Option Compare Database
|
||||
|
||||
' 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 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 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
|
||||
|
||||
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
|
||||
|
||||
|
||||
|
||||
' 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
|
||||
|
||||
Dim hSock As Long
|
||||
|
||||
|
||||
' 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 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
|
||||
MsgBox ("Connection Error:" + Retval)
|
||||
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 Data As String) As Long
|
||||
SendData = send(hSock, ByVal Data, Len(Data), 0&)
|
||||
End Function
|
||||
|
||||
' Sind Daten angekommen ?
|
||||
Public Function DataComeIn() As Long
|
||||
Dim Tmpstr As String * 1
|
||||
|
||||
DataComeIn = recv(hSock, ByVal Tmpstr, Len(Tmpstr), MSG_PEEK)
|
||||
If DataComeIn = -1 Then
|
||||
DataComeIn = WSAGetLastError()
|
||||
End If
|
||||
End Function
|
||||
|
||||
' Daten ermitteln
|
||||
Public Function GetData() As String
|
||||
Dim Tmpstr As String * 4096, Retval As Long
|
||||
|
||||
Retval = recv(hSock, 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
|
||||
|
||||
|
||||
Public Function StartWinSocket() As Long
|
||||
|
||||
Dim Retval As Long, WSD As WSAData
|
||||
|
||||
Retval = WSAStartup(&H202, WSD)
|
||||
If Retval < 0 Then
|
||||
StartWinSocket = -1
|
||||
End If
|
||||
|
||||
StartWinSocket = 0
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
Public Sub EndWinSocket()
|
||||
|
||||
Call Disconnect(hSock)
|
||||
Call WSACleanup
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
Public Function ReceiveString(length) As String
|
||||
|
||||
Dim resultString As String
|
||||
|
||||
While Len(resultString) < length
|
||||
|
||||
While DataComeIn() = 0
|
||||
DoEvents
|
||||
Wend
|
||||
|
||||
resultString = resultString + GetData()
|
||||
|
||||
Wend
|
||||
ReceiveString = resultString
|
||||
|
||||
End Function
|
||||
Reference in New Issue
Block a user