form1.frm

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

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form Form1 
   Caption         =   "接收端"
   ClientHeight    =   4770
   ClientLeft      =   4140
   ClientTop       =   2700
   ClientWidth     =   7890
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   ScaleHeight     =   4770
   ScaleWidth      =   7890
   Begin VB.TextBox txtcode 
      Appearance      =   0  'Flat
      Height          =   375
      Left            =   1521
      TabIndex        =   11
      Top             =   2880
      Width           =   2295
   End
   Begin VB.CommandButton unzipcode 
      Caption         =   "解码"
      Height          =   375
      Left            =   2040
      TabIndex        =   9
      Top             =   1080
      Width           =   855
   End
   Begin VB.TextBox Text5 
      Height          =   375
      Left            =   6110
      TabIndex        =   7
      Text            =   "0"
      Top             =   2040
      Width           =   1586
   End
   Begin VB.CommandButton Command3 
      Caption         =   "断开连接"
      Height          =   375
      Left            =   6123
      TabIndex        =   4
      Top             =   3240
      Width           =   1573
   End
   Begin VB.TextBox Text3 
      Height          =   338
      Left            =   1200
      Locked          =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   3
      Top             =   480
      Width           =   3240
   End
   Begin VB.CommandButton Command1 
      Caption         =   "连接发送端"
      Height          =   375
      Left            =   6123
      TabIndex        =   2
      Top             =   2640
      Width           =   1573
   End
   Begin VB.TextBox Text2 
      Height          =   375
      Left            =   6120
      TabIndex        =   1
      Text            =   "2008"
      Top             =   1320
      Width           =   1586
   End
   Begin VB.TextBox Text1 
      Height          =   375
      Left            =   6120
      TabIndex        =   0
      Text            =   "127.0.0.1"
      Top             =   600
      Width           =   1586
   End
   Begin MSWinsockLib.Winsock Winsock1 
      Left            =   6786
      Top             =   117
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.Label Label5 
      Caption         =   "原始数据"
      Height          =   255
      Left            =   240
      TabIndex        =   13
      Top             =   480
      Width           =   855
   End
   Begin VB.Label Label4 
      Caption         =   "解码后结果："
      Height          =   255
      Left            =   240
      TabIndex        =   12
      Top             =   2640
      Width           =   1095
   End
   Begin VB.Label errorMsg 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      ForeColor       =   &H000000FF&
      Height          =   375
      Left            =   1680
      TabIndex        =   10
      Top             =   1755
      Visible         =   0   'False
      Width           =   1695
   End
   Begin VB.Label Label3 
      Caption         =   "本地端口："
      Height          =   260
      Left            =   5265
      TabIndex        =   8
      Top             =   2158
      Width           =   975
   End
   Begin VB.Label Label2 
      Caption         =   "发送端端口："
      Height          =   260
      Left            =   5148
      TabIndex        =   6
      Top             =   1404
      Width           =   1066
   End
   Begin VB.Label Label1 
      Caption         =   "发送端IP："
      Height          =   255
      Left            =   5025
      TabIndex        =   5
      Top             =   720
      Width           =   1095
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Dim a(1 To 9) As Integer
'初始化约定的多项式
Private Sub initialpoly()
a(1) = 1
a(5) = 1
a(2) = 0: a(3) = 1: a(4) = 0
End Sub

Private Sub Command1_Click()
Winsock1.Protocol = sckTCPProtocol
Winsock1.RemoteHost = Text1.Text
Winsock1.RemotePort = CLng(Text2.Text)
Winsock1.LocalPort = CLng(Text5.Text)
Winsock1.Connect
Command1.Enabled = False
Command3.Enabled = True
End Sub



Private Sub Command3_Click()
Winsock1.Close
Command3.Enabled = False
Command1.Enabled = True

End Sub


Private Sub Form_Load()
Command3.Enabled = False
Command1.Enabled = True
'初始化多项式
Call initialpoly
End Sub





Private Sub unzipcode_Click()
Dim str As String
ReDim b(1 To 16)
str = Trim(Text3.Text)
If Len(Text3.Text) <= 0 Then
MsgBox "长度不允许为零！", vbInformation

Exit Sub
End If
txtcode.Text = Left(str, Len(str) - UBound(a) + 1)

ReDim b(1 To Len(str))
For i = 1 To Len(str)
  
  b(i) = CInt(Mid(str, i, 1))
Next i

For m = 1 To Len(Trim(str)) - UBound(a) + 1
  Dim temp As Integer
  temp = b(m)
  For h = 1 To UBound(a)
    If temp = 1 Then
          b(m - 1 + h) = b(m - 1 + h) Xor a(h)
         
  Else
         
         b(m - 1 + h) = b(m - 1 + h) Xor 0
         
      End If
         
   Next h
Next m
For k = Len(Trim(str)) - UBound(a) + 1 To Len(Trim(str))
 
If b(k) = 1 Then
Exit For
End If
 Next k
 If k <= Len(Trim(str)) Then
   errorMsg.Caption = "传输数据有差错！"
   errorMsg.Visible = True
  Else
   errorMsg.Visible = True
   errorMsg.Caption = "数据正常传输"
    errorMsg.ForeColor = blue
    
    
 End If
End Sub

Private Sub Winsock1_Close()
MsgBox "连接中断!", 0 + 48, "中断"
Winsock1.Close
Command3.Enabled = False
Command1.Enabled = True
Command2.Enabled = False
End Sub

Private Sub Winsock1_Connect()
MsgBox "连接成功!"

End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim strdata As String

Winsock1.GetData strdata, vbString
Text3.Text = Left(strdata, Len(Trim(strdata)) - 9)
For i = 1 To Len(Trim(Right(strdata, 9)))
   a(i) = Mid(Right(strdata, 9), i, 1)

 
Next i
 MsgBox "数据已被接收端接收！", vbInformation

End Sub

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)
MsgBox "错误代码:" & Number
End Sub