📄 mcs51isp.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form MCS51ISP
Caption = "MCS51ISP"
ClientHeight = 3315
ClientLeft = 60
ClientTop = 345
ClientWidth = 5550
LinkTopic = "Form1"
ScaleHeight = 3315
ScaleWidth = 5550
StartUpPosition = 3 '窗口缺省
Begin MSComDlg.CommonDialog CommonDialog1
Left = 3120
Top = 2400
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.Timer Timer1
Interval = 500
Left = 4080
Top = 2400
End
Begin VB.CheckBox LB3
Caption = "LB3"
Height = 255
Left = 4440
TabIndex = 11
Top = 720
Width = 735
End
Begin VB.CheckBox LB2
Caption = "LB2"
Height = 255
Left = 3120
TabIndex = 10
Top = 720
Width = 735
End
Begin VB.CheckBox LB1
Caption = "LB1"
Height = 255
Left = 1680
TabIndex = 9
Top = 720
Width = 615
End
Begin VB.CommandButton WriteS
Caption = "写保密位"
Height = 495
Left = 240
TabIndex = 8
Top = 600
Width = 1095
End
Begin VB.CheckBox Check1
Caption = "文件更新后自动下载"
Height = 375
Left = 360
TabIndex = 7
Top = 2520
Width = 1935
End
Begin VB.TextBox Text2
Height = 375
Left = 240
TabIndex = 6
Text = "Text2"
Top = 2880
Width = 5175
End
Begin VB.CommandButton Exit
Caption = "退出"
Height = 495
Left = 4320
TabIndex = 5
Top = 1920
Width = 1095
End
Begin VB.CommandButton Eras
Caption = "全片擦除"
Height = 495
Left = 3000
TabIndex = 4
Top = 1920
Width = 1095
End
Begin VB.CommandButton Veri
Caption = "校验代码"
Height = 495
Left = 1680
TabIndex = 3
Top = 1920
Width = 1095
End
Begin VB.CommandButton Prog
Caption = "下载代码"
Height = 495
Left = 240
TabIndex = 2
Top = 1920
Width = 1095
End
Begin VB.TextBox Text1
Height = 495
Left = 1800
TabIndex = 1
Text = "Text1"
Top = 1200
Width = 3615
End
Begin VB.CommandButton OpenFile
Caption = "打开文件"
Height = 495
Left = 240
TabIndex = 0
Top = 1200
Width = 1095
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "mcudiy.com 楚浩单片机工作室"
BeginProperty Font
Name = "华文行楷"
Size = 15.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 375
Left = 1200
TabIndex = 12
Top = 0
Width = 3855
End
End
Attribute VB_Name = "MCS51ISP"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Const ptraddress = &H378
Const Delay = 2
Dim file_date
Private Function r_c(codeaddress As Integer) As Integer '读代码字节
Dim i As Integer
Dim con1 As Integer
Dim X As Integer
X = 0
outbyte (((codeaddress And &HFF00) / (2 ^ 8) * 8) And &HF8 Or 1 Or ((codeaddress And &H2000) / _
(2 ^ 11))) '合并命令与高地址字节
outbyte (codeaddress And &HFF)
For con1 = 7 To 0 Step -1
DIO_OutputByte ptraddress, 2 ^ 7 '输出时钟低电平，RST高
For i = 1 To Delay
Next i
DIO_OutputByte ptraddress, (2 ^ 7 + 2 ^ 4) '输出时钟高电平，RST高
For i = 1 To Delay
Next i
If (DIO_InputByte(ptraddress + 1)) And &H40 Then '采集数据
X = X + 2 ^ con1
End If
For i = 1 To Delay
Next i
DIO_OutputByte ptraddress, 2 ^ 7 '输出时钟低电平
Next con1
r_c = X
End Function
Private Sub w_c_b(codeaddress As Integer, codedata As Integer) '写代码字节
outbyte (((codeaddress And &HFF00) / (2 ^ 8) * 8) And &HF8 Or 2 Or ((codeaddress And &H2000) / _
(2 ^ 11))) '合并命令与高地址字节
outbyte (codeaddress And &HFF)
outbyte codedata
End Sub
Private Sub Exit_Click()
Call ShutdownWinIo
End
End Sub
Private Sub outbyte(data As Integer) '输出字节
Dim Delay As Integer
Dim i As Integer
For con = 7 To 0 Step -1
DIO_OutputByte ptraddress, 2 ^ 7 '输出时钟低电平，RST高
For i = 1 To Delay
Next i
If (data And 2 ^ con) = 2 ^ con Then '如果数据位为1则输出1
DIO_OutputByte ptraddress, (2 ^ 7 + 2 ^ 5)
For i = 1 To Delay
Next i
DIO_OutputByte ptraddress, (2 ^ 7 + 2 ^ 5 + 2 ^ 4) '输出时钟高电平
For i = 1 To Delay
Next i
DIO_OutputByte ptraddress, (2 ^ 7 + 2 ^ 5) '输出时钟低电平
Else
DIO_OutputByte ptraddress, 2 ^ 7 '如果数据位为0则输出0
For i = 1 To Delay
Next i
DIO_OutputByte ptraddress, (2 ^ 7 + 2 ^ 4) '输出时钟高电平
For i = 1 To Delay
Next i
DIO_OutputByte ptraddress, 2 ^ 7 '输出时钟低电平
End If
For i = 1 To Delay
Next i
Next con
End Sub
Private Sub Form_Load()
If InitializeWinIo = False Then
MsgBox "错误，无法开启端口！"
End
End If
Timer1.Enabled = False
Text1.Text = "*.HEX"
Text2.Text = "请选择目标文件！"
Beep
End Sub
Private Sub OpenFile_Click() '打开文件按钮
On Error GoTo errhandler
CommonDialog1.Filter = "*.HEX|*.hex"
CommonDialog1.FilterIndex = 2
CommonDialog1.ShowOpen
If CommonDialog1.FileName <> "" Then
Text1.Text = CommonDialog1.FileName
'file_date = FileDateTime(text1.Text)
End If
errhandler:
End Sub
Private Sub StartProg() '发送串行编程命令
DIO_OutputByte ptraddress, 0 '打开74hc244，点亮编程指示灯
TimeDelay (20)
DIO_OutputByte ptraddress, 2 ^ 7 '设置RST为高
TimeDelay (20)
outbyte &HAC
outbyte &H53
outbyte &H53
End Sub
Private Sub Prog_Click()
ii = 0
oo = 0
If Text1.Text = "*.hex" Or Text1.Text = "" Then
Text2.Text = "未选择文件或文件不存在，请重新选择目标文件！"
GoTo err
End If
FileNumber = FreeFile
Open Text1.Text For Input As FileNumber
StartProg
Do While Not EOF(FileNumber)
Line Input #FileNumber, inbuf
If Left$(inbuf, 1) <> ":" Then
Text2.Text = "非Inter格式Hex文件，请重新选择或进行文件转换！"
GoTo err
End If
Dim i As Integer
Dim o As Integer
o = 0
For i = 2 To Val("&h" + Mid$(inbuf, 2, 2) + 5) * 2 Step 2 '检查文件
o = (o + Val("&h" + Mid$(inbuf, i, 2))) And &HFF
Next i
If o <> 0 Then
Text2.Text = "文件检查未通过，请重新编译文件！"
GoTo err
End If
'-------------------------------------------
If Val("&h" + Mid$(inbuf, 8, 2)) > 1 Then
GoTo NEXT_LOOP
End If
'--------------------------------------------
If Val("&h" + Mid$(inbuf, 2, 2)) <> 0 Then
o = Val("&h" + Mid$(inbuf, 4, 4))
For i = 10 To Val("&h" + Mid$(inbuf, 2, 2)) * 2 + 8 Step 2
w_c_b o, Val("&h" + Mid$(inbuf, i, 2))
ii = ii + 1
Dim t As Long
t = GetTickCount
TimeDelay (3)
Text2.Text = Str$(ii) + " Bytes"
o = o + 1
DoEvents
Next i
End If
NEXT_LOOP:
Loop
err:
DoEvents
DIO_OutputByte ptraddress, 2 ^ 3
Close FileNumber
Beep
End Sub
'---------------------------------------------------------------
Private Sub Eras_Click() '全片擦除
StartProg
outbyte &HAC
outbyte &HAC
outbyte &HAC
TimeDelay (50)
DIO_OutputByte ptraddress, 2 ^ 3
End Sub
Private Sub Veri_Click() '校验文件
FileNumber = FreeFile
If Text1.Text = "*.hex" Or Text1.Text = "" Then
Text2.Text = "请选择目标文件！"
GoTo err
End If
Open (Text1.Text) For Input As FileNumber
StartProg
Do While Not EOF(FileNumber)
Line Input #FileNumber, inbuf
If Left$(inbuf, 1) <> ":" Then
Text2.Text = "非Inter格式Hex文件，请重新选择！"
GoTo err
End If
'-------------------------------------------
If Val("&h" + Mid$(inbuf, 8, 2)) > 1 Then
GoTo NEXT_LOOP
End If
'--------------------------------------------
Dim i As Integer
Dim o As Integer
If Val("&h" + Mid$(inbuf, 2, 2)) <> 0 Then
o = Val("&h" + Mid$(inbuf, 4, 4))
For i = 10 To Val("&h" + Mid$(inbuf, 2, 2)) * 2 + 8 Step 2
If r_c(o) <> Val("&h" + Mid$(inbuf, i, 2)) Then
oo = oo + 1
End If
o = o + 1
ii = ii + 1
Text2.Text = Str$(ii) + " Bytes"
DoEvents
Next i
End If
NEXT_LOOP:
Loop
If oo = 0 Then
Text2.Text = "文件检验通过"
Else
Text2.Text = "文件检验共发现" + Str$(oo) + "字节错误！"
End If
err:
DIO_OutputByte ptraddress, 2 ^ 3
Close FileNumber
Beep
End Sub
Private Sub WriteS_Click()
Dim temp As Integer
StartProg
outbyte &HAC
temp = &HFF
If LB1.Value = 1 Then
temp = temp And &H7F
End If
If LB2.Value = 1 Then
temp = temp And &HBF
End If
If LB3.Value = 1 Then
temp = temp And &HDF
End If
outbyte temp
outbyte temp
Text2.Text = "OK!"
TimeDelay (20)
DIO_OutputByte ptraddress, 2 ^ 3
End Sub
Private Sub check1_click() '文件更新后自动重下载
If Check1.Value = 1 Then
Timer1.Enabled = True
If Text1.Text <> "*.hex" And Text1.Text <> "" Then
file_data = FileDateTime(Text1)
End If
Else
Timer1.Enabled = False
End If
End Sub
Private Sub Timer1_Timer() '文件是否更新检查
Timer1.Enabled = False
On err GoTo err1
If Text1.Text <> "*.hex" And Text1.Text <> "" Then
If file_date <> FileDateTime(Text1) Then
Prog_Click
file_date = FileDateTime(Text1)
End If
End If
err1:
Timer1.Enabled = True
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -