VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "CSocket"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False

Option Explicit


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


Public SocketHandle&
Public State As sockType
Public LocalPort&
Public RemoteHost$
Public RemotePort&
Public LineSeparator$

Public SSLEnable As Boolean
Public SSLCipher$
Public SSLSubject$
Public SSLIssuer$
Public SSLServerCertificate$
Public SSLServerKey$
Public SSLTrusted As Boolean
Public SSLCAFile$

Public TimeOut As Integer '[ms]

Public WindowProcOld&
Public SSLHandle&
Public WindowHandle&
Private LineBuffer$

Public Sub Connect(ByVal host As String, ByVal Port As Long)
    If SocketHandle Then Disconnect
    StartWinsock
    
    SocketHandle = 0: SSLHandle& = 0: RemotePort& = 0
    State = sockConnecting
    SSLCipher$ = ""
    SSLSubject$ = ""
    SSLIssuer$ = ""
    SSLTrusted = False
    
    Dim sockin As sockaddr
    ClearSockAddr sockin
    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 LocalPort& > 0 Then
       Dim sockout As sockaddr
       ClearSockAddr sockout
       sockout.sin_family = AF_INET
       sockout.sin_port = htons(LocalPort&)
       If sockout.sin_port = INVALID_SOCKET Then Disconnect: Exit Sub
       If bind(SocketHandle, sockout, sockaddr_size) Then Disconnect: Exit Sub
    End If
    'If SetSockLinger(SocketHandle, 1, 0) = SOCKET_ERROR Then Disconnect: Exit Sub
    
    If Not SSLEnable Then
       If WSAAsyncSelect(SocketHandle, WindowHandle&, CSocketMsg, FD_READ Or FD_WRITE Or FD_CONNECT Or FD_CLOSE) Then Disconnect: Exit Sub
       connectsocket SocketHandle, sockin, sockaddr_size
       If TimeOut Then SetTimer WindowHandle&, SocketHandle, TimeOut, 0
    Else
       If connectsocket(SocketHandle, sockin, sockaddr_size) Then Disconnect: Exit Sub
       SSLHandle& = ssl_init_client(SocketHandle, SSLCAFile): If SSLHandle& = 0 Then Disconnect: Exit Sub
       WindowProc FD_CONNECT, 0
       If WSAAsyncSelect(SocketHandle, WindowHandle&, CSocketMsg, FD_READ Or FD_WRITE Or FD_CONNECT Or FD_CLOSE) Then Disconnect: Exit Sub
       SSLTrusted = ssl_getverify(SSLHandle&) = 0
    End If
End Sub


Public Sub Listen()
    If SocketHandle Then Disconnect
    StartWinsock
        
    SocketHandle = 0
    RemoteHost$ = ""
    RemotePort& = 0
    
    Dim sockin As sockaddr
    ClearSockAddr sockin
    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&, CSocketMsg, 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
    LocalPort& = GetLocalPort(SocketHandle)
End Sub


Public Property Get LocalIP() As String
    LocalIP = AddrToIP$(GetLocalHost(SocketHandle))
End Property


Public Function SendData(data As Variant) As Long
    SendData = 0
    If SocketHandle = 0 Then Exit Function
    
    Dim TheMsg() As Byte, sTemp$
    
    Select Case VarType(data)
        Case 8209   'byte array
           sTemp = data
           TheMsg = sTemp$
        Case 8      'string, if we recieve a string, its assumed we are in linemode
           sTemp = data
           Log "< " + sTemp$
           TheMsg = StrConv(sTemp$ + LineSeparator$, vbFromUnicode)
        Case 17 'Byte
           ReDim TheMsg(0 To 0)
           TheMsg(0) = data
        Case Else
           sTemp = CStr(data)
           TheMsg = sTemp$
    End Select
    
    If UBound(TheMsg) > -1 Then
       'Debug.Print "send"; (UBound(TheMsg) - LBound(TheMsg) + 1)
       Dim p&, l&
       p& = LBound(TheMsg)
       Do While p& <= UBound(TheMsg) And SocketHandle <> 0
          If SSLHandle& = 0 Then
             l& = send(SocketHandle, TheMsg(p&), UBound(TheMsg) - p& + 1, 0)
          Else
             l& = ssl_send(SSLHandle&, TheMsg(p&), UBound(TheMsg) - p& + 1)
          End If
          If l& > 0 Then p& = p& + l&
          If l& = 0 Then Exit Do
       Loop
    End If
End Function


Public Sub Disconnect()
    State = sockClosed
    LocalPort = 0
    If SocketHandle Then
       If SSLHandle& Then ssl_cleanup SSLHandle&: SSLHandle& = 0
       KillTimer WindowHandle&, SocketHandle
       closesocket SocketHandle
       SocketHandle = 0
    End If
    EndWinsock
End Sub


Public Sub Accept(server As CSocket)
    Dim Sock As sockaddr
    SSLEnable = server.SSLEnable
    SSLServerCertificate = server.SSLServerCertificate
    SSLServerKey = server.SSLServerKey
    
    StartWinsock
    
    SocketHandle = acceptsocket(server.SocketHandle, Sock, sockaddr_size)
    
    If SSLEnable Then
       If WSAAsyncSelect(SocketHandle, WindowHandle, 0, 0) Then Disconnect: Exit Sub
       Dim l&: l& = 0
       If ioctlsocket(SocketHandle, FIONBIO, l&) Then Disconnect: Exit Sub
       SSLHandle& = ssl_init_server(SocketHandle, SSLServerCertificate$, SSLServerKey$): If SSLHandle& <= 100 Then Disconnect: Exit Sub
       If WSAAsyncSelect(SocketHandle, WindowHandle&, CSocketMsg, FD_READ Or FD_WRITE Or FD_CLOSE Or FD_ACCEPT) Then Disconnect: Exit Sub
    End If

    '??SetSockLinger SocketHandle, 1, 0
    RemoteHost$ = GetPeerHostByAddr(SocketHandle)
    RemotePort& = GetPeerPort(SocketHandle)
    If SocketHandle Then State = sockConnected
End Sub


Public Sub SendFile(file$)
Const Block = 5000
Dim f%, l&

f% = FreeFile
Open file$ For Binary As #f%
l& = LOF(f%)
If l& >= Block Then ReDim b(0 To Block - 1) As Byte
Do While l& > 0
   DoEvents
   If l& < Block Then ReDim b(0 To l& - 1)
   Get #f%, , b
   l& = l& - Block
   SendData b
Loop
Close #f%

End Sub


Public Sub WindowProc(WSAEvent As Long, data As Variant)
    Dim er$
    
    Select Case WSAEvent
        Case 0
           er$ = data
           RaiseEvent Error(0, er$)
           Disconnect
        Case FD_CLOSE
           Log "closed " & RemoteHost$ & ":" & RemotePort&
           RaiseEvent Closed
           Disconnect
        Case FD_CONNECT
           If RemotePort& Then Exit Sub
           RemoteHost$ = GetPeerHostByAddr(SocketHandle)
           RemotePort& = GetPeerPort(SocketHandle)
           Log ""
           Log "------------------------------------------------------"
           Log "connected " & RemoteHost$ & ":" & RemotePort&
           If SSLHandle& > 0 Then
               Dim puffer As String * 1000
               ssl_getcipher SSLHandle&, puffer, 1000: SSLCipher$ = parse$(puffer, Chr$(0))
               ssl_getsubject SSLHandle&, puffer, 1000: SSLSubject$ = parse$(puffer, Chr$(0))
               ssl_getissuer SSLHandle&, puffer, 1000: SSLIssuer$ = parse$(puffer, Chr$(0))
           End If
           LocalPort& = GetLocalPort(SocketHandle)
           State = sockConnected
           RaiseEvent Connect
        Case FD_ACCEPT
           RaiseEvent ConnectionRequest
        Case FD_READ
           Dim b() As Byte
           b = data
           'Debug.Print "... " & (UBound(b) - LBound(b) + 1) & " Bytes received"
           'Debug.Print "... ";: For n% = LBound(b) To UBound(b): Debug.Print b(n);: Next: Debug.Print
           If Len(LineSeparator$) = 0 Then
              'Log "> " + StrConv(b, vbUnicode)
              RaiseEvent DataArrival(b, RemoteHost)
           Else
              Dim line$, z$
              line$ = StrConv(b, vbUnicode)
              If InStr(line$, Chr$(0)) Then line$ = Left$(line$, InStr(line$, Chr$(0)) - 1)
              LineBuffer$ = LineBuffer$ + line$
              'Debug.Print "***"; LineBuffer$; "***": For i% = 1 To Len(LineBuffer$): Debug.Print Asc(Mid$(LineBuffer$, i%, 1));: Next: Debug.Print
              Do While InStr(LineBuffer$, LineSeparator$)
                 'Log "> " + Left$(LineBuffer$, InStr(LineBuffer$, LineSeparator$) - 1)
                 z$ = Left$(LineBuffer$, InStr(LineBuffer$, LineSeparator$) - 1)
                 LineBuffer$ = Mid$(LineBuffer$, InStr(LineBuffer$, LineSeparator$) + Len(LineSeparator$))
                 RaiseEvent LineDataArrival(z$, RemoteHost)
              Loop
           End If
        Case FD_WRITE
           RaiseEvent SendComplete
    End Select
End Sub


Public Function MyIP() As String
   Dim ich$, adapter%, ip$, dnsname$, iplocal$, ipglobal$, ip0$, ip1%, ip2%, ip3%, ip4%
   
   MyIP = "": iplocal$ = "": ipglobal$ = ""
   StartWinsock
   ich$ = GetLocalHostName(): adapter% = 0
   Do
      ip$ = HostByName$(ich$, adapter%): If Len(ip$) = 0 Then Exit Do
      ip0$ = ip$: ip1% = Val(parse$(ip0$, ".")): ip2% = Val(parse$(ip0$, ".")): ip3% = Val(parse$(ip0$, ".")): ip4% = Val(ip0$)
      If (ip1% = 127 And ip2% = 0) Or (ip1% = 10) Or (ip1% = 172 And ip2% <= 16 And ip2% <= 31) Or (ip1% = 192 And ip2% = 168) Then
         iplocal$ = ip$
      Else
         ipglobal$ = ip$
      End If
      adapter% = adapter% + 1
   Loop
   If Len(ipglobal$) Then MyIP = ipglobal$ Else MyIP = iplocal$
   EndWinsock
End Function


Public Function MyName() As String
   StartWinsock
   MyName = GetLocalHostName()
   EndWinsock
End Function

'------------------------------------


Private Sub Class_Initialize()
    Sockets.Add Me
    WindowProcOld = 0
    WindowHandle& = 0
    
    State = sockClosed
    SocketHandle = 0
    LocalPort& = 0
    RemoteHost$ = ""
    RemotePort& = 0
    LineSeparator$ = ""
    SSLEnable = False
    TimeOut = 5000
End Sub

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


Private Sub StartWinsock()
    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 If
       'Debug.Print "LowVersion = "; Trim$(StartupData.wVersion), "HighVersion="; Trim$(StartupData.wHighVersion)
       'Debug.Print "Description = "; Trim$(StartupData.szDescription)
       'Debug.Print "SystemStatus = "; Trim$(StartupData.szSystemStatus)
       'Debug.Print "Maximum Sockets = "; Trim$(StartupData.iMaxSockets)
    End If
    usedcount% = usedcount% + 1
    
    WindowHandle& = CreateWindowEx(0&, "static", "tst", WS_OVERLAPPEDWINDOW, 5&, 1&, 200&, 100&, 0&, 0&, App.hInstance, ByVal 0&)
    WindowProcOld& = SetWindowProc(WindowHandle&, 0)
End Sub


Private Sub EndWinsock()
    If WindowHandle& Then
       SetWindowProc WindowHandle&, WindowProcOld&
       WindowProcOld& = 0
       DestroyWindow WindowHandle&
       WindowHandle& = 0
       
       usedcount% = usedcount% - 1: If usedcount% = 0 Then WSACleanup
    End If
End Sub


Private Sub Log(l$)
   'Dim f%
   'f% = FreeFile: Open "c:\log.txt" For Append As #f%: Print #f%, l$: Close #f%
   'Debug.Print l$
End Sub

Private Function parse$(ByRef a$, ByVal s$)
   If InStr(a$, s$) Then
      parse$ = Left$(a$, InStr(a$, s$) - 1): a$ = Mid$(a$, InStr(a$, s$) + Len(s$))
   Else
      parse$ = a$: a$ = ""
   End If
End Function