bs.frm

vb编程器界面,实现基本的编程,写入,擦除,校验,芯片选择等功能

      End
      Begin VB.Menu check_null 
         Caption         =   "检空"
      End
      Begin VB.Menu eraser 
         Caption         =   "擦除"
      End
      Begin VB.Menu write 
         Caption         =   "写入"
      End
      Begin VB.Menu parity 
         Caption         =   "校验"
      End
      Begin VB.Menu encode 
         Caption         =   "加密"
      End
      Begin VB.Menu read 
         Caption         =   "读出"
      End
   End
   Begin VB.Menu edit 
      Caption         =   "编辑"
      Begin VB.Menu color 
         Caption         =   "颜色"
      End
      Begin VB.Menu size 
         Caption         =   "字号"
         Begin VB.Menu S 
            Caption         =   "四号"
            Index           =   0
         End
         Begin VB.Menu S 
            Caption         =   "三号"
            Index           =   1
         End
         Begin VB.Menu S 
            Caption         =   "二号"
            Index           =   2
         End
      End
      Begin VB.Menu font 
         Caption         =   "字体"
      End
      Begin VB.Menu bold 
         Caption         =   "粗体"
      End
   End
   Begin VB.Menu choose 
      Caption         =   "端口选择"
      Begin VB.Menu comm1 
         Caption         =   "串口1"
      End
      Begin VB.Menu comm2 
         Caption         =   "串口2"
      End
   End
   Begin VB.Menu help 
      Caption         =   "帮助"
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim filen As Long  '输入文件长度
Dim folen As Long  '输出文件长度
Dim fibuf() As Byte  '文件输入缓冲区
Dim fobuf() As Byte  '文件输出缓冲区
Dim flereclen As Long   '已接收文件字节数
Dim flag As Boolean  '通信正确标志,初值为假（form启动中赋初值）
Dim chiptype As Byte ' 定义芯片型号值,C51为2,S51为1,2051位0


Private Sub auto_Click()
    MSComm1.Output = "88"
    If Not flag Then
     MsgBox "通信出错", vbOKOnly, "出错信息"
     Exit Sub
    Else
      ProBar1.Width = 0
      Label10.Caption = "正在鉴别......."
      Call identify_Click
      Label10.Caption = "鉴别成功"
      ProBar1.Width = 800
      Label10.Caption = "鉴别成功" + Chr(13) + Chr(10) + "正在擦除........"
      Call eraser_Click
      Label10.Caption = "鉴别成功" + Chr(13) + Chr(10) + "擦除成功"
      ProBar1.Width = 2700
      Label10.Caption = "鉴别成功" + Chr(13) + Chr(10) + "擦除成功" + Chr(13) + Chr(10) + "正在写入............"
      Call write_Click
      Label10.Caption = "鉴别成功" + Chr(13) + Chr(10) + "擦除成功" + Chr(13) + Chr(10) + "写入成功"
      ProBar1.Width = 7900
     End If
     flag = False '为下次通信准备，赋初值
End Sub

Private Sub bold_Click()
If bold.Checked = False Then
   Text1.FontBold = True
   bold.Checked = True
   size.Visible = True
Else
   Text1.FontBold = False
   bold.Checked = False
   size.Visible = False
End If
End Sub


Private Sub check_null_Click()
  MSComm1.Output = "aa"
  Label10.Caption = "鉴别成功" + Chr(13) + Chr(10) + "正在检空......."
 'If !flag Then
   ' MsgBox "通信出错", vbOKOnly, "出错信息"
  '  Exit Sub
 ' Else
     'For i = 0 To 65000
     ' succ = MSComm1.Input
    '  If (succ) Then
        Label10.Caption = "校验成功" + Chr(13) + Chr(10) + "检空成功"
        flag = False '为下次通信准备，赋初值
       ' Exit Sub
     ' End If
    'Next i
   ' MsgBox "通信出错", vbOKOnly, "出错信息"
  'End If
 ' flag = False '为下次通信准备，赋初值
End Sub

Private Sub color_Click()
  ComDia.ShowColor
  Text1.ForeColor = ComDia.color
End Sub

Private Sub comm1_Click()
 If MSComm1.PortOpen Then
  Shape1.FillColor = vbRed
  Shape2.FillColor = vbWhite
  MsgBox " 串口已经打开!", vbOKOnly, "提示信息"
  Exit Sub
 Else
  Shape1.FillColor = vbRed
  Shape2.FillColor = vbWhite
  MSComm1.CommPort = 1
  MSComm1.Settings = "9600,n,8,1"  '奇校验
  MSComm1.RThreshold = 1     '每次接收到字符即产生OnComm事件.MSComm1.RThreshold =0则关闭自动接收
  MSComm1.RTSEnable = True
  MSComm1.DTREnable = True
  MSComm1.InBufferSize = filen  '设置接收缓冲区的字节长度
  MSComm1.OutBufferSize = folen '设置发送缓冲区的字节长度
  MSComm1.InBufferCount = 0     '清除接收缓冲区的数据
  MSComm1.OutBufferCount = 0     '清除发送缓冲区的数据
  MSComm1.PortOpen = True
  If Err Then MsgBox "串口没打开"
 End If
End Sub

Private Sub comm2_Click()
On Error GoTo porterr
 If MSComm2.PortOpen Then
  Shape1.FillColor = vbWhite
  Shape2.FillColor = vbRed
  MsgBox " 串口已经打开!", vbOKOnly, "提示信息"
  Exit Sub
  Else
  Shape1.FillColor = vbWhite
  Shape2.FillColor = vbRed
  MSComm2.CommPort = 2
  MSComm2.Settings = "9600,n,8,1"  '奇校验
  MSComm2.RThreshold = 1       '每次接收到字符即产生OnComm事件
  MSComm2.RTSEnable = True
  MSComm2.DTREnable = True
  MSComm2.InBufferSize = filen  '设置接收缓冲区的字节长度
  MSComm2.OutBufferSize = folen '设置发送缓冲区的字节长度
  MSComm2.InBufferCount = 0     '清除接收缓冲区的数据
  MSComm2.OutBufferCount = 0     '清除发送缓冲区的数据
  MSComm2.PortOpen = True
porterr:
  If Err.Number = "8002" Then MsgBox "无效端口号!串口没打开!", vbOKCancel, "出错信息"
 End If
End Sub

Private Sub encode_Click()
Dim i, j As Integer
Dim succ
  MSComm1.Output = "ee"
  Label10.Caption = "正在加密........."
  If Not flag Then                                      '单片机收到命令后发来的确认信号
    MsgBox "通信出错", vbOKOnly, "出错信息"
    Exit Sub                                        '如果没收到此信号,视为通信不成功
  Else
    For i = 0 To 65500                             '等待完成
     For j = 0 To 65000
      succ = MSComm1.Input
      If (succ) Then
        Label10.Caption = "加密成功"
        flag = False '为下次通信准备，赋初值
        Exit Sub
      End If
     Next j
    Next i
    MsgBox "通信出错", vbOKOnly, "出错信息"
  End If
  flag = False '为下次通信准备，赋初值
End Sub

Private Sub eraser_Click()
  Dim succ As Byte
  Dim i, j As Integer
  MSComm1.Output = "bb"
  Label10.Caption = "正在擦除........"
  If Not flag Then
    MsgBox "通信出错", vbOKOnly, "出错信息"
    Exit Sub
  Else
    For i = 0 To 65500
     For j = 0 To 3
      succ = MSComm1.Input
      If (succ) Then
        Label10.Caption = "擦除成功"
        flag = False '为下次通信准备，赋初值
        Exit Sub
      End If
     Next j
    Next i
    MsgBox "通信出错", vbOKOnly, "出错信息"

  End If
  flag = False '为下次通信准备，赋初值
End Sub

Private Sub exit_Click()
End
End Sub

Private Sub font_Click()
  ComDia.ShowFont
  Text1.FontName = ComDia.FontName
End Sub



Private Sub Form_Load()
  Form1.Width = 10455
  Form1.Height = 11625
  flag = False
End Sub



Private Sub identify_Click()
  Dim succ As Byte
  Dim i As Integer
  MSComm1.Output = "99"
  Label10.Caption = "正在鉴别......."
  If MSComm1.Input = 85 Then
     For i = 0 To 65000
      succ = MSComm1.Input
      If (succ) Then
        Label10.Caption = "鉴别成功"
        Label4.Caption = succ
        flag = False '为下次通信准备，赋初值
        Exit Sub
      End If
    Next i
    MsgBox "通信出错", vbOKOnly, "出错信息"
  'MSComm1.InputMode = comInputModeBinary
  'MSComm2.InputMode = comInputModeBinary
  End If
  flag = False '为下次通信准备，赋初值
End Sub



Private Sub MSComm1_OnComm()
flag = True
If Not flag Then
 MsgBox "通信出错", vbOKOnly, "出错信息"
End If
End Sub

Private Sub MSComm2_OnComm()
flag = True
If Not flag Then
 MsgBox "通信出错", vbOKOnly, "出错信息"
End If
End Sub

Private Sub open_Click()
 ComDia.DialogTitle = "打开文件"
 ComDia.Filter = "*.HEX|*.HEX;|*.TXT|*.TXT;|*.ASM|*.ASM; |*.C|*.C;"
 ComDia.ShowOpen
 StatusBar1.Panels.Item(6) = ComDia.FileName
 Dim tx As String
 Text1.Text = ""
 If ComDia.FileName <> "" Then
  Open ComDia.FileName For Input As #1
  Do While Not EOF(1)
    Line Input #1, tx
    Text1.Text = Text1.Text + tx + Chr(13) + Chr(10)
  Loop
  Close #1
 End If
End Sub



Private Sub Option1_Click()
   Option1.Value = True
End Sub

Private Sub Option1_DblClick()
   Option1.Value = False
End Sub

Private Sub parity_Click()
  Dim succ As Byte
  Dim i, j As Integer
  MSComm1.Output = "dd"
  Label10.Caption = "正在校验........."
  If Not flag Then                                      '单片机收到命令后发来的确认信号
    MsgBox "通信出错", vbOKOnly, "出错信息"
    Exit Sub                                        '如果没收到此信号,视为通信不成功
  Else
    For i = 0 To 65500                             '等待完成
     For j = 0 To 65500
      succ = MSComm1.Input
      If (succ) Then
        Label10.Caption = "校验成功"
        flag = False '为下次通信准备，赋初值
        Exit Sub
      End If
     Next j
    Next i
    MsgBox "通信出错", vbOKOnly, "出错信息"

  End If
 flag = False '为下次通信准备，赋初值
 End Sub

Private Sub printer_Click()
  ComDia.ShowPrinter
End Sub

Private Sub read_Click()
  Dim count As Long
  MSComm1.Output = "77"
  Label10.Caption = "正在读出............."
  If Not flag Then                                      '单片机收到命令后发来的确认信号
    MsgBox "通信出错", vbOKOnly, "出错信息"
    Exit Sub                                        '如果没收到此信号,视为通信不成功
  ElseIf (chiptype) Then
    Do While count < 2048
     Text1.Text = Text1.Text + MSComm1.Input + Chr(13) + Chr(10)
    Loop
    Label10.Caption = "读出成功"
    flag = False '为下次通信准备，赋初值
    Exit Sub
   Else
    Do While count < 4096
     Text1.Text = Text1.Text + MSComm1.Input + Chr(13) + Chr(10)
    Loop
    Label10.Caption = "读出成功"
    flag = False '为下次通信准备，赋初值
    Exit Sub
   End If
  
  '  MsgBox "通信出错", vbOKOnly, "出错信息"
  flag = False '为下次通信准备，赋初值
End Sub

Private Sub S_Click(Index As Integer)
Select Case Index
  Case 0
      Text1.FontSize = 22
      S(0).Checked = True
      S(1).Checked = False
      S(2).Checked = False
  Case 1
        Text1.FontSize = 18
        S(0).Checked = False
        S(1).Checked = True
        S(2).Checked = False

  Case 2
      Text1.FontSize = 14
      S(0).Checked = False
      S(1).Checked = False
      S(2).Checked = True
 End Select

End Sub

Private Sub save_Click()
  ComDia.ShowSave
  Dim overw As Integer
  If Dir(ComDia.FileName) <> "" Then
    overw = MsgBox("此文件已存在，是否替换？", vbOKCancel)
  If overw = vbOK Then
    GoTo save
  End If
  Else
save:
  Open ComDia.FileName For Output As #1
  Print #1, Text1.Text
  Close #1
  End If
  End Sub


Private Sub serial_2051_Click()
   Label6.Caption = "serial_2051"
   chiptype = 0 ' 定义芯片型号值,C51为2,S51为1,2051位0
End Sub

Private Sub serial_ISP_Click()
   Label6.Caption = "serial_ISP"
   chiptype = 1 ' 定义芯片型号值,C51为2,S51为1,2051位0
End Sub

Private Sub seril_51_Click()
   Label6.Caption = "serial_51"
End Sub

Private Sub size_Click()
  Text1.FontSize = ComDia.FontSize
  chiptype = 2 ' 定义芯片型号值,C51为2,S51为1,2051位0
End Sub
 

 






Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
  Select Case Toolbar1.Index
     Case 1
       Call check_null_Click
     Case 2
       Call identify_Click
     Case 3
       Call auto_Click
     Case 4
       Call eraser_Click
     Case 5
       Call read_Click
     Case 6
       Call parity_Click
     Case 7
       Call encode_Click
     Case 8
       Call write_Click
     End Select
End Sub

Private Sub write_Click()
  Dim succ As Byte
  Dim i, j As Integer
  MSComm1.Output = "cc"
  Label10.Caption = "正在写入............"
  If Not flag Then
    MsgBox "通信出错", vbOKOnly, "出错信息"
    Exit Sub
  Else
    For i = 0 To 65500
     For j = 0 To 65500
      succ = MSComm1.Input
      If (succ) Then
        Label10.Caption = "写入成功"
        flag = False '为下次通信准备，赋初值
        Exit Sub
      End If
     Next j
    Next i
    MsgBox "通信出错", vbOKOnly, "出错信息"
  End If
  flag = False '为下次通信准备，赋初值
End Sub