form1.frm

海明码发送与接收程序 测试信道的可靠性 可单独设立监听端口

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form Form1 
   Caption         =   "发送端"
   ClientHeight    =   5085
   ClientLeft      =   3510
   ClientTop       =   2700
   ClientWidth     =   7935
   LinkTopic       =   "Form1"
   ScaleHeight     =   5085
   ScaleWidth      =   7935
   Begin VB.Frame Frame2 
      Caption         =   "生成多项式"
      Height          =   1815
      Index           =   0
      Left            =   120
      TabIndex        =   14
      Top             =   120
      Width           =   5175
      Begin VB.CheckBox Check1 
         Caption         =   "x8"
         Height          =   300
         Index           =   0
         Left            =   120
         TabIndex        =   26
         Top             =   1200
         Value           =   1  'Checked
         Width           =   495
      End
      Begin VB.CheckBox Check1 
         Caption         =   "x7"
         Height          =   300
         Index           =   1
         Left            =   720
         TabIndex        =   25
         Top             =   1200
         Width           =   495
      End
      Begin VB.CheckBox Check1 
         Caption         =   "x6"
         Height          =   300
         Index           =   2
         Left            =   1200
         TabIndex        =   24
         Top             =   1200
         Width           =   495
      End
      Begin VB.CheckBox Check1 
         Caption         =   "x5"
         Height          =   300
         Index           =   3
         Left            =   1680
         TabIndex        =   23
         Top             =   1200
         Width           =   495
      End
      Begin VB.OptionButton Option1 
         Caption         =   "Setting CRC-8=101H"
         Height          =   495
         Index           =   2
         Left            =   3360
         TabIndex        =   22
         Top             =   360
         Value           =   -1  'True
         Width           =   1695
      End
      Begin VB.OptionButton Option1 
         Caption         =   "CRC-8=131H"
         Height          =   375
         Index           =   1
         Left            =   1800
         TabIndex        =   21
         Top             =   360
         Width           =   1215
      End
      Begin VB.CheckBox Check1 
         Caption         =   "1"
         Height          =   300
         Index           =   8
         Left            =   4560
         TabIndex        =   20
         Top             =   1200
         Value           =   1  'Checked
         Width           =   495
      End
      Begin VB.OptionButton Option1 
         Caption         =   "CRC-8=107H"
         Height          =   375
         Index           =   0
         Left            =   360
         TabIndex        =   19
         Top             =   360
         Width           =   1215
      End
      Begin VB.CheckBox Check1 
         Caption         =   "x1"
         Height          =   300
         Index           =   7
         Left            =   3960
         TabIndex        =   18
         Top             =   1200
         Width           =   495
      End
      Begin VB.CheckBox Check1 
         Caption         =   "x2"
         Height          =   300
         Index           =   6
         Left            =   3480
         TabIndex        =   17
         Top             =   1200
         Width           =   495
      End
      Begin VB.CheckBox Check1 
         Caption         =   "x3"
         Height          =   300
         Index           =   5
         Left            =   2880
         TabIndex        =   16
         Top             =   1200
         Width           =   495
      End
      Begin VB.CheckBox Check1 
         Caption         =   "x4"
         Height          =   300
         Index           =   4
         Left            =   2280
         TabIndex        =   15
         Top             =   1200
         Width           =   495
      End
   End
   Begin VB.CommandButton cmdexit 
      Caption         =   "退 出"
      Height          =   375
      Left            =   6720
      TabIndex        =   13
      Top             =   4560
      Width           =   855
   End
   Begin VB.ListBox List1 
      Height          =   240
      Left            =   5520
      TabIndex        =   12
      Top             =   1560
      Visible         =   0   'False
      Width           =   1950
   End
   Begin VB.OptionButton tennelopt 
      Caption         =   "有噪信道"
      Height          =   375
      Index           =   0
      Left            =   3360
      TabIndex        =   9
      Top             =   2040
      Width           =   1215
   End
   Begin VB.OptionButton tennelopt 
      Caption         =   "无噪信道"
      Height          =   375
      Index           =   1
      Left            =   1080
      TabIndex        =   8
      Top             =   2040
      Value           =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton convert 
      Caption         =   "编 码"
      Height          =   364
      Left            =   2160
      TabIndex        =   7
      Top             =   3720
      Width           =   960
   End
   Begin VB.TextBox senddata 
      Appearance      =   0  'Flat
      Height          =   360
      Left            =   960
      TabIndex        =   6
      Top             =   3000
      Width           =   3255
   End
   Begin VB.TextBox Text3 
      Height          =   375
      Left            =   5520
      TabIndex        =   3
      Text            =   "2008"
      Top             =   720
      Width           =   1845
   End
   Begin VB.CommandButton Command2 
      Caption         =   "断 开"
      Height          =   375
      Left            =   5400
      TabIndex        =   2
      Top             =   4560
      Width           =   1095
   End
   Begin VB.CommandButton cmdsend 
      Caption         =   "发 送"
      Height          =   375
      Left            =   4080
      TabIndex        =   1
      Top             =   4560
      Width           =   1005
   End
   Begin VB.TextBox sendframe 
      Appearance      =   0  'Flat
      Height          =   375
      Left            =   960
      TabIndex        =   0
      Top             =   4560
      Width           =   2775
   End
   Begin MSWinsockLib.Winsock Winsock1 
      Index           =   0
      Left            =   840
      Top             =   120
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.Label Label4 
      Caption         =   "(D9....D1D0)"
      Height          =   255
      Left            =   960
      TabIndex        =   11
      Top             =   2640
      Width           =   1455
   End
   Begin VB.Label Label3 
      Caption         =   "发送数据"
      Height          =   255
      Left            =   240
      TabIndex        =   10
      Top             =   2640
      Width           =   735
   End
   Begin VB.Label Label2 
      Caption         =   "编码结果"
      Height          =   360
      Left            =   120
      TabIndex        =   5
      Top             =   4560
      Width           =   795
   End
   Begin VB.Label Label1 
      Caption         =   "本地监听端口:"
      Height          =   375
      Left            =   5760
      TabIndex        =   4
      Top             =   240
      Width           =   1305
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
 Dim a

Dim Clients As Integer

Private Sub Command1_Click()
Dim I As Integer
For I = 1 To Clients
    If Winsock1(I).State = sckConnected Then
       Winsock1(I).senddata Winsock1(0).LocalIP & ":" & Text2.Text & vbCrLf
    End If
Next
Text1.Text = Text1.Text & "本地" & ":" & Text2.Text & vbCrLf
Text2.Text = ""
End Sub

Private Sub cmdexit_Click()
End
End Sub

Private Sub cmdsend_Click()
Dim I As Integer
Dim sendpoly As String
ReDim c(1 To 9) As Integer
Dim str As String
If Len(sendframe.Text) <= 0 Then
 MsgBox "长度不允许为零！", vbInformation
  Exit Sub
End If
ReDim c(1 To Len(sendframe.Text)) As Integer

If tennelopt(0).Value = True Then
For I = 1 To Len(sendframe.Text)
 c(I) = CInt(Mid(sendframe.Text, I, 1))
 
 Next I
c(1) = c(1) Xor 1
For I = 1 To UBound(c)
 str = str + CStr(c(I))
Next I
Else
  str = sendframe.Text
End If

For I = 0 To UBound(a)
  sendpoly = sendpoly + CStr(a(I))
Next I
str = str + sendpoly
For I = 1 To Clients
    If Winsock1(I).State = sckConnected Then
       Winsock1(I).senddata str
     
    End If
Next






End Sub


Private Sub Command2_Click()
Dim Datas As Variant
Dim Index As Integer
Command2.Enabled = False
Datas = Split(List1.Text, " ")
Index = Val(Datas(0))
Winsock1(Index).Close
List1.RemoveItem List1.ListIndex
Unload Winsock1(Index)
Load Winsock1(Index)
End Sub

Private Sub convert_Click()
 Dim count As Integer
  ReDim b(1 To 19)
 If senddata.Text = "" Then
   MsgBox ("发送数据不允许为空!")
   Exit Sub
 ElseIf Len(senddata.Text) < 10 Then

  MsgBox ("请输入10位数据二进制数据!")

End If
count = Len(Trim(senddata.Text)) + UBound(a)

ReDim b(1 To count)

'******************
'初始化待发送的数据

For I = 1 To count
 If I <= Len(senddata.Text) Then
 b(I) = CInt(Mid(senddata.Text, I, 1))
 Else
  
  b(I) = 0
  End If
 
Next I

'**********************
'*********************
'对数据进行CRC编码
For m = 1 To UBound(b) - UBound(a)
  Dim temp As Integer
  temp = b(m)
  For h = 1 To UBound(a) + 1
    If temp = 1 Then
          b(m - 1 + h) = b(m - 1 + h) Xor a(h - 1)
         
  Else
         
         b(m - 1 + h) = b(m - 1 + h) Xor 0
         
      End If
         
   Next h
Next m

'*********************
'*********************
'生成带发送的数据帧
Dim str As String
str = str + senddata.Text
For j = 1 To UBound(b)
If j > Len(Trim(senddata.Text)) Then
str = str + CStr(b(j))

End If
Next j

'*********************
sendframe.Text = str



End Sub

'初始化多项式
Private Sub initCheck()

 a = Array(1, 0, 0, 0, 0, 0, 0, 0, 1)
 
For I = 1 To UBound(a)
 Check1(I - 1).Value = CStr(a(I - 1))

Next I
End Sub
Private Sub Form_Load()
Dim I As Integer
Call initCheck   '调用初始化方法

Clients = 20
Winsock1(0).Protocol = sckTCPProtocol
Winsock1(0).LocalPort = Text3.Text
Winsock1(0).Listen
For I = 1 To Clients
  Load Winsock1(I)
Next

Command2.Enabled = False
End Sub



Private Sub Text2_Change()

End Sub









Private Sub Option1_Click(Index As Integer)
If Index = 0 Then
 a = Array(1, 0, 0, 0, 0, 0, 1, 1, 1)
ElseIf Index = 1 Then
 a = Array(1, 0, 0, 1, 1, 0, 0, 0, 1)
Else
  a = Array(1, 0, 0, 0, 0, 0, 0, 0, 1)
End If
For I = 1 To UBound(a)
Check1(I - 1).Value = CStr(a(I - 1))
Next I

End Sub

Private Sub Winsock1_Close(Index As Integer)

Winsock1(Index).Close
Unload Winsock1(Index)
Load Winsock1(Index)
End Sub

Private Sub Winsock1_ConnectionRequest(Index As Integer, ByVal requestID As Long)
Dim I As Integer
For I = 1 To Clients
    If Winsock1(I).State = sckClosed Then
       Winsock1(I).Accept requestID
      
       Exit For
    End If
Next
End Sub
Private Sub Winsock1_DataArrival(Index As Integer, ByVal bytesTotal As Long)
On Error Resume Next
Dim I As Integer
Dim ClientData As Variant
Winsock1(Index).GetData ClientData, vbString
Text1.Text = Text1.Text & Winsock1(Index).RemoteHostIP & ":" & ClientData & vbCrLf
For I = 1 To Clients
    If Winsock1(I).State = sckConnected Then
       If I <> Index Then
            Winsock1(I).senddata Winsock1(Index).RemoteHostIP & ClientData & vbCrLf
       End If
    End If
Next
End Sub