aduc702x_i2c_downloader.frm

ADuC7026_I2C_downloader是ADuC7026 ARM 单片机的I2C接口的烧写程序

Private Sub AboutAuthor_Click()
 Form3.Show
End Sub

Private Sub AboutDownloader_Click()
 Form2.Show
End Sub

Private Sub AutoRun_Click()
 If Check2.Value = 1 Then
  Check2.Value = 0
 Else
  Check2.Value = 1
 End If
End Sub

Private Sub AutoVerify_Click()
 If Check1.Value = 1 Then
  Check1.Value = 0
 Else
  Check1.Value = 1
 End If
End Sub

Private Sub Check1_Click()
 If Check1.Value = 1 Then
  AutoVerify.Checked = True
 Else
  AutoVerify.Checked = False
 End If
End Sub

Private Sub Check2_Click()

 If Check2.Value = 1 Then
  AutoRun.Checked = True
 Else
  AutoRun.Checked = False
 End If
 
End Sub

Private Sub Close_Click()
 Unload Me
End Sub

Private Function CheckChipID() As Boolean
  
 DataBuffer(0) = 8
 WritePacket 4, DataBuffer, 1
 ReadData 4, DataBuffer, 24

 If ((DataBuffer(0) = 65) And (DataBuffer(1) = 68) And (DataBuffer(2) = 117) And (DataBuffer(3) = 67) And (DataBuffer(4) = 55)) Then
 
 ChipID = StrConv(DataBuffer, vbUnicode)
 StatusBar1.Panels("info").Text = "Chip ID:" & ChipID
 ChipOK = True
 StatusBar1.Panels("status").Text = "Check ID OK"
 Else
 ChipOK = False
 StatusBar1.Panels("status").Text = "Check ID failed"
 End If
 
 CheckChipID = ChipOK
 
End Function

Private Sub Cal_Sum(ByRef P_Data() As Byte, ByVal Num As Byte)
 Dim i As Long
 Dim Sum As Long
 Sum = 0
 For i = 2 To Num - 1
  Sum = Sum + P_Data(i)
 Next i
 If Sum <> 0 Then
  Sum = ((Not Sum) + 1) And &HFF
 End If
 P_Data(i) = Sum
End Sub


Private Sub Combo1_Click()

 If Combo1.Text = "378H(LPT1)" Then
  PortAddr = "&H378"
  LPT1.Checked = True
  LPT2.Checked = False
  LPT3.Checked = False
 End If
  
 If Combo1.Text = "278H(LPT2)" Then
  PortAddr = "&H278"
  LPT1.Checked = False
  LPT2.Checked = True
  LPT3.Checked = False
 End If
 
 If Combo1.Text = "3BCH(LPT3)" Then
  PortAddr = "&H3BC"
  LPT1.Checked = False
  LPT2.Checked = False
  LPT3.Checked = True
 End If

End Sub



Private Sub DownLoad_Click()
 Dim NumOfLines As Long
 Dim Result As Long
 Dim i As Long
 Dim CurrentPage As Long
 Dim TotalErasePages As Long
 Dim Addr(0 To 3) As Byte
 Dim Temp As Long
 
 DownLoad.Enabled = False
 OpenFile.Enabled = False
 Run.Enabled = False
 ReadID.Enabled = False
 Verify.Enabled = False
 
 
 StatusBar1.Panels("status").Text = "Check chip ID"
 DelayTime = 10 * (10002 - Speed.Value)
 
 
 If (CheckChipID() = True) Then
  NumOfLines = Check_HEX_File(FileDir.Text)
  If NumOfLines = 0 Then
   GoTo Exit_sub
  End If
  
  Status.Caption = ""
  ProgressBar1.Visible = True
  StatusBar1.Panels("status").Text = "Erase..."
  
  
  TotalErasePages = 0
  
  For i = 0 To 200
   If PageNeedErase(i) = 1 Then
    TotalErasePages = TotalErasePages + 1
   End If
  Next
  
  CurrentPage = 0
  For i = 0 To 200
   If PageNeedErase(i) = 1 Then
   
    Temp = i * &H200
    Addr(0) = 0
    Addr(1) = 0
    Addr(2) = (Temp And &HFF00) / 256
    Addr(3) = (Temp And &HFF)
    Result = ErasePage(Addr, 1)
    
    If Result <> 6 Then
     GoTo EraseError
    End If
    CurrentPage = CurrentPage + 1
    ProgressBar1.Value = CurrentPage * 100 / TotalErasePages
   End If
  Next
  
  StatusBar1.Panels("status").Text = "Erase OK"
  
  Result = WriteOneFile(FileDir.Text, NumOfLines)
 
  ProgressBar1.Visible = False
  
  If Result = 1 Then
   Status.Caption = "下载成功！"
   If Check1.Value = 1 Then      '自动校验
    Verify_Click
   End If
   If Check2.Value = 1 Then  '自动运行
    Run_Click
   End If
  GoTo Exit_sub
  End If
  
  If Result = 0 Then
   Status.Caption = "下载失败！"
  End If
  
  Else
   MsgBox "校验芯片ID错误。请检查电路是否正确连接", vbOKOnly + vbCritical, "芯片ID错误"
  GoTo Exit_sub
 End If
 
EraseError:
 Status.Caption = "擦除失败！"
 
Exit_sub:
 DownLoad.Enabled = True
 OpenFile.Enabled = True
 Run.Enabled = True
 ReadID.Enabled = True
 Verify.Enabled = True
 
End Sub

Private Sub WritePacket(ByVal device_addr As Byte, ByRef P_Data() As Byte, ByVal Num As Byte)
 Dim i, n, DeviceAddr, WrData As Long
  Delay
  ClrSDA
  DeviceAddr = device_addr
  For i = 0 To 6
   ClrSCL
   If ((DeviceAddr And &H80) = &H80) Then
    SetSDA
   Else
    ClrSDA
   End If
   DeviceAddr = DeviceAddr * 2
   SetSCL
'   GetSCL
'   Do While SCL = False
'    GetSCL
'   Loop
  Next
  ClrSCL
  ClrSDA 'SDA输出0，表示写操作
  SetSCL
'  GetSCL
'   Do While SCL = False
'    GetSCL
'   Loop
  ClrSCL
  SetSDA '释放SDA
  SetSCL
  GetSDA
 ' MsgBox "get     sda"
  If (SDA = True) Then '设备未响应
   'MsgBox "设备未连接", vbOKOnly, "错误"
   ChipOK = False
   StatusBar1.Panels("info").Text = "No chip"
   Exit Sub
  End If
  For n = 0 To Num - 1
   WrData = P_Data(n)
   For i = 0 To 7
   ClrSCL
   If ((WrData And &H80) = &H80) Then
    SetSDA
   Else
    ClrSDA
   End If
   WrData = WrData * 2
   SetSCL
  Next
  ClrSCL
  SetSDA '释放SDA线
  SetSCL
  GetSDA
  If (SDA = True) Then '设备未响应
   'MsgBox "设备未响应", vbOKOnly, "错误"
   ChipOK = False
   StatusBar1.Panels("info").Text = "No chip"
   Exit Sub
  End If
 Next
 ClrSCL
 ClrSDA
 SetSCL
 SetSDA
End Sub

Private Sub ReadData(ByVal device_addr As Byte, ByRef P_Data() As Byte, ByVal Num As Byte)
 Dim i, n, r_data, DeviceAddr As Long
 ClrSDA
 DeviceAddr = device_addr
 For i = 0 To 6
  ClrSCL
  If ((DeviceAddr And &H80) = &H80) Then
   SetSDA
  Else
   ClrSDA
  End If
  DeviceAddr = DeviceAddr * 2
  SetSCL
 Next i
 ClrSCL
 SetSDA '读操作
 SetSCL
 ClrSCL
 SetSDA '释放SDA线
 SetSCL
 GetSDA
 If (SDA = True) Then
  'MsgBox "设备未连接"
  ChipOK = False
  StatusBar1.Panels("info").Text = "No chip"
  DataBuffer(0) = 0
  Exit Sub
 End If
 For n = 0 To Num - 1
  r_data = 0
  For i = 0 To 7
   ClrSCL
   SetSDA
   r_data = r_data * 2
   SetSCL
   GetSDA
   If (SDA = True) Then
    r_data = r_data + 1
   End If
  Next i
  P_Data(n) = r_data And &HFF
  If (n < Num - 1) Then
   ClrSCL
   ClrSDA
   SetSCL
  End If
 Next n
ClrSCL
SetSDA
SetSCL
ClrSCL
ClrSDA
SetSCL
SetSDA
P_Data(n) = 0
End Sub

Private Sub DownloaderHelp_Click()
 HelpWindow.Show
End Sub

Private Sub Exit_Click()
 Unload Form1
End Sub

Private Sub Form_Load()
 Dim Result As Boolean
 Dim PortVal As Long
 
 StatusBar1.Panels("time").Text = Time
 
 Combo1.AddItem "378H(LPT1)"
 Combo1.AddItem "278H(LPT2)"
 Combo1.AddItem "3BCH(LPT3)"
 
 
 FileDir.Text = GetSetting(App.Title, "settings", "FileDir", App.Path)

 PortAddr = GetSetting(App.Title, "settings", "PortAddr", "&H378")
 
 Speed.Value = GetSetting(App.Title, "settings", "Speed", 8000)
 
 Check1.Value = GetSetting(App.Title, "settings", "AutoVerify", 0)
 Check2.Value = GetSetting(App.Title, "settings", "AutoRun", 0)
 
 If PortAddr = "&H378" Then
  Combo1.Text = "378H(LPT1)"
 End If
  
 If PortAddr = "&H278" Then
  Combo1.Text = "278H(LPT2)"
 End If
 
 If PortAddr = "&H3BC" Then
  Combo1.Text = "3BCH(LPT3)"
 End If
 
 
 Timer1.Interval = 500
 Timer1.Enabled = True
 
 'DelayTime = 10000   '默认延时设置为10000
 
 
 If InitializeWinIo = False Then
  MsgBox "初始化并口失败！程序被迫关闭", vbOKOnly + vbCritical, "并口错误"
  Unload Me
  Exit Sub
 End If
 
 PortVal = &HF  '设置数据口为输出
 Result = SetPortVal(2 + Val(PortAddr), PortVal, 1)  '往控制端口写数据
 
 SetSCL
 SetSDA
 
 If Result = False Then MsgBox "并口错误！", vbOKOnly + vbCritical, "错误"
 
End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim PortVal As Long

PortVal = &HC4
SetPortVal 2 + Val(PortAddr), PortVal, 1  '往控制端口写数据

PortVal = &HFF
SetPortVal Val(PortAddr), PortVal, 1
ShutdownWinIo

SaveSetting App.Title, "settings", "PortAddr", PortAddr
SaveSetting App.Title, "settings", "FileDir", FileDir.Text
SaveSetting App.Title, "settings", "Speed", Speed.Value
SaveSetting App.Title, "settings", "AutoVerify", Check1.Value
SaveSetting App.Title, "settings", "AutoRun", Check2.Value

Unload Form2
Unload Form3
Unload HelpWindow

End Sub

Private Function Check_HEX_FileLine(ByRef DataLine As String) As Boolean

 Dim CheckOK As Boolean
 Dim Addr As Long
 Dim HEX_Value(0 To 50) As Byte
 Dim HEX_Char(0 To 100) As Byte
 Dim i As Long
 Dim n As Long
 Dim Sum As Long
 
 n = Len(DataLine)
 For i = 0 To n - 1
  HEX_Char(i) = Asc(Mid(DataLine, i + 1, 1))
 Next
 If HEX_Char(0) <> 58 Then
  CheckOK = False
  MsgBox "错误的HEX文件。错误原因：行没有以冒号开头"
  GoTo Exit_sub
 End If
 
 Sum = 0
 HEX_Char(n) = 0
 For i = 1 To n - 1 Step 2
  If (HEX_Char(i) - 48) > 9 Then
   HEX_Value((i - 1) / 2) = 16 * (HEX_Char(i) - 65 + 10)
  Else
   HEX_Value((i - 1) / 2) = 16 * (HEX_Char(i) - 48)
  End If
  If (HEX_Char(i + 1) - 48) > 9 Then
   HEX_Value((i - 1) / 2) = HEX_Value((i - 1) / 2) + (HEX_Char(i + 1) - 65 + 10)
  Else
   HEX_Value((i - 1) / 2) = HEX_Value((i - 1) / 2) + (HEX_Char(i + 1) - 48)
  End If
  Sum = Sum + HEX_Value((i - 1) / 2)
 Next i
 If (Sum And &HFF) = 0 Then
  CheckOK = True
 Else
  CheckOK = False
 End If
 
 If HEX_Value(3) = 0 Then 'DataLine
  If HEX_Value(0) <> 0 Then
   Addr = HEX_Value(1)
   Addr = Addr * 256 + HEX_Value(2)
   PageNeedErase((Addr And &HFE00) / &H200) = 1
   PageNeedErase(((Addr + HEX_Value(0)) And &HFE00) / &H200) = 1
  End If
 End If
 
Exit_sub:
 Check_HEX_FileLine = CheckOK
End Function

Private Function Check_HEX_File(ByRef Dir As String) As Long
 On Error GoTo Exit_sub
 Dim i As Long
 Dim FileLine As String
 Dim NumOfLines As Long
 Dim OK As Boolean
 
 
 For i = 0 To 200        '需要擦除标志清零
  PageNeedErase(i) = 0