Dear Experts,
I am working on a TCP/IP project but my problem is that whenever my programme trying to reconnect again to server then server giving message port number is different.

i.e. every time my programme is run its port no showing different in server so kindly guide how can i fix a particular port number for my programme.

Regards,


pardeep

It seems that the original port was never closed. When it is still open, the following connection will open a new port.

Close the original when exiting the server.

@Pardeep3dec, please mark this thread as solved if you have managed to get a solution, found at the bottom of this page, thanks.:)

It has been open for some time now.

Exactly my programme is running on client and sending request connection continously when connection established by receiving operation session then we are receiving so many messages but after 30 seconds connection going lost. Programme should connect automatically to that server but programme is unable to connect.


pardeep

Dim strData As String, MsgID As Integer, VentID1 As Long, VentID2 As Long, ventid As Long, AlarmCode As Integer, Indx As Integer
Dim strVent As String, IPStr As String, Tsecfrom As String
Dim con As ADODB.Connection
Dim rs As ADODB.Recordset: Dim ATS_Data(30): Dim ATS_Msg(30)
Dim WinsockIP As Integer
Dim TSec As Date
Dim First As Boolean
Dim LStore As Boolean 'ready for getting value from CAT server
Dim GrpATSMsg As OPCGroup
Dim GrpATSMsgData As OPCGroup
Dim ShATS() As Long: Dim ers() As Long
Dim ShATSMsg() As Long
Dim CH() As Long
Dim TagStr(30) As String
Dim s As String
Dim srv As OPCServer
Private Declare Sub Sleep Lib "kernel32" (ByVal dwmilliseconds As Long)


Private Sub cmdConnect_Click()


While Winsock1.State <> 0 'And Winsock2.State <> 0 And Winsock3.State <> 0 And Winsock4.State <> 0
Winsock1.Close
'Winsock2.Close
'Winsock3.Close
'Winsock4.Close
Wend
While Winsock1.State = 0 'And Winsock2.State = 0 And Winsock3.State = 0 And Winsock4.State = 0
Winsock1.RemoteHost = "172.18.20.15"
Winsock1.RemotePort = 4600
Winsock1.LocalPort = 4663
Winsock1.Connect

''Winsock2.RemoteHost = "172.19.20.15" 'Change this to your host IP
''Winsock2.RemotePort = 4601
''Winsock2.LocalPort = 4664
''Winsock2.Connect

''Winsock3.RemoteHost = "172.18.20.16" 'Change this to your host IP
''Winsock3.RemotePort = 4600
''Winsock3.LocalPort = 4665
''Winsock3.Connect

''Winsock4.RemoteHost = "172.19.20.16" 'Change this to your host IP
''Winsock4.RemotePort = 4601
''Winsock4.LocalPort = 2300
''Winsock4.Connect
Wend


End Sub

Private Sub cmdSend_Click()
'On erro GoTo tmp
If Winsock1.State <> sckConnected Then 'And Winsock2.State <> sckConnected And Winsock3.State <> sckConnected And Winsock4.State <> sckConnected
cmdConnect_Click 'automatic trigger for CmdSend from CmdConnect
Else
Dim strRequestConnection As String
strRequestConnection = Chr(11) & Chr(2)
TSec = Now()
If Winsock1.State = sckConnected Then
Winsock1.SendData strRequestConnection
Debug.Print "Message Request Connection Sended"
End If
' If Winsock2.State = sckConnected Then
' Winsock2.SendData strRequestConnection
' End If
'
' If Winsock3.State = sckConnected Then
' Winsock3.SendData strRequestConnection
' End If
' If Winsock4.State = sckConnected Then
' Winsock4.SendData strRequestConnection
' End If

Timer1.Enabled = True
End If
'Debug.Print Winsock1.State
'Debug.Print Winsock2.State
'Debug.Print Winsock3.State
'Debug.Print Winsock4.State

'tmp:
'Debug.Print "Error : " & Err.Number

End Sub

Private Sub Form_Click()
'Dim s11 As String
's11 = Text1.Text & Text2.Text & Text3.Text
'GrpATSMsgData.OPCItems(28).Write (Val(s11))

End Sub

Private Sub Form_Load()

Set srv = New OPCServer
srv.Connect "RSLinx OPC Server"
Set GrpATSMsg = srv.OPCGroups.Add("ATS")
Set GrpATSMsgData = srv.OPCGroups.Add("ATSData")

'GrpATSMsg.OPCItems.AddItem "[ATS]ATS_Data[0]", 1 '772
'GrpATSMsg.OPCItems.AddItem "[ATS]ATS_Data[1]", 2 '772
'GrpATSMsg.OPCItems.AddItem "[ATS]ATS_Data[2]", 3 '772
'GrpATSMsg.OPCItems.AddItem "[ATS]ATS_Data[3]", 4 '771
'GrpATSMsg.OPCItems.AddItem "[ATS]ATS_Data[4]", 5 '771
'GrpATSMsg.OPCItems.AddItem "[ATS]ATS_Data[5]", 6 '771
'GrpATSMsg.OPCItems.AddItem "[ATS]ATS_Data[6]", 7 '761
'GrpATSMsg.OPCItems.AddItem "[ATS]ATS_Data[7]", 8 '761
'GrpATSMsg.OPCItems.AddItem "[ATS]ATS_Data[8]", 9 '761
'GrpATSMsg.OPCItems.AddItem "[ATS]ATS_Data[9]", 10 '751
'GrpATSMsg.OPCItems.AddItem "[ATS]ATS_Data[10]", 11 '751
'GrpATSMsg.OPCItems.AddItem "[ATS]ATS_Data[11]", 12 '751
'GrpATSMsg.OPCItems.AddItem "[ATS]ATS_Data[12]", 13 '741
'GrpATSMsg.OPCItems.AddItem "[ATS]ATS_Data[13]", 14 '741
'GrpATSMsg.OPCItems.AddItem "[ATS]ATS_Data[14]", 15 '741
'GrpATSMsg.OPCItems.AddItem "[ATS]ATS_Data[15]", 16 '781
'GrpATSMsg.OPCItems.AddItem "[ATS]ATS_Data[16]", 17 '781
'GrpATSMsg.OPCItems.AddItem "[ATS]ATS_Data[17]", 18 '781
'GrpATSMsg.OPCItems.AddItem "[ATS]ATS_Data[18]", 19 '782
'GrpATSMsg.OPCItems.AddItem "[ATS]ATS_Data[19]", 20 '782
'GrpATSMsg.OPCItems.AddItem "[ATS]ATS_Data[20]", 21 '782
'GrpATSMsg.OPCItems.AddItem "[ATS]ATS_Data[21]", 22 '773
'GrpATSMsg.OPCItems.AddItem "[ATS]ATS_Data[22]", 23 '773
'GrpATSMsg.OPCItems.AddItem "[ATS]ATS_Data[23]", 24 '773
'GrpATSMsg.OPCItems.AddItem "[ATS]ATS_Data[24]", 25 '762
'GrpATSMsg.OPCItems.AddItem "[ATS]ATS_Data[25]", 26 '762
'GrpATSMsg.OPCItems.AddItem "[ATS]ATS_Data[26]", 27 '762
'GrpATSMsg.OPCItems.AddItem "[ATS]ATS_Data[27]", 28 '752
'GrpATSMsg.OPCItems.AddItem "[ATS]ATS_Data[28]", 29 '752
'GrpATSMsg.OPCItems.AddItem "[ATS]ATS_Data[29]", 30 '752
'GrpATSMsg.IsSubscribed = True

ReDim CH(30)
For i = 1 To 30
TagStr(i) = "[ATS]ATS_Data[" & i - 1 & "]"
CH(i) = i
ATS_Data(i) = 0: ATS_Msg(i) = 0
Next
GrpATSMsg.OPCItems.AddItems 30, TagStr, CH, ShATS, ers

'GrpATSMsgData.OPCItems.AddItem "[ATS]ATS_Array.msg[0]", 1 '772
'GrpATSMsgData.OPCItems.AddItem "[ATS]ATS_Array.msg[1]", 2 '772
'GrpATSMsgData.OPCItems.AddItem "[ATS]ATS_Array.msg[2]", 3 '772
'GrpATSMsgData.OPCItems.AddItem "[ATS]ATS_Array.msg[3]", 4 '771
'GrpATSMsgData.OPCItems.AddItem "[ATS]ATS_Array.msg[4]", 5 '771
'GrpATSMsgData.OPCItems.AddItem "[ATS]ATS_Array.msg[5]", 6 '771
'GrpATSMsgData.OPCItems.AddItem "[ATS]ATS_Array.msg[6]", 7 '761
'GrpATSMsgData.OPCItems.AddItem "[ATS]ATS_Array.msg[7]", 8 '761
'GrpATSMsgData.OPCItems.AddItem "[ATS]ATS_Array.msg[8]", 9 '761
'GrpATSMsgData.OPCItems.AddItem "[ATS]ATS_Array.msg[9]", 10 '751
'GrpATSMsgData.OPCItems.AddItem "[ATS]ATS_Array.msg[10]", 11 '751
'GrpATSMsgData.OPCItems.AddItem "[ATS]ATS_Array.msg[11]", 12 '751
'GrpATSMsgData.OPCItems.AddItem "[ATS]ATS_Array.msg[12]", 13 '741
'GrpATSMsgData.OPCItems.AddItem "[ATS]ATS_Array.msg[13]", 14 '741
'GrpATSMsgData.OPCItems.AddItem "[ATS]ATS_Array.msg[14]", 15 '741
'GrpATSMsgData.OPCItems.AddItem "[ATS]ATS_Array.msg[15]", 16 '781
'GrpATSMsgData.OPCItems.AddItem "[ATS]ATS_Array.msg[16]", 17 '781
'GrpATSMsgData.OPCItems.AddItem "[ATS]ATS_Array.msg[17]", 18 '781
'GrpATSMsgData.OPCItems.AddItem "[ATS]ATS_Array.msg[18]", 19 '782
'GrpATSMsgData.OPCItems.AddItem "[ATS]ATS_Array.msg[19]", 20 '782
'GrpATSMsgData.OPCItems.AddItem "[ATS]ATS_Array.msg[20]", 21 '782
'GrpATSMsgData.OPCItems.AddItem "[ATS]ATS_Array.msg[21]", 22 '773
'GrpATSMsgData.OPCItems.AddItem "[ATS]ATS_Array.msg[22]", 23 '773
'GrpATSMsgData.OPCItems.AddItem "[ATS]ATS_Array.msg[23]", 24 '773
'GrpATSMsgData.OPCItems.AddItem "[ATS]ATS_Array.msg[24]", 25 '762
'GrpATSMsgData.OPCItems.AddItem "[ATS]ATS_Array.msg[25]", 26 '762
'GrpATSMsgData.OPCItems.AddItem "[ATS]ATS_Array.msg[26]", 27 '762
'GrpATSMsgData.OPCItems.AddItem "[ATS]ATS_Array.msg[27]", 28 '752
'GrpATSMsgData.OPCItems.AddItem "[ATS]ATS_Array.msg[28]", 29 '752
'GrpATSMsgData.OPCItems.AddItem "[ATS]ATS_Array.msg[29]", 30 '752
ReDim CH(30)
For i = 1 To 30
TagStr(i) = "[ATS]ATS_Array.msg[" & i - 1 & "]"
CH(i) = i
Next
GrpATSMsgData.OPCItems.AddItems 30, TagStr, CH, ShATSMsg, ers

GrpATSMsgData.OPCItems.AddItem "[ATS]ATS_Array.Active_IP", 31 '
GrpATSMsgData.OPCItems.AddItem "[ATS]ATS_Array.Operation_Session", 32 '
GrpATSMsgData.IsSubscribed = True


GrpATSMsgData.OPCItems(31).Write (0)
GrpATSMsgData.OPCItems(32).Write (0)

Set con = New ADODB.Connection
con.ConnectionString = "provider=sqloledb.1;integrated security=sspi;persist security info=false;initial catalog=ATSMessages;Data Source=Dataserver"
con.Open
First = True
LStore = False
Tsecfrom = "NOATS"
End Sub

Private Sub Timer1_Timer()
If First = True Then
cmdSend_Click
Else
Select Case Tsecfrom
Case "OATS"
If DateDiff("s", TSec, Now()) = 31 Then
Timer2.Enabled = False
GrpATSMsgData.OPCItems(31).Write (0)
GrpATSMsgData.OPCItems(32).Write (0)
cmdConnect_Click
First = True
LStore = False
Sleep (15000)
cmdSend_Click
Tsecfrom = "NOATS"
End If

Case "NOATS"
If DateDiff("s", TSec, Now()) = 11 Then
GrpATSMsgData.OPCItems(32).Write (0)
WithinGrace
TSec = Now()
Tsecfrom = "OATS"
End If
End Select

First = False
End If
Debug.Print Second(Now())
Debug.Print Winsock1.State
Debug.Print Winsock2.State
Debug.Print Winsock3.State
Debug.Print Winsock4.State

End Sub

Public Sub WithinGrace()
Select Case WinsockIP
Case 1
If Winsock1.State <> 7 Then

If Winsock1.State <> 2 Then
While Winsock1.State <> sckClosed '
Winsock1.Close '
'If LStore = False Then Exit loop '
Wend
Winsock1.Connect
End If
' Sleep (15000)
' cmdSend_Click
End If

Case 2
If Winsock2.State <> 7 Then
If Winsock2.State <> 2 Then
While Winsock2.State <> sckClosed '
Winsock2.Close '
'If LStore = False Then Exit Do '
Wend

Winsock2.Connect
End If
' cmdSend_Click
End If
Case 3
If Winsock3.State <> 7 Then
If Winsock3.State <> 2 Then

While Winsock3.State <> sckClosed '
Winsock3.Close '
'If LStore = False Then Exit Do '
Wend

Winsock3.Connect
End If
' cmdSend_Click
End If
Case 4
If Winsock4.State <> 7 Then
If Winsock1.State <> 2 Then

While Winsock4.State <> sckClosed '
Winsock4.Close '
' If LStore = False Then Exit Do '
Wend

Winsock4.Connect
End If
' cmdSend_Click
End If
End Select

End Sub

Public Function WithinGraceDisc()
Select Case WinsockIP
Case 1
If Winsock1.State <> 7 Then
Winsock1.Connect
Winsock2.Connect
Winsock3.Connect
Winsock4.Connect
First = True
LStore = False
cmdSend_Click
End If
Case 2
If Winsock2.State <> 7 Then
Winsock1.Connect
Winsock2.Connect
Winsock3.Connect
Winsock4.Connect
First = True
LStore = False
cmdSend_Click
End If
Case 3
If Winsock3.State <> 7 Then
Winsock1.Connect
Winsock2.Connect
Winsock3.Connect
Winsock4.Connect
First = True
LStore = False
cmdSend_Click
End If
Case 4
If Winsock4.State <> 7 Then
Winsock1.Connect
Winsock2.Connect
Winsock3.Connect
Winsock4.Connect
First = True
LStore = False
cmdSend_Click
End If
End Select
End Function

Private Sub Timer2_Timer()
WithinGrace
End Sub

Private Sub Winsock1_Connect()
Debug.Print "connect 1"
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
'On Error GoTo tmp
Debug.Print "172.18.20.15"
Debug.Print bytesTotal
WinsockIP = 1
IPStr = "172.18.20.15/" + CStr(bytesTotal)
If bytesTotal > 5 Then Exit Sub 'ByteStrm (bytesTotal)

Winsock1.GetData strData, vbString
MsgID = Asc(Mid(strData, 2, 1))

If MsgID = 1 Then
''While Winsock2.State <> 0 And Winsock3.State <> 0 And Winsock4.State <> 0
Winsock2.Close
Winsock3.Close
Winsock4.Close
''If LStore = False Then Exit Do
''Wend
GrpATSMsgData.OPCItems(31).Write (1)
GrpATSMsgData.OPCItems(32).Write (1)
LStore = True
Tsecfrom = "OATS" 'operation ATS Session
TSec = Now()
First = False
Timer2.Enabled = True
End If


If bytesTotal = 5 And LStore = True Then
VentID1 = Asc(Mid(strData, 3, 1))

VentID2 = Asc(Mid(strData, 4, 1))

AlarmCode = Asc(Mid(strData, 5, 1))
Debug.Print "MsgID"
Debug.Print MsgID
Debug.Print "ventID1"
Debug.Print VentID1
Debug.Print "VentID2"
Debug.Print VentID2
DecToBin VentID1, VentID2
Debug.Print AlarmCode
Debug.Print "bintodeci"
Debug.Print strVent
Tsecfrom = "NOATS"
TSec = Now()
s = MsgID & strVent & AlarmCode
Indx = StrventIndex(strVent)
Call tmp(MsgID, AlarmCode, Indx)
Msglog
End If

End Sub
Private Sub Winsock2_DataArrival(ByVal bytesTotal As Long)
'On erro GoTo tmp
Debug.Print "172.19.20.15"
Debug.Print bytesTotal
WinsockIP = 2
IPStr = "172.19.20.15/" + CStr(bytesTotal)
If bytesTotal > 5 Then Exit Sub

Winsock2.GetData strData, vbString
MsgID = Asc(Mid(strData, 2, 1))

If MsgID = 1 Then
Winsock1.Close
Winsock3.Close
Winsock4.Close

GrpATSMsgData.OPCItems(31).Write (2)
GrpATSMsgData.OPCItems(32).Write (1)
LStore = True
Tsecfrom = "OATS" 'operation ATS Session
TSec = Now()
End If


If bytesTotal = 5 And LStore = True Then
VentID1 = Asc(Mid(strData, 3, 1))

VentID2 = Asc(Mid(strData, 4, 1))

AlarmCode = Asc(Mid(strData, 5, 1))
Debug.Print "MsgID"
Debug.Print MsgID
Debug.Print "ventID1"
Debug.Print VentID1
Debug.Print "VentID2"
Debug.Print VentID2
DecToBin VentID1, VentID2
Debug.Print AlarmCode
Debug.Print "bintodeci"
Debug.Print strVent
Tsecfrom = "NOATS"
TSec = Now()
s = MsgID & strVent & AlarmCode
Indx = StrventIndex(strVent)
Call tmp(MsgID, AlarmCode, Indx)
Msglog
End If

First = False


End Sub
Private Sub Winsock3_DataArrival(ByVal bytesTotal As Long)
'On Error GoTo tmp
Debug.Print "172.18.20.16"
Debug.Print bytesTotal
WinsockIP = 3
IPStr = "172.18.20.16/" + CStr(bytesTotal)
If bytesTotal > 5 Then Exit Sub

Winsock3.GetData strData, vbString
MsgID = Asc(Mid(strData, 2, 1))

If MsgID = 1 Then
Winsock2.Close
Winsock1.Close
Winsock4.Close
GrpATSMsgData.OPCItems(31).Write (3)
GrpATSMsgData.OPCItems(32).Write (1)

LStore = True
Tsecfrom = "OATS" 'operation ATS Session
TSec = Now()
End If


If bytesTotal = 5 And LStore = True Then
VentID1 = Asc(Mid(strData, 3, 1))

VentID2 = Asc(Mid(strData, 4, 1))

AlarmCode = Asc(Mid(strData, 5, 1))
Debug.Print "MsgID"
Debug.Print MsgID
Debug.Print "ventID1"
Debug.Print VentID1
Debug.Print "VentID2"
Debug.Print VentID2
DecToBin VentID1, VentID2
Debug.Print AlarmCode
Debug.Print "bintodeci"
Debug.Print strVent
Tsecfrom = "NOATS"
TSec = Now()
s = MsgID & strVent & AlarmCode
Indx = StrventIndex(strVent)
Call tmp(MsgID, AlarmCode, Indx)
Msglog
End If

First = False
End Sub
Private Sub Winsock4_DataArrival(ByVal bytesTotal As Long)
'On Error GoTo tmp
Debug.Print "172.19.20.16"
Debug.Print bytesTotal
WinsockIP = 4
IPStr = "172.19.20.16/" + CStr(bytesTotal)
If bytesTotal > 5 Then Exit Sub

Winsock4.GetData strData, vbString
MsgID = Asc(Mid(strData, 2, 1))

If MsgID = 1 Then
Winsock2.Close
Winsock3.Close
Winsock1.Close
GrpATSMsgData.OPCItems(31).Write (4)
GrpATSMsgData.OPCItems(32).Write (1)

LStore = True
Tsecfrom = "OATS" 'operation ATS Session
TSec = Now()
End If


If bytesTotal = 5 And LStore = True Then
VentID1 = Asc(Mid(strData, 3, 1))

VentID2 = Asc(Mid(strData, 4, 1))

AlarmCode = Asc(Mid(strData, 5, 1))
Debug.Print "MsgID"
Debug.Print MsgID
Debug.Print "ventID1"
Debug.Print VentID1
Debug.Print "VentID2"
Debug.Print VentID2
DecToBin VentID1, VentID2
Debug.Print AlarmCode
Debug.Print "bintodeci"
Debug.Print strVent
Tsecfrom = "NOATS"
TSec = Now()
s = MsgID & strVent & AlarmCode
Indx = StrventIndex(strVent)
Call tmp(MsgID, AlarmCode, Indx)
Msglog
End If

First = False
End Sub


Public Function Msglog()

con.Execute ("insert into rawmsges values('" & Now() & "',' " & s & " ','" & IPStr & "' )")

End Function
Public Function DecToBin(DeciValue1 As Long, DeciValue2 As Long)

Dim i As Integer, NoOfBits As Integer, curBin1(8) As Integer, curBin2(8) As Integer

NoOfBits = 8

'Do While DeciValue1 > (2 ^ NoOfBits) - 1
'NoOfBits = NoOfBits + 8
'Loop
DecToBin = vbNullString


For i = 0 To 7
DecToBin = CStr((DeciValue1 And 2 ^ i) / 2 ^ i) & DecToBin
curBin1(i) = (DeciValue1 And 2 ^ i) / 2 ^ i
Next i

For i = 0 To 7
DecToBin = CStr((DeciValue2 And 2 ^ i) / 2 ^ i) & DecToBin
curBin2(i) = (DeciValue2 And 2 ^ i) / 2 ^ i
Next i

strVent = curBin1(0) * 1 + curBin1(1) * 2 + curBin1(2) * 4 + curBin1(3) * 8
strVent = strVent & CStr(curBin2(4) * 1 + curBin2(5) * 2 + curBin2(6) * 4 + curBin2(7) * 8)
strVent = strVent & CStr(curBin2(0) * 1 + curBin2(1) * 2 + curBin2(2) * 4 + curBin2(3) * 8)


End Function

Private Sub Winsock1_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)
Debug.Print "error from 172.18.20.15"
Debug.Print Scode
Debug.Print Source
Debug.Print Description
End Sub

Private Sub Winsock1_SendComplete()
Debug.Print "ip 1"
End Sub

Private Sub Winsock1_SendProgress(ByVal bytesSent As Long, ByVal bytesRemaining As Long)
Debug.Print "data send to 2"
Debug.Print bytesSent
Debug.Print "data Remai to 2"
Debug.Print bytesRemaining

End Sub

Private Sub Winsock2_Connect()
Debug.Print "connect 2"
End Sub


Private Sub Winsock2_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)
Debug.Print "error from 2"
Debug.Print Scode
Debug.Print Source
Debug.Print Description
End Sub

Private Sub Winsock2_SendComplete()
Debug.Print "ip 2"
End Sub

Private Sub Winsock2_SendProgress(ByVal bytesSent As Long, ByVal bytesRemaining As Long)
Debug.Print "data send to 2"
Debug.Print bytesSent
Debug.Print "data Remai to 2"
Debug.Print bytesRemaining
End Sub

Private Sub Winsock3_Connect()
Debug.Print "connect 3"
End Sub


Private Sub Winsock3_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)
Debug.Print "error from 3"
Debug.Print Scode
Debug.Print Source
Debug.Print Description

End Sub

Private Sub Winsock3_SendComplete()
Debug.Print "ip 3"
End Sub

Private Sub Winsock3_SendProgress(ByVal bytesSent As Long, ByVal bytesRemaining As Long)
Debug.Print "data send to 3"
Debug.Print bytesSent
Debug.Print "data Remai to 3"
Debug.Print bytesRemaining
End Sub

Private Sub Winsock4_Connect()
Debug.Print "connect 4"
End Sub


Private Sub Winsock4_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)
Debug.Print "error from 4"
Debug.Print Scode
Debug.Print Source
Debug.Print Description

End Sub

Private Sub Winsock4_SendComplete()
Debug.Print "ip 4"
End Sub

Private Sub Winsock4_SendProgress(ByVal bytesSent As Long, ByVal bytesRemaining As Long)
Debug.Print "data send to 4"
Debug.Print bytesSent
Debug.Print "data Remai to 4"
Debug.Print bytesRemaining

End Sub

Public Sub tmp(ByRef MsgID As Integer, ByRef AlarmCode As Integer, ByVal Indx As Integer)
' 772 771 761 751 741 781 782 773 762 752"

If MsgID = 2 Then
If AlarmCode = 1 Then GrpATSMsg.OPCItems(Indx).Write (Val(s)) Else: GrpATSMsg.OPCItems(Indx).Write (Val(s))
ElseIf MsgID = 3 Then
If AlarmCode = 1 Then GrpATSMsg.OPCItems(Indx + 1).Write (Val(s)) Else: GrpATSMsg.OPCItems(Indx + 1).Write (Val(s))
ElseIf MsgID = 4 Then
If AlarmCode = 2 Then GrpATSMsg.OPCItems(Indx + 2).Write (Val(s)) Else: GrpATSMsg.OPCItems(Indx + 2).Write (Val(s))
End If

' If MsgID = 2 Then
' If AlarmCode = 1 Then GrpATSMsgData.OPCItems(Indx).Write (Val(s)) Else: GrpATSMsgData.OPCItems(Indx).Write (Val(s))
' ElseIf MsgID = 3 Then
' If AlarmCode = 1 Then GrpATSMsgData.OPCItems(Indx + 1).Write (Val(s)) Else: GrpATSMsgData.OPCItems(Indx + 1).Write (Val(s))
' ElseIf MsgID = 4 Then
' If AlarmCode = 2 Then GrpATSMsgData.OPCItems(Indx + 2).Write (Val(s)) Else: GrpATSMsgData.OPCItems(Indx + 2).Write (Val(s))
' End If


'Select Case Val(strVent)
'
' Case 772
' If MsgID = 2 Then
' If AlarmCode = 1 Then ATS_Data(1) = 1 Else: ATS_Data(1) = 0
' ElseIf MsgID = 3 Then
' If AlarmCode = 1 Then ATS_Data(2) = 1 Else: ATS_Data(2) = 0
' ElseIf MsgID = 4 Then
' If AlarmCode = 2 Then ATS_Data(3) = 1 Else: ATS_Data(3) = 0
' End If
'
' If MsgID = 2 Then
' If AlarmCode = 1 Then ATS_Msg(1) = Val(s) Else: ATS_Msg(1) = Val(s)
' ElseIf MsgID = 3 Then
' If AlarmCode = 1 Then ATS_Msg(2) = Val(s) Else: ATS_Msg(2) = Val(s)
' ElseIf MsgID = 4 Then
' If AlarmCode = 2 Then ATS_Msg(3) = Val(s) Else: ATS_Msg(3) = Val(s)
' End If
'
' Case 771
' If MsgID = 2 Then
' If AlarmCode = 1 Then ATS_Data(4) = 1 Else: ATS_Data(4) = 0
' ElseIf MsgID = 3 Then
' If AlarmCode = 1 Then ATS_Data(5) = 1 Else: ATS_Data(5) = 0
' ElseIf MsgID = 4 Then
' If AlarmCode = 2 Then ATS_Data(6) = 1 Else: ATS_Data(6) = 0
' End If
'
' If MsgID = 2 Then
' If AlarmCode = 1 Then ATS_Msg(4) = Val(s) Else: ATS_Msg(4) = Val(s)
' ElseIf MsgID = 3 Then
' If AlarmCode = 1 Then ATS_Msg(5) = Val(s) Else: ATS_Msg(5) = Val(s)
' ElseIf MsgID = 4 Then
' If AlarmCode = 2 Then ATS_Msg(6) = Val(s) Else: ATS_Msg(6) = Val(s)
' End If
'
' Case 761
' If MsgID = 2 Then
' If AlarmCode = 1 Then ATS_Data(7) = 1 Else: ATS_Data(7) = 0
' ElseIf MsgID = 3 Then
' If AlarmCode = 1 Then ATS_Data(8) = 1 Else: ATS_Data(8) = 0
' ElseIf MsgID = 4 Then
' If AlarmCode = 2 Then ATS_Data(9) = 1 Else: ATS_Data(9) = 0
' End If
'
' If MsgID = 2 Then
' If AlarmCode = 1 Then ATS_Msg(7) = Val(s) Else: ATS_Msg(7) = Val(s)
' ElseIf MsgID = 3 Then
' If AlarmCode = 1 Then ATS_Msg(8) = Val(s) Else: ATS_Msg(8) = Val(s)
' ElseIf MsgID = 4 Then
' If AlarmCode = 2 Then ATS_Msg(9) = Val(s) Else: ATS_Msg(9) = Val(s)
' End If
'
' Case 751
' If MsgID = 2 Then
' If AlarmCode = 1 Then ATS_Data(10) = 1 Else: ATS_Data(10) = 0
' ElseIf MsgID = 3 Then
' If AlarmCode = 1 Then ATS_Data(11) = 1 Else: ATS_Data(11) = 0
' ElseIf MsgID = 4 Then
' If AlarmCode = 2 Then ATS_Data(12) = 1 Else: ATS_Data(12) = 0
' End If
'
' If MsgID = 2 Then
' If AlarmCode = 1 Then ATS_Msg(10) = Val(s) Else: ATS_Msg(10) = Val(s)
' ElseIf MsgID = 3 Then
' If AlarmCode = 1 Then ATS_Msg(11) = Val(s) Else: ATS_Msg(11) = Val(s)
' ElseIf MsgID = 4 Then
' If AlarmCode = 2 Then ATS_Msg(12) = Val(s) Else: ATS_Msg(12) = Val(s)
' End If
'
' Case 741
' If MsgID = 2 Then
' If AlarmCode = 1 Then ATS_Data(13) = 1 Else: ATS_Data(13) = 0
' ElseIf MsgID = 3 Then
' If AlarmCode = 1 Then ATS_Data(14) = 1 Else: ATS_Data(14) = 0
' ElseIf MsgID = 4 Then
' If AlarmCode = 2 Then ATS_Data(15) = 1 Else: ATS_Data(15) = 0
' End If
'
' If MsgID = 2 Then
' If AlarmCode = 1 Then ATS_Msg(13) = Val(s) Else: ATS_Msg(13) = Val(s)
' ElseIf MsgID = 3 Then
' If AlarmCode = 1 Then ATS_Msg(14) = Val(s) Else: ATS_Msg(14) = Val(s)
' ElseIf MsgID = 4 Then
' If AlarmCode = 2 Then ATS_Msg(15) = Val(s) Else: ATS_Msg(15) = Val(s)
' End If
'
' Case 781
' If MsgID = 2 Then
' If AlarmCode = 1 Then ATS_Data(16) = 1 Else: ATS_Data(16) = 0
' ElseIf MsgID = 3 Then
' If AlarmCode = 1 Then ATS_Data(17) = 1 Else: ATS_Data(17) = 0
' ElseIf MsgID = 4 Then
' If AlarmCode = 2 Then ATS_Data(18) = 1 Else: ATS_Data(18) = 0
' End If
'
' If MsgID = 2 Then
' If AlarmCode = 1 Then ATS_Msg(16) = Val(s) Else: ATS_Msg(16) = Val(s)
' ElseIf MsgID = 3 Then
' If AlarmCode = 1 Then ATS_Msg(17) = Val(s) Else: ATS_Msg(17) = Val(s)
' ElseIf MsgID = 4 Then
' If AlarmCode = 2 Then ATS_Msg(18) = Val(s) Else: ATS_Msg(18) = Val(s)
' End If
'
' Case 782
' If MsgID = 2 Then
' If AlarmCode = 1 Then ATS_Data(19) = 1 Else: ATS_Data(19) = 0
' ElseIf MsgID = 3 Then
' If AlarmCode = 1 Then ATS_Data(20) = 1 Else: ATS_Data(20) = 0
' ElseIf MsgID = 4 Then
' If AlarmCode = 2 Then ATS_Data(21) = 1 Else: ATS_Data(21) = 0
' End If
'
' If MsgID = 2 Then
' If AlarmCode = 1 Then ATS_Msg(19) = Val(s) Else: ATS_Msg(19) = Val(s)
' ElseIf MsgID = 3 Then
' If AlarmCode = 1 Then ATS_Msg(20) = Val(s) Else: ATS_Msg(20) = Val(s)
' ElseIf MsgID = 4 Then
' If AlarmCode = 2 Then ATS_Msg(21) = Val(s) Else: ATS_Msg(21) = Val(s)
' End If
'
' Case 773
' If MsgID = 2 Then
' If AlarmCode = 1 Then ATS_Data(22) = 1 Else: ATS_Data(22) = 0
' ElseIf MsgID = 3 Then
' If AlarmCode = 1 Then ATS_Data(23) = 1 Else: ATS_Data(23) = 0
' ElseIf MsgID = 4 Then
' If AlarmCode = 2 Then ATS_Data(24) = 1 Else: ATS_Data(24) = 0
' End If
'
' If MsgID = 2 Then
' If AlarmCode = 1 Then ATS_Msg(22) = Val(s) Else: ATS_Msg(22) = Val(s)
' ElseIf MsgID = 3 Then
' If AlarmCode = 1 Then ATS_Msg(23) = Val(s) Else: ATS_Msg(23) = Val(s)
' ElseIf MsgID = 4 Then
' If AlarmCode = 2 Then ATS_Msg(24) = Val(s) Else: ATS_Msg(24) = Val(s)
' End If
'
' Case 762
' If MsgID = 2 Then
' If AlarmCode = 1 Then ATS_Data(25) = 1 Else: ATS_Data(25) = 0
' ElseIf MsgID = 3 Then
' If AlarmCode = 1 Then ATS_Data(26) = 1 Else: ATS_Data(26) = 0
' ElseIf MsgID = 4 Then
' If AlarmCode = 2 Then ATS_Data(27) = 1 Else: ATS_Data(27) = 0
' End If
'
' If MsgID = 2 Then
' If AlarmCode = 1 Then ATS_Msg(25) = Val(s) Else: ATS_Msg(25) = Val(s)
' ElseIf MsgID = 3 Then
' If AlarmCode = 1 Then ATS_Msg(26) = Val(s) Else: ATS_Msg(26) = Val(s)
' ElseIf MsgID = 4 Then
' If AlarmCode = 2 Then ATS_Msg(27) = Val(s) Else: ATS_Msg(27) = Val(s)
' End If
'
' Case 752
' If MsgID = 2 Then
' If AlarmCode = 1 Then ATS_Data(28) = 1 Else: ATS_Data(28) = 0
' ElseIf MsgID = 3 Then
' If AlarmCode = 1 Then ATS_Data(29) = 1 Else: ATS_Data(29) = 0
' ElseIf MsgID = 4 Then
' If AlarmCode = 2 Then ATS_Data(30) = 1 Else: ATS_Data(30) = 0
' End If
'
' If MsgID = 2 Then
' If AlarmCode = 1 Then ATS_Msg(28) = Val(s) Else: ATS_Msg(28) = Val(s)
' ElseIf MsgID = 3 Then
' If AlarmCode = 1 Then ATS_Msg(29) = Val(s) Else: ATS_Msg(29) = Val(s)
' ElseIf MsgID = 4 Then
' If AlarmCode = 2 Then ATS_Msg(30) = Val(s) Else: ATS_Msg(30) = Val(s)
' End If
'
'End Select

'GrpATSMsg.SyncWrite 30, ShATS, ATS_Data, ers
'GrpATSMsgData.SyncWrite 30, ShATSMsg, ATS_Msg, ers

End Sub

Public Function StrventIndex(strVent As String) As Integer
'772 771 761 751 741 781 782 773 762 752"

Select Case Val(strVent)
Case 772
StrventIndex = 1
Case 771
StrventIndex = 4
Case 761
StrventIndex = 7
Case 751
StrventIndex = 10
Case 741
StrventIndex = 13
Case 781
StrventIndex = 16
Case 782
StrventIndex = 19
Case 773
StrventIndex = 22
Case 762
StrventIndex = 25
Case 752
StrventIndex = 28
End Select
End Function


Public Sub ByteStrm(strData As Long)
Dim StrLength As Integer
Dim StreamData As Integer
StrLength = Len(strData)
If Asc(Mid(strData, 2, 1)) = 1 Then
StreamData = 4
While StreamData <= StrLength
MsgID = Asc(Mid(strData, StreamData, 1))

VentID1 = Asc(Mid(strData, StreamData + 1, 1))

VentID2 = Asc(Mid(strData, StreamData + 2, 1))

AlarmCode = Asc(Mid(strData, StreamData + 3, 1))
s = MsgID & strVent & AlarmCode
Indx = StrventIndex(strVent)
Call tmp(MsgID, AlarmCode, Indx)
Msglog
StreamData = StreamData + 5
Wend

Else
StreamData = 2
While StreamData <= StrLength
MsgID = Asc(Mid(strData, StreamData, 1))

VentID1 = Asc(Mid(strData, StreamData + 1, 1))

VentID2 = Asc(Mid(strData, StreamData + 2, 1))

AlarmCode = Asc(Mid(strData, StreamData + 3, 1))
s = MsgID & strVent & AlarmCode
Indx = StrventIndex(strVent)
Call tmp(MsgID, AlarmCode, Indx)
Msglog
StreamData = StreamData + 5
Wend


End If
End Sub

Please add code in code brackets for us, it makes it much easier to read, thanks.:)

What I could gather from your code is that it seems that when you open the port again, it is already in use by another control or application. You need to catch the error and then tell the winsock control to connect through another port.

You can try something like -

Public Function CheckPort(msc As MSComm, ByVal p As Integer) As Boolean

On Error Resume Next
msc.commport = p
msc.PortOpen = True
If Err = 0 Then
     CheckPort = True
     msc.PortOpen = False
End If

End Function

You can also try and assign a much higher port number -

Winsock1.RemotePort = 32750
'Can go up to 32767
This question has already been answered. Start a new discussion instead.