赵云龙
级别: 正式会员
精华主题: 0
发帖数量: 6 个
工控威望: 53 点
下载积分: 256 分
在线时间: 8(小时)
注册时间: 2023-11-23
最后登录: 2024-11-20
查看赵云龙的 主题 / 回贴
楼主  发表于: 67天前
Option Explicit

Private Sub Form_Load()

  '设置本地任意可用端口,这样系统会自动分配一个未被占用的端口

  Winsock1.LocalPort = 0

  Winsock2.LocalPort = 0

  '设置通信协议为 TCP 协议

  Winsock1.Protocol = sckTCPProtocol

  Winsock2.Protocol = sckTCPProtocol

  '开始监听,等待客户端连接

  Winsock1.Listen

  Winsock2.Listen

  '初始化PLC地址,IP,端口数据

  Open App.Path & "\data\add.ini" For Binary As #1

  Add = StrConv(InputB$(LOF(1), 1), vbUnicode)

  Close #1

  Open App.Path & "\data\ip.ini" For Binary As #1

  ip = StrConv(InputB$(LOF(1), 1), vbUnicode)

  Close #1

  Open App.Path & "\data\port.ini" For Binary As #1

  port = StrConv(InputB$(LOF(1), 1), vbUnicode)

  Close #1

  reg.Text = "0"

  high.Text = "0"

  low.Text = "0"

End Sub



Private Sub SendData_Click()

  '如果 Winsock 处于已连接状态

  If Winsock1.State = sckConnected Then

    '构造 Modbus TCP 请求数据

    Dim PLC_Add As Long

    Dim dataToSend As Integer

    Dim dataToSend1 As Integer

    Dim dataToSend2 As Integer

    'Add PLC起始地址,reg:寄存器地址,high/low高低字节位(数据)。

    PLC_Add = Val(Add.Text)

    To_reg = Val(reg.Text)

    To_high = Val(high.Text)

    To_low = Val(low.Text)

    'MODBUSTCP报文

     Dim request As String

    request = Chr(&H0) & Chr(&H1) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H6) & Chr(&H1) & Chr(&H6) & Chr(PLC_Add - 40001) & Chr(To_reg) & Chr(To_high) & Chr(To_low)

      '发送构造好的请求数据给 PLC

      Winsock1.SendData request

    Exit Sub

  

  Else

    '如果未连接到 PLC,弹出消息提示

    MsgBox "Not connected to PLC."

  End If

  

End Sub


Private Sub Timer1_Timer()

  '定时器事件,用于周期性检查连接状态并更新界面

  If Winsock1.State = sckConnected Then

    '如果连接成功,将标签的背景色设置为绿色(十六进制颜色值 &HC000&)

    connection.BackColor = &HC000&

  Else

    '如果未连接,将标签的背景色设置为红色(十六进制颜色值 &HFF&)

    connection.BackColor = &HFF&

  End If

    

End Sub



Private Sub Timer2_Timer()

  '定时器事件,用于周期性检查连接状态并重新连接

  If connection.BackColor = &HFF& Then

  '检查 Winsock 的状态,如果不是已关闭状态

  If Winsock1.State <> sckClosed Then

    '关闭当前连接,以便重新连接到 PLC

    Winsock1.Close

    '确认连接IP地址及端口

    Timer3.Interval = 1

  End If

  If Winsock2.State <> sckClosed Then

    '关闭当前连接,以便重新连接到 PLC

    Winsock2.Close

    '确认连接IP地址及端口

    Timer3.Interval = 1

  End If

  

    '变量

    Dim plc_ip As String

    Dim plc_port As Integer

    '读取IP及端口参数

    plc_ip = ip.Text

    plc_port = port.Text

    '连接到指定的 PLC IP 地址和端口号,这里需替换为实际的 PLC IP 和端口

    Winsock1.Connect plc_ip, plc_port

    Winsock2.Connect plc_ip, plc_port

    '停止IP地址及端口确认

    Timer3.Interval = 0

  End If

End Sub



Private Sub Command1_Click()

    '打开通讯设置窗口

    Form2.Show

End Sub



Private Sub ConnectToPLC_Click()

  '判断通讯是否启动连接

  If Timer2.Interval = 0 Then

     '开始连接

    Timer2.Interval = 1

  ElseIf Timer2.Interval = 1 Then

    '判断通讯是否启动连接

    If Winsock1.State <> sckClosed Then

    '停止连接

    Timer2.Interval = 0

    '断开连接

    Winsock1.Close

    Winsock2.Close

    

    End If

    

  End If



End Sub



Private Sub Timer3_Timer()

    '读取起始地址

    Open App.Path & "\data\add.ini" For Binary As #1

    '更新起始地址

    Add = StrConv(InputB$(LOF(1), 1), vbUnicode)

    Close #1

    '读取IP地址

    Open App.Path & "\data\ip.ini" For Binary As #1

    '更新IP地址

    ip = StrConv(InputB$(LOF(1), 1), vbUnicode)

    Close #1

    '读取端口

    Open App.Path & "\data\port.ini" For Binary As #1

    '更新端口

    port = StrConv(InputB$(LOF(1), 1), vbUnicode)

    Close #1

    '停止更新

    Timer3.Interval = 0

End Sub





Private Sub TCP0_Click(Index As Integer)

  '对齐寄存器地址

  If reg.Text <> 0 Then

    reg.Text = 0

  End If

  '开关量转换

  If reg.Text = 0 Then

    If low.Text = 0 Then

      low.Text = 1

      SendData_Click

    ElseIf low.Text = 1 Then

      low.Text = 0

      SendData_Click

    End If

  End If



End Sub



Private Sub TCP1_Click(Index As Integer)

  '对齐寄存器地址

  If reg.Text <> 1 Then

    reg.Text = 1

  End If

  '开关量转换

  If reg.Text = 1 Then

    If low.Text = 0 Then

      low.Text = 1

      SendData_Click

    ElseIf low.Text = 1 Then

      low.Text = 0

      SendData_Click

    End If

  End If



End Sub



Private Sub TCP2_Click(Index As Integer)

  '对齐寄存器地址

  If reg.Text <> 2 Then

    reg.Text = 2

  End If

  '开关量转换

  If reg.Text = 2 Then

    If low.Text = 0 Then

      low.Text = 1

      SendData_Click

    ElseIf low.Text = 1 Then

      low.Text = 0

      SendData_Click

    End If

  End If



End Sub



Private Sub TCP3_Click(Index As Integer)

  '对齐寄存器地址

  If reg.Text <> 3 Then

    reg.Text = 3

  End If

  '开关量转换

  If reg.Text = 3 Then

    If low.Text = 0 Then

      low.Text = 1

      SendData_Click

    ElseIf low.Text = 1 Then

      low.Text = 0

      SendData_Click

    End If

  End If



End Sub



Private Sub TCP4_Click(Index As Integer)

  '对齐寄存器地址

  If reg.Text <> 4 Then

    reg.Text = 4

  End If

  '开关量转换

  If reg.Text = 4 Then

    If low.Text = 0 Then

      low.Text = 1

      SendData_Click

    ElseIf low.Text = 1 Then

      low.Text = 0

      SendData_Click

    End If

  End If



End Sub



Private Sub TCP5_Click(Index As Integer)

  '对齐寄存器地址

  If reg.Text <> 5 Then

    reg.Text = 5

  End If

  '开关量转换

  If reg.Text = 5 Then

    If low.Text = 0 Then

      low.Text = 1

      SendData_Click

    ElseIf low.Text = 1 Then

      low.Text = 0

      SendData_Click

    End If

  End If


End Sub



Private Sub end_Click()

End

End Sub


powtiger
狂人日妓
级别: 略有小成
精华主题: 0
发帖数量: 314 个
工控威望: 449 点
下载积分: 3356 分
在线时间: 124(小时)
注册时间: 2014-03-04
最后登录: 2024-11-09
查看powtiger的 主题 / 回贴
1楼  发表于: 66天前
VB工程发一个上来学习啊
科技创造未来,人才决定明天!
tandekun
级别: 探索解密
精华主题: 0
发帖数量: 100 个
工控威望: 123 点
下载积分: 5174 分
在线时间: 30(小时)
注册时间: 2021-12-17
最后登录: 2024-11-22
查看tandekun的 主题 / 回贴
2楼  发表于: 66天前
背景图有点影响观感
mhbxfys
趁年轻,走遍中国!
级别: 网络英雄
精华主题: 0
发帖数量: 675 个
工控威望: 7027 点
下载积分: 7217 分
在线时间: 231(小时)
注册时间: 2012-01-04
最后登录: 2024-11-21
查看mhbxfys的 主题 / 回贴
3楼  发表于: 65天前
大神啊
感谢每位朋友! 承接plc柜、电气柜设计、定制。触摸屏组态、调试。 蓝海华腾变频器代理,变频器维修!!!   QQ:545636511