咨詢熱線

      18621916738

      當前位置:首頁  >  技術文章  >  西門子S7-200 ModBus從站通訊程序

      西門子S7-200 ModBus從站通訊程序

      更新時間:2016-01-04      點擊次數:2473

      西門子S7-200 ModBus從站通訊程序

      一直看到有些朋友在問ModBus主從站的通訊問題,今天抽空兒給大家發幾篇。

      事先申明,我是調用的主從站庫,庫本身并不是我編寫的,我沒有那么大的能耐。

      另外,上位機是用VB編寫,VB本身不是很熟,如果有什么錯誤,請大家海諒。

      zui后,這僅僅只是一個測試程序,如果各位想用到商業方面,還需要各位自己去完善。

      說明:PLC從站,PC作主站,用ModBus協議進行通訊。PC機讀取PLCVW區的數據;PC機還讀取PLC內部I或者O地址的狀態。

      ///////////////////////////////////////

      以下是PLC程序實現,方便貼出,已轉換為STL

      TITLE=程序注釋

      Network 1 // 網絡標題

      // 在*個循環周期內初始化Modbus從站協議

      LD SM0.1

      CALL SBR3, 1, 12, 9600, 0, 0, 128, 32, 1000, &VB0, M10.1, MB11

      Network 2 

      // 在每個循環周期內執行Modbus 從站協議

      LD SM0.0

      CALL SBR1, M10.2, MB12

      Network 3 

      LD SM0.0

      MOVW AIW0, VW100

      /I +54, VW100

      MOVW AIW2, VW102

      /I +54, VW102

      MOVW AIW4, VW104

      /I +54, VW104

      MOVW AIW6, VW106

      /I +54, VW106

      Network 4 

      LD SM0.0

      = Q0.0

      Network 5 

      LD I0.0

      = Q0.1

      Network 6 

      LD I0.1

      = Q0.2

      ///////////////////////////////////

      以下是VB源碼

      Option Explicit

      Private Declare Function GetTickCount Lib "kernel32" () As Long

      Dim x1

      Dim p11, p12, p13, p14, p15, p16, p17, p18

      Function CRC16(data() As Byte) As String

      Dim CRC16Lo As Byte, CRC16Hi As Byte 'CRC寄存器

      Dim CL As Byte, CH As Byte '多項式碼&HA001

      Dim SaveHi As Byte, SaveLo As Byte

      Dim i As Integer

      Dim Flag As Integer

      CRC16Lo = &HFF

      CRC16Hi = &HFF

      CL = &H1

      CH = &HA0

      For i = 0 To UBound(data)

      CRC16Lo = CRC16Lo Xor data(i) '每一個數據與CRC寄存器進行異或

      For Flag = 0 To 7

      SaveHi = CRC16Hi

      SaveLo = CRC16Lo

      CRC16Hi = CRC16Hi \ 2 '高位右移一位

      CRC16Lo = CRC16Lo \ 2 '低位右移一位

      If ((SaveHi And &H1) = &H1) Then '如果高位字節zui后一位為1

      CRC16Lo = CRC16Lo Or &H80 '則低位字節右移后前面補1

      End If '否則自動補0

      If ((SaveLo And &H1) = &H1) Then '如果LSB為1,則與多項式碼進行異或

      CRC16Hi = CRC16Hi Xor CH

      CRC16Lo = CRC16Lo Xor CL

      End If

      Next Flag

      Next i

      Dim ReturnData(1) As Byte

      ReturnData(0) = CRC16Hi 'CRC高位

      ReturnData(1) = CRC16Lo 'CRC低位

      CRC16 = ReturnData

      End Function

      Private Sub About_Click()

      frmAbout.Show

      End Sub

      Private Sub Form_Load() '初始化

      Timer1.Enabled = False '定時器1無效

      Timer1.Interval = 1000 '定時器1時間為1S

      Timer2.Enabled = True '定時器2有效

      Timer2.Interval = 1000 '定時器2時間為1S

      Text1.Text = ""

      Text2.Text = ""

      Text3.Text = ""

      Text4.Text = ""

      Text5.Text = ""

      Text6.Text = ""

      Text8.Text = ""

      Text10.Text = ""

      MSComm1.CommPort = 1 '設定端口號

      MSComm1.Settings = "9600,n,8,1" '設定通訊波特率

      MSComm1.InBufferSize = 1024 '接收緩沖器大小

      MSComm1.OutBufferSize = 1024 '輸出緩沖器大小

      MSComm1.InputMode = comInputModeBinary '以二進制傳輸

      MSComm1.RThreshold = 1 '

      MSComm1.SThreshold = 0

      MSComm1.InputLen = 0 '讀取接收緩沖器所有字符

      MSComm1.OutBufferCount = 0 '清空發送緩沖區

      MSComm1.InBufferCount = 0 '清空接收緩沖區

      If MSComm1.PortOpen = False Then

      Command3.Caption = "打開串口"

      Else

      Command3.Caption = "關閉串口"

      End If

      End Sub

      Private Sub Command1_Click()

      Timer1.Enabled = True

      End Sub

      Private Sub Command2_Click() '退出程序,定時器1無效

      Timer1.Enabled = False

      Cls

      Unload Me

      End Sub

      Private Sub Command3_Click()

      On Error Resume Next

      If MSComm1.PortOpen = False Then

      MSComm1.PortOpen = True

      Else

      MSComm1.PortOpen = False

      End If

      If MSComm1.PortOpen Then '打開關閉按鈕顯示文字

      Command3.Caption = "關閉串口"

      Else

      Command3.Caption = "打開串口"

      End If

      If Err Then '打開串口失敗,則顯示出錯信息

      MsgBox Error$, 48, "錯誤信息"

      Exit Sub

      End If

      End Sub

      Private Sub Timer1_Timer() '讀V存儲區數據

      Dim CRC() As Byte

      Dim FGetData As String

      Dim aa() As Byte

      Dim s As String

      Dim str As String

      Dim i As Integer

      Dim bb, cc As String

      ReDim aa(5) As Byte '定義動態數組

      aa(0) = &HC

      aa(1) = &H3

      aa(2) = &H0

      aa(3) = &H32

      aa(4) = &H0

      aa(5) = &H4

      CRC = CRC16(aa)

      str = CRC

      s = ""

      For i = 1 To LenB(str)

      s = s + Hex(AscB(MidB(str, i, 1)))

      Next i

      bb = Right(s, 2)

      cc = Mid(s, 1, 2)

      If Len(s) < 4 Then

      cc = Mid(s, 1, 1)

      End If

      ReDim Preserve aa(0 To 7) As Byte

      aa(6) = Val("&H" & bb)

      aa(7) = Val("&H" & cc)

      MSComm1.OutBufferCount = 0 '清空輸出寄存器

      MSComm1.Output = aa

      FGetData = ReceiveData

      Text5.Text = FGetData

      p11 = Val("&H" & Mid(FGetData, 7, 4))

      p12 = Val("&H" & Mid(FGetData, 11, 4))

      p13 = Val("&H" & Mid(FGetData, 15, 4))

      p14 = Val("&H" & Mid(FGetData, 19, 4))

      End Sub

      Private Sub Command4_Click() 'I狀態

      Dim CRC() As Byte

      Dim FGetData As String

      Dim aa() As Byte

      Dim s As String

      Dim str As String

      Dim i As Integer

      Dim bb, cc As String

      ReDim aa(5) As Byte '定義動態數組

      aa(0) = &HC

      aa(1) = &H2

      aa(2) = &H0

      aa(3) = &H0

      aa(4) = &H0

      aa(5) = &H1

      CRC = CRC16(aa)

      str = CRC

      s = ""

      For i = 1 To LenB(str)

      s = s + Hex(AscB(MidB(str, i, 1)))

      Next i

      bb = Right(s, 2)

      cc = Mid(s, 1, 2)

      If Len(s) < 4 Then

      cc = Mid(s, 1, 1)

      End If

      ReDim Preserve aa(0 To 7) As Byte

      aa(6) = Val("&H" & bb)

      aa(7) = Val("&H" & cc)

      MSComm1.OutBufferCount = 0 '清空輸出寄存器

      MSComm1.Output = aa

      FGetData = IReceiveData

      p17 = Val("&H" & Mid(FGetData, 7, 2))

      p18 = Val("&H" & Mid(FGetData, 9, 2))

      End Sub

      Private Sub Command5_Click() 'Q狀態

      Dim CRC() As Byte

      Dim FGetData As String

      Dim aa() As Byte

      Dim s As String

      Dim str As String

      Dim i As Integer

      Dim bb, cc As String

      ReDim aa(5) As Byte '定義動態數組

      aa(0) = &HC

      aa(1) = &H1

      aa(2) = &H0

      aa(3) = &H0

      aa(4) = &H0

      aa(5) = &H1

      CRC = CRC16(aa)

      str = CRC

      s = ""

      For i = 1 To LenB(str)

      s = s + Hex(AscB(MidB(str, i, 1)))

      Next i

      bb = Right(s, 2)

      cc = Mid(s, 1, 2)

      If Len(s) < 4 Then

      cc = Mid(s, 1, 1)

      End If

      ReDim Preserve aa(0 To 7) As Byte

      aa(6) = Val("&H" & bb)

      aa(7) = Val("&H" & cc)

      MSComm1.OutBufferCount = 0 '清空輸出寄存器

      MSComm1.Output = aa

      FGetData = QReceiveData

      p15 = Val("&H" & Mid(FGetData, 7, 2))

      p16 = Val("&H" & Mid(FGetData, 9, 2))

      End Sub

      Private Function ReceiveData() As String '返回V存儲器區數據

      Dim FGetData As String

      Dim t1 As Long

      Dim av As Variant

      Dim i As Integer

      Dim ReDataLen As Integer

      FGetData = ""

      t1 = GetTickCount() '取時間,做延時用

      Do '循環等待接收數據

      DoEvents

      If MSComm1.InBufferCount > 0 Then '串口有數據了

      ReDataLen = MSComm1.InBufferCount '取數據長度

      av = MSComm1.Input '將串口數據取出來

      For i = 0 To ReDataLen - 1

      FGetData = FGetData & Right("00" & Hex(av(i)), 2)

      Next i

      End If

      If Len(FGetData) >= 6 Then

      If Len(FGetData) > Val("&H" & Mid(FGetData, 5, 2)) * 2 + 8 Then

      ReceiveData = FGetData

      Exit Function

      End If

      End If

      If GetTickCount - t1 > 2000 Then '2秒沒收完就不收了

      ReceiveData = ""

      Exit Function

      End If

      Loop

      End Function

      Private Function IReceiveData() As String '反回I狀態

      Dim FGetData As String

      Dim t1 As Long

      Dim av As Variant

      Dim i As Integer

      Dim ReDataLen As Integer

      FGetData = ""

      t1 = GetTickCount() '取時間,做延時用

      Do '循環等待接收數據

      DoEvents

      If MSComm1.InBufferCount > 0 Then '串口有數據了

      ReDataLen = MSComm1.InBufferCount '取數據長度

      av = MSComm1.Input '將串口數據取出來

      For i = 0 To ReDataLen - 1

      FGetData = FGetData & Right("00" & Hex(av(i)), 2)

      Next i

      End If

      If Len(FGetData) >= 6 Then

      If Len(FGetData) > Val("&H" & Mid(FGetData, 5, 2)) * 2 + 8 Then

      IReceiveData = FGetData

      Exit Function

      End If

      End If

      If GetTickCount - t1 > 2000 Then '2秒沒收完就不收了

      IReceiveData = ""

      Exit Function

      End If

      Loop

      End Function

      Private Function QReceiveData() As String '反回Q狀態

      Dim FGetData As String

      Dim t1 As Long

      Dim av As Variant

      Dim i As Integer

      Dim ReDataLen As Integer

      FGetData = ""

      t1 = GetTickCount() '取時間,做延時用

      Do '循環等待接收數據

      DoEvents

      If MSComm1.InBufferCount > 0 Then '串口有數據了

      ReDataLen = MSComm1.InBufferCount '取數據長度

      av = MSComm1.Input '將串口數據取出來

      For i = 0 To ReDataLen - 1

      FGetData = FGetData & Right("00" & Hex(av(i)), 2)

      Next i

      End If

      If Len(FGetData) >= 6 Then

      If Len(FGetData) > Val("&H" & Mid(FGetData, 5, 2)) * 2 + 8 Then

      QReceiveData = FGetData

      Exit Function

      End If

      End If

      If GetTickCount - t1 > 2000 Then '2秒沒收完就不收了

      QReceiveData = ""

      Exit Function

      End If

      Loop

      End Function

      Private Sub Timer2_Timer()

      x1 = x1 + 1

      Text10.Text = str(x1)

      Text1.Text = str(p11)

      Text2.Text = str(p12)

      Text3.Text = str(p13)

      Text4.Text = str(p14)

      Text7.Text = str(p15)

      If Text7.Text = 1 Then Text7.BackColor = RGB(255, 0, 255)

      If Text7.Text = 0 Then Text7.BackColor = RGB(0, 255, 255)

      'Text6.Text = str(p16)

      Text9.Text = str(p17)

      If Text9.Text = 1 Then Text9.BackColor = RGB(255, 0, 255)

      If Text9.Text = 0 Then Text9.BackColor = RGB(0, 255, 255)

      'Text8.Text = str(p18)

      End Sub
       

      聯系我們

      上海翰粵自動化系統有限公司 公司地址:上海市松江區思賢路2399弄137號   技術支持:化工儀器網
      • 聯系人:黃政武
      • QQ:76868608
      • 公司傳真:021-57657276
      • 郵箱:76868608@qq.com

      掃一掃 更多精彩

      微信二維碼

      網站二維碼

      亚洲婷婷综合色高清在线| 亚洲AV无码一区二区二三区入口 | 亚洲精品无码国产| 亚洲中文字幕无码爆乳av中文 | 亚洲综合一区二区精品导航| 亚洲国产精品第一区二区| 亚洲av日韩av高潮潮喷无码| 无码专区—VA亚洲V天堂| 亚洲电影中文字幕| 亚洲日本一区二区| 亚洲精品中文字幕乱码| 亚洲成A∨人片在线观看无码| 亚洲免费视频网站| 亚洲激情黄色小说| 亚洲午夜在线一区| 亚洲AV无码无限在线观看不卡| 国产精品亚洲片夜色在线| 中文字幕乱码亚洲无线三区| 亚洲欧洲无码一区二区三区| 亚洲av色香蕉一区二区三区蜜桃| 爱情岛论坛亚洲品质自拍视频网站| 国产精品亚洲一区二区三区在线观看 | 亚洲人成色777777在线观看| 亚洲性猛交XXXX| 久久精品国产亚洲AV果冻传媒| 亚洲国产精品lv| 亚洲另类视频在线观看| 亚洲人成综合网站7777香蕉| 亚洲乱码中文字幕在线| 国产精品亚洲а∨无码播放不卡| 亚洲精品视频免费| 国产亚洲人成无码网在线观看| 亚洲精品免费视频| 亚洲一级免费毛片| 亚洲成AV人片在WWW| 亚洲情a成黄在线观看| 久久被窝电影亚洲爽爽爽| 久久综合亚洲色一区二区三区| 亚洲人成电影在线观看青青| 亚洲久热无码av中文字幕| 亚洲 自拍 另类小说综合图区 |