frmmain.frm

VB写PC端ISP程序W78E516UpdataOfVB,请配合本人用C51写的华邦8位单片机ISP程序w78e516_ISPofC51使用

  Dim CommandString() As Byte, STR As String
  Dim CommandLength As Long
  On Error GoTo ERCOM
  OpenCom Frmmain.MSCOM, 0, 0
   
  
  CommandLength = DataLength + 5 + 1
  ReDim CommandString(CommandLength)
   CommandString(0) = HeaderFlag
   CommandString(1) = PortNo    '端口号
   CommandString(2) = handle    '命令字
   CommandString(3) = 0         '包长度
   CommandString(4) = DataLength + 5 '数据长度
   If DataLength <> 0 Then
    CopyMemory CommandString(5), DataBuf(LBound(DataBuf)), DataLength
   End If
   STR = CRC16(CommandString, DataLength + 5)
   Select Case (Len(STR))
          Case 1
             STR = "000" + STR
          Case 2
             STR = "00" + STR
          Case 3
             STR = "0" + STR
    End Select
    
   CommandString(DataLength + 5) = CByte("&H" + Mid(STR, 1, 2))
   CommandString(DataLength + 5 + 1) = CByte("&H" + Mid(STR, 3, 2))
   Me.MSCOM.Output = CommandString
   
   Exit Sub
ERCOM:
  MsgBox "打开串口错！"
End Sub

Public Sub SENDResetMcuCode()   '复位MCU
Dim BT() As Byte
StatusBar.Panels(4).Text = "复位MCU "
SendTcpIpCommand MSComPort, RestMcuCode, 0, BT
ReceiveData Frmmain.MSCOM
 If ReceiveBuf(3) = 0 Then
   If DisFlag = True Then MsgBox "连接超时!", vbExclamation + vbOKOnly, "系统信息"
   StatusBar.Panels(4).Text = "连接超时 "
   OKFlag = False
 Else
  If ReceiveBuf(0) = Asc("O") And ReceiveBuf(1) = Asc("K") Then
     If DisFlag = True Then MsgBox "复位MCU成功!", vbExclamation + vbOKOnly, "系统信息"
     StatusBar.Panels(4).Text = "复位MCU成功 "
     OKFlag = True
  Else
   If DisFlag = True Then MsgBox "复位MCU失败!", vbExclamation + vbOKOnly, "系统信息"
   StatusBar.Panels(4).Text = "复位MCU失败"
   OKFlag = False
  End If
 End If
End Sub
Public Sub SENDEraseCode()  '擦除命令
Dim BT() As Byte
StatusBar.Panels(4).Text = "正在擦除......"
SendTcpIpCommand MSComPort, EraseCode, 0, BT
ReceiveData Frmmain.MSCOM
 If ReceiveBuf(3) = 0 Then
   If DisFlag = True Then MsgBox "连接超时!", vbExclamation + vbOKOnly, "系统信息"
   StatusBar.Panels(4).Text = "连接超时 "
   OKFlag = False
 Else
  If ReceiveBuf(0) = Asc("O") And ReceiveBuf(1) = Asc("K") Then
   If DisFlag = True Then MsgBox "擦除成功!", vbExclamation + vbOKOnly, "系统信息"
   StatusBar.Panels(4).Text = "擦除成功"
   OKFlag = True
  Else
    If DisFlag = True Then MsgBox "擦除失败!", vbExclamation + vbOKOnly, "系统信息"
    StatusBar.Panels(4).Text = "擦除失败"
    OKFlag = False
  End If
 End If
End Sub



Public Sub SENDBlankCode()   '全空检查命令
Dim BT(5) As Byte
BT(0) = 0
BT(1) = 1
BT(2) = 0
BT(3) = 0

StatusBar.Panels(4).Text = "正在全空检查...... "
SendTcpIpCommand MSComPort, BlankCode, 4, BT
ReceiveData Frmmain.MSCOM
 If ReceiveBuf(3) = 0 Then
   If DisFlag = True Then MsgBox "连接超时!", vbExclamation + vbOKOnly, "系统信息"
   StatusBar.Panels(4).Text = "连接超时 "
   OKFlag = False
 Else
  If ReceiveBuf(0) = Asc("O") And ReceiveBuf(1) = Asc("K") Then
     If DisFlag = True Then MsgBox "全空检查成功!", vbExclamation + vbOKOnly, "系统信息"
     StatusBar.Panels(4).Text = "全空检查成功 "
     OKFlag = True
  Else
   If DisFlag = True Then MsgBox "全空检查失败!", vbExclamation + vbOKOnly, "系统信息"
   StatusBar.Panels(4).Text = "全空检查失败"
   OKFlag = False
  End If
 End If
End Sub
Public Sub SENDProgramCode()
Dim DataBuf(256) As Byte, i As Byte
Dim DataCount As Long   '数据指针
Dim STR As String
Dim DataLength As Integer  '数据包数据长度
Dim BagLength As Byte
If CHKFile.Value = 1 Then  '检测是否需要重装文件
  OpenFileFunction SysInfomation.OpenFilePath
End If
BagLength = 128
DataCount = 0
Xp_ProgressBar2.Max = fileleng
Xp_ProgressBar2.Min = 0
StatusBar.Panels(4).Text = "正在编程...... "
 TT = GetTickCount()
Do
 If fileleng - DataCount < BagLength Then
   DataLength = fileleng - DataCount
 Else
  DataLength = BagLength
 End If
 CopyMemory DataBuf(4), txdatabuf(DataCount), DataLength
 STR = CStr(Hex(DataCount))
 Select Case (Len(STR))
       Case 1
           STR = "0000000" + STR
       Case 2
           STR = "000000" + STR
       Case 3
           STR = "00000" + STR
       Case 4
           STR = "0000" + STR
       Case 5
           STR = "000" + STR
       Case 6
           STR = "00" + STR
       Case 7
           STR = "0" + STR
End Select
 Xp_ProgressBar2.Value = DataCount
 Xp_ProgressBar2.ToolTipText = STR
 
 DataBuf(0) = CByte("&H" + Mid(STR, 1, 2))
 DataBuf(1) = CByte("&H" + Mid(STR, 3, 2))
 DataBuf(2) = CByte("&H" + Mid(STR, 5, 2))
 DataBuf(3) = CByte("&H" + Mid(STR, 7, 2))
 SendTcpIpCommand MSComPort, ProgramCode, DataLength + 4, DataBuf
 ReceiveData Frmmain.MSCOM
 If ReceiveBuf(3) = 0 Then
   If DisFlag = True Then MsgBox "连接超时!", vbExclamation + vbOKOnly, "系统信息"
    StatusBar.Panels(4).Text = "连接超时"
    OKFlag = False
   Exit Sub
 Else
  If ReceiveBuf(0) = Asc("E") And ReceiveBuf(1) = Asc("R") Then
   If DisFlag = True Then MsgBox "编程失败!", vbExclamation + vbOKOnly, "系统信息"
    StatusBar.Panels(4).Text = "编程失败"
    OKFlag = False
    Exit Sub
  End If
 End If
 DataCount = DataCount + DataLength
  
    STR = CStr(FormatPercent(DataCount / fileleng)) + "    "
    If Mid(STR, 1, 1) = "." Then STR = "0" + STR
    
    StatusBar.Panels(6).Text = STR
    STR = CVar((GetTickCount - TT) / 1000) + 0.05
    If Mid(STR, 1, 1) = "." Then STR = "0" + STR
    
    STR = STR + "S"
   StatusBar.Panels(5).Text = STR
 
 Loop Until fileleng <= DataCount
  If DisFlag = True Then MsgBox "编程成功!", vbExclamation + vbOKOnly, "系统信息"
  
  StatusBar.Panels(4).Text = "编程成功 "
   OKFlag = True
 
   

End Sub

Public Sub AutoProgram()
Dim i As Byte
DisFlag = False
For i = 0 To 5
   If CHK(i).Value = 1 Then
     OKFlag = False
      Select Case (i)
         Case Is = 0
              Call SENDEraseCode
              If OKFlag = False Then GoTo ER
        Case Is = 1
              Call SENDBlankCode
              If OKFlag = False Then GoTo ER
        Case Is = 2
              Call SENDProgramCode
              If OKFlag = False Then GoTo ER
        Case Is = 5
             Call SENDResetMcuCode
             If OKFlag = False Then GoTo ER
       End Select
    End If
Next i
   MsgBox "自动编程完成!"
   Exit Sub
ER:
  MsgBox "自动编程失败!"
End Sub
Public Sub DownLoadZK()

If ProgramFlash(AM29F016Code) = False Then
  Exit Sub
End If

'If ReadFlash(AM29F016Code, AM29F016ChipCapability) = False Then
'   Exit Sub
'End If

  
End Sub

Public Function ProgramFlash(ByVal ChipCode As Byte) As Boolean
Dim DataBuf(256) As Byte, i As Byte
Dim DataCount As Long   '数据指针
Dim STR As String
Dim DataLength As Integer  '数据包数据长度
DataCount = 0
Xp_ProgressBar2.Max = fileleng
Xp_ProgressBar2.Min = 0
Xp_ProgressBar2.Value = 0
Do
 If fileleng - DataCount < 128 Then
   DataLength = fileleng - DataCount
 Else
  DataLength = 128
 End If
 CopyMemory DataBuf(5), txdatabuf(DataCount), DataLength
 STR = CStr(Hex(DataCount + ZKStartAdd))
 Select Case (Len(STR))
       Case 1
           STR = "0000000" + STR
       Case 2
           STR = "000000" + STR
       Case 3
           STR = "00000" + STR
       Case 4
           STR = "0000" + STR
       Case 5
           STR = "000" + STR
       Case 6
           STR = "00" + STR
       Case 7
           STR = "0" + STR
End Select
Xp_ProgressBar2.Value = DataCount
Xp_ProgressBar2.ToolTipText = STR
 DataBuf(0) = &H45
 DataBuf(1) = CByte("&H" + Mid(STR, 1, 2))
 DataBuf(2) = CByte("&H" + Mid(STR, 3, 2))
 DataBuf(3) = CByte("&H" + Mid(STR, 5, 2))
 DataBuf(4) = CByte("&H" + Mid(STR, 7, 2))
 SendTcpIpCommand MSComPort, ChipCode, DataLength + 5, DataBuf
 ReceiveData Frmmain.MSCOM
 If ReceiveBuf(3) = 0 Then
  If DisFlag = True Then MsgBox "连接超时!", vbExclamation + vbOKOnly, "系统信息"
   ProgramFlash = False
   OKFlag = False
   Exit Function
 Else
  If ReceiveBuf(0) = Asc("E") And ReceiveBuf(1) = Asc("R") Then
  If DisFlag = True Then MsgBox "字库下载失败!", vbExclamation + vbOKOnly, "系统信息"
    ProgramFlash = False
    OKFlag = False
    Exit Function
  End If
 End If
 DataCount = DataCount + DataLength
 Loop Until fileleng <= DataCount
 If DisFlag = True Then MsgBox "字库下载成功!", vbExclamation + vbOKOnly, "系统信息"
  ProgramFlash = True
  OKFlag = True
End Function

Public Function ReadFlash(ByVal ChipCode As Byte, ByVal ChipCapability) As Boolean
Dim DataBuf() As Byte, i As Byte
Dim DataCount As Long   '数据指针
Dim STR As String
Dim DataLength As Integer  '数据包数据长度
Dim TT As Long
Dim StrADD As Long, EndADD As Long
Dim Count As Byte
Xp_ProgressBar2.Max = ChipCapability
Xp_ProgressBar2.Min = 0
Xp_ProgressBar2.Value = 0
Do
    If ChipCapability - DataCount < 128 Then
        DataLength = ChipCapability - DataCount
    Else
        DataLength = 128
    End If
   STR = CStr(Hex(DataCount))
   Select Case (Len(STR))
       Case 1
           STR = "0000000" + STR
       Case 2
           STR = "000000" + STR
       Case 3
           STR = "00000" + STR
       Case 4
           STR = "0000" + STR
       Case 5
           STR = "000" + STR
       Case 6
           STR = "00" + STR
       Case 7
           STR = "0" + STR
    End Select
    Xp_ProgressBar2.Value = DataCount
    Xp_ProgressBar2.ToolTipText = "0x" + STR
    DataBuf(0) = &H55
    DataBuf(1) = CByte("&H" + Mid(STR, 1, 2))
    DataBuf(2) = CByte("&H" + Mid(STR, 3, 2))
    DataBuf(3) = CByte("&H" + Mid(STR, 5, 2))
    DataBuf(4) = CByte("&H" + Mid(STR, 7, 2))
    STR = CStr(Hex(DataLength))
    Select Case (Len(STR))
            Case 1
                STR = "000" + STR
            Case 2
                STR = "00" + STR
            Case 3
                STR = "0" + STR
    End Select
    DataBuf(5) = CByte("&H" + Mid(STR, 1, 2))
    DataBuf(6) = CByte("&H" + Mid(STR, 3, 2))
    
    SendTcpIpCommand MSComPort, ChipCode, 7, DataBuf
    TT = GetTickCount
    Do
        DoEvents
    Loop Until MSCOM.InBufferCount >= DataLength Or GetTickCount - TT >= 30000
    If MSCOM.InBufferCount < DataLength Then
       If DisFlag = True Then MsgBox "连接超时!", vbExclamation + vbOKOnly, "系统信息"
        ReadFlash = False
    Exit Function
     End If
    DataBuf = MSCOM.Input
    StrADD = LBound(DataBuf)
    EndADD = UBound(DataBuf)
    For Count = StrADD To EndADD        '保存数据
        rxdatabuf(DataCount + Count - StrADD) = DataBuf(Count)
    Next Count
    DataCount = DataCount + DataLength
 Loop Until fileleng <= DataCount
 
  ReadFlash = True
End Function


Public Sub SetInISP()               '发送命令,进入ISP状态
  Dim CommandString() As Byte, StringCom, STR As String
  Dim CommandLength As Long
  On Error GoTo ERCOM
   StringCom = "9600,N,8,1"

   If MSCOM.PortOpen = True Then
     MSCOM.PortOpen = False
   End If

    MSCOM.CommPort = SysInfomation.MsComNo
    MSCOM.Settings = StringCom
    MSCOM.InBufferCount = 0              '清空缓冲区
    MSCOM.InputMode = comInputModeBinary '
    MSCOM.InputLen = 0         '一次从串口读8BYTES数据
    MSCOM.RThreshold = 0         '串口接受到的数据超过6字节后引发串口事件
    MSCOM.PortOpen = True                '打开串口
    Frmmain.StatusBar.Panels(3).Text = "Status: Open"
    Frmmain.StatusBar.Panels(2).Text = "Speed 9600"
   '/ DelayNu = 0
   
  
  CommandLength = 6
  ReDim CommandString(CommandLength)
   CommandString(0) = &H1B
   CommandString(1) = &H10   '端口号
   CommandString(2) = &H95    '命令字
   CommandString(3) = 0         '包长度
   CommandString(4) = &H5       '数据长度
    
   STR = CRC16(CommandString, 5)
   Select Case (Len(STR))
          Case 1
             STR = "000" + STR
          Case 2
             STR = "00" + STR
          Case 3
             STR = "0" + STR
    End Select
    
   CommandString(5) = CByte("&H" + Mid(STR, 1, 2))
   CommandString(5 + 1) = CByte("&H" + Mid(STR, 3, 2))
  MSCOM.InBufferCount = 0
   Me.MSCOM.Output = CommandString
   ReceiveData Frmmain.MSCOM
   If ReceiveBuf(3) = 0 Then
   If DisFlag = True Then MsgBox "连接超时!", vbExclamation + vbOKOnly, "系统信息"
   StatusBar.Panels(4).Text = "连接超时 "
   OKFlag = False
 Else
  If ReceiveBuf(0) = Asc("O") And ReceiveBuf(1) = Asc("K") Then
     If DisFlag = True Then MsgBox "ISP状态!", vbExclamation + vbOKOnly, "系统信息"
     StatusBar.Panels(5).Text = "ISP状态"
     OKFlag = True
  Else
   If DisFlag = True Then MsgBox "进入ISP状态失败!", vbExclamation + vbOKOnly, "系统信息"
   StatusBar.Panels(5).Text = "进入ISP失败"
   OKFlag = False
  End If
 End If
   
   Exit Sub
ERCOM:
  MsgBox "打开串口错！"
End Sub