form1.frm

VB做的

StuBar.Panels(8).Text = "装载完毕,前方框打勾则成功"
Me.MousePointer = 0
Exit Sub
1
Me.MousePointer = 0
Msg Err.Description
End Sub

Private Sub ComExit_Click()
If MsgBox("     你真的要退出系统吗？  ", 4, "系统提示") = vbNo Then
   Exit Sub
End If
Unload Me
End Sub

Private Sub Command1_Click()
On Error GoTo 1
Dim I As Integer
Lab0.Caption = "扇区" & "0"
Lab1.Caption = "扇区" & "1"
Lab2.Caption = "扇区" & "2"
Lab3.Caption = "扇区" & "3"
StuBar.Panels(8).Text = ""
StuBar.Panels.Item(4).Text = ""
StuBar.Panels.Item(6).Text = ""
StuBar.Panels(4).ToolTipText = ""
StuBar.Panels(6).ToolTipText = ""
WriteNum = 1
For I = 0 To 11
   Txt(I).Text = ""
   Check1(I).Value = 0
   Check1(I).Enabled = False
Next I
Me.Refresh
For I = 0 To 3
   
   '""""""""""""""""""""""""""""""""""
   Delay (0.1)
   Rel = SubXk(I)            '寻卡
   If Rel = 2 Then
      GoTo 2
   ElseIf Rel = 3 Then
      Exit Sub
   End If
   Delay (0.1)
   '"""""""""""""""""""""""""""""""""""
   Rel = SubRead(I)          '读卡
   If Rel = 3 Then
      Exit Sub
   ElseIf Rel = 1 Then
      CmdRing_Click
   End If
   Delay (0.1)
   '""""""""""""""""""""""""""""""""
2
Next I
Txt(0).Enabled = False
Check1(0).Enabled = False
Check1(0).Value = 0
StuBar.Panels(8).Text = "读卡完毕,文本框有数据成功"
Exit Sub
1
Msg Err.Description
End Sub

Private Sub Command2_Click()
On Error GoTo 1
Dim I As Integer
Lab0.Caption = "扇区" & "4"
Lab1.Caption = "扇区" & "5"
Lab2.Caption = "扇区" & "6"
Lab3.Caption = "扇区" & "7"
StuBar.Panels(8).Text = ""
StuBar.Panels.Item(4).Text = ""
StuBar.Panels.Item(6).Text = ""
StuBar.Panels(4).ToolTipText = ""
StuBar.Panels(6).ToolTipText = ""
WriteNum = 2
For I = 0 To 11
   Txt(I).Text = ""
   Check1(I).Value = 0
   Check1(I).Enabled = False
Next I
Me.Refresh
For I = 4 To 7
   '""""""""""""""""""""""""""""""""""
   Delay (0.1)
   Rel = SubXk(I)            '寻卡
   If Rel = 2 Then
      GoTo 2
   ElseIf Rel = 3 Then
      Exit Sub
   End If
   Delay (0.1)
   '"""""""""""""""""""""""""""""""""""
   Rel = SubRead(I)          '读卡
   If Rel = 3 Then
      Exit Sub
   ElseIf Rel = 1 Then
      CmdRing_Click
   End If
   Delay (0.1)
   '""""""""""""""""""""""""""""""""
2
Next I
Txt(0).Enabled = True
StuBar.Panels(8).Text = "读卡完毕,文本框有数据成功"
Exit Sub
1
Msg Err.Description
End Sub

Private Sub Command3_Click()
On Error GoTo 1
Dim I As Integer
Lab0.Caption = "扇区" & "8"
Lab1.Caption = "扇区" & "9"
Lab2.Caption = "扇区" & "10"
Lab3.Caption = "扇区" & "11"
StuBar.Panels(8).Text = ""
StuBar.Panels.Item(4).Text = ""
StuBar.Panels.Item(6).Text = ""
StuBar.Panels(4).ToolTipText = ""
StuBar.Panels(6).ToolTipText = ""
WriteNum = 3
For I = 0 To 11
   Txt(I).Text = ""
   Check1(I).Value = 0
   Check1(I).Enabled = False
Next I
Me.Refresh
For I = 8 To 11
   '""""""""""""""""""""""""""""""""""
   Delay (0.1)
   Rel = SubXk(I)            '寻卡
   If Rel = 2 Then
      GoTo 2
   ElseIf Rel = 3 Then
      Exit Sub
   End If
   Delay (0.1)
   '"""""""""""""""""""""""""""""""""""
   Rel = SubRead(I)          '读卡
   If Rel = 3 Then
      Exit Sub
   ElseIf Rel = 1 Then
      CmdRing_Click
   End If
   Delay (0.1)
   '""""""""""""""""""""""""""""""""
2
Next I
Txt(0).Enabled = True
StuBar.Panels(8).Text = "读卡完毕,文本框有数据成功"
Exit Sub
1
Msg Err.Description
End Sub

Private Sub Command4_Click()
On Error GoTo 1
Dim I As Integer
Lab0.Caption = "扇区" & "12"
Lab1.Caption = "扇区" & "13"
Lab2.Caption = "扇区" & "14"
Lab3.Caption = "扇区" & "15"
StuBar.Panels(8).Text = ""
StuBar.Panels.Item(4).Text = ""
StuBar.Panels.Item(6).Text = ""
StuBar.Panels(4).ToolTipText = ""
StuBar.Panels(6).ToolTipText = ""
WriteNum = 4
For I = 0 To 11
   Txt(I).Text = ""
   Check1(I).Value = 0
   Check1(I).Enabled = False
Next I
Me.Refresh
For I = 12 To 15
   '""""""""""""""""""""""""""""""""""
   Delay (0.1)
   Rel = SubXk(I)            '寻卡
   If Rel = 2 Then
      GoTo 2
   ElseIf Rel = 3 Then
      Exit Sub
   End If
   Delay (0.1)
   '"""""""""""""""""""""""""""""""""""
   Rel = SubRead(I)          '读卡
   If Rel = 3 Then
      Exit Sub
   ElseIf Rel = 1 Then
      CmdRing_Click
   End If
   Delay (0.1)
   '""""""""""""""""""""""""""""""""
2
Next I
Txt(0).Enabled = True
StuBar.Panels(8).Text = "读卡完毕,文本框有数据成功"
Exit Sub
1
Msg Err.Description
End Sub

Private Sub Command5_Click()
On Error GoTo 1
Dim I As Integer
If WriteNum = 0 Then
   Msg "请在读出某几个扇区后，选择要写入的块后再写入"
   Exit Sub
End If
If Check1(0).Value = 0 And Check1(1).Value = 0 And Check1(2).Value = 0 And Check1(3).Value = 0 And _
Check1(4).Value = 0 And Check1(5).Value = 0 And Check1(6).Value = 0 And Check1(7).Value = 0 And _
Check1(8).Value = 0 And Check1(9).Value = 0 And Check1(10).Value = 0 And Check1(11).Value = 0 Then
   Msg "请选择要写入数据的块"
   Exit Sub
End If
For I = 0 To 11
   If Check1(I).Value = 1 Then
      If Len(Txt(I).Text) <> 32 Then
         Msg "请输入32位的数据"
         Txt(I).SetFocus
         Exit Sub
      End If
   End If
   Che1(I).Value = 0
Next I
StuBar.Panels(8).Text = ""
StuBar.Panels.Item(4).Text = ""
StuBar.Panels.Item(6).Text = ""
StuBar.Panels(4).ToolTipText = ""
StuBar.Panels(6).ToolTipText = ""
For I = 0 To 11
   If Check1(I).Value = 1 Then
      '""""""""""""""""""""""""""""""""""
      Delay (0.1)
      Rel = SubXk(I \ 3 + (WriteNum - 1) * 4)    '寻卡
      If Rel = 2 Then
         GoTo 2
      ElseIf Rel = 3 Then
         Exit Sub
      End If
      Delay (0.1)
      '"""""""""""""""""""""""""""""""""""
      Rel = SubWrite(I)          '写卡
      If Rel = 3 Then
         Exit Sub
      End If
      Delay (0.1)
      '""""""""""""""""""""""""""""""""
   End If
2
Next I
StuBar.Panels(8).Text = "写卡完毕,前方框打勾则成功"
Exit Sub
1
Msg Err.Description
End Sub

Private Sub CmdRing_Click()
Dim Temp As Variant
Dim StrByte(6) As Byte

Me.MousePointer = 11
StrByte(0) = &H2
StrByte(1) = &HFD
StrByte(2) = &H87
StrByte(3) = &H78
StrByte(4) = &H32
StrByte(5) = &HCD
Temp = StrByte
MSComm1.OutBufferCount = 0
MSComm1.InBufferCount = 0
MSComm1.Output = Temp
MSComm1.OutBufferCount = 0
'SdStr = SubBack       '返回值(鸣叫不理返回值)
Me.MousePointer = 0
End Sub

Private Sub ComText_Click()
On Error GoTo 1
Dim FsStr As Variant
Dim StrByte(4) As Byte
StuBar.Panels(2).Text = ""
StrByte(0) = &H1
StrByte(1) = &HFE
StrByte(2) = &H88
StrByte(3) = &H77
FsStr = StrByte
SdStr = ""
MSComm1.OutBufferCount = 0
MSComm1.InBufferCount = 0
MSComm1.Output = FsStr
MSComm1.OutBufferCount = 0
SdStr = SubBack
If SdStr = "E0" Then
   StuBar.Panels(2).Text = "成功"
   Delay (0.1)
   CmdRing_Click
Else
   StuBar.Panels(2).Text = "失败"
End If
Exit Sub
1
Msg Err.Description
End Sub

Private Sub Form_Activate()
ComText.SetFocus
End Sub

Private Sub Form_Load()
On Error GoTo 1
Me.MousePointer = 11
With MSComm1
    .CommPort = Val(CBckh.Text)         ' 设置通信口
    '.Settings = "9600,S,8,1"          '空校验,8位数据位,1位结束位
    '.InBufferSize = 70                '接收缓冲区64字节
    '.OutBufferSize = 70               '发送缓冲区64字节
    .InputMode = comInputModeBinary   '接受方式为二进制形式
    '.RThreshold = 0
    .InBufferCount = 0                '清空接收缓冲区
    .OutBufferCount = 0               '清空发送缓冲区
    '.SThreshold = 0
    .InputLen = 1                     '每次从缓冲区读一字节
    If .PortOpen = False Then
        .PortOpen = True
        If Err Then
            Msg "串口通信无效!"
            Exit Sub
        End If
    End If
End With
WriteNum = 0

'""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
ComText_Click          '登陆即测通讯
'""""""""""""""""""""""""""""""""""""""""""""""""""""""""""

'""""""""""""""""""""""""""""""""""""""""""""""""""""""""
Dim Sf As String, File As Integer, Buffer As String, I As Integer
Sf = App.Path & "\system.ini"
If Dir(Sf) <> "" Then
   File = FreeFile()
   Open Sf For Input As File
   If Not EOF(File) Then
      Line Input #File, Buffer
      CBckh.Text = Trim(Buffer)
   End If
   I = 0
   While Not EOF(File)
      Line Input #File, Buffer
      Text(I).Text = Trim(Buffer)
      I = I + 1
      If I > 15 Then
         Close File
         Exit Sub
      End If
   Wend
   Close File
End If
'""""""""""""""""""""""""""""""""""""""""""""""""""""""""""

Me.MousePointer = 0
Exit Sub
1
Me.MousePointer = 0
Msg Err.Description
End Sub

Private Sub Form_Unload(Cancel As Integer)
On Error GoTo ErrHandle
If MSComm1.PortOpen = True Then
   MSComm1.PortOpen = False
End If

'""""""""""""""""""""""""""""""""""""""""""""""""""""""""
Dim Sf As String, File As Integer, Buffer As String, I As Integer
Sf = App.Path & "\system.ini"
If Dir(Sf) <> "" Then
   Buffer = CBckh.Text & Chr(13) & Chr(10)
   For I = 0 To 15
      Buffer = Buffer & Text(I).Text & Chr(13) & Chr(10)
   Next I
   File = FreeFile()
   Open Sf For Output As File
   Print #File, Buffer
   Close File
End If
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""

Exit Sub
ErrHandle:
Msg Err.Description
End Sub

Private Sub Text_KeyPress(Index As Integer, KeyAscii As Integer)
On Error GoTo 1
Dim TextStr As String
If KeyAscii = 13 And Index < 15 Then
   Text(Index + 1).SetFocus
ElseIf KeyAscii = 13 Then
   Text(0).SetFocus
End If
TextStr = Text(Index).Text
If KeyAscii <> 8 Then
   If (KeyAscii < 48 Or KeyAscii > 57) And (KeyAscii