form1.frm

目前只支持 s51

      TabIndex        =   0
      Top             =   1680
      Width           =   1455
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Dim FileTime As Variant

Private Sub AutoProg_Click()
If Check2.Value Then ReadSign_Click
If Check3.Value Then CaChu_Click
If Check4.Value Then Prog_Click
If Check5.Value Then Veri_Click
End Sub

'---------------------------------------------------------------
Private Sub CaChu_Click()
    MaxLen = 0 '
    ReadSign_Click
    EraseS51
    ShowMsg "擦除完成"
End Sub

Private Sub Check1_Click()
  Timer1.Enabled = Check1.Value
End Sub


Private Sub Command1_Click()
SetRST 1
DelayUS 100000
SetRST 0
End Sub

Private Sub Exit_Click()
 ShutdownWinIo
 End
End Sub

Private Sub Form_Load()
Dim sPath As String
HexFileNameStr = ""
SignString = ""
DelayTime = 1
sPath = App.Path
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
ChipTypeFileName = sPath & "ChipType.ini"
SysIniFileName = sPath & "ISPSys.ini"

ChipRom = 4
FileCodeLen = 0
InitPort
'GoTo ABC                         '调试使用
    If InitializeWinIo = False Then
        MsgBox "错误，无法开启端口！"
        End
    End If
ABC:
  ShowMsg "初始化完成"
  Command1_Click '硬件复位
  Timer1.Enabled = Check1.Value
End Sub

Private Sub OpenFile_Click() '打开文件按钮
  On Error GoTo Exit1
  Dim i As Integer
  Dim ii As Integer
  Dim FileNum As Integer
ABC:
    CommonDialog1.Filter = "*.HEX|*.hex"
    CommonDialog1.Action = 1
    If CommonDialog1.Filename <> "" Then
        Text1.Text = CommonDialog1.Filename
    Else
        Text1.Text = ""
        GoTo ABC
    End If
    HexFileNameStr = Text1.Text
  tmp = ""
  MaxLen = 0
  InitPBar HexFileNameStr
  Exit Sub
Exit1:
ShowMsg "读文件错误"
End Sub

Private Sub Prog_Click()
ReadSign_Click
If Trim(HexFileNameStr = "") Or (Dir(HexFileNameStr) = "") Then OpenFile_Click
InitPBar HexFileNameStr
StartProgS51
AT89S51Prog HexFileNameStr
OverProgS51
ShowMsg "编程完成"
'ReadIn_Click
End Sub


Private Sub ReadIn_Click()
Dim Addr As Integer
Dim i As Byte
Dim ii As Integer
Dim iii As Integer
Dim Abcd As Long
Dim rCode As String
Dim tmp As String
Dim temp As String
Dim ReadFileByte() As String  '64k
ReadSign_Click
Abcd = ChipRom * 1024
ReDim ReadFileByte(0 To Abcd)
List2.Clear
rCode = ""
i = 1
ii = 0
Addr = 0
Abcd = 0
tmp = ""
PBar.Value = 0
ShowMsg "开始读"
StartProgS51
MaxLen = ChipRom * 1024
PBar.Max = MaxLen + 1
Do Until Addr > MaxLen ''''''''''''''''''''''''''''''''''''''''''''''''
  tmp = Hex(Val(ReadS51(Addr)))
  ReadFileByte(Addr) = tmp
  If Len(tmp) = 1 Then tmp = "0" & tmp
  If Len(tmp) = 0 Then tmp = "FF"
  rCode = rCode & " " & tmp
  i = i + 1
  If i > 16 Then
     temp = Hex(Abcd + 1 - 16)
     Select Case Len(temp)
       Case 1
             temp = "000" & temp
       Case 2
             temp = "00" & temp
       Case 3
             temp = "0" & temp
     End Select
    If Right(temp, 1) <> ":" Then temp = temp & ":"
    ReadFileByte(ii) = temp & rCode
    rCode = ""
    i = 1
    ii = ii + 1
  End If
  Abcd = Abcd + 1
 PBar.Value = PBar.Value + 1
 Addr = Addr + 1
Loop
OverProgS51

iii = 0
For iii = ii - 1 To 0 Step -1
   If iii = 1 Then
     iii = iii
   End If
    List2.AddItem ReadFileByte(iii), 0
Next
ShowMsg "读完成"
End Sub

Private Sub ReadSign_Click()
ShowMsg "开始读特征字"
SignString = ReadSignS51
ShowMsg "读特征字完成"
ShowMsg "特征字：" & SignString
ShowMsg "该器件为：" & GetSysIni(ChipTypeFileName, Trim(SignString), "Name", "NoChip")
ChipRom = GetSysIni(ChipTypeFileName, Trim(SignString), "ROM", "0")
ChipPID = GetSysIni(ChipTypeFileName, Trim(SignString), "PID", "0")
ChipRSign = GetSysIni(ChipTypeFileName, Trim(SignString), "RSign", "0")
ChipRRsign = GetSysIni(ChipTypeFileName, Trim(SignString), "RRSign", "0")
ChipWSign = GetSysIni(ChipTypeFileName, Trim(SignString), "WSign", "0")
ChipEsign = GetSysIni(ChipTypeFileName, Trim(SignString), "Esign", "0")
End Sub

Private Sub Slider1_Scroll()
Slider1.Text = "当前速度： " & (101 - Slider1.Value)
DelayTime = Slider1.Value
ShowMsg "当前速度：" & (101 - Slider1.Value)
End Sub

Private Sub Timer1_Timer() '文件是否更新检查
    Timer1.Enabled = False
    On Err GoTo err1
    If Text1.Text <> "*.hex" And Text1.Text <> "" Then
        If FileTime <> FileDateTime(Text1) Then
            Prog_Click
            FileTime = FileDateTime(HexFileNameStr)
        End If
    End If
err1:
    Timer1.Enabled = True
End Sub


Sub InitPBar(FileN As String)
  Dim i As Integer
  Dim ii As Integer
  Dim FileNum As Integer
  Dim LineInBuf As String
  Dim ReadFileByte() As String  '64k
  Dim Abcd As Long
  Dim tmp As String
  Dim temp As String
  
  
  tmp = ""
  temp = ""
  MaxLen = 0
  ii = 0
  i = 0
  List3.Clear
  If Dir(HexFileNameStr) = "" Then
      MsgBox "未选择文件或文件不存在！"
      GoTo Exit1
  End If
  FileTime = FileDateTime(HexFileNameStr)
  FileNum = FreeFile
  Open HexFileNameStr For Input As FileNum
  Do Until EOF(FileNum)
      Line Input #FileNum, LineInBuf
      If Val("&H" + Mid$(LineInBuf, 2, 2)) <> 0 Then
        For i = 10 To Len(LineInBuf) - 2 Step 2
          tmp = Mid$(LineInBuf, i, 2)
          MaxLen = MaxLen + 1
        Next i
      End If
  Loop
  Close FileNum
  ReDim ReadFileByte(0 To MaxLen + 16)
  FileCodeLen = MaxLen + 1
  
  FileNum = FreeFile
  Open HexFileNameStr For Input As FileNum
  Do Until EOF(FileNum)
      Line Input #FileNum, LineInBuf
      If Val("&H" + Mid$(LineInBuf, 2, 2)) <> 0 Then
        ii = Val("&H" + Mid$(LineInBuf, 4, 4)) '地址
        For i = 10 To Len(LineInBuf) - 2 Step 2
          tmp = Mid$(LineInBuf, i, 2)
          ReadFileByte(ii) = tmp
          ii = ii + 1
        Next i
        ii = 0
      End If
  Loop
  Close FileNum
  PBar.Max = MaxLen + 1
  PBar.Min = 0
  PBar.Value = 0
  
  ii = 0
  tmp = ""
  For i = 0 To MaxLen - 1 + 16 '+16补上最后不到16位的数据
   If ReadFileByte(i) = "" Then
      tmp = tmp & " " & "FF"
   Else
      tmp = tmp & " " & ReadFileByte(i)
   End If
   ii = ii + 1
   If ii >= 16 Then
     temp = Hex(i - 15)
     Select Case Len(temp)
       Case 1
             temp = "000" & temp
       Case 2
             temp = "00" & temp
       Case 3
             temp = "0" & temp
     End Select
     
     If Right(temp, 1) <> ":" Then temp = temp & ":"
     List3.AddItem temp & tmp
      ii = 0
      tmp = ""
   End If
  Next
  FileTime = FileDateTime(HexFileNameStr)
  ShowMsg "读文件完成"
  Exit Sub
Exit1:
    ShowMsg "读文件错误"
End Sub

Private Sub Veri_Click()
 ReadSign_Click
 ShowMsg "共发现： " & VerifyS51(HexFileNameStr) & " 个字节不同"
End Sub


Private Sub WriteS_Click()
'ReadSign_Click
If LB1.Value Then LockBitS51 (1)
If LB2.Value Then LockBitS51 (2)
If LB3.Value Then LockBitS51 (3)
End Sub