?? frmmain.frm

?? VB寫PC端ISP程序W78E516UpdataOfVB,請配合本人用C51寫的華邦8位單片機ISP程序w78e516_ISPofC51使用
?? FRM
?? 第 1 頁 / 共 3 頁
字號:
上一頁 1 23
  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
上一頁 1 23
?? 文件大小 41 K
?? 上傳用戶 llll45356874
?? 所屬分類單片機開發
??? 相關標簽

#UpdataOfVB #ISP #516 #ISPofC
?? 快捷鍵說明

復制代碼 Ctrl + C
搜索代碼 Ctrl + F
全屏模式 F11
切換主題 Ctrl + Shift + D
顯示快捷鍵 ?
增大字號 Ctrl + =
減小字號 Ctrl + -
亚洲欧美第一页_禁久久精品乱码_粉嫩av一区二区三区免费野_久草精品视频

?? frmmain.frm

?? 快捷鍵說明
