VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CSocket"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Public SocketHandle As Long
Public State As Integer
Public LocalPort As Long
Public RemoteHost As String
Public RemotePort As Long
Public LocalRooterIP As Double

Public WindowProcOld As Long
Public WindowHandle As Long

Public UseSSL As Integer
Public ServerFrameID As Long

Event Connected()
Event Closed()
Event SendComplete()
Event DataArrival()
Event LineDataArrival(LineData As String, RemoteHostIP As String)
Event Error(Error As Long, Description As String)
Event ConnectionRequest()

Private tcpDataBuff(2047) As Byte

Private Sub Class_Initialize()
  Sockets.Add Me
  WindowProcOld = 0
  State = sockClosed
  SocketHandle = 0
  LocalPort = 0
  RemoteHost = ""
  RemotePort = 0
End Sub

Private Sub Class_Terminate()
  Dim n As Integer
  If State > 0 Then Disconnect
  For n = 1 To Sockets.Count
    If Sockets(n) Is Me Then Sockets.Remove n: Exit For
  Next
End Sub

Private Sub StartWinsock()
  WindowHandle = CreateWindowEx(0&, "static", "tst", WS_OVERLAPPEDWINDOW, 5&, 1&, 200&, 100&, 0&, 0&, App.hInstance, 0)
  
  If UsedCount = 0 Then
    Dim StartupData As WSADataType
    If WSAStartup(257, StartupData) Then
       MsgBox "Winsock is not installed or Setup properly.", vbCritical, "Winsock Error"
       End
    End If
  End If
  UsedCount = UsedCount + 1
  
  If UseSSL = 1 Then
    If UsedSSLCount = 0 Then
      On Error Resume Next
      If SSLStartup(Form1.DataPort.hwnd) = 0 Then
        MsgBox "OpenSSL is not installed or Setup properly.", vbCritical, "OpenSSL Error"
        SSLIsAvailable = False
        UseSSL = 0
      End If
      If Err.Number Then
        MsgBox "Can't load OpenSSL: " + Err.Description, vbCritical, "OpenSSL Error"
        SSLIsAvailable = False
        UseSSL = 0
      End If
      On Error GoTo 0
    End If
    UsedSSLCount = UsedSSLCount + 1
  End If
  
  WindowProcOld = SetWindowProc(WindowHandle, 0)
End Sub

Private Sub EndWinsock()
  SetWindowProc WindowHandle, WindowProcOld
  WindowProcOld = 0
  DestroyWindow WindowHandle
  
  UsedCount = UsedCount - 1
  If UsedCount = 0 Then WSACleanup

  If UseSSL = 1 Then
    UsedSSLCount = UsedSSLCount - 1
    If UsedSSLCount = 0 Then SSLCleanup
  End If
End Sub

Public Sub Connect(ByVal Host As String, ByVal Port As Long)
  Dim saZero As sockaddr
  Dim sockin As sockaddr
    
  If SocketHandle Then Disconnect
  StartWinsock
  SocketHandle = 0
  State = sockConnecting
    
  sockin = saZero
  sockin.sin_family = AF_INET
  sockin.sin_port = htons(Port)
  If sockin.sin_port = INVALID_SOCKET Then Disconnect: Exit Sub
  
  sockin.sin_addr = GetHostByNameAlias(Host)
  If sockin.sin_addr = INADDR_NONE Then Disconnect: Exit Sub
  
  SocketHandle = Socket(PF_INET, SOCK_STREAM, IPPROTO_TCP)
  If SocketHandle <= 0 Then Disconnect: Exit Sub
  
  If SetSockLinger(SocketHandle, 1, 0) = SOCKET_ERROR Then Disconnect: Exit Sub
  If WSAAsyncSelect(SocketHandle, WindowHandle, 2000&, FD_READ Or FD_WRITE Or FD_CONNECT Or FD_CLOSE) Then Disconnect: Exit Sub
  If connectsocket(SocketHandle, sockin, sockaddr_size) <> -1 Then Disconnect: Exit Sub
  If UseSSL = 1 Then
    'Verbundenen Socket an OpenSSL übergeben und SSL Verbindung aufbauen.
    'Meldungen über die Verbindung gehen über das PlugIn-Interface an dessen FrameID
    If SSLConnect(SocketHandle, ServerFrameID, 1&, Host) = 0 Then Disconnect
  End If
End Sub

Public Sub Listen()
  Dim saZero As sockaddr
  Dim sockin As sockaddr
  
  If SocketHandle Then Disconnect
  StartWinsock
  SocketHandle = 0
  RemoteHost = ""
  RemotePort = 0
  
  sockin = saZero     'zero out the structure
  sockin.sin_family = AF_INET
  sockin.sin_port = htons(LocalPort)
  If sockin.sin_port = INVALID_SOCKET Then EndWinsock: Exit Sub
  sockin.sin_addr = htonl(INADDR_ANY)
  If sockin.sin_addr = INADDR_NONE Then EndWinsock: Exit Sub
  
  SocketHandle = Socket(PF_INET, SOCK_STREAM, IPPROTO_TCP): If SocketHandle <= 0 Then Disconnect: Exit Sub
  If bind(SocketHandle, sockin, sockaddr_size) Then Disconnect: Exit Sub
  If WSAAsyncSelect(SocketHandle, WindowHandle, 2000&, FD_READ Or FD_WRITE Or FD_CLOSE Or FD_ACCEPT) Then Disconnect: Exit Sub
  If listensocket(SocketHandle, 5) Then Disconnect: Exit Sub
  
  State = sockListening
End Sub

Public Function SendData(Data As String) As Long
  If SocketHandle = 0 Then Exit Function
  If Len(Data) Then
    If UseSSL = 1 Then
      SendData = SSLSend(SocketHandle, ByVal Data, Len(Data))
    Else
      SendData = send(SocketHandle, ByVal Data, Len(Data), 0)
    End If
  End If
End Function

Public Function SendDataBin(ByteArrayPtr As Long, ByteLen As Long) As Long
  If SocketHandle = 0 Then Exit Function
  If ByteLen Then
    If UseSSL = 1 Then
      'Workaround weil SSLSendBin in die übergebene Zeichenkette schreibt:
      'Dim TempBuff As Byte
      'MemCopyRev TempBuff, ByteArrayPtr + ByteLen, 1
      SendDataBin = SSLSendBin(SocketHandle, ByteArrayPtr, ByteLen)
      'MemCopyEx ByteArrayPtr + ByteLen, TempBuff, 1
    Else
      SendDataBin = binSend(SocketHandle, ByteArrayPtr, ByteLen, 0)
    End If
  End If
End Function

Public Sub Disconnect()
  If UseSSL = 1 Then SSLDisconnect SocketHandle
  closesocket SocketHandle
  SocketHandle = 0
  State = sockClosed
  EndWinsock
End Sub
   
Public Sub Accept(Server As CSocket)
  Dim sock As sockaddr
  Dim TempSockH As Long
  
  If Not Me Is Server Then StartWinsock
  TempSockH = acceptsocket(Server.SocketHandle, sock, sockaddr_size)
    
  RemoteHost = GetPeerHostByAddr(TempSockH)
  RemotePort = GetPeerPort(TempSockH)
  If Me Is Server Then closesocket SocketHandle
  SocketHandle = TempSockH
  State = sockConnected
End Sub
   
Public Function Recive(buf As String) As Long
  Dim RecVal As Long

  If Len(buf) < 1024 Then buf = Space(1024)
  
  If UseSSL = 1 Then
    RecVal = SSLRecv(SocketHandle, ByVal buf, 1024)
  Else
    RecVal = recv(SocketHandle, ByVal buf, 1024, 0)
  End If

  If RecVal < 0 Then
    buf = ""
    RecVal = 0
  Else
    buf = Left(buf, RecVal)
  End If
  Recive = RecVal
End Function

Public Function ReciveBin(ByteArrayPtr As Long, ByteLen As Long) As Long
  Dim RecVal As Long

  If UseSSL = 1 Then
    RecVal = SSLRecvBin(SocketHandle, ByteArrayPtr, ByteLen)
  Else
    RecVal = binRecv(SocketHandle, ByteArrayPtr, ByteLen, 0)
  End If

  If RecVal < 0 Then
    ReciveBin = 0
  Else
    ReciveBin = RecVal
  End If
End Function
   
Public Sub WindowProc(WSAEvent As Long, Data As Variant)
  Dim er As String
  
  Select Case WSAEvent
    Case 0
      er = Data
      State = sockClosed
      RaiseEvent Error(0, er)
    Case FD_CLOSE
      State = sockClosed
      RaiseEvent Closed
      Disconnect
    Case FD_CONNECT
      State = sockConnected
      RemoteHost = GetPeerHostByAddr(SocketHandle)
      RemotePort = GetPeerPort(SocketHandle)
      RaiseEvent Connected
    Case FD_ACCEPT
      RaiseEvent ConnectionRequest
    Case FD_READ
      RaiseEvent DataArrival
    Case FD_WRITE
      RaiseEvent SendComplete
  End Select
End Sub
