本人最近為了實現電腦與Delta VFD-M變頻器通訊，特意用VB6.0編了一個Modbus協議通訊軟件，不過這只是一個測試版，但Modbus的ASCii協議和RTU協議都已經實現。現在將源程序上貼，希望可以幫助到有需要的朋友，謝謝！(我發現圖片貼不上去）
   另外，假如你覺得有更好的想法，歡迎E-mail指教。
附：VB6源程序

Option Explicit
Private Text1text As String
Private RTUCRC As String
'串口選擇
Private Sub Combo1_Click()
             MSComm1.CommPort = Combo1.ListIndex + 1
End Sub
'數據位改變
Private Sub Combo2_Click()
       Call setting
End Sub
'波特率改變
Private Sub Combo3_Click()
       Call setting
End Sub
'奇偶校驗改變
Private Sub Combo4_Click()
       Call setting
End Sub
'停止位改變
Private Sub Combo5_Click()
       Call setting
End Sub
Private Sub setting()
        MSComm1.Settings = CStr(Combo3.Text) & "," & CStr(Combo4.Text) & "," & CStr(Combo2.Text) _
                                         & "," & CStr(Combo5.Text)
End Sub
'打開關閉串口
Private Sub Command1_Click()
       On Error Resume Next
       If MSComm1.PortOpen = False Then
           MSComm1.PortOpen = True
       Else
              MSComm1.PortOpen = False
       End If
       
       If MSComm1.PortOpen Then                                '打開關閉按鈕顯示文字及combo1使能
            Command1.Caption = "關閉串口"
            Combo1.Enabled = False
       Else
             Command1.Caption = "打開串口"
             Combo1.Enabled = True
       End If
       
         If Err Then                                                          '打開串口失敗，則顯示出錯信息
              MsgBox Error$, 48, "錯誤信息"
               Exit Sub
          End If
End Sub
'10轉16進制
Private Sub Command2_Click(Index As Integer)
    On Error Resume Next
        Text4.Text = Hex(Text3.Text)
          If Err Then                                                          ''則顯示出錯信息
              MsgBox Error$, 48, "錯誤信息"
               Exit Sub
          End If
End Sub
'16轉10進制
Private Sub Command3_Click()
        Dim a As Long
        a = Val("&H" & CStr(Text4.Text))
        Text3.Text = a
End Sub
'手動串口發送
Private Sub Command4_Click()
        If MSComm1.PortOpen = False Then
                 MsgBox "請先打開串口", , "錯誤信息"
                 Exit Sub
         End If
         Call sentsub
End Sub
'清除接收窗
Private Sub Command5_Click()
         Text2.Text = ""
End Sub
Private Sub Command6_Click()
       Unload Me
End Sub
Private Sub Command7_Click()
       On Error Resume Next
         Dim STP As String
          STP = CStr(Chr(2)) & "010001" & CStr(Chr(3)) & "25"
          MSComm1.Settings = "9600,N,7,2"
          MSComm1.PortOpen = True
          MSComm1.Output = STP
          MSComm1.PortOpen = False
          If Err Then                                                          '打開串口失敗，則顯示出錯信息
              MsgBox Error$, 48, "錯誤信息"
               Exit Sub
          End If
End Sub
Private Sub Command8_Click()
       On Error Resume Next
       Dim FWD As String
          FWD = CStr(Chr(2)) & "010101" & CStr(Chr(3)) & "26"
          MSComm1.Settings = "9600,N,7,2"
          MSComm1.PortOpen = True
          MSComm1.Output = FWD
          MSComm1.PortOpen = False
          If Err Then                                                          '打開串口失敗，則顯示出錯信息
              MsgBox Error$, 48, "錯誤信息"
               Exit Sub
          End If
End Sub
Private Sub Command9_Click()
       On Error Resume Next
          Dim REV As String
          REV = CStr(Chr(2)) & "010201" & CStr(Chr(3)) & "27"
          MSComm1.Settings = "9600,N,7,2"
          MSComm1.PortOpen = True
          MSComm1.Output = REV
          MSComm1.PortOpen = False
          If Err Then                                                          '打開串口失敗，則顯示出錯信息
              MsgBox Error$, 48, "錯誤信息"
               Exit Sub
          End If
End Sub
'窗口加載
Private Sub Form_Load()
        Dim d%
           For d = 1 To 16
                  Combo1.AddItem ("COM" & CStr(d))
           Next
                  Combo1.ListIndex = 0
                 
           Combo2.AddItem "6"
           Combo2.AddItem "7"
           Combo2.AddItem "8"
           Combo2.ListIndex = 2
           
           Combo3.AddItem "110"
           Combo3.AddItem "330"
           Combo3.AddItem "1200"
           Combo3.AddItem "2400"
           Combo3.AddItem "4800"
           Combo3.AddItem "9600"
           Combo3.AddItem "19200"
           Combo3.AddItem "38400"
           Combo3.AddItem "56000"
           Combo3.AddItem "57600"
           Combo3.AddItem "115200"
           Combo3.ListIndex = 5
           
           Combo4.AddItem "n"
           Combo4.AddItem "o"
           Combo4.AddItem "e"
           Combo4.ListIndex = 0
           
           Combo5.AddItem "1"
           Combo5.AddItem "2"
           Combo5.ListIndex = 0
           
           For d = 0 To 254
               Combo6.AddItem d
           Next
               Combo6.ListIndex = 1
           
        Text1.Text = "010601001770"
        Text2.Text = ""
        Text3.Text = ""
        Text4.Text = ""
        Text5.Text = "1000"
        Text6.Text = "06"
        Text7.Text = "0"
        Text8.Text = "1"
       
        Option1.Value = True
        Option3.Value = True
        Option7.Value = True
        Option9.Value = True
       
        If MSComm1.PortOpen = False Then
               Command1.Caption = "打開串口"
        Else
               Command1.Caption = "關閉串口"
        End If
End Sub
'串口接收程序
Private Sub MSComm1_OnComm()
       Dim Hexchr As String, hexstring As String, i As Integer, j As Integer, hexdisp As String
       If Option8.Value Then
            hexstring = MSComm1.Input                                                                    '十六進制顯示
           i = Len(hexstring)
            For j = 1 To i
                Hexchr = Mid(hexstring, j, 1)
                If Hex(Asc(Hexchr)) < 16 Then
                   Text2.Text = Text2.Text & "0" & Hex(Asc(Hexchr)) & " "
                Else
                   Text2.Text = Text2.Text & Hex(Asc(Hexchr)) & " "
               End If
           Next j
           Text2.Text = Text2.Text & CStr(Chr(13)) & CStr(Chr(10))
       Else
           Text2.Text = Text2.Text & MSComm1.Input & CStr(Chr(13)) & CStr(Chr(10))   'ASCII碼顯示
       End If
End Sub
'手動發送選擇
Private Sub Option1_Click()
        If Option1.Value = True Then
             Timer1.Enabled = False
             Command4.Enabled = True
       Else
             Timer1.Enabled = True
             Command4.Enabled = False
       End If
End Sub
'Delta ASCII發送協議
Private Sub Option10_Click()
       Combo6.Enabled = True
      Text6.Enabled = True
      Text7.Enabled = True
      Text8.Enabled = True
      Label10.Enabled = True
      Label11.Enabled = True
      Label12.Enabled = True
      Label13.Enabled = True
      Option6.Enabled = False
      Option7.Enabled = False
      Option11.Value = True
      Combo2.ListIndex = 1
      Combo5.ListIndex = 1
      Text1.Enabled = False
      Label14.Enabled = False
      Frame7.Visible = True
End Sub

'自動發送選擇
Private Sub Option2_Click()
        If Option2.Value = True Then
             Timer1.Enabled = True
             Command4.Enabled = False
       Else
             Timer1.Enabled = False
             Command4.Enabled = True
       End If
End Sub
Private Sub Option3_Click()               'Non選項
      Combo6.Enabled = False
      Text6.Enabled = False
      Text7.Enabled = False
      Text8.Enabled = False
      Label10.Enabled = False
      Label11.Enabled = False
      Label12.Enabled = False
      Label13.Enabled = False
      Option6.Enabled = True
      Option7.Enabled = True
      Combo2.ListIndex = 2
      Combo5.ListIndex = 0
      Text1.Enabled = True
      Label14.Enabled = True
      Frame7.Visible = False
End Sub
Private Sub Option4_Click()               'ASCII選項
      Combo6.Enabled = True
      Text6.Enabled = True
      Text7.Enabled = True
      Text8.Enabled = True
      Label10.Enabled = True
      Label11.Enabled = True
      Label12.Enabled = True
      Label13.Enabled = True
      Option6.Enabled = False
      Option7.Enabled = False
      Combo2.ListIndex = 1
      Combo5.ListIndex = 1
      Text1.Enabled = False
      Label14.Enabled = False
      Frame7.Visible = False
End Sub
Private Sub Option5_Click()               'RTU選項
      Combo6.Enabled = True
      Text6.Enabled = True
      Text7.Enabled = True
      Text8.Enabled = True
      Label10.Enabled = True
      Label11.Enabled = True
      Label12.Enabled = True
      Label13.Enabled = True
      Option6.Enabled = False
      Option7.Enabled = False
      Combo2.ListIndex = 2
      Combo5.ListIndex = 1
      Text1.Enabled = False
      Label14.Enabled = False
      Frame7.Visible = False
End Sub
'發送時間間隔調整輸入
Private Sub Text5_Change()
       Dim number As String
       Dim num As Integer
       Dim numcyc As Integer
       num = Len(Text5.Text)
       For numcyc = 1 To num
           number = Mid(Text5.Text, numcyc, 1)
           Select Case InStr("0123456789", number)
           Case 0
              MsgBox "輸入時間間隔錯誤，請重新輸入", , "錯誤信息"
              Exit Sub
           End Select
       Next
        Timer1.Interval = Text5.Text
End Sub
'自動發送定時器
Private Sub Timer1_Timer()
        If MSComm1.PortOpen Then
              Call sentsub
        End If
End Sub
'狀態刷新定時器
Private Sub Timer2_Timer()
        StatusBar1.Panels(1).Text = "串口選擇：" & CStr(Combo1.Text)
        StatusBar1.Panels(2).Text = "串口設置：" & CStr(MSComm1.Settings)
        StatusBar1.Panels(3).Text = "串口狀態：" & CStr(MSComm1.PortOpen)
End Sub
'串口發送子程序
Private Sub sentsub()
            Dim optioncase%
            If Option3.Value Then optioncase = 1
            If Option4.Value Then optioncase = 2
            If Option5.Value Then optioncase = 3
            If Option10.Value Then optioncase = 4
            Select Case optioncase
            Case 1
                    If Option6.Value Then
                      Text1text = Text1.Text
                      Call Hexsent
                    Else
                      Text1text = Text1.Text
                      Call ASCIIsent
                    End If
            Case 2
                 Call incorporate                '將輸入的十進制從機地址、命令、資料地址和資料內容合并成字符串
                 Call ASCIIcheck
                 Call ASCIIsent
            Case 3
                 Call incorporate                 '將輸入的十進制從機地址、命令、資料地址和資料內容合并成字符串
                 Call RTUcheck
                 Call Hexsent
            Case 4
                 Call incorporate1                '將輸入的十進制從機地址、命令、資料地址和資料內容合并成字符串
                 Call deltaASCII
                 Call ASCIIsent
           End Select
End Sub
'十六進制發送
Private Sub Hexsent()
           Dim hexchrlen%, Hexchr As String, hexcyc%, hexmid As Byte, hexmiddle As String
           Dim hexchrgroup() As Byte, i As Integer
              hexchrlen = Len(Text1text)
              For hexcyc = 1 To hexchrlen                                                  '檢查Text1文本框內數值是否合適
              Hexchr = Mid(Text1text, hexcyc, 1)
              If InStr("0123456789ABCDEFabcdef", Hexchr) = 0 Then
                    MsgBox "無效的數值，請重新輸入", , "錯誤信息"
                    Exit Sub
               End If
              Next
              ReDim hexchrgroup(1 To hexchrlen \ 2) As Byte
              For hexcyc = 1 To hexchrlen Step 2                                         '將文本框內數值分成兩個、兩個
                    i = i + 1
                    Hexchr = Mid(Text1text, hexcyc, 2)
                    hexmid = Val("&H" & CStr(Hexchr))
                    hexchrgroup(i) = hexmid
                    'MSComm1.Output = CStr(hexmid)
              Next
              MSComm1.Output = hexchrgroup
End Sub
'ASC碼發送
Private Sub ASCIIsent()
               MSComm1.Output = Text1text
End Sub
'ASC校驗,此段程序計算出LRC校驗值，并加上字頭和字尾
Private Sub ASCIIcheck()
        Dim a%, b%, chrnum%, Lrcbyte As String
        Dim checksum%, char%, AscLrc%, Lrc%
       
        chrnum = Len(Text1text)
        For a = 1 To chrnum Step 2
           char = Val("&H" & CStr(Mid(Text1text, a, 2)))   '兩個兩個的取字符
           checksum = checksum + char                      '全部加起來
        Next
        AscLrc = checksum Mod &H100                        '取255的余數
        Lrc = (&HFF - AscLrc) + 1                                '取二次補
        If Lrc < 16 Then                                               '此段程序是判斷Hex(lrc)是否是一位數，
            Lrcbyte = "0" + CStr(Hex(Lrc))                     '如果是的話，前面加0；否則不加零
       Else
           Lrcbyte = CStr(Hex(Lrc))
       End If
        Text1text = CStr(Chr(58)) & CStr(Text1text) & Lrcbyte & CStr(Chr(13)) & CStr(Chr(10))
End Sub
'DeltaASCII校驗,此段程序計算出LRC校驗值，并加上字頭和字尾
Private Sub deltaASCII()
        Dim a%, b%, chrnum%, Lrcbyte As String
        Dim checksum%, char%, Lrc%
                 
        chrnum = Len(Text1text)
        For a = 1 To chrnum
           char = Asc(Mid(Text1text, a, 1))   '兩個兩個的取字符
           checksum = checksum + char                      '全部加起來
        Next
        Lrc = (checksum + &H3) Mod &H100                       '取255的余數
        If Lrc < 16 Then                                               '此段程序是判斷Hex(lrc)是否是一位數，
            Lrcbyte = "0" + CStr(Hex(Lrc))                     '如果是的話，前面加0；否則不加零
       Else
           Lrcbyte = CStr(Hex(Lrc))
       End If
        Text1text = CStr(Chr(2)) & CStr(Text1text) & CStr(Chr(3)) & Lrcbyte
End Sub

'RTU校驗
Private Sub RTUcheck()
       Dim CRC() As Byte
       Dim d(5) As Byte
       Dim string1 As String
       Dim j As Integer, chrlength As Integer, temp As String
       
       string1 = Text1text
       chrlength = Len(string1)
       For j = 0 To chrlength / 2 - 1
                 temp = Mid(string1, j * 2 + 1, 2)
                 d(j) = Val("&H" & temp)
       Next
       RTUCRC = CRC16(d)                         '調用CRC16計算函數, CRC(0)為高位,  CRC(1)為低位
       Text1text = Text1text & RTUCRC
End Sub
Private Sub incorporate()                                       '將輸入的十進制從機地址、命令、資料地址和資料內容合并成字符串
      Dim wholechar As String, wc%, wcyc%, wchar As String
      Dim SID As String, Cmd As String, InfoAdd As String, data As String
      Dim SIDnum%, Cmdnum%, InfoAddNum%, Datanum%
     
     On Error Resume Next
       wholechar = CStr(Combo6.Text) & CStr(Text6.Text) & CStr(Text7.Text) & CStr(Text8.Text)
       wc = Len(wholechar)
       For wcyc = 1 To wc
           wchar = Mid(wholechar, wcyc, 1)
           If InStr("0123456789", wchar) = 0 Then
               MsgBox "輸入錯誤，請重新輸入", , "錯誤提示"
               Exit Sub
           End If
       Next

            SIDnum = Len(CStr(Hex(Combo6.Text)))
             Select Case SIDnum
             Case 0
               Exit Sub
            Case 1
                SID = "0" & CStr(Hex(Combo6.Text))
            Case 2
                SID = CStr(Hex(Combo6.Text))
            End Select

            Cmdnum = Len(CStr(Hex(Text6.Text)))
            Select Case Cmdnum
            Case 0
               Exit Sub
            Case 1
                 Cmd = "0" & CStr(Hex(Text6.Text))
            Case 1
                 Cmd = CStr(Hex(Text6.Text))
            End Select
           
            InfoAddNum = Len(CStr(Hex(Text7.Text)))
            Select Case InfoAddNum
            Case 0
               Exit Sub
            Case 1
                 InfoAdd = "000" & CStr(Hex(Text7.Text))
            Case 2
                 InfoAdd = "00" & CStr(Hex(Text7.Text))
            Case 3
                 InfoAdd = "0" & CStr(Hex(Text7.Text))
            Case 4
                 InfoAdd = CStr(Hex(Text7.Text))
           End Select
                 
            Datanum = Len(CStr(Hex(Text8.Text)))
            Select Case Datanum
            Case 0
               Exit Sub
            Case 1
                 data = "000" & CStr(Hex(Text8.Text))
            Case 2
                 data = "00" & CStr(Hex(Text8.Text))
            Case 3
                 data = "0" & CStr(Hex(Text8.Text))
            Case 4
                 data = CStr(Hex(Text8.Text))
           End Select
           
          If Err Then                                                          '顯示出錯信息
              MsgBox Error$, 48, "錯誤信息"
               Exit Sub
          End If
           Text1text = CStr(SID) & CStr(Cmd) & CStr(InfoAdd) & CStr(data)
End Sub
Private Sub incorporate1()                                       '將輸入的十進制從機地址、命令、資料地址和資料內容合并成字符串
      Dim wholechar As String, wc%, wcyc%, wchar As String
      Dim SID As String, Cmd As String, InfoAdd As String, data As String
      Dim SIDnum%, Cmdnum%, InfoAddNum%, Datanum%
     
     On Error Resume Next
       wholechar = CStr(Combo6.Text) & CStr(Text7.Text) & CStr(Text8.Text)
       wc = Len(wholechar)
       For wcyc = 1 To wc
           wchar = Mid(wholechar, wcyc, 1)
           If InStr("0123456789", wchar) = 0 Then
               MsgBox "輸入錯誤，請重新輸入", , "錯誤提示"
               Exit Sub
           End If
       Next

            SIDnum = Len(CStr(Hex(Combo6.Text)))
             Select Case SIDnum
             Case 0
               Exit Sub
            Case 1
                SID = "0" & CStr(Hex(Combo6.Text))
            Case 2
                SID = CStr(Hex(Combo6.Text))
            End Select

           'Cmdnum = Len(CStr(Hex(Text6.Text)))
            'Select Case Cmdnum
            'Case 0
            '   Exit Sub
            'Case 1
            '     Cmd = "0" & CStr(Hex(Text6.Text))
            'Case 1
            '     Cmd = CStr(Hex(Text6.Text))
            'End Select
           
            InfoAddNum = Len(CStr(Hex(Text7.Text)))
            Select Case InfoAddNum
            Case 0
               Exit Sub
            Case 1
                 InfoAdd = "0" & CStr(Hex(Text7.Text))
            Case 2
                 InfoAdd = CStr(Hex(Text7.Text))
           End Select
                 
            Datanum = Len(CStr(Hex(Text8.Text)))
            Select Case Datanum
            Case 0
               Exit Sub
            Case 1
                 data = "000" & CStr(Hex(Text8.Text))
            Case 2
                 data = "00" & CStr(Hex(Text8.Text))
            Case 3
                 data = "0" & CStr(Hex(Text8.Text))
            Case 4
                 data = CStr(Hex(Text8.Text))
           End Select
           
          If Err Then                                                          '顯示出錯信息
              MsgBox Error$, 48, "錯誤信息"
               Exit Sub
          End If
           
           If Option11.Value Then
                 Cmd = "08"
                 Text1text = CStr(SID) & CStr(Cmd) & CStr(InfoAdd)
            Else
                 Cmd = "07"
                 Text1text = CStr(SID) & CStr(Cmd) & CStr(InfoAdd) & CStr(data)
           End If
           
End Sub
Private Function CRC16(data() As Byte) As String
     Dim CRC16Lo As Byte, CRC16Hi As Byte      'CRC寄存器
     Dim CL As Byte, CH As Byte                '多項式碼&HA001
     Dim CRCLo As String, CRCHi As String
     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 '如果高位字節最后一位為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
     If Len(Hex(CRC16Hi)) = 1 Then
        CRCHi = "0" + Hex(CRC16Hi)
     Else
        CRCHi = Hex(CRC16Hi)
     End If
     If Len(Hex(CRC16Lo)) = 1 Then
        CRCLo = "0" + Hex(CRC16Lo)
     Else
        CRCLo = Hex(CRC16Lo)
     End If
        CRC16 = CRCLo + CRCHi
 End Function