winsocksender.cls

sender file + winsock

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "WinsockSender"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private WithEvents mws As Winsock
Attribute mws.VB_VarHelpID = -1

Public Event Status(Description As String, Number As Integer)
'log requests into the buffer and send them when the connection
'is ready to send data
Private mBuffer As StringBuffer

Public Sub Initialize(IP As String, Port As Integer, Protocol As Integer)
    Set mws = Form1.Winsock2
    mws.RemoteHost = IP
    mws.RemotePort = Port
    mws.Protocol = Protocol
    Set mBuffer = New StringBuffer
    mBuffer.Initialize LILO
End Sub


Private Sub mWs_Close()
    'if the connection has closed but there is still data
    'to be sent then connect. The data will be sent in the connect event
    If mBuffer.Size Then mws.Connect
    LogStatus
End Sub

Private Sub mWs_Connect()
    'once we have connected we check the buffer and if there is data
    'to be sent, we send the data
    RaiseEvent Status("Connected to remote host", sckConnected)
    mws.SendData mBuffer.Pop
    LogStatus
End Sub

Property Get Connected() As Boolean
    Connected = mws.State = sckConnected
End Property

Private Sub mWs_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
    'if there is an error we try and force the connection closed
    LogStatus
    If mws.State Then mws.Close
    RaiseEvent Status(Description, Number)
End Sub

Public Sub SendString(Data As String)
    Dim i As Integer
    'if the connection is closed at this time then
    'open the conenction.
    'If the connection is waiting to close then
    'call the close method one more time
    
    'In the connection and close events check if there
    'are items to send in the buffer. Then if the connection is closed
    'open the connection
    
    'push data onto the stack - First in first out
    mBuffer.Push Data
    If mws.State <> sckConnected Then
        If mws.State = 9 Then mws.Close
        If mws.State = sckError Then mws.Close
        If mws.State = 0 Then mws.Connect
    Else
        'mws.SendData Data
        'PopBuffer
        mws.SendData mBuffer.Pop
        mws.Close
    End If
    
    LogStatus
    If Err.Number Then RaiseEvent Status(Err.Description, Err.Number)
End Sub

Private Sub Class_Terminate()
    If mws.State Then mws.Close
    Set mBuffer = Nothing
    Set mws = Nothing
End Sub

Private Sub mWs_SendComplete()
    'Debug.Print "Send COmplete"
    LogStatus
    If mBuffer.Size Then
        mws.SendData mBuffer.Pop
    Else
        mws.Close
    End If
    Debug.Print mBuffer.Size
End Sub


Private Sub LogStatus()
    Dim l As Long
    Dim strState As String
    Select Case mws.State
       Case sckClosed
          strState = "Closed"
       Case sckOpen
          strState = "Open"
       Case sckListening
          strState = "Listening"
       Case sckConnectionPending
          strState = "Connection pending"
       Case sckResolvingHost
          strState = "Resolving host"
       Case sckHostResolved
          strState = "Host resolved"
       Case sckConnecting
          strState = "Connecting"
       Case sckConnected
          strState = "Connected"
       Case sckClosing
          strState = "Peer is closing the connection"
       Case sckError
          strState = "Error"
    End Select

    l = FreeFile
    Open App.Path & "\Events.log" For Append As #l
    Print #l, "WinsockSender: " & strState
    Close #l
End Sub